93 |
(require 'gud) |
(require 'gud) |
94 |
|
|
95 |
(defvar tool-bar-map) |
(defvar tool-bar-map) |
96 |
|
(defvar speedbar-initial-expansion-list-name) |
97 |
|
|
98 |
(defvar gdb-frame-address "main" "Initialization for Assembler buffer.") |
(defvar gdb-frame-address "main" "Initialization for Assembler buffer.") |
99 |
(defvar gdb-previous-frame-address nil) |
(defvar gdb-previous-frame-address nil) |
157 |
"A list of trigger functions that have run later than their output |
"A list of trigger functions that have run later than their output |
158 |
handlers.") |
handlers.") |
159 |
|
|
160 |
;; end of gdb variables |
(defvar gdb-first-post-prompt nil) |
161 |
|
(defvar gdb-version nil) |
162 |
|
(defvar gdb-locals-font-lock-keywords nil) |
163 |
|
(defconst gdb-error-regexp "\\^error,msg=\"\\(.+\\)\"") |
164 |
|
|
165 |
|
(defvar gdb-locals-font-lock-keywords-1 |
166 |
|
'( |
167 |
|
;; var = (struct struct_tag) value |
168 |
|
( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)" |
169 |
|
(1 font-lock-variable-name-face) |
170 |
|
(3 font-lock-keyword-face) |
171 |
|
(4 font-lock-type-face)) |
172 |
|
;; var = (type) value |
173 |
|
( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)" |
174 |
|
(1 font-lock-variable-name-face) |
175 |
|
(3 font-lock-type-face)) |
176 |
|
;; var = val |
177 |
|
( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]" |
178 |
|
(1 font-lock-variable-name-face)) |
179 |
|
) |
180 |
|
"Font lock keywords used in `gdb-local-mode'.") |
181 |
|
|
182 |
|
(defvar gdb-locals-font-lock-keywords-2 |
183 |
|
'( |
184 |
|
;; var = type value |
185 |
|
( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)" |
186 |
|
(1 font-lock-variable-name-face) |
187 |
|
(3 font-lock-type-face)) |
188 |
|
) |
189 |
|
"Font lock keywords used in `gdb-local-mode'.") |
190 |
|
|
191 |
|
;; Variables for GDB 6.4+ |
192 |
|
|
193 |
|
(defvar gdb-source-file-list nil |
194 |
|
"List of source files for the current executable") |
195 |
|
(defvar gdb-register-names nil "List of register names.") |
196 |
|
(defvar gdb-changed-registers nil |
197 |
|
"List of changed register numbers (strings).") |
198 |
|
|
199 |
;;;###autoload |
;;;###autoload |
200 |
(defun gdba (command-line) |
(defun gdba (command-line) |
251 |
;; |
;; |
252 |
;; Let's start with a basic gud-gdb buffer and then modify it a bit. |
;; Let's start with a basic gud-gdb buffer and then modify it a bit. |
253 |
(gdb command-line) |
(gdb command-line) |
254 |
(gdb-ann3)) |
(gdb-init-1)) |
255 |
|
|
256 |
(defvar gdb-debug-log nil) |
(defvar gdb-debug-log nil) |
257 |
|
|
394 |
(setq expr (concat (car var1) "." (match-string 2 varno))))) |
(setq expr (concat (car var1) "." (match-string 2 varno))))) |
395 |
expr)) |
expr)) |
396 |
|
|
397 |
(defun gdb-ann3 () |
(defun gdb-init-1 () |
398 |
(setq gdb-debug-log nil) |
(setq gdb-debug-log nil) |
399 |
(set (make-local-variable 'gud-minor-mode) 'gdba) |
(set (make-local-variable 'gud-minor-mode) 'gdba) |
400 |
(set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) |
(set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) |
451 |
'gdb-mouse-toggle-breakpoint-fringe) |
'gdb-mouse-toggle-breakpoint-fringe) |
452 |
|
|
453 |
(setq comint-input-sender 'gdb-send) |
(setq comint-input-sender 'gdb-send) |
454 |
;; |
|
455 |
;; (re-)initialize |
;; (re-)initialize |
456 |
(setq gdb-frame-address (if gdb-show-main "main" nil)) |
(setq gdb-frame-address (if gdb-show-main "main" nil)) |
457 |
(setq gdb-previous-frame-address nil |
(setq gdb-previous-frame-address nil |
462 |
gdb-frame-number nil |
gdb-frame-number nil |
463 |
gdb-var-list nil |
gdb-var-list nil |
464 |
gdb-var-changed nil |
gdb-var-changed nil |
465 |
gdb-first-prompt nil |
gdb-first-post-prompt t |
466 |
gdb-prompting nil |
gdb-prompting nil |
467 |
gdb-input-queue nil |
gdb-input-queue nil |
468 |
gdb-current-item nil |
gdb-current-item nil |
472 |
gdb-flush-pending-output nil |
gdb-flush-pending-output nil |
473 |
gdb-location-alist nil |
gdb-location-alist nil |
474 |
gdb-find-file-unhook nil |
gdb-find-file-unhook nil |
475 |
|
gdb-source-file-list nil |
476 |
gdb-error nil |
gdb-error nil |
477 |
gdb-macro-info nil |
gdb-macro-info nil |
478 |
gdb-buffer-fringe-width (car (window-fringes))) |
gdb-buffer-fringe-width (car (window-fringes))) |
479 |
;; |
|
480 |
(setq gdb-buffer-type 'gdba) |
(setq gdb-buffer-type 'gdba) |
481 |
;; |
|
482 |
(if gdb-use-inferior-io-buffer (gdb-clear-inferior-io)) |
(if gdb-use-inferior-io-buffer (gdb-clear-inferior-io)) |
483 |
;; |
|
484 |
|
;; Hack to see test for GDB 6.4+ (-stack-info-frame was implemented in 6.4) |
485 |
|
(setq gdb-version nil) |
486 |
|
(gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n" |
487 |
|
'gdb-get-version))) |
488 |
|
|
489 |
|
(defun gdb-init-2 () |
490 |
(if (eq window-system 'w32) |
(if (eq window-system 'w32) |
491 |
(gdb-enqueue-input (list "set new-console off\n" 'ignore))) |
(gdb-enqueue-input (list "set new-console off\n" 'ignore))) |
492 |
(gdb-enqueue-input (list "set height 0\n" 'ignore)) |
(gdb-enqueue-input (list "set height 0\n" 'ignore)) |
495 |
(gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program |
(gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program |
496 |
(gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program |
(gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program |
497 |
(gdb-enqueue-input (list "server info source\n" 'gdb-source-info)) |
(gdb-enqueue-input (list "server info source\n" 'gdb-source-info)) |
498 |
;; |
|
499 |
(gdb-set-gud-minor-mode-existing-buffers) |
(if (string-equal gdb-version "pre-6.4") |
500 |
|
(progn |
501 |
|
(gdb-set-gud-minor-mode-existing-buffers) |
502 |
|
(setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-1)) |
503 |
|
(gdb-enqueue-input |
504 |
|
(list "server interpreter mi -data-list-register-names\n" |
505 |
|
'gdb-get-register-names)) |
506 |
|
; Needs GDB 6.2 onwards. |
507 |
|
(gdb-enqueue-input |
508 |
|
(list "server interpreter mi \"-file-list-exec-source-files\"\n" |
509 |
|
'gdb-set-gud-minor-mode-existing-buffers-1)) |
510 |
|
(setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)) |
511 |
|
|
512 |
(run-hooks 'gdba-mode-hook)) |
(run-hooks 'gdba-mode-hook)) |
513 |
|
|
514 |
|
(defun gdb-get-version () |
515 |
|
(goto-char (point-min)) |
516 |
|
(if (and (re-search-forward gdb-error-regexp nil t) |
517 |
|
(string-match ".*(missing implementation)" (match-string 1))) |
518 |
|
(setq gdb-version "pre-6.4") |
519 |
|
(setq gdb-version "6.4+")) |
520 |
|
(gdb-init-2)) |
521 |
|
|
522 |
(defun gdb-mouse-until (event) |
(defun gdb-mouse-until (event) |
523 |
"Execute source lines by dragging the overlay arrow (fringe) with the mouse." |
"Execute source lines by dragging the overlay arrow (fringe) with the mouse." |
524 |
(interactive "e") |
(interactive "e") |
569 |
:group 'gud |
:group 'gud |
570 |
:version "22.1") |
:version "22.1") |
571 |
|
|
572 |
(defun gud-watch () |
(defun gud-watch (&optional event) |
573 |
"Watch expression at point." |
"Watch expression at point." |
574 |
(interactive) |
(interactive (list last-input-event)) |
575 |
|
(if event (posn-set-point (event-end event))) |
576 |
(require 'tooltip) |
(require 'tooltip) |
577 |
(save-selected-window |
(save-selected-window |
578 |
(let ((expr (tooltip-identifier-from-point (point)))) |
(let ((expr (tooltip-identifier-from-point (point)))) |
758 |
INDENT is the current indentation depth." |
INDENT is the current indentation depth." |
759 |
(cond ((string-match "+" text) ;expand this node |
(cond ((string-match "+" text) ;expand this node |
760 |
(if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) |
(if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) |
761 |
(gdb-var-list-children token) |
(if (string-equal gdb-version "pre-6.4") |
762 |
|
(gdb-var-list-children token) |
763 |
|
(gdb-var-list-children-1 token)) |
764 |
(progn |
(progn |
765 |
(gdbmi-var-update) |
(gdbmi-var-update) |
766 |
(gdbmi-var-list-children token)))) |
(gdbmi-var-list-children token)))) |
849 |
;; GUD buffers are an exception to the rules |
;; GUD buffers are an exception to the rules |
850 |
(gdb-set-buffer-rules 'gdba 'error) |
(gdb-set-buffer-rules 'gdba 'error) |
851 |
|
|
|
;; |
|
852 |
;; Partial-output buffer : This accumulates output from a command executed on |
;; Partial-output buffer : This accumulates output from a command executed on |
853 |
;; behalf of emacs (rather than the user). |
;; behalf of emacs (rather than the user). |
854 |
;; |
;; |
944 |
(get-buffer-process gud-comint-buffer))) |
(get-buffer-process gud-comint-buffer))) |
945 |
|
|
946 |
|
|
|
;; |
|
947 |
;; gdb communications |
;; gdb communications |
948 |
;; |
;; |
949 |
|
|
1097 |
(defun gdb-prompt (ignored) |
(defun gdb-prompt (ignored) |
1098 |
"An annotation handler for `prompt'. |
"An annotation handler for `prompt'. |
1099 |
This sends the next command (if any) to gdb." |
This sends the next command (if any) to gdb." |
1100 |
(when gdb-first-prompt (gdb-ann3)) |
(when gdb-first-prompt |
1101 |
|
(gdb-init-1) |
1102 |
|
(setq gdb-first-prompt nil)) |
1103 |
(let ((sink gdb-output-sink)) |
(let ((sink gdb-output-sink)) |
1104 |
(cond |
(cond |
1105 |
((eq sink 'user) t) |
((eq sink 'user) t) |
1196 |
"An annotation handler for `post-prompt'. |
"An annotation handler for `post-prompt'. |
1197 |
This begins the collection of output from the current command if that |
This begins the collection of output from the current command if that |
1198 |
happens to be appropriate." |
happens to be appropriate." |
1199 |
(unless gdb-pending-triggers |
;; Don't add to queue if there outstanding items or GDB is not known yet. |
1200 |
|
(unless (or gdb-pending-triggers gdb-first-post-prompt) |
1201 |
(gdb-get-selected-frame) |
(gdb-get-selected-frame) |
1202 |
(gdb-invalidate-frames) |
(gdb-invalidate-frames) |
1203 |
(gdb-invalidate-breakpoints) |
(gdb-invalidate-breakpoints) |
1204 |
;; Do this through gdb-get-selected-frame -> gdb-frame-handler |
;; Do this through gdb-get-selected-frame -> gdb-frame-handler |
1205 |
;; so gdb-frame-address is updated. |
;; so gdb-frame-address is updated. |
1206 |
;; (gdb-invalidate-assembler) |
;; (gdb-invalidate-assembler) |
1207 |
(gdb-invalidate-registers) |
|
1208 |
|
(if (string-equal gdb-version "pre-6.4") |
1209 |
|
(gdb-invalidate-registers) |
1210 |
|
(gdb-get-changed-registers) |
1211 |
|
(gdb-invalidate-registers-1)) |
1212 |
|
|
1213 |
(gdb-invalidate-memory) |
(gdb-invalidate-memory) |
1214 |
(gdb-invalidate-locals) |
(if (string-equal gdb-version "pre-6.4") |
1215 |
|
(gdb-invalidate-locals) |
1216 |
|
(gdb-invalidate-locals-1)) |
1217 |
|
|
1218 |
(gdb-invalidate-threads) |
(gdb-invalidate-threads) |
1219 |
(unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. |
(unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. |
1220 |
;; FIXME: with GDB-6 on Darwin, this might very well work. |
;; FIXME: with GDB-6 on Darwin, this might very well work. |
1223 |
(setq gdb-var-changed t) ; force update |
(setq gdb-var-changed t) ; force update |
1224 |
(dolist (var gdb-var-list) |
(dolist (var gdb-var-list) |
1225 |
(setcar (nthcdr 5 var) nil)) |
(setcar (nthcdr 5 var) nil)) |
1226 |
(gdb-var-update)))) |
(if (string-equal gdb-version "pre-6.4") |
1227 |
|
(gdb-var-update) |
1228 |
|
(gdb-var-update-1))))) |
1229 |
|
(setq gdb-first-post-prompt nil) |
1230 |
(let ((sink gdb-output-sink)) |
(let ((sink gdb-output-sink)) |
1231 |
(cond |
(cond |
1232 |
((eq sink 'user) t) |
((eq sink 'user) t) |
1988 |
\\{gdb-registers-mode-map}" |
\\{gdb-registers-mode-map}" |
1989 |
(kill-all-local-variables) |
(kill-all-local-variables) |
1990 |
(setq major-mode 'gdb-registers-mode) |
(setq major-mode 'gdb-registers-mode) |
1991 |
(setq mode-name (if gdb-all-registers "Registers:All" "Registers:")) |
(setq mode-name "Registers") |
1992 |
(setq buffer-read-only t) |
(setq buffer-read-only t) |
1993 |
(use-local-map gdb-registers-mode-map) |
(use-local-map gdb-registers-mode-map) |
1994 |
(run-mode-hooks 'gdb-registers-mode-hook) |
(run-mode-hooks 'gdb-registers-mode-hook) |
1995 |
(if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) |
(if (string-equal gdb-version "pre-6.4") |
1996 |
'gdb-invalidate-registers |
(progn |
1997 |
'gdbmi-invalidate-registers)) |
(if gdb-all-registers (setq mode-name "Registers:All")) |
1998 |
|
'gdb-invalidate-registers) |
1999 |
|
'gdb-invalidate-registers-1)) |
2000 |
|
|
2001 |
(defun gdb-registers-buffer-name () |
(defun gdb-registers-buffer-name () |
2002 |
(with-current-buffer gud-comint-buffer |
(with-current-buffer gud-comint-buffer |
2016 |
(display-buffer (gdb-get-create-buffer 'gdb-registers-buffer)))) |
(display-buffer (gdb-get-create-buffer 'gdb-registers-buffer)))) |
2017 |
|
|
2018 |
(defun gdb-all-registers () |
(defun gdb-all-registers () |
2019 |
"Toggle the display of floating-point registers." |
"Toggle the display of floating-point registers (pre GDB 6.4 only)." |
2020 |
(interactive) |
(interactive) |
2021 |
(if gdb-all-registers |
(when (string-equal gdb-version "pre-6.4") |
2022 |
(progn |
(if gdb-all-registers |
2023 |
(setq gdb-all-registers nil) |
(progn |
2024 |
(with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer) |
(setq gdb-all-registers nil) |
2025 |
(setq mode-name "Registers:"))) |
(with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer) |
2026 |
(setq gdb-all-registers t) |
(setq mode-name "Registers"))) |
2027 |
(with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer) |
(setq gdb-all-registers t) |
2028 |
(setq mode-name "Registers:All"))) |
(with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer) |
2029 |
(message (format "Display of floating-point registers %sabled" |
(setq mode-name "Registers:All"))) |
2030 |
(if gdb-all-registers "en" "dis"))) |
(message (format "Display of floating-point registers %sabled" |
2031 |
(gdb-invalidate-registers)) |
(if gdb-all-registers "en" "dis"))) |
2032 |
|
(gdb-invalidate-registers))) |
2033 |
|
|
2034 |
|
|
2035 |
;; Memory buffer. |
;; Memory buffer. |
2133 |
(customize-set-variable 'gdb-memory-format "x") |
(customize-set-variable 'gdb-memory-format "x") |
2134 |
(gdb-invalidate-memory)) |
(gdb-invalidate-memory)) |
2135 |
|
|
2136 |
(defvar gdb-memory-format-keymap |
(defvar gdb-memory-format-map |
2137 |
(let ((map (make-sparse-keymap))) |
(let ((map (make-sparse-keymap))) |
2138 |
(define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1) |
(define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1) |
2139 |
map) |
map) |
2195 |
(customize-set-variable 'gdb-memory-unit "b") |
(customize-set-variable 'gdb-memory-unit "b") |
2196 |
(gdb-invalidate-memory)) |
(gdb-invalidate-memory)) |
2197 |
|
|
2198 |
(defvar gdb-memory-unit-keymap |
(defvar gdb-memory-unit-map |
2199 |
(let ((map (make-sparse-keymap))) |
(let ((map (make-sparse-keymap))) |
2200 |
(define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1) |
(define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1) |
2201 |
map) |
map) |
2310 |
'face font-lock-warning-face |
'face font-lock-warning-face |
2311 |
'help-echo "mouse-3: Select display format" |
'help-echo "mouse-3: Select display format" |
2312 |
'mouse-face 'mode-line-highlight |
'mouse-face 'mode-line-highlight |
2313 |
'local-map gdb-memory-format-keymap) |
'local-map gdb-memory-format-map) |
2314 |
" Unit Size: " |
" Unit Size: " |
2315 |
(propertize gdb-memory-unit |
(propertize gdb-memory-unit |
2316 |
'face font-lock-warning-face |
'face font-lock-warning-face |
2317 |
'help-echo "mouse-3: Select unit size" |
'help-echo "mouse-3: Select unit size" |
2318 |
'mouse-face 'mode-line-highlight |
'mouse-face 'mode-line-highlight |
2319 |
'local-map gdb-memory-unit-keymap)))) |
'local-map gdb-memory-unit-map)))) |
2320 |
(set (make-local-variable 'font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) |
2321 |
'(gdb-memory-font-lock-keywords)) |
'(gdb-memory-font-lock-keywords)) |
2322 |
(run-mode-hooks 'gdb-memory-mode-hook) |
(run-mode-hooks 'gdb-memory-mode-hook) |
2351 |
"server info locals\n" |
"server info locals\n" |
2352 |
gdb-info-locals-handler) |
gdb-info-locals-handler) |
2353 |
|
|
2354 |
(defvar gdb-locals-watch-keymap |
(defvar gdb-locals-watch-map |
2355 |
(let ((map (make-sparse-keymap))) |
(let ((map (make-sparse-keymap))) |
2356 |
(define-key map "\r" '(lambda () (interactive) |
(define-key map "\r" '(lambda () (interactive) |
2357 |
(beginning-of-line) |
(beginning-of-line) |
2367 |
(concat (propertize "[struct/union]" |
(concat (propertize "[struct/union]" |
2368 |
'mouse-face 'highlight |
'mouse-face 'highlight |
2369 |
'help-echo "mouse-2: create watch expression" |
'help-echo "mouse-2: create watch expression" |
2370 |
'local-map gdb-locals-watch-keymap) "\n")) |
'local-map gdb-locals-watch-map) "\n")) |
2371 |
|
|
2372 |
(defconst gdb-array-string |
(defconst gdb-array-string |
2373 |
(concat " " (propertize "[array]" |
(concat " " (propertize "[array]" |
2374 |
'mouse-face 'highlight |
'mouse-face 'highlight |
2375 |
'help-echo "mouse-2: create watch expression" |
'help-echo "mouse-2: create watch expression" |
2376 |
'local-map gdb-locals-watch-keymap) "\n")) |
'local-map gdb-locals-watch-map) "\n")) |
2377 |
|
|
2378 |
;; Abbreviate for arrays and structures. |
;; Abbreviate for arrays and structures. |
2379 |
;; These can be expanded using gud-display. |
;; These can be expanded using gud-display. |
2409 |
(define-key map "q" 'kill-this-buffer) |
(define-key map "q" 'kill-this-buffer) |
2410 |
map)) |
map)) |
2411 |
|
|
|
(defvar gdb-locals-font-lock-keywords |
|
|
'( |
|
|
;; var = (struct struct_tag) value |
|
|
( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)" |
|
|
(1 font-lock-variable-name-face) |
|
|
(3 font-lock-keyword-face) |
|
|
(4 font-lock-type-face)) |
|
|
;; var = (type) value |
|
|
( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)" |
|
|
(1 font-lock-variable-name-face) |
|
|
(3 font-lock-type-face)) |
|
|
;; var = val |
|
|
( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]" |
|
|
(1 font-lock-variable-name-face)) |
|
|
) |
|
|
"Font lock keywords used in `gdb-local-mode'.") |
|
|
|
|
2412 |
(defun gdb-locals-mode () |
(defun gdb-locals-mode () |
2413 |
"Major mode for gdb locals. |
"Major mode for gdb locals. |
2414 |
|
|
2422 |
'(gdb-locals-font-lock-keywords)) |
'(gdb-locals-font-lock-keywords)) |
2423 |
(run-mode-hooks 'gdb-locals-mode-hook) |
(run-mode-hooks 'gdb-locals-mode-hook) |
2424 |
(if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) |
(if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) |
2425 |
'gdb-invalidate-locals |
(if (string-equal gdb-version "pre-6.4") |
2426 |
|
'gdb-invalidate-locals |
2427 |
|
'gdb-invalidate-locals-1) |
2428 |
'gdbmi-invalidate-locals)) |
'gdbmi-invalidate-locals)) |
2429 |
|
|
2430 |
(defun gdb-locals-buffer-name () |
(defun gdb-locals-buffer-name () |
2682 |
(add-hook 'find-file-hook 'gdb-find-file-hook) |
(add-hook 'find-file-hook 'gdb-find-file-hook) |
2683 |
|
|
2684 |
(defun gdb-find-file-hook () |
(defun gdb-find-file-hook () |
2685 |
"Set up buffer for debugging if file is part of the source code |
"Set up buffer for debugging if file is part of the source code |
2686 |
of the current session." |
of the current session." |
2687 |
(if (and (not gdb-find-file-unhook) |
(if (and (buffer-name gud-comint-buffer) |
2688 |
;; in case gud or gdb-ui is just loaded |
;; in case gud or gdb-ui is just loaded |
2689 |
gud-comint-buffer |
gud-comint-buffer |
|
(buffer-name gud-comint-buffer) |
|
2690 |
(eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) |
(eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) |
2691 |
'gdba)) |
'gdba)) |
2692 |
(condition-case nil |
(if (string-equal gdb-version "pre-6.4") |
2693 |
(gdb-enqueue-input |
(condition-case nil |
2694 |
(list (concat gdb-server-prefix "list " |
(gdb-enqueue-input |
2695 |
(file-name-nondirectory buffer-file-name) |
(list (concat gdb-server-prefix "list " |
2696 |
":1\n") |
(file-name-nondirectory buffer-file-name) |
2697 |
`(lambda () (gdb-set-gud-minor-mode ,(current-buffer))))) |
":1\n") |
2698 |
(error (setq gdb-find-file-unhook t))))) |
`(lambda () (gdb-set-gud-minor-mode ,(current-buffer))))) |
2699 |
|
(error (setq gdb-find-file-unhook t))) |
2700 |
|
(if (member buffer-file-name gdb-source-file-list) |
2701 |
|
(with-current-buffer (find-buffer-visiting buffer-file-name) |
2702 |
|
(set (make-local-variable 'gud-minor-mode) 'gdba) |
2703 |
|
(set (make-local-variable 'tool-bar-map) gud-tool-bar-map)))))) |
2704 |
|
|
2705 |
;;from put-image |
;;from put-image |
2706 |
(defun gdb-put-string (putstring pos &optional dprop &rest sprops) |
(defun gdb-put-string (putstring pos &optional dprop &rest sprops) |
2979 |
(setq gdb-current-language (match-string 1))) |
(setq gdb-current-language (match-string 1))) |
2980 |
(gdb-invalidate-assembler)) |
(gdb-invalidate-assembler)) |
2981 |
|
|
2982 |
|
;; Code specific to GDB 6.4 |
2983 |
|
|
2984 |
|
(defconst gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") |
2985 |
|
|
2986 |
|
(defun gdb-set-gud-minor-mode-existing-buffers-1 () |
2987 |
|
"Create list of source files for current GDB session." |
2988 |
|
(goto-char (point-min)) |
2989 |
|
(while (re-search-forward gdb-source-file-regexp nil t) |
2990 |
|
(push (match-string 1) gdb-source-file-list)) |
2991 |
|
(dolist (buffer (buffer-list)) |
2992 |
|
(with-current-buffer buffer |
2993 |
|
(when (member buffer-file-name gdb-source-file-list) |
2994 |
|
(set (make-local-variable 'gud-minor-mode) 'gdba) |
2995 |
|
(set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
2996 |
|
(when gud-tooltip-mode |
2997 |
|
(make-local-variable 'gdb-define-alist) |
2998 |
|
(gdb-create-define-alist) |
2999 |
|
(add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))) |
3000 |
|
|
3001 |
|
; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. |
3002 |
|
(defun gdb-var-list-children-1 (varnum) |
3003 |
|
(gdb-enqueue-input |
3004 |
|
(list (concat "server interpreter mi \"-var-update " varnum "\"\n") |
3005 |
|
'ignore)) |
3006 |
|
(gdb-enqueue-input |
3007 |
|
(list (concat "server interpreter mi \"-var-list-children --all-values " |
3008 |
|
varnum "\"\n") |
3009 |
|
`(lambda () (gdb-var-list-children-handler-1 ,varnum))))) |
3010 |
|
|
3011 |
|
(defconst gdb-var-list-children-regexp-1 |
3012 |
|
"name=\"\\(.+?\\)\",exp=\"\\(.+?\\)\",numchild=\"\\(.+?\\)\",\ |
3013 |
|
value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") |
3014 |
|
|
3015 |
|
(defun gdb-var-list-children-handler-1 (varnum) |
3016 |
|
(goto-char (point-min)) |
3017 |
|
(let ((var-list nil)) |
3018 |
|
(catch 'child-already-watched |
3019 |
|
(dolist (var gdb-var-list) |
3020 |
|
(if (string-equal varnum (cadr var)) |
3021 |
|
(progn |
3022 |
|
(push var var-list) |
3023 |
|
(while (re-search-forward gdb-var-list-children-regexp-1 nil t) |
3024 |
|
(let ((varchild (list (match-string 2) |
3025 |
|
(match-string 1) |
3026 |
|
(match-string 3) |
3027 |
|
(match-string 5) |
3028 |
|
(read (match-string 4)) |
3029 |
|
nil))) |
3030 |
|
(dolist (var1 gdb-var-list) |
3031 |
|
(if (string-equal (cadr var1) (cadr varchild)) |
3032 |
|
(throw 'child-already-watched nil))) |
3033 |
|
(push varchild var-list)))) |
3034 |
|
(push var var-list))) |
3035 |
|
(setq gdb-var-changed t) |
3036 |
|
(setq gdb-var-list (nreverse var-list))))) |
3037 |
|
|
3038 |
|
; Uses "-var-update --all-values". Needs GDB 6.4 onwards. |
3039 |
|
(defun gdb-var-update-1 () |
3040 |
|
(if (not (member 'gdb-var-update gdb-pending-triggers)) |
3041 |
|
(progn |
3042 |
|
(gdb-enqueue-input |
3043 |
|
(list |
3044 |
|
(if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) |
3045 |
|
"server interpreter mi \"-var-update --all-values *\"\n" |
3046 |
|
"-var-update --all-values *\n") |
3047 |
|
'gdb-var-update-handler-1)) |
3048 |
|
(push 'gdb-var-update gdb-pending-triggers)))) |
3049 |
|
|
3050 |
|
(defconst gdb-var-update-regexp-1 "name=\"\\(.*?\\)\",value=\\(\".*?\"\\),") |
3051 |
|
|
3052 |
|
(defun gdb-var-update-handler-1 () |
3053 |
|
(goto-char (point-min)) |
3054 |
|
(while (re-search-forward gdb-var-update-regexp-1 nil t) |
3055 |
|
(let ((varnum (match-string 1))) |
3056 |
|
(catch 'var-found1 |
3057 |
|
(let ((num 0)) |
3058 |
|
(dolist (var gdb-var-list) |
3059 |
|
(if (string-equal varnum (cadr var)) |
3060 |
|
(progn |
3061 |
|
(setcar (nthcdr 5 var) t) |
3062 |
|
(setcar (nthcdr 4 var) (read (match-string 2))) |
3063 |
|
(setcar (nthcdr num gdb-var-list) var) |
3064 |
|
(throw 'var-found1 nil))) |
3065 |
|
(setq num (+ num 1)))))) |
3066 |
|
(setq gdb-var-changed t)) |
3067 |
|
(setq gdb-pending-triggers |
3068 |
|
(delq 'gdb-var-update gdb-pending-triggers)) |
3069 |
|
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) |
3070 |
|
;; dummy command to update speedbar at right time |
3071 |
|
(gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn)) |
3072 |
|
;; keep gdb-pending-triggers non-nil till end |
3073 |
|
(push 'gdb-speedbar-timer gdb-pending-triggers))) |
3074 |
|
|
3075 |
|
;; Registers buffer. |
3076 |
|
;; |
3077 |
|
(gdb-set-buffer-rules 'gdb-registers-buffer |
3078 |
|
'gdb-registers-buffer-name |
3079 |
|
'gdb-registers-mode) |
3080 |
|
|
3081 |
|
(def-gdb-auto-update-trigger gdb-invalidate-registers-1 |
3082 |
|
(gdb-get-buffer 'gdb-registers-buffer) |
3083 |
|
(if (eq gud-minor-mode 'gdba) |
3084 |
|
"server interpreter mi \"-data-list-register-values x\"\n" |
3085 |
|
"-data-list-register-values x\n") |
3086 |
|
gdb-data-list-register-values-handler) |
3087 |
|
|
3088 |
|
(defconst gdb-data-list-register-values-regexp |
3089 |
|
"number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"") |
3090 |
|
|
3091 |
|
(defun gdb-data-list-register-values-handler () |
3092 |
|
(setq gdb-pending-triggers (delq 'gdb-invalidate-registers |
3093 |
|
gdb-pending-triggers)) |
3094 |
|
(goto-char (point-min)) |
3095 |
|
(if (re-search-forward gdb-error-regexp nil t) |
3096 |
|
(with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) |
3097 |
|
(let ((buffer-read-only nil)) |
3098 |
|
(erase-buffer) |
3099 |
|
(insert (match-string 1)) |
3100 |
|
(goto-char (point-min)))) |
3101 |
|
(let ((register-list (reverse gdb-register-names)) |
3102 |
|
(register nil) (register-string nil) (register-values nil)) |
3103 |
|
(goto-char (point-min)) |
3104 |
|
(while (re-search-forward gdb-data-list-register-values-regexp nil t) |
3105 |
|
(setq register (pop register-list)) |
3106 |
|
(setq register-string (concat register "\t" (match-string 2) "\n")) |
3107 |
|
(if (member (match-string 1) gdb-changed-registers) |
3108 |
|
(put-text-property 0 (length register-string) |
3109 |
|
'face 'font-lock-warning-face |
3110 |
|
register-string)) |
3111 |
|
(setq register-values |
3112 |
|
(concat register-values register-string))) |
3113 |
|
(let ((buf (gdb-get-buffer 'gdb-registers-buffer))) |
3114 |
|
(with-current-buffer buf |
3115 |
|
(let ((p (window-point (get-buffer-window buf 0))) |
3116 |
|
(buffer-read-only nil)) |
3117 |
|
(erase-buffer) |
3118 |
|
(insert register-values) |
3119 |
|
(set-window-point (get-buffer-window buf 0) p)))))) |
3120 |
|
(gdb-data-list-register-values-custom)) |
3121 |
|
|
3122 |
|
(defun gdb-data-list-register-values-custom () |
3123 |
|
(with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) |
3124 |
|
(save-excursion |
3125 |
|
(let ((buffer-read-only nil) |
3126 |
|
start end) |
3127 |
|
(goto-char (point-min)) |
3128 |
|
(while (< (point) (point-max)) |
3129 |
|
(setq start (line-beginning-position)) |
3130 |
|
(setq end (line-end-position)) |
3131 |
|
(when (looking-at "^[^\t]+") |
3132 |
|
(unless (string-equal (match-string 0) "No registers.") |
3133 |
|
(put-text-property start (match-end 0) |
3134 |
|
'face font-lock-variable-name-face) |
3135 |
|
(add-text-properties start end |
3136 |
|
'(help-echo "mouse-2: edit value" |
3137 |
|
mouse-face highlight)))) |
3138 |
|
(forward-line 1)))))) |
3139 |
|
|
3140 |
|
;; Needs GDB 6.4 onwards (used to fail with no stack). |
3141 |
|
(defun gdb-get-changed-registers () |
3142 |
|
(if (not (member 'gdb-get-changed-registers gdb-pending-triggers)) |
3143 |
|
(progn |
3144 |
|
(gdb-enqueue-input |
3145 |
|
(list |
3146 |
|
(if (eq gud-minor-mode 'gdba) |
3147 |
|
"server interpreter mi -data-list-changed-registers\n" |
3148 |
|
"-data-list-changed-registers\n") |
3149 |
|
'gdb-get-changed-registers-handler)) |
3150 |
|
(push 'gdb-get-changed-registers gdb-pending-triggers)))) |
3151 |
|
|
3152 |
|
(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"") |
3153 |
|
|
3154 |
|
(defun gdb-get-changed-registers-handler () |
3155 |
|
(setq gdb-pending-triggers |
3156 |
|
(delq 'gdb-get-changed-registers gdb-pending-triggers)) |
3157 |
|
(setq gdb-changed-registers nil) |
3158 |
|
(goto-char (point-min)) |
3159 |
|
(while (re-search-forward gdb-data-list-register-names-regexp nil t) |
3160 |
|
(push (match-string 1) gdb-changed-registers))) |
3161 |
|
|
3162 |
|
|
3163 |
|
;; Locals buffer. |
3164 |
|
;; |
3165 |
|
;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. |
3166 |
|
(gdb-set-buffer-rules 'gdb-locals-buffer |
3167 |
|
'gdb-locals-buffer-name |
3168 |
|
'gdb-locals-mode) |
3169 |
|
|
3170 |
|
(def-gdb-auto-update-trigger gdb-invalidate-locals-1 |
3171 |
|
(gdb-get-buffer 'gdb-locals-buffer) |
3172 |
|
"server interpreter mi -\"stack-list-locals --simple-values\"\n" |
3173 |
|
gdb-stack-list-locals-handler) |
3174 |
|
|
3175 |
|
(defconst gdb-stack-list-locals-regexp |
3176 |
|
"name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") |
3177 |
|
|
3178 |
|
(defvar gdb-locals-watch-map-1 |
3179 |
|
(let ((map (make-sparse-keymap))) |
3180 |
|
(define-key map [mouse-2] 'gud-watch) |
3181 |
|
map) |
3182 |
|
"Keymap to create watch expression of a complex data type local variable.") |
3183 |
|
|
3184 |
|
;; Dont display values of arrays or structures. |
3185 |
|
;; These can be expanded using gud-watch. |
3186 |
|
(defun gdb-stack-list-locals-handler () |
3187 |
|
(setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1 |
3188 |
|
gdb-pending-triggers)) |
3189 |
|
(let (local locals-list) |
3190 |
|
(goto-char (point-min)) |
3191 |
|
(while (re-search-forward gdb-stack-list-locals-regexp nil t) |
3192 |
|
(let ((local (list (match-string 1) |
3193 |
|
(match-string 2) |
3194 |
|
nil))) |
3195 |
|
(if (looking-at ",value=\\(\".*\"\\)}") |
3196 |
|
(setcar (nthcdr 2 local) (read (match-string 1)))) |
3197 |
|
(push local locals-list))) |
3198 |
|
(let ((buf (gdb-get-buffer 'gdb-locals-buffer))) |
3199 |
|
(and buf (with-current-buffer buf |
3200 |
|
(let* ((window (get-buffer-window buf 0)) |
3201 |
|
(p (window-point window)) |
3202 |
|
(buffer-read-only nil)) |
3203 |
|
(erase-buffer) |
3204 |
|
(dolist (local locals-list) |
3205 |
|
(setq name (car local)) |
3206 |
|
(if (or (not (nth 2 local)) |
3207 |
|
(string-match "\\*$" (nth 1 local))) |
3208 |
|
(add-text-properties 0 (length name) |
3209 |
|
`(mouse-face highlight |
3210 |
|
help-echo "mouse-2: create watch expression" |
3211 |
|
local-map ,gdb-locals-watch-map-1) |
3212 |
|
name)) |
3213 |
|
(insert |
3214 |
|
(concat name "\t" (nth 1 local) |
3215 |
|
"\t" (nth 2 local) "\n"))) |
3216 |
|
(set-window-point window p))))))) |
3217 |
|
|
3218 |
|
(defun gdb-get-register-names () |
3219 |
|
"Create a list of register names." |
3220 |
|
(goto-char (point-min)) |
3221 |
|
(setq gdb-register-names nil) |
3222 |
|
(while (re-search-forward gdb-data-list-register-names-regexp nil t) |
3223 |
|
(push (match-string 1) gdb-register-names))) |
3224 |
|
|
3225 |
(provide 'gdb-ui) |
(provide 'gdb-ui) |
3226 |
|
|
3227 |
;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 |
;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 |