2005-02-24 Andrew Cagney <cagney@gnu.org>
[deliverable/binutils-gdb.git] / gdb / mi / gdb-mi.el
1 ;;; gdb-mi.el (internally gdbmi6.el) - (24th May 2004)
2
3 ;; Run gdb with GDB/MI (-interp=mi) and access CLI using "cli-command"
4 ;; (could use "-interpreter-exec console cli-command")
5
6 ;; Author: Nick Roberts <nickrob@gnu.org>
7 ;; Maintainer: Nick Roberts <nickrob@gnu.org>
8 ;; Keywords: unix, tools
9
10 ;; Copyright (C) 2004 Free Software Foundation, Inc.
11
12 ;; This file is part of GNU GDB.
13
14 ;; GNU GDB is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;;; Commentary:
25
26 ;; This mode acts as a graphical user interface to GDB and requires GDB 6.1
27 ;; onwards. You can interact with GDB through the GUD buffer in the usual way,
28 ;; but there are also buffers which control the execution and describe the
29 ;; state of your program. It separates the input/output of your program from
30 ;; that of GDB and displays expressions and their current values in their own
31 ;; buffers. It also uses features of Emacs 21 such as the fringe/display
32 ;; margin for breakpoints, and the toolbar (see the GDB Graphical Interface
33 ;; section in the Emacs info manual).
34
35 ;; Start the debugger with M-x gdbmi.
36
37 ;; This file uses GDB/MI as the primary interface to GDB. It is still under
38 ;; development and is part of a process to migrate Emacs from annotations
39 ;; (as used in gdb-ui.el) to GDB/MI.
40
41 ;; Known Bugs:
42 ;;
43
44 ;;; Code:
45
46 (require 'gud)
47 (require 'gdb-ui)
48 \f
49
50 ;;;###autoload
51 (defun gdbmi (command-line)
52 "Run gdb on program FILE in buffer *gud-FILE*.
53 The directory containing FILE becomes the initial working directory
54 and source-file directory for your debugger.
55
56 If `gdb-many-windows' is nil (the default value) then gdb just
57 pops up the GUD buffer unless `gdb-show-main' is t. In this case
58 it starts with two windows: one displaying the GUD buffer and the
59 other with the source file with the main routine of the inferior.
60
61 If `gdb-many-windows' is t, regardless of the value of
62 `gdb-show-main', the layout below will appear. Keybindings are
63 given in relevant buffer.
64
65 Watch expressions appear in the speedbar/slowbar.
66
67 The following interactive lisp functions help control operation :
68
69 `gdb-many-windows' - Toggle the number of windows gdb uses.
70 `gdb-restore-windows' - To restore the window layout.
71
72 See Info node `(emacs)GDB Graphical Interface' for a more
73 detailed description of this mode.
74
75
76 ---------------------------------------------------------------------
77 GDB Toolbar
78 ---------------------------------------------------------------------
79 GUD buffer (I/O of GDB) | Locals buffer
80 |
81 |
82 |
83 ---------------------------------------------------------------------
84 Source buffer | Input/Output (of inferior) buffer
85 | (comint-mode)
86 |
87 |
88 |
89 |
90 |
91 |
92 ---------------------------------------------------------------------
93 Stack buffer | Breakpoints buffer
94 RET gdb-frames-select | SPC gdb-toggle-breakpoint
95 | RET gdb-goto-breakpoint
96 | d gdb-delete-breakpoint
97 ---------------------------------------------------------------------
98 "
99 ;;
100 (interactive (list (gud-query-cmdline 'gdbmi)))
101 ;;
102 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
103 (gdb command-line)
104 ;;
105 (setq gdb-debug-log nil)
106 (set (make-local-variable 'gud-minor-mode) 'gdbmi)
107 (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
108 ;;
109 (gud-def gud-break (if (not (string-equal mode-name "Machine"))
110 (gud-call "-break-insert %f:%l" arg)
111 (save-excursion
112 (beginning-of-line)
113 (forward-char 2)
114 (gud-call "-break-insert *%a" arg)))
115 "\C-b" "Set breakpoint at current line or address.")
116 ;;
117 (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
118 (gud-call "clear %f:%l" arg)
119 (save-excursion
120 (beginning-of-line)
121 (forward-char 2)
122 (gud-call "clear *%a" arg)))
123 "\C-d" "Remove breakpoint at current line or address.")
124 ;;
125 (gud-def gud-until (if (not (string-equal mode-name "Machine"))
126 (gud-call "until %f:%l" arg)
127 (save-excursion
128 (beginning-of-line)
129 (forward-char 2)
130 (gud-call "until *%a" arg)))
131 "\C-u" "Continue to current line or address.")
132
133 (define-key gud-minor-mode-map [left-margin mouse-1]
134 'gdb-mouse-toggle-breakpoint)
135 (define-key gud-minor-mode-map [left-fringe mouse-1]
136 'gdb-mouse-toggle-breakpoint)
137
138 (setq comint-input-sender 'gdbmi-send)
139 ;;
140 ;; (re-)initialise
141 (setq gdb-main-file nil)
142 (setq gdb-current-address "main")
143 (setq gdb-previous-address nil)
144 (setq gdb-previous-frame nil)
145 (setq gdb-current-frame "main")
146 (setq gdb-view-source t)
147 (setq gdb-selected-view 'source)
148 (setq gdb-var-list nil)
149 (setq gdb-var-changed nil)
150 (setq gdb-prompting nil)
151 (setq gdb-current-item nil)
152 (setq gdb-pending-triggers nil)
153 (setq gdb-output-sink 'user)
154 (setq gdb-server-prefix nil)
155 ;;
156 (setq gdb-buffer-type 'gdbmi)
157 ;;
158 ;; FIXME: use tty command to separate io.
159 ;;(gdb-clear-inferior-io)
160 ;;
161 (if (eq window-system 'w32)
162 (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
163 ;; find source file and compilation directory here
164 (gdb-enqueue-input (list "list main\n" 'ignore)) ; C program
165 (gdb-enqueue-input (list "list MAIN__\n" 'ignore)) ; Fortran program
166 (gdb-enqueue-input (list "info source\n" 'gdbmi-source-info))
167 ;;
168 (run-hooks 'gdbmi-mode-hook))
169
170 ; Force nil till fixed.
171 (defconst gdbmi-use-inferior-io-buffer nil)
172
173 ; uses --all-values Needs GDB 6.1 onwards.
174 (defun gdbmi-var-list-children (varnum)
175 (gdb-enqueue-input
176 (list (concat "-var-update " varnum "\n") 'ignore))
177 (gdb-enqueue-input
178 (list (concat "-var-list-children --all-values "
179 varnum "\n")
180 `(lambda () (gdbmi-var-list-children-handler ,varnum)))))
181
182 (defconst gdbmi-var-list-children-regexp
183 "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",value=\"\\(.*?\\)\""
184 )
185
186 (defun gdbmi-var-list-children-handler (varnum)
187 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
188 (goto-char (point-min))
189 (let ((var-list nil))
190 (catch 'child-already-watched
191 (dolist (var gdb-var-list)
192 (if (string-equal varnum (cadr var))
193 (progn
194 (push var var-list)
195 (while (re-search-forward gdbmi-var-list-children-regexp nil t)
196 (let ((varchild (list (match-string 2)
197 (match-string 1)
198 (match-string 3)
199 nil
200 (match-string 4)
201 nil)))
202 (if (looking-at ",type=\"\\(.*?\\)\"")
203 (setcar (nthcdr 3 varchild) (match-string 1)))
204 (dolist (var1 gdb-var-list)
205 (if (string-equal (cadr var1) (cadr varchild))
206 (throw 'child-already-watched nil)))
207 (push varchild var-list))))
208 (push var var-list)))
209 (setq gdb-var-changed t)
210 (setq gdb-var-list (nreverse var-list))))))
211 \f
212 ;(defun gdbmi-send (proc string)
213 ; "A comint send filter for gdb."
214 ; (setq gdb-output-sink 'user)
215 ; (setq gdb-prompting nil)
216 ; (process-send-string proc (concat "-interpreter-exec console \"" string "\"")))
217
218 (defun gdbmi-send (proc string)
219 "A comint send filter for gdb."
220 (setq gdb-output-sink 'user)
221 (setq gdb-prompting nil)
222 (process-send-string proc (concat string "\n")))
223
224 (defcustom gud-gdbmi-command-name "~/gdb/gdb/gdb -interp=mi"
225 "Default command to execute an executable under the GDB-UI debugger."
226 :type 'string
227 :group 'gud)
228
229 (defconst gdb-stopped-regexp
230 "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*")
231
232 (defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"")
233
234 (defconst gdb-internals-regexp "&\".*\\n\"\n")
235
236 (defconst gdb-gdb-regexp "(gdb) \n")
237
238 (defconst gdb-running-regexp "^\\^running")
239
240 (defun gdbmi-prompt ()
241 "This handler terminates the any collection of output. It also
242 sends the next command (if any) to gdb."
243 (unless gdb-pending-triggers
244 (gdb-get-current-frame)
245 (gdbmi-invalidate-frames)
246 (gdbmi-invalidate-breakpoints)
247 (gdbmi-invalidate-locals)
248 (dolist (frame (frame-list))
249 (when (string-equal (frame-parameter frame 'name) "Speedbar")
250 (setq gdb-var-changed t) ; force update
251 (dolist (var gdb-var-list)
252 (setcar (nthcdr 5 var) nil))))
253 (gdb-var-update))
254 (let ((sink gdb-output-sink))
255 (when (eq sink 'emacs)
256 (let ((handler
257 (car (cdr gdb-current-item))))
258 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
259 (funcall handler)))))
260 (let ((input (gdb-dequeue-input)))
261 (if input
262 (gdb-send-item input)
263 (progn
264 (setq gud-running nil)
265 (setq gdb-prompting t)
266 (gud-display-frame)))))
267
268 (defun gud-gdbmi-marker-filter (string)
269 "Filter GDB/MI output."
270 (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
271 ;; Recall the left over gud-marker-acc from last time
272 (setq gud-marker-acc (concat gud-marker-acc string))
273 ;; Start accumulating output for the GUD buffer
274 (let ((output ""))
275
276 (if (string-match gdb-running-regexp gud-marker-acc)
277 (setq gud-marker-acc (substring gud-marker-acc (match-end 0))
278 gud-running t))
279
280 ;; Remove the trimmings from the console stream.
281 (while (string-match gdb-console-regexp gud-marker-acc)
282 (setq
283 gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
284 (match-string 1 gud-marker-acc)
285 (substring gud-marker-acc (match-end 0)))))
286
287 ;; Remove log stream containing debugging messages being produced by GDB's
288 ;; internals.
289 (while (string-match gdb-internals-regexp gud-marker-acc)
290 (setq
291 gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
292 (substring gud-marker-acc (match-end 0)))))
293
294 (if (string-match gdb-stopped-regexp gud-marker-acc)
295 (setq
296
297 ;; Extract the frame position from the marker.
298 gud-last-frame (cons (match-string 2 gud-marker-acc)
299 (string-to-int (match-string 3 gud-marker-acc)))
300
301 ;; Append any text before the marker to the output we're going
302 ;; to return - we don't include the marker in this text.
303 output (gdbmi-concat-output output
304 (substring gud-marker-acc 0 (match-beginning 0)))
305
306 ;; Set the accumulator to the remaining text.
307 gud-marker-acc (substring gud-marker-acc (match-end 0))))
308
309 (while (string-match gdb-gdb-regexp gud-marker-acc)
310 (setq
311
312 ;; Append any text up to and including prompt less \n to the output.
313 output (gdbmi-concat-output output
314 (substring gud-marker-acc 0 (- (match-end 0) 1)))
315
316 ;; Set the accumulator to the remaining text.
317 gud-marker-acc (substring gud-marker-acc (match-end 0)))
318 (gdbmi-prompt))
319
320 (setq output (gdbmi-concat-output output gud-marker-acc))
321 (setq gud-marker-acc "")
322 output))
323
324 (defun gdbmi-concat-output (so-far new)
325 (let ((sink gdb-output-sink))
326 (cond
327 ((eq sink 'user) (concat so-far new))
328 ((eq sink 'emacs)
329 (gdb-append-to-partial-output new)
330 so-far)
331 ((eq sink 'inferior)
332 (gdb-append-to-inferior-io new)
333 so-far))))
334 \f
335
336 ;; Breakpoint buffer : This displays the output of `-break-list'.
337 ;;
338 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
339 ;; This defines the auto update rule for buffers of type
340 ;; `gdb-breakpoints-buffer'.
341 ;;
342 ;; It defines a function that queues the command below. That function is
343 ;; called:
344 gdbmi-invalidate-breakpoints
345 ;;
346 ;; To update the buffer, this command is sent to gdb.
347 "-break-list\n"
348 ;;
349 ;; This also defines a function to be the handler for the output
350 ;; from the command above. That function will copy the output into
351 ;; the appropriately typed buffer. That function will be called:
352 gdb-break-list-handler
353 ;; buffer specific functions
354 gdb-break-list-custom)
355
356 (defconst gdb-break-list-regexp
357 "number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
358
359 (defun gdb-break-list-handler ()
360 (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
361 gdb-pending-triggers))
362 (let ((breakpoint nil)
363 (breakpoints-list nil))
364 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
365 (goto-char (point-min))
366 (while (re-search-forward gdb-break-list-regexp nil t)
367 (let ((breakpoint (list (match-string 1)
368 (match-string 2)
369 (match-string 3)
370 (match-string 4)
371 (match-string 5)
372 (match-string 6)
373 (match-string 7)
374 (match-string 8))))
375 (push breakpoint breakpoints-list))))
376 (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
377 (and buf (with-current-buffer buf
378 (let ((p (point))
379 (buffer-read-only nil))
380 (erase-buffer)
381 (insert "Num Type Disp Enb Func\tFile:Line\tAddr\n")
382 (dolist (breakpoint breakpoints-list)
383 (insert (concat
384 (nth 0 breakpoint) " "
385 (nth 1 breakpoint) " "
386 (nth 2 breakpoint) " "
387 (nth 3 breakpoint) " "
388 (nth 5 breakpoint) "\t"
389 (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t"
390 (nth 4 breakpoint) "\n")))
391 (goto-char p))))))
392 (gdb-break-list-custom))
393
394 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
395 (defun gdb-break-list-custom ()
396 (let ((flag)(address))
397 ;;
398 ;; remove all breakpoint-icons in source buffers but not assembler buffer
399 (dolist (buffer (buffer-list))
400 (with-current-buffer buffer
401 (if (and (eq gud-minor-mode 'gdbmi)
402 (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
403 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
404 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
405 (save-excursion
406 (goto-char (point-min))
407 (while (< (point) (- (point-max) 1))
408 (forward-line 1)
409 (if (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")
410 (progn
411 (setq flag (char-after (match-beginning 1)))
412 (let ((line (match-string 3)) (buffer-read-only nil)
413 (file (match-string 2)))
414 (add-text-properties (point-at-bol) (point-at-eol)
415 '(mouse-face highlight
416 help-echo "mouse-2, RET: visit breakpoint"))
417 (with-current-buffer
418 (find-file-noselect
419 (if (file-exists-p file) file
420 (expand-file-name file gdb-cdir)))
421 (save-current-buffer
422 (set (make-local-variable 'gud-minor-mode) 'gdbmi)
423 (set (make-local-variable 'tool-bar-map)
424 gud-tool-bar-map))
425 ;; only want one breakpoint icon at each location
426 (save-excursion
427 (goto-line (string-to-number line))
428 (gdb-put-breakpoint-icon (eq flag ?y)))))))))
429 (end-of-line)))
430 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
431
432 ;; Frames buffer. This displays a perpetually correct bactrack trace.
433 ;;
434 (def-gdb-auto-updated-buffer gdb-stack-buffer
435 gdbmi-invalidate-frames
436 "-stack-list-frames\n"
437 gdb-stack-list-frames-handler
438 gdb-stack-list-frames-custom)
439
440 (defconst gdb-stack-list-frames-regexp
441 "level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
442
443 (defun gdb-stack-list-frames-handler ()
444 (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
445 gdb-pending-triggers))
446 (let ((frame nil)
447 (call-stack nil))
448 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
449 (goto-char (point-min))
450 (while (re-search-forward gdb-stack-list-frames-regexp nil t)
451 (let ((frame (list (match-string 1)
452 (match-string 2)
453 (match-string 3)
454 (match-string 4)
455 (match-string 5))))
456 (push frame call-stack))))
457 (let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
458 (and buf (with-current-buffer buf
459 (let ((p (point))
460 (buffer-read-only nil))
461 (erase-buffer)
462 (insert "Level\tFunc\tFile:Line\tAddr\n")
463 (dolist (frame (nreverse call-stack))
464 (insert (concat
465 (nth 0 frame) "\t"
466 (nth 2 frame) "\t"
467 (nth 3 frame) ":" (nth 4 frame) "\t"
468 (nth 1 frame) "\n")))
469 (goto-char p))))))
470 (gdb-stack-list-frames-custom))
471
472 (defun gdb-stack-list-frames-custom ()
473 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
474 (save-excursion
475 (let ((buffer-read-only nil))
476 (goto-char (point-min))
477 (forward-line 1)
478 (while (< (point) (point-max))
479 (add-text-properties (point-at-bol) (point-at-eol)
480 '(mouse-face highlight
481 help-echo "mouse-2, RET: Select frame"))
482 (beginning-of-line)
483 (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
484 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
485 (equal (match-string 1) gdb-current-frame))
486 (put-text-property (point-at-bol) (point-at-eol)
487 'face '(:inverse-video t)))
488 (forward-line 1))))))
489
490 ;; Locals buffer.
491 ;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards.
492 (def-gdb-auto-updated-buffer gdb-locals-buffer
493 gdbmi-invalidate-locals
494 "-stack-list-locals 2\n"
495 gdb-stack-list-locals-handler
496 gdb-stack-list-locals-custom)
497
498 (defconst gdb-stack-list-locals-regexp
499 (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))
500
501 ;; Dont display values of arrays or structures.
502 ;; These can be expanded using gud-watch.
503 (defun gdb-stack-list-locals-handler nil
504 (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals
505 gdb-pending-triggers))
506 (let ((local nil)
507 (locals-list nil))
508 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
509 (goto-char (point-min))
510 (while (re-search-forward gdb-stack-list-locals-regexp nil t)
511 (let ((local (list (match-string 1)
512 (match-string 2)
513 nil)))
514 (if (looking-at ",value=\"\\(.*?\\)\"")
515 (setcar (nthcdr 2 local) (match-string 1)))
516 (push local locals-list))))
517 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
518 (and buf (with-current-buffer buf
519 (let ((p (point))
520 (buffer-read-only nil))
521 (erase-buffer)
522 (dolist (local locals-list)
523 (insert
524 (concat (car local) "\t" (nth 1 local) "\t"
525 (or (nth 2 local)
526 (if (string-match "struct" (nth 1 local))
527 "(structure)"
528 "(array)"))
529 "\n")))
530 (goto-char p)))))))
531
532 (defun gdb-stack-list-locals-custom ()
533 nil)
534
535 (defun gdbmi-source-info ()
536 "Find the source file where the program starts and displays it with related
537 buffers."
538 (goto-char (point-min))
539 (if (search-forward "source file is " nil t)
540 (if (looking-at "\\S-*")
541 (setq gdb-main-file (match-string 0)))
542 (setq gdb-view-source nil))
543 (if (search-forward "directory is " nil t)
544 (if (looking-at "\\S-*:\\(\\S-*\\)")
545 (setq gdb-cdir (match-string 1))
546 (looking-at "\\S-*")
547 (setq gdb-cdir (match-string 0))))
548
549 ;temporary heuristic
550 (if gdb-main-file
551 (setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir)))
552
553 (if gdb-many-windows
554 (gdb-setup-windows)
555 (gdb-get-create-buffer 'gdb-breakpoints-buffer)
556 (when gdb-show-main
557 (switch-to-buffer gud-comint-buffer)
558 (delete-other-windows)
559 (split-window)
560 (other-window 1)
561 (switch-to-buffer
562 (if gdb-view-source
563 (gud-find-file gdb-main-file)
564 (gdb-get-create-buffer 'gdb-assembler-buffer)))
565 (other-window 1))))
566
567 (provide 'gdb-mi)
568 ;;; gdbmi.el ends here
This page took 0.058266 seconds and 4 git commands to generate.