aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNick Roberts2009-12-29 20:15:34 +1300
committerNick Roberts2009-12-29 20:15:34 +1300
commit49f073bd8a61b525da3fbc35981abdaa7fc24182 (patch)
treec4dc7de6c4a412d118c1ed10ad4ac589856bfd5f
parent460f6e7ced30ef7dbbf05284f0ca28f94e613c71 (diff)
downloademacs-49f073bd8a61b525da3fbc35981abdaa7fc24182.tar.gz
emacs-49f073bd8a61b525da3fbc35981abdaa7fc24182.zip
This changeset reverts GDB Graphical Interface to use annotations. It incorporates features added
(and never released) on the EMACS_23_1_RC branch. Namely reverse debugging and the display of STL collections as watch expressions. The long term aim is to move to GDB/MI, so these changes will be re-instated at some time in the future. At the moment, however, there are issues with gdb-mi.el that have not yet
-rw-r--r--doc/emacs/building.texi225
-rw-r--r--doc/emacs/emacs.texi18
-rw-r--r--etc/NEWS7
-rw-r--r--lisp/Makefile.in2
-rw-r--r--lisp/progmodes/gdb-mi.el4192
-rw-r--r--lisp/progmodes/gdb-ui.el4129
-rw-r--r--lisp/progmodes/gud.el203
7 files changed, 4302 insertions, 4474 deletions
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index a5ce5f20c7b..343eb646a83 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -854,12 +854,11 @@ multiple programs within one Emacs session.
854* Source Buffers:: Use the mouse in the fringe/margin to 854* Source Buffers:: Use the mouse in the fringe/margin to
855 control your program. 855 control your program.
856* Breakpoints Buffer:: A breakpoint control panel. 856* Breakpoints Buffer:: A breakpoint control panel.
857* Threads Buffer:: Displays your threads.
858* Stack Buffer:: Select a frame from the call stack. 857* Stack Buffer:: Select a frame from the call stack.
859* Other GDB-UI Buffers:: Input/output, locals, registers, 858* Other GDB-UI Buffers:: Input/output, locals, registers,
860 assembler, threads and memory buffers. 859 assembler, threads and memory buffers.
861* Watch Expressions:: Monitor variable values in the speedbar. 860* Watch Expressions:: Monitor variable values in the speedbar.
862* Multithreaded Debugging:: Debugging programs with several threads. 861* Reverse Debugging:: Execute and reverse debug your program.
863@end menu 862@end menu
864 863
865@node GDB-UI Layout 864@node GDB-UI Layout
@@ -884,7 +883,7 @@ displays the following frame layout:
884|--------------------------------+--------------------------------+ 883|--------------------------------+--------------------------------+
885| Primary Source buffer | I/O buffer for debugged pgm | 884| Primary Source buffer | I/O buffer for debugged pgm |
886|--------------------------------+--------------------------------+ 885|--------------------------------+--------------------------------+
887| Stack buffer | Breakpoints/Thread buffer | 886| Stack buffer | Breakpoints/Threads buffer |
888+--------------------------------+--------------------------------+ 887+--------------------------------+--------------------------------+
889@end group 888@end group
890@end smallexample 889@end smallexample
@@ -1012,92 +1011,10 @@ Visit the source line for the current breakpoint
1012Visit the source line for the breakpoint you click on. 1011Visit the source line for the breakpoint you click on.
1013@end table 1012@end table
1014 1013
1015@vindex gdb-show-threads-by-default
1016When @code{gdb-many-windows} is non-@code{nil}, the breakpoints buffer 1014When @code{gdb-many-windows} is non-@code{nil}, the breakpoints buffer
1017shares its window with the threads buffer. To switch from one to the 1015shares its window with the threads buffer. To switch from one to the
1018other click with @kbd{Mouse-1} on the relevant button in the header 1016other click with @kbd{Mouse-1} on the relevant button in the header
1019line, or press @kbd{TAB} inside that buffer. If 1017line.
1020@code{gdb-show-threads-by-default} is non-@code{nil}, the threads
1021buffer, rather than the breakpoints buffer, is shown at start up.
1022
1023@node Threads Buffer
1024@subsubsection Threads Buffer
1025
1026@findex gdb-select-thread
1027The threads buffer displays a summary of all threads currently in your
1028program (@pxref{Threads, Threads, Debugging programs with multiple
1029threads, gdb, The GNU debugger}). Move point to any thread in the list
1030and press @key{RET} to select it (@code{gdb-select-thread}) and
1031display the associated source in the primary source buffer.
1032Alternatively, click @kbd{Mouse-2} on a thread to select it. Contents
1033of all GDB buffers are updated whenever you select a thread.
1034
1035 You can customize variables under @code{gdb-buffers} group to select
1036fields included in threads buffer.
1037
1038@table @code
1039@item gdb-thread-buffer-verbose-names
1040@vindex gdb-thread-buffer-verbose-names
1041Show long thread names like @samp{Thread 0x4e2ab70 (LWP 1983)} in
1042threads buffer.
1043
1044@item gdb-thread-buffer-arguments
1045@vindex gdb-thread-buffer-arguments
1046Show arguments of thread top frames in threads buffer.
1047
1048@item gdb-thread-buffer-locations
1049@vindex gdb-thread-buffer-locations
1050Show file information or library names in threads buffer.
1051
1052@item gdb-thread-buffer-addresses
1053@vindex gdb-thread-buffer-addresses
1054Show addresses for thread frames in threads buffer.
1055@end table
1056
1057 It’s possible to observe information for several threads
1058simultaneously (in addition to buffers which show information for
1059currently selected thread) using the following keys from the threads
1060buffer.
1061
1062@table @kbd
1063@item d
1064@kindex d @r{(GDB threads buffer)}
1065@findex gdb-display-disassembly-for-thread
1066Display disassembly buffer for the thread at current line.
1067(@code{gdb-display-disassembly-for-thread})
1068
1069@item f
1070@kindex f @r{(GDB threads buffer)}
1071@findex gdb-display-stack-for-thread
1072Display stack buffer for the thread at current line.
1073(@code{gdb-display-stack-for-thread}).
1074
1075@item l
1076@kindex l @r{(GDB threads buffer)}
1077@findex gdb-display-locals-for-thread
1078Display locals buffer for the thread at current line.
1079(@code{gdb-display-locals-for-thread}).
1080
1081@item r
1082@kindex r @r{(GDB threads buffer)}
1083@findex gdb-display-registers-for-thread
1084Display registers buffer for the thread at current line.
1085(@code{gdb-display-registers-for-thread}).
1086@end table
1087
1088Pressing their upper-case counterparts, @kbd{D}, @kbd{F} ,@kbd{L} and
1089@kbd{R} displays the corresponding buffer in a new frame.
1090
1091 When you create a buffer showing information about some specific
1092thread, it becomes bound to that thread and keeps showing actual
1093information while you debug your program. Every GDB buffer contains a
1094number of thread it shows information for in its mode name. Thread
1095number is also included in the buffer name of bound buffers to prevent
1096buffer names clashing.
1097
1098Further commands are available in the threads buffer which depend on the
1099mode of GDB that is used for controlling execution of your program.
1100(@pxref{Multithreaded Debugging, Stopping and Starting Multi-threaded Programs}).
1101 1018
1102@node Stack Buffer 1019@node Stack Buffer
1103@subsubsection Stack Buffer 1020@subsubsection Stack Buffer
@@ -1134,7 +1051,7 @@ as are the commands to send signals to the debugged program.
1134@item Locals Buffer 1051@item Locals Buffer
1135The locals buffer displays the values of local variables of the 1052The locals buffer displays the values of local variables of the
1136current frame for simple data types (@pxref{Frame Info, Frame Info, 1053current frame for simple data types (@pxref{Frame Info, Frame Info,
1137Information on a frame, gdb, The GNU debugger}). Press @key{RET} or 1054Information on a frame, gdb, The GNU debugger}). Press @key{RET} or
1138click @kbd{Mouse-2} on the value if you want to edit it. 1055click @kbd{Mouse-2} on the value if you want to edit it.
1139 1056
1140Arrays and structures display their type only. With GDB 6.4 or later, 1057Arrays and structures display their type only. With GDB 6.4 or later,
@@ -1153,12 +1070,27 @@ With GDB 6.4 or later, recently changed register values display with
1153press @key{SPC} to toggle the display of floating point registers 1070press @key{SPC} to toggle the display of floating point registers
1154(@code{toggle-gdb-all-registers}). 1071(@code{toggle-gdb-all-registers}).
1155 1072
1156@item Disassembly Buffer 1073@item Assembler Buffer
1157The disassembly buffer displays the current frame as machine code. An 1074The assembler buffer displays the current frame as machine code. An
1158arrow points to the current instruction, and you can set and remove 1075arrow points to the current instruction, and you can set and remove
1159breakpoints as in a source buffer. Breakpoint icons also appear in 1076breakpoints as in a source buffer. Breakpoint icons also appear in
1160the fringe or margin. 1077the fringe or margin.
1161 1078
1079@item Threads Buffer
1080@findex gdb-threads-select
1081The threads buffer displays a summary of all threads currently in your
1082program (@pxref{Threads, Threads, Debugging programs with multiple
1083threads, gdb, The GNU debugger}). Move point to any thread in the
1084list and press @key{RET} to select it (@code{gdb-threads-select}) and
1085display the associated source in the primary source buffer.
1086Alternatively, click @kbd{Mouse-2} on a thread to select it. If the
1087locals buffer is visible, its contents update to display the variables
1088that are local in the new thread.
1089
1090When there is more than one main thread and the threads buffer is
1091present, Emacs displays the selected thread number in the mode line of
1092many of the GDB-UI Buffers.
1093
1162@item Memory Buffer 1094@item Memory Buffer
1163The memory buffer lets you examine sections of program memory 1095The memory buffer lets you examine sections of program memory
1164(@pxref{Memory, Memory, Examining memory, gdb, The GNU debugger}). 1096(@pxref{Memory, Memory, Examining memory, gdb, The GNU debugger}).
@@ -1171,9 +1103,8 @@ size for these data items.
1171 1103
1172When @code{gdb-many-windows} is non-@code{nil}, the threads buffer 1104When @code{gdb-many-windows} is non-@code{nil}, the threads buffer
1173shares its window with the breakpoints buffer, and the locals buffer 1105shares its window with the breakpoints buffer, and the locals buffer
1174with the registers buffer. To switch from one to the other click with 1106with the registers buffer. To switch from one to the other click with
1175@kbd{Mouse-1} on the relevant button in the header line or press 1107@kbd{Mouse-1} on the relevant button in the header line.
1176@kbd{TAB} inside the buffer.
1177 1108
1178@node Watch Expressions 1109@node Watch Expressions
1179@subsubsection Watch Expressions 1110@subsubsection Watch Expressions
@@ -1241,96 +1172,26 @@ expressions updates, set @code{gdb-speedbar-auto-raise} to
1241non-@code{nil}. This can be useful if you are debugging with a full 1172non-@code{nil}. This can be useful if you are debugging with a full
1242screen Emacs frame. 1173screen Emacs frame.
1243 1174
1244@node Multithreaded Debugging 1175@node Reverse Debugging
1245@subsubsection Stopping and Starting Multi-threaded Programs 1176@subsubsection Reverse Debugging
1246@cindex Multithreaded debugging in GDB 1177
1247 1178 The GDB tool bar shares many buttons with the other GUD debuggers
1248@subsubheading All-stop Debugging 1179for tasks like stepping and printing expressions. It also has a
1249 1180further set of buttons that allow reverse debugging (@pxref{Process
1250In all-stop mode, whenever your program stops, @emph{all} threads of 1181Record and Replay, , ,gdb, The GNU debugger}). This is useful when it
1251execution stop. Likewise, whenever you restart the program, all 1182takes a long time to reproduce the conditions where your program fails
1252threads start executing. @xref{All-Stop Mode, , All-Stop Mode, gdb, 1183or for transient problems, like race conditions in multi-threaded
1253The GNU debugger}. You can enable this behaviour in Emacs by setting 1184programs, where a failure might otherwise be hard to reproduce.
1254@code{gdb-non-stop-setting} to @code{nil} before starting a debugging 1185
1255session. 1186To use reverse debugging, set a breakpoint slightly before the
1256 1187location of interest and run your program to that point. Enable
1257@subsubheading Non-stop Debugging 1188process recording by clicking on the record button. At this point, a
1258@cindex Non-stop debugging in GDB 1189new set of buttons appear. These buttons allow program execution in
1259 1190the reverse direction. Run your program over the code where the
1260For some multi-threaded targets, GDB supports a further mode of 1191problem occurs, and then use the new set of buttons to retrace your
1261operation in which you can examine stopped program threads in the 1192steps, examine values, and analyze the problem. When analysis is
1262debugger while other threads continue to execute freely. 1193complete, turn off process recording by clicking on the record button
1263@xref{Non-Stop Mode, , Non-Stop Mode, gdb, The GNU debugger}. 1194again.
1264This is referred to as @dfn{non-stop} mode.
1265
1266Versions of GDB prior to 7.0 do not support non-stop mode and it does
1267not work on all targets. In such cases, Emacs uses all-stop mode
1268regardless of the value of @code{gdb-non-stop-setting}.
1269
1270@vindex gdb-non-stop-setting
1271If the variable @code{gdb-non-stop-setting} is non-@code{nil} (the
1272default value), Emacs tries to start GDB in non-stop mode. Note that
1273GDB debugging session needs to be restarted for change of this setting
1274to take effect.
1275
1276@vindex gdb-switch-when-another-stopped
1277When a thread stops in non-stop mode, Emacs automatically switches to
1278that thread. It may be undesirable to allow switching of current
1279thread when some other stopped thread is already selected. Set
1280@code{gdb-switch-when-another-stopped} to @code{nil} to prevent this.
1281
1282@vindex gdb-switch-reasons
1283Emacs can decide whether or not to switch to the stopped thread
1284depending on the reason which caused the stop. Customize
1285@code{gdb-switch-reasons} to select stop reasons which make Emacs
1286switch thread.
1287
1288@vindex gdb-stopped-hooks
1289The variable @code{gdb-stopped-hooks} allows you to execute your
1290functions whenever some thread stops.
1291
1292 In non-stop mode, you can switch between different modes for GUD
1293execution control commands.
1294
1295@vindex gdb-gud-control-all-threads
1296@table @dfn
1297@item Non-stop/A
1298
1299When @code{gdb-gud-control-all-threads} is @code{t} (the default
1300value), interruption and continuation commands apply to all threads,
1301so you can halt or continue all your threads with one command using
1302@code{gud-stop-subjob} and @code{gud-cont}, respectively. The
1303@samp{Go} button is shown on the toolbar when at least one thread is
1304stopped, whereas @samp{Stop} button is shown when at least one thread
1305is running.
1306
1307@item Non-stop/T
1308
1309When @code{gdb-gud-control-all-threads} is @code{nil}, only the
1310current thread is stopped/continued. @samp{Go} and @samp{Stop}
1311buttons on the GUD toolbar are shown depending on the state of current
1312thread.
1313@end table
1314
1315You can change the current value of @code{gdb-gud-control-all-threads}
1316from the tool bar or from @samp{GUD->GDB-MI} menu.
1317
1318 Stepping commands always apply to the current thread.
1319
1320@subsubheading Fine Thread Control
1321
1322 In non-stop mode, you can interrupt/continue your threads without
1323selecting them. Hitting @kbd{i} in threads buffer interrupts thread
1324under point, @kbd{c} continues it, @kbd{s} steps through. More such
1325commands may be added in the future.
1326
1327Combined with creating bound buffers for any thread, this allows you
1328to change and track state of many threads in the same time.
1329
1330 Note that when you interrupt a thread, it stops with @samp{signal
1331received} reason. If that reason is included in your
1332@code{gdb-switch-reasons} (it is by default), Emacs will switch to
1333that thread.
1334 1195
1335@node Executing Lisp 1196@node Executing Lisp
1336@section Executing Lisp Expressions 1197@section Executing Lisp Expressions
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 4b9ea28dcc3..7037574245a 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -745,16 +745,14 @@ Running Debuggers Under Emacs
745 745
746GDB Graphical Interface 746GDB Graphical Interface
747 747
748* GDB-UI Layout:: Control the number of displayed buffers. 748* GDB-UI Layout:: Control the number of displayed buffers.
749* Source Buffers:: Use the mouse in the fringe/margin to 749* Source Buffers:: Use the mouse in the fringe/margin to
750 control your program. 750 control your program.
751* Breakpoints Buffer:: A breakpoint control panel. 751* Breakpoints Buffer:: A breakpoint control panel.
752* Threads Buffer:: Displays your threads. 752* Stack Buffer:: Select a frame from the call stack.
753* Stack Buffer:: Select a frame from the call stack. 753* Other GDB-UI Buffers::Input/output, locals, registers,
754* Other GDB-UI Buffers:: Input/output, locals, registers, 754 assembler, threads and memory buffers.
755 assembler, threads and memory buffers. 755* Watch Expressions:: Monitor variable values in the speedbar.
756* Watch Expressions:: Monitor variable values in the speedbar.
757* Multithreaded Debugging:: Debugging programs with several threads.
758 756
759Maintaining Large Programs 757Maintaining Large Programs
760 758
diff --git a/etc/NEWS b/etc/NEWS
index 6fda272c0d0..b687d397581 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -218,11 +218,10 @@ dired buffers automatically on revisiting.
218*** When `doc-view-continuous' is non-nil, scrolling a line 218*** When `doc-view-continuous' is non-nil, scrolling a line
219on the page edge advances to the next/previous page. 219on the page edge advances to the next/previous page.
220 220
221** gdb-mi 221** GDB-UI
222 222
223*** GDB User Interface migrated to GDB Machine Interface and now 223*** Toolbar functionality for reverse debugging. Display of STL collections as
224supports multithread non-stop debugging and debugging of several 224 watch expressions. These features require GDB 7.0 or later.
225threads simultaneously.
226 225
227** Grep 226** Grep
228 227
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 387144c19d7..dfa3a98871e 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -1233,7 +1233,7 @@ ELCFILES = \
1233 $(lisp)/progmodes/f90.elc \ 1233 $(lisp)/progmodes/f90.elc \
1234 $(lisp)/progmodes/flymake.elc \ 1234 $(lisp)/progmodes/flymake.elc \
1235 $(lisp)/progmodes/fortran.elc \ 1235 $(lisp)/progmodes/fortran.elc \
1236 $(lisp)/progmodes/gdb-mi.elc \ 1236 $(lisp)/progmodes/gdb-ui.elc \
1237 $(lisp)/progmodes/glasses.elc \ 1237 $(lisp)/progmodes/glasses.elc \
1238 $(lisp)/progmodes/grep.elc \ 1238 $(lisp)/progmodes/grep.elc \
1239 $(lisp)/progmodes/gud.elc \ 1239 $(lisp)/progmodes/gud.elc \
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
deleted file mode 100644
index 0f9532dcb3e..00000000000
--- a/lisp/progmodes/gdb-mi.el
+++ /dev/null
@@ -1,4192 +0,0 @@
1;;; gdb-mi.el --- User Interface for running GDB
2
3;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
4
5;; Author: Nick Roberts <nickrob@gnu.org>
6;; Maintainer: FSF
7;; Keywords: unix, tools
8
9;; This file is part of GNU Emacs.
10
11;; Homepage: http://www.emacswiki.org/emacs/GDB-MI
12
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26;;; Credits:
27
28;; This file was written by by Nick Roberts following the general design
29;; used in gdb-ui.el for Emacs 22.1 - 23.1. It is currently being developed
30;; by Dmitry Dzhus <dima@sphinx.net.ru> as part of the Google Summer
31;; of Code 2009 Project "Emacs GDB/MI migration".
32
33;;; Commentary:
34
35;; This mode acts as a graphical user interface to GDB. You can interact with
36;; GDB through the GUD buffer in the usual way, but there are also further
37;; buffers which control the execution and describe the state of your program.
38;; It separates the input/output of your program from that of GDB and displays
39;; expressions and their current values in their own buffers. It also uses
40;; features of Emacs 21 such as the fringe/display margin for breakpoints, and
41;; the toolbar (see the GDB Graphical Interface section in the Emacs info
42;; manual).
43
44;; M-x gdb will start the debugger.
45
46;; This file uses GDB/MI as the primary interface to GDB. It is still under
47;; development and is part of a process to migrate Emacs from annotations (as
48;; used in gdb-ui.el) to GDB/MI. It runs gdb with GDB/MI (-interp=mi) and
49;; access CLI using "-interpreter-exec console cli-command". This code works
50;; without gdb-ui.el and uses MI tokens instead of queues. Eventually MI
51;; should be asynchronous.
52
53;; This mode will PARTLY WORK WITH RECENT GDB RELEASES (status in modeline
54;; doesn't update properly when execution commands are issued from GUD buffer)
55;; and WORKS BEST when GDB runs asynchronously: maint set linux-async on.
56;;
57;; You need development version of GDB 7.0 for the thread buffer to work.
58
59;; This file replaces gdb-ui.el and is for development with GDB. Use the
60;; release branch of Emacs 22 for the latest version of gdb-ui.el.
61
62;; Windows Platforms:
63
64;; If you are using Emacs and GDB on Windows you will need to flush the buffer
65;; explicitly in your program if you want timely display of I/O in Emacs.
66;; Alternatively you can make the output stream unbuffered, for example, by
67;; using a macro:
68
69;; #ifdef UNBUFFERED
70;; setvbuf (stdout, (char *) NULL, _IONBF, 0);
71;; #endif
72
73;; and compiling with -DUNBUFFERED while debugging.
74
75;; If you are using Cygwin GDB and find that the source is not being displayed
76;; in Emacs when you step through it, possible solutions are to:
77
78;; 1) Use Cygwin X Windows and Cygwin Emacs.
79;; (Since 22.1 Emacs builds under Cygwin.)
80;; 2) Use MinGW GDB instead.
81;; 3) Use cygwin-mount.el
82
83;;; Mac OSX:
84
85;; GDB in Emacs on Mac OSX works best with FSF GDB as Apple have made
86;; some changes to the version that they include as part of Mac OSX.
87;; This requires GDB version 7.0 or later (estimated release date Aug 2009)
88;; as earlier versions don not compile on Mac OSX.
89
90;;; Known Bugs:
91
92;; 1) Stack buffer doesn't parse MI output if you stop in a routine without
93;; line information, e.g., a routine in libc (just a TODO item).
94
95;; TODO:
96;; 2) Watch windows to work with threads.
97;; 3) Use treebuffer.el instead of the speedbar for watch-expressions?
98;; 4) Mark breakpoint locations on scroll-bar of source buffer?
99
100;;; Code:
101
102(require 'gud)
103(require 'json)
104(require 'bindat)
105(eval-when-compile (require 'cl))
106
107(defvar tool-bar-map)
108(defvar speedbar-initial-expansion-list-name)
109(defvar speedbar-frame)
110
111(defvar gdb-memory-address "main")
112(defvar gdb-memory-last-address nil
113 "Last successfully accessed memory address.")
114(defvar gdb-memory-next-page nil
115 "Address of next memory page for program memory buffer.")
116(defvar gdb-memory-prev-page nil
117 "Address of previous memory page for program memory buffer.")
118
119(defvar gdb-thread-number nil
120 "Main current thread.
121
122Invalidation triggers use this variable to query GDB for
123information on the specified thread by wrapping GDB/MI commands
124in `gdb-current-context-command'.
125
126This variable may be updated implicitly by GDB via `gdb-stopped'
127or explicitly by `gdb-select-thread'.
128
129Only `gdb-setq-thread-number' should be used to change this
130value.")
131
132(defvar gdb-frame-number nil
133 "Selected frame level for main current thread.
134
135Updated according to the following rules:
136
137When a thread is selected or current thread stops, set to \"0\".
138
139When current thread goes running (and possibly exits eventually),
140set to nil.
141
142May be manually changed by user with `gdb-select-frame'.")
143
144(defvar gdb-frame-address nil "Identity of frame for watch expression.")
145
146;; Used to show overlay arrow in source buffer. All set in
147;; gdb-get-main-selected-frame. Disassembly buffer should not use
148;; these but rely on buffer-local thread information instead.
149(defvar gdb-selected-frame nil
150 "Name of selected function for main current thread.")
151(defvar gdb-selected-file nil
152 "Name of selected file for main current thread.")
153(defvar gdb-selected-line nil
154 "Number of selected line for main current thread.")
155
156(defvar gdb-threads-list nil
157 "Associative list of threads provided by \"-thread-info\" MI command.
158
159Keys are thread numbers (in strings) and values are structures as
160returned from -thread-info by `gdb-json-partial-output'. Updated in
161`gdb-thread-list-handler-custom'.")
162
163(defvar gdb-running-threads-count nil
164 "Number of currently running threads.
165
166Nil means that no information is available.
167
168Updated in `gdb-thread-list-handler-custom'.")
169
170(defvar gdb-stopped-threads-count nil
171 "Number of currently stopped threads.
172
173See also `gdb-running-threads-count'.")
174
175(defvar gdb-breakpoints-list nil
176 "Associative list of breakpoints provided by \"-break-list\" MI command.
177
178Keys are breakpoint numbers (in string) and values are structures
179as returned from \"-break-list\" by `gdb-json-partial-output'
180\(\"body\" field is used). Updated in
181`gdb-breakpoints-list-handler-custom'.")
182
183(defvar gdb-current-language nil)
184(defvar gdb-var-list nil
185 "List of variables in watch window.
186Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP)
187where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame
188address for root variables.")
189(defvar gdb-main-file nil "Source file from which program execution begins.")
190
191;; Overlay arrow markers
192(defvar gdb-stack-position nil)
193(defvar gdb-thread-position nil)
194(defvar gdb-disassembly-position nil)
195
196(defvar gdb-location-alist nil
197 "Alist of breakpoint numbers and full filenames. Only used for files that
198Emacs can't find.")
199(defvar gdb-active-process nil
200 "GUD tooltips display variable values when t, and macro definitions otherwise.")
201(defvar gdb-error "Non-nil when GDB is reporting an error.")
202(defvar gdb-macro-info nil
203 "Non-nil if GDB knows that the inferior includes preprocessor macro info.")
204(defvar gdb-register-names nil "List of register names.")
205(defvar gdb-changed-registers nil
206 "List of changed register numbers (strings).")
207(defvar gdb-buffer-fringe-width nil)
208(defvar gdb-last-command nil)
209(defvar gdb-prompt-name nil)
210(defvar gdb-token-number 0)
211(defvar gdb-handler-alist '())
212(defvar gdb-handler-number nil)
213(defvar gdb-source-file-list nil
214 "List of source files for the current executable.")
215(defvar gdb-first-done-or-error t)
216(defvar gdb-source-window nil)
217(defvar gdb-inferior-status nil)
218(defvar gdb-continuation nil)
219(defvar gdb-version nil)
220(defvar gdb-filter-output nil
221 "Message to be shown in GUD console.
222
223This variable is updated in `gdb-done-or-error' and returned by
224`gud-gdbmi-marker-filter'.")
225
226(defvar gdb-non-stop nil
227 "Indicates whether current GDB session is using non-stop mode.
228
229It is initialized to `gdb-non-stop-setting' at the beginning of
230every GDB session.")
231
232(defvar gdb-buffer-type nil
233 "One of the symbols bound in `gdb-buffer-rules'.")
234(make-variable-buffer-local 'gdb-buffer-type)
235
236(defvar gdb-output-sink 'nil
237 "The disposition of the output of the current gdb command.
238Possible values are these symbols:
239
240 `user' -- gdb output should be copied to the GUD buffer
241 for the user to see.
242
243 `emacs' -- output should be collected in the partial-output-buffer
244 for subsequent processing by a command. This is the
245 disposition of output generated by commands that
246 gdb mode sends to gdb on its own behalf.")
247
248;; Pending triggers prevent congestion: Emacs won't send two similar
249;; consecutive requests.
250
251(defvar gdb-pending-triggers '()
252 "A list of trigger functions which have not yet been handled.
253
254Elements are either function names or pairs (buffer . function)")
255
256(defmacro gdb-add-pending (item)
257 `(push ,item gdb-pending-triggers))
258(defmacro gdb-pending-p (item)
259 `(member ,item gdb-pending-triggers))
260(defmacro gdb-delete-pending (item)
261 `(setq gdb-pending-triggers
262 (delete ,item gdb-pending-triggers)))
263
264(defmacro gdb-wait-for-pending (&rest body)
265 "Wait until `gdb-pending-triggers' is empty and evaluate FORM.
266
267This function checks `gdb-pending-triggers' value every
268`gdb-wait-for-pending' seconds."
269 (run-with-timer
270 0.5 nil
271 `(lambda ()
272 (if (not gdb-pending-triggers)
273 (progn ,@body)
274 (gdb-wait-for-pending ,@body)))))
275
276;; Publish-subscribe
277
278(defmacro gdb-add-subscriber (publisher subscriber)
279 "Register new PUBLISHER's SUBSCRIBER.
280
281SUBSCRIBER must be a pair, where cdr is a function of one
282argument (see `gdb-emit-signal')."
283 `(add-to-list ',publisher ,subscriber t))
284
285(defmacro gdb-delete-subscriber (publisher subscriber)
286 "Unregister SUBSCRIBER from PUBLISHER."
287 `(setq ,publisher (delete ,subscriber
288 ,publisher)))
289
290(defun gdb-get-subscribers (publisher)
291 publisher)
292
293(defun gdb-emit-signal (publisher &optional signal)
294 "Call cdr for each subscriber of PUBLISHER with SIGNAL as argument."
295 (dolist (subscriber (gdb-get-subscribers publisher))
296 (funcall (cdr subscriber) signal)))
297
298(defvar gdb-buf-publisher '()
299 "Used to invalidate GDB buffers by emitting a signal in
300`gdb-update'.
301
302Must be a list of pairs with cars being buffers and cdr's being
303valid signal handlers.")
304
305(defgroup gdb nil
306 "GDB graphical interface"
307 :group 'tools
308 :link '(info-link "(emacs)GDB Graphical Interface")
309 :version "23.2")
310
311(defgroup gdb-non-stop nil
312 "GDB non-stop debugging settings"
313 :group 'gdb
314 :version "23.2")
315
316(defgroup gdb-buffers nil
317 "GDB buffers"
318 :group 'gdb
319 :version "23.2")
320
321(defcustom gdb-debug-log-max 128
322 "Maximum size of `gdb-debug-log'. If nil, size is unlimited."
323 :group 'gdb
324 :type '(choice (integer :tag "Number of elements")
325 (const :tag "Unlimited" nil))
326 :version "22.1")
327
328(defcustom gdb-non-stop-setting t
329 "When in non-stop mode, stopped threads can be examined while
330other threads continue to execute.
331
332GDB session needs to be restarted for this setting to take
333effect."
334 :type 'boolean
335 :group 'gdb-non-stop
336 :version "23.2")
337
338;; TODO Some commands can't be called with --all (give a notice about
339;; it in setting doc)
340(defcustom gdb-gud-control-all-threads t
341 "When enabled, GUD execution commands affect all threads when
342in non-stop mode. Otherwise, only current thread is affected."
343 :type 'boolean
344 :group 'gdb-non-stop
345 :version "23.2")
346
347(defcustom gdb-switch-reasons t
348 "List of stop reasons which cause Emacs to switch to the thread
349which caused the stop. When t, switch to stopped thread no matter
350what the reason was. When nil, never switch to stopped thread
351automatically.
352
353This setting is used in non-stop mode only. In all-stop mode,
354Emacs always switches to the thread which caused the stop."
355 ;; exited, exited-normally and exited-signalled are not
356 ;; thread-specific stop reasons and therefore are not included in
357 ;; this list
358 :type '(choice
359 (const :tag "All reasons" t)
360 (set :tag "Selection of reasons..."
361 (const :tag "A breakpoint was reached." "breakpoint-hit")
362 (const :tag "A watchpoint was triggered." "watchpoint-trigger")
363 (const :tag "A read watchpoint was triggered." "read-watchpoint-trigger")
364 (const :tag "An access watchpoint was triggered." "access-watchpoint-trigger")
365 (const :tag "Function finished execution." "function-finished")
366 (const :tag "Location reached." "location-reached")
367 (const :tag "Watchpoint has gone out of scope" "watchpoint-scope")
368 (const :tag "End of stepping range reached." "end-stepping-range")
369 (const :tag "Signal received (like interruption)." "signal-received"))
370 (const :tag "None" nil))
371 :group 'gdb-non-stop
372 :version "23.2"
373 :link '(info-link "(gdb)GDB/MI Async Records"))
374
375(defcustom gdb-stopped-hooks nil
376 "This variable holds a list of functions to be called whenever
377GDB stops.
378
379Each function takes one argument, a parsed MI response, which
380contains fields of corresponding MI *stopped async record:
381
382 ((stopped-threads . \"all\")
383 (thread-id . \"1\")
384 (frame (line . \"38\")
385 (fullname . \"/home/sphinx/projects/gsoc/server.c\")
386 (file . \"server.c\")
387 (args ((value . \"0x804b038\")
388 (name . \"arg\")))
389 (func . \"hello\")
390 (addr . \"0x0804869e\"))
391 (reason . \"end-stepping-range\"))
392
393Note that \"reason\" is only present in non-stop debugging mode.
394
395`bindat-get-field' may be used to access the fields of response.
396
397Each function is called after the new current thread was selected
398and GDB buffers were updated in `gdb-stopped'."
399 :type '(repeat function)
400 :group 'gdb
401 :version "23.2"
402 :link '(info-link "(gdb)GDB/MI Async Records"))
403
404(defcustom gdb-switch-when-another-stopped t
405 "When nil, Emacs won't switch to stopped thread if some other
406stopped thread is already selected."
407 :type 'boolean
408 :group 'gdb-non-stop
409 :version "23.2")
410
411(defcustom gdb-stack-buffer-locations t
412 "Show file information or library names in stack buffers."
413 :type 'boolean
414 :group 'gdb-buffers
415 :version "23.2")
416
417(defcustom gdb-stack-buffer-addresses nil
418 "Show frame addresses in stack buffers."
419 :type 'boolean
420 :group 'gdb-buffers
421 :version "23.2")
422
423(defcustom gdb-thread-buffer-verbose-names t
424 "Show long thread names in threads buffer."
425 :type 'boolean
426 :group 'gdb-buffers
427 :version "23.2")
428
429(defcustom gdb-thread-buffer-arguments t
430 "Show function arguments in threads buffer."
431 :type 'boolean
432 :group 'gdb-buffers
433 :version "23.2")
434
435(defcustom gdb-thread-buffer-locations t
436 "Show file information or library names in threads buffer."
437 :type 'boolean
438 :group 'gdb-buffers
439 :version "23.2")
440
441(defcustom gdb-thread-buffer-addresses nil
442 "Show addresses for thread frames in threads buffer."
443 :type 'boolean
444 :group 'gdb-buffers
445 :version "23.2")
446
447(defcustom gdb-show-threads-by-default nil
448 "Show threads list buffer instead of breakpoints list by
449default."
450 :type 'boolean
451 :group 'gdb-buffers
452 :version "23.2")
453
454(defvar gdb-debug-log nil
455 "List of commands sent to and replies received from GDB.
456Most recent commands are listed first. This list stores only the last
457`gdb-debug-log-max' values. This variable is used to debug GDB-MI.")
458
459;;;###autoload
460(defcustom gdb-enable-debug nil
461 "Non-nil means record the process input and output in `gdb-debug-log'."
462 :type 'boolean
463 :group 'gdb
464 :version "22.1")
465
466(defcustom gdb-cpp-define-alist-program "gcc -E -dM -"
467 "Shell command for generating a list of defined macros in a source file.
468This list is used to display the #define directive associated
469with an identifier as a tooltip. It works in a debug session with
470GDB, when `gud-tooltip-mode' is t.
471
472Set `gdb-cpp-define-alist-flags' for any include paths or
473predefined macros."
474 :type 'string
475 :group 'gdb
476 :version "22.1")
477
478(defcustom gdb-cpp-define-alist-flags ""
479 "Preprocessor flags for `gdb-cpp-define-alist-program'."
480 :type 'string
481 :group 'gdb
482 :version "22.1")
483
484 (defcustom gdb-create-source-file-list t
485 "Non-nil means create a list of files from which the executable was built.
486 Set this to nil if the GUD buffer displays \"initializing...\" in the mode
487 line for a long time when starting, possibly because your executable was
488 built from a large number of files. This allows quicker initialization
489 but means that these files are not automatically enabled for debugging,
490 e.g., you won't be able to click in the fringe to set a breakpoint until
491 execution has already stopped there."
492 :type 'boolean
493 :group 'gdb
494 :version "23.1")
495
496(defcustom gdb-show-main nil
497 "Non-nil means display source file containing the main routine at startup.
498Also display the main routine in the disassembly buffer if present."
499 :type 'boolean
500 :group 'gdb
501 :version "22.1")
502
503(defun gdb-force-mode-line-update (status)
504 (let ((buffer gud-comint-buffer))
505 (if (and buffer (buffer-name buffer))
506 (with-current-buffer buffer
507 (setq mode-line-process
508 (format ":%s [%s]"
509 (process-status (get-buffer-process buffer)) status))
510 ;; Force mode line redisplay soon.
511 (force-mode-line-update)))))
512
513(defun gdb-enable-debug (arg)
514 "Toggle logging of transaction between Emacs and Gdb.
515The log is stored in `gdb-debug-log' as an alist with elements
516whose cons is send, send-item or recv and whose cdr is the string
517being transferred. This list may grow up to a size of
518`gdb-debug-log-max' after which the oldest element (at the end of
519the list) is deleted every time a new one is added (at the front)."
520 (interactive "P")
521 (setq gdb-enable-debug
522 (if (null arg)
523 (not gdb-enable-debug)
524 (> (prefix-numeric-value arg) 0)))
525 (message (format "Logging of transaction %sabled"
526 (if gdb-enable-debug "en" "dis"))))
527
528;; These two are used for menu and toolbar
529(defun gdb-control-all-threads ()
530 "Switch to non-stop/A mode."
531 (interactive)
532 (setq gdb-gud-control-all-threads t)
533 ;; Actually forcing the tool-bar to update.
534 (force-mode-line-update)
535 (message "Now in non-stop/A mode."))
536
537(defun gdb-control-current-thread ()
538 "Switch to non-stop/T mode."
539 (interactive)
540 (setq gdb-gud-control-all-threads nil)
541 ;; Actually forcing the tool-bar to update.
542 (force-mode-line-update)
543 (message "Now in non-stop/T mode."))
544
545(defun gdb-find-watch-expression ()
546 (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
547 (varnum (car var)) expr array)
548 (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum)
549 (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet
550 (component-list (split-string (match-string 2 varnum) "\\." t)))
551 (setq expr (nth 1 var1))
552 (setq varnumlet (car var1))
553 (dolist (component component-list)
554 (setq var2 (assoc varnumlet gdb-var-list))
555 (setq expr (concat expr
556 (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2))
557 (concat "[" component "]")
558 (concat "." component))))
559 (setq varnumlet (concat varnumlet "." component)))
560 expr)))
561
562;; noall is used for commands which don't take --all, but only
563;; --thread.
564(defun gdb-gud-context-command (command &optional noall)
565 "When `gdb-non-stop' is t, add --thread option to COMMAND if
566`gdb-gud-control-all-threads' is nil and --all option otherwise.
567If NOALL is t, always add --thread option no matter what
568`gdb-gud-control-all-threads' value is.
569
570When `gdb-non-stop' is nil, return COMMAND unchanged."
571 (if gdb-non-stop
572 (if (and gdb-gud-control-all-threads
573 (not noall)
574 (string-equal gdb-version "7.0+"))
575 (concat command " --all ")
576 (gdb-current-context-command command))
577 command))
578
579(defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg)
580 "`gud-call' wrapper which adds --thread/--all options between
581CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'.
582
583NOARG must be t when this macro is used outside `gud-def'"
584 `(gud-call
585 (concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
586 ,(when (not noarg) 'arg)))
587
588;;;###autoload
589(defun gdb (command-line)
590 "Run gdb on program FILE in buffer *gud-FILE*.
591The directory containing FILE becomes the initial working directory
592and source-file directory for your debugger.
593
594If `gdb-many-windows' is nil (the default value) then gdb just
595pops up the GUD buffer unless `gdb-show-main' is t. In this case
596it starts with two windows: one displaying the GUD buffer and the
597other with the source file with the main routine of the inferior.
598
599If `gdb-many-windows' is t, regardless of the value of
600`gdb-show-main', the layout below will appear. Keybindings are
601shown in some of the buffers.
602
603Watch expressions appear in the speedbar/slowbar.
604
605The following commands help control operation :
606
607`gdb-many-windows' - Toggle the number of windows gdb uses.
608`gdb-restore-windows' - To restore the window layout.
609
610See Info node `(emacs)GDB Graphical Interface' for a more
611detailed description of this mode.
612
613
614+----------------------------------------------------------------------+
615| GDB Toolbar |
616+-----------------------------------+----------------------------------+
617| GUD buffer (I/O of GDB) | Locals buffer |
618| | |
619| | |
620| | |
621+-----------------------------------+----------------------------------+
622| Source buffer | I/O buffer (of debugged program) |
623| | (comint-mode) |
624| | |
625| | |
626| | |
627| | |
628| | |
629| | |
630+-----------------------------------+----------------------------------+
631| Stack buffer | Breakpoints buffer |
632| RET gdb-select-frame | SPC gdb-toggle-breakpoint |
633| | RET gdb-goto-breakpoint |
634| | D gdb-delete-breakpoint |
635+-----------------------------------+----------------------------------+"
636 ;;
637 (interactive (list (gud-query-cmdline 'gdb)))
638
639 (when (and gud-comint-buffer
640 (buffer-name gud-comint-buffer)
641 (get-buffer-process gud-comint-buffer)
642 (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
643 (gdb-restore-windows)
644 (error
645 "Multiple debugging requires restarting in text command mode"))
646 ;;
647 (gud-common-init command-line nil 'gud-gdbmi-marker-filter)
648 (set (make-local-variable 'gud-minor-mode) 'gdbmi)
649 (setq comint-input-sender 'gdb-send)
650
651 (gud-def gud-tbreak "tbreak %f:%l" "\C-t"
652 "Set temporary breakpoint at current line.")
653 (gud-def gud-jump
654 (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l"))
655 "\C-j" "Set execution address to current line.")
656
657 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
658 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
659 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
660 (gud-def gud-pstar "print* %e" nil
661 "Evaluate C dereferenced pointer expression at point.")
662
663 (gud-def gud-step (gdb-gud-context-call "-exec-step" "%p" t)
664 "\C-s"
665 "Step one source line with display.")
666 (gud-def gud-stepi (gdb-gud-context-call "-exec-step-instruction" "%p" t)
667 "\C-i"
668 "Step one instruction with display.")
669 (gud-def gud-next (gdb-gud-context-call "-exec-next" "%p" t)
670 "\C-n"
671 "Step one line (skip functions).")
672 (gud-def gud-nexti (gdb-gud-context-call "-exec-next-instruction" "%p" t)
673 nil
674 "Step one instruction (skip functions).")
675 (gud-def gud-cont (gdb-gud-context-call "-exec-continue")
676 "\C-r"
677 "Continue with display.")
678 (gud-def gud-finish (gdb-gud-context-call "-exec-finish" nil t)
679 "\C-f"
680 "Finish executing current function.")
681 (gud-def gud-run "-exec-run"
682 nil
683 "Run the program.")
684
685 (gud-def gud-break (if (not (string-match "Disassembly" mode-name))
686 (gud-call "break %f:%l" arg)
687 (save-excursion
688 (beginning-of-line)
689 (forward-char 2)
690 (gud-call "break *%a" arg)))
691 "\C-b" "Set breakpoint at current line or address.")
692
693 (gud-def gud-remove (if (not (string-match "Disassembly" mode-name))
694 (gud-call "clear %f:%l" arg)
695 (save-excursion
696 (beginning-of-line)
697 (forward-char 2)
698 (gud-call "clear *%a" arg)))
699 "\C-d" "Remove breakpoint at current line or address.")
700
701 ;; -exec-until doesn't support --all yet
702 (gud-def gud-until (if (not (string-match "Disassembly" mode-name))
703 (gud-call "-exec-until %f:%l" arg)
704 (save-excursion
705 (beginning-of-line)
706 (forward-char 2)
707 (gud-call "-exec-until *%a" arg)))
708 "\C-u" "Continue to current line or address.")
709 ;; TODO Why arg here?
710 (gud-def
711 gud-go (gud-call (if gdb-active-process
712 (gdb-gud-context-command "-exec-continue")
713 "-exec-run") arg)
714 nil "Start or continue execution.")
715
716 ;; For debugging Emacs only.
717 (gud-def gud-pp
718 (gud-call
719 (concat
720 "pp1 " (if (eq (buffer-local-value
721 'major-mode (window-buffer)) 'speedbar-mode)
722 (gdb-find-watch-expression) "%e")) arg)
723 nil "Print the Emacs s-expression.")
724
725 (define-key gud-minor-mode-map [left-margin mouse-1]
726 'gdb-mouse-set-clear-breakpoint)
727 (define-key gud-minor-mode-map [left-fringe mouse-1]
728 'gdb-mouse-set-clear-breakpoint)
729 (define-key gud-minor-mode-map [left-margin C-mouse-1]
730 'gdb-mouse-toggle-breakpoint-margin)
731 (define-key gud-minor-mode-map [left-fringe C-mouse-1]
732 'gdb-mouse-toggle-breakpoint-fringe)
733
734 (define-key gud-minor-mode-map [left-margin drag-mouse-1]
735 'gdb-mouse-until)
736 (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
737 'gdb-mouse-until)
738 (define-key gud-minor-mode-map [left-margin mouse-3]
739 'gdb-mouse-until)
740 (define-key gud-minor-mode-map [left-fringe mouse-3]
741 'gdb-mouse-until)
742
743 (define-key gud-minor-mode-map [left-margin C-drag-mouse-1]
744 'gdb-mouse-jump)
745 (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1]
746 'gdb-mouse-jump)
747 (define-key gud-minor-mode-map [left-fringe C-mouse-3]
748 'gdb-mouse-jump)
749 (define-key gud-minor-mode-map [left-margin C-mouse-3]
750 'gdb-mouse-jump)
751
752 (local-set-key "\C-i" 'gud-gdb-complete-command)
753 (setq gdb-first-prompt t)
754 (setq gud-running nil)
755
756 (gdb-update)
757
758 (run-hooks 'gdb-mode-hook))
759
760(defun gdb-init-1 ()
761 ;; (re-)initialise
762 (setq gdb-selected-frame nil
763 gdb-frame-number nil
764 gdb-thread-number nil
765 gdb-var-list nil
766 gdb-pending-triggers nil
767 gdb-output-sink 'user
768 gdb-location-alist nil
769 gdb-source-file-list nil
770 gdb-last-command nil
771 gdb-token-number 0
772 gdb-handler-alist '()
773 gdb-handler-number nil
774 gdb-prompt-name nil
775 gdb-first-done-or-error t
776 gdb-buffer-fringe-width (car (window-fringes))
777 gdb-debug-log nil
778 gdb-source-window nil
779 gdb-inferior-status nil
780 gdb-continuation nil
781 gdb-buf-publisher '()
782 gdb-threads-list '()
783 gdb-breakpoints-list '()
784 gdb-register-names '()
785 gdb-non-stop gdb-non-stop-setting)
786 ;;
787 (setq gdb-buffer-type 'gdbmi)
788 ;;
789 (gdb-force-mode-line-update
790 (propertize "initializing..." 'face font-lock-variable-name-face))
791
792 (gdb-get-buffer-create 'gdb-inferior-io)
793 (gdb-clear-inferior-io)
794 (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter)
795 (gdb-input
796 ;; Needs GDB 6.4 onwards
797 (list (concat "-inferior-tty-set "
798 (process-tty-name (get-process "gdb-inferior")))
799 'ignore))
800 (if (eq window-system 'w32)
801 (gdb-input (list "-gdb-set new-console off" 'ignore)))
802 (gdb-input (list "-gdb-set height 0" 'ignore))
803
804 (when gdb-non-stop
805 (gdb-input (list "-gdb-set non-stop 1" 'gdb-non-stop-handler)))
806
807 ;; find source file and compilation directory here
808 (gdb-input
809 ; Needs GDB 6.2 onwards.
810 (list "-file-list-exec-source-files" 'gdb-get-source-file-list))
811 (if gdb-create-source-file-list
812 (gdb-input
813 ; Needs GDB 6.0 onwards.
814 (list "-file-list-exec-source-file" 'gdb-get-source-file)))
815 (gdb-input
816 (list "-gdb-show prompt" 'gdb-get-prompt)))
817
818(defun gdb-non-stop-handler ()
819 (goto-char (point-min))
820 (if (re-search-forward "No symbol" nil t)
821 (progn
822 (message "This version of GDB doesn't support non-stop mode. Turning it off.")
823 (setq gdb-non-stop nil)
824 (setq gdb-version "pre-7.0"))
825 (setq gdb-version "7.0+")
826 (gdb-input (list "-gdb-set target-async 1" 'ignore))
827 (gdb-input (list "-enable-pretty-printing" 'ignore))))
828
829(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")
830
831(defun gdb-create-define-alist ()
832 "Create an alist of #define directives for GUD tooltips."
833 (let* ((file (buffer-file-name))
834 (output
835 (with-output-to-string
836 (with-current-buffer standard-output
837 (and file
838 (file-exists-p file)
839 ;; call-process doesn't work with remote file names.
840 (not (file-remote-p default-directory))
841 (call-process shell-file-name file
842 (list t nil) nil "-c"
843 (concat gdb-cpp-define-alist-program " "
844 gdb-cpp-define-alist-flags))))))
845 (define-list (split-string output "\n" t))
846 (name))
847 (setq gdb-define-alist nil)
848 (dolist (define define-list)
849 (setq name (nth 1 (split-string define "[( ]")))
850 (push (cons name define) gdb-define-alist))))
851
852(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
853(defvar tooltip-use-echo-area)
854
855(defun gdb-tooltip-print (expr)
856 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
857 (goto-char (point-min))
858 (if (re-search-forward ".*value=\\(\".*\"\\)" nil t)
859 (tooltip-show
860 (concat expr " = " (read (match-string 1)))
861 (or gud-tooltip-echo-area tooltip-use-echo-area
862 (not (display-graphic-p)))))))
863
864;; If expr is a macro for a function don't print because of possible dangerous
865;; side-effects. Also printing a function within a tooltip generates an
866;; unexpected starting annotation (phase error).
867(defun gdb-tooltip-print-1 (expr)
868 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
869 (goto-char (point-min))
870 (if (search-forward "expands to: " nil t)
871 (unless (looking-at "\\S-+.*(.*).*")
872 (gdb-input
873 (list (concat "-data-evaluate-expression " expr)
874 `(lambda () (gdb-tooltip-print ,expr))))))))
875
876(defun gdb-init-buffer ()
877 (set (make-local-variable 'gud-minor-mode) 'gdbmi)
878 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
879 (when gud-tooltip-mode
880 (make-local-variable 'gdb-define-alist)
881 (gdb-create-define-alist)
882 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))
883
884(defmacro gdb-if-arrow (arrow-position &rest body)
885 `(if ,arrow-position
886 (let ((buffer (marker-buffer ,arrow-position)) (line))
887 (if (equal buffer (window-buffer (posn-window end)))
888 (with-current-buffer buffer
889 (when (or (equal start end)
890 (equal (posn-point start)
891 (marker-position ,arrow-position)))
892 ,@body))))))
893
894(defun gdb-mouse-until (event)
895 "Continue running until a source line past the current line.
896The destination source line can be selected either by clicking
897with mouse-3 on the fringe/margin or dragging the arrow
898with mouse-1 (default bindings)."
899 (interactive "e")
900 (let ((start (event-start event))
901 (end (event-end event)))
902 (gdb-if-arrow gud-overlay-arrow-position
903 (setq line (line-number-at-pos (posn-point end)))
904 (gud-call (concat "until " (number-to-string line))))
905 (gdb-if-arrow gdb-disassembly-position
906 (save-excursion
907 (goto-char (point-min))
908 (forward-line (1- (line-number-at-pos (posn-point end))))
909 (forward-char 2)
910 (gud-call (concat "until *%a"))))))
911
912(defun gdb-mouse-jump (event)
913 "Set execution address/line.
914The destination source line can be selected either by clicking with C-mouse-3
915on the fringe/margin or dragging the arrow with C-mouse-1 (default bindings).
916Unlike `gdb-mouse-until' the destination address can be before the current
917line, and no execution takes place."
918 (interactive "e")
919 (let ((start (event-start event))
920 (end (event-end event)))
921 (gdb-if-arrow gud-overlay-arrow-position
922 (setq line (line-number-at-pos (posn-point end)))
923 (progn
924 (gud-call (concat "tbreak " (number-to-string line)))
925 (gud-call (concat "jump " (number-to-string line)))))
926 (gdb-if-arrow gdb-disassembly-position
927 (save-excursion
928 (goto-char (point-min))
929 (forward-line (1- (line-number-at-pos (posn-point end))))
930 (forward-char 2)
931 (progn
932 (gud-call (concat "tbreak *%a"))
933 (gud-call (concat "jump *%a")))))))
934
935(defcustom gdb-show-changed-values t
936 "If non-nil change the face of out of scope variables and changed values.
937Out of scope variables are suppressed with `shadow' face.
938Changed values are highlighted with the face `font-lock-warning-face'."
939 :type 'boolean
940 :group 'gdb
941 :version "22.1")
942
943(defcustom gdb-max-children 40
944 "Maximum number of children before expansion requires confirmation."
945 :type 'integer
946 :group 'gdb
947 :version "22.1")
948
949(defcustom gdb-delete-out-of-scope t
950 "If non-nil delete watch expressions automatically when they go out of scope."
951 :type 'boolean
952 :group 'gdb
953 :version "22.2")
954
955(defcustom gdb-speedbar-auto-raise nil
956 "If non-nil raise speedbar every time display of watch expressions is\
957 updated."
958 :type 'boolean
959 :group 'gdb
960 :version "22.1")
961
962(defcustom gdb-use-colon-colon-notation nil
963 "If non-nil use FUN::VAR format to display variables in the speedbar."
964 :type 'boolean
965 :group 'gdb
966 :version "22.1")
967
968(defun gdb-speedbar-auto-raise (arg)
969 "Toggle automatic raising of the speedbar for watch expressions.
970With prefix argument ARG, automatically raise speedbar if ARG is
971positive, otherwise don't automatically raise it."
972 (interactive "P")
973 (setq gdb-speedbar-auto-raise
974 (if (null arg)
975 (not gdb-speedbar-auto-raise)
976 (> (prefix-numeric-value arg) 0)))
977 (message (format "Auto raising %sabled"
978 (if gdb-speedbar-auto-raise "en" "dis"))))
979
980(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
981(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)
982
983(declare-function tooltip-identifier-from-point "tooltip" (point))
984
985(defun gud-watch (&optional arg event)
986 "Watch expression at point.
987With arg, enter name of variable to be watched in the minibuffer."
988 (interactive (list current-prefix-arg last-input-event))
989 (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer)))
990 (if (eq minor-mode 'gdbmi)
991 (progn
992 (if event (posn-set-point (event-end event)))
993 (require 'tooltip)
994 (save-selected-window
995 (let ((expr
996 (if arg
997 (completing-read "Name of variable: "
998 'gud-gdb-complete-command)
999 (if (and transient-mark-mode mark-active)
1000 (buffer-substring (region-beginning) (region-end))
1001 (concat (if (eq major-mode 'gdb-registers-mode) "$")
1002 (tooltip-identifier-from-point (point)))))))
1003 (set-text-properties 0 (length expr) nil expr)
1004 (gdb-input
1005 (list (concat"-var-create - * " expr "")
1006 `(lambda () (gdb-var-create-handler ,expr)))))))
1007 (message "gud-watch is a no-op in this mode."))))
1008
1009(defun gdb-var-create-handler (expr)
1010 (let* ((result (gdb-json-partial-output)))
1011 (if (not (bindat-get-field result 'msg))
1012 (let ((var
1013 (list (bindat-get-field result 'name)
1014 (if (and (string-equal gdb-current-language "c")
1015 gdb-use-colon-colon-notation gdb-selected-frame)
1016 (setq expr (concat gdb-selected-frame "::" expr))
1017 expr)
1018 (bindat-get-field result 'numchild)
1019 (bindat-get-field result 'type)
1020 (bindat-get-field result 'value)
1021 nil
1022 (bindat-get-field result 'has_more)
1023 gdb-frame-address)))
1024 (push var gdb-var-list)
1025 (speedbar 1)
1026 (unless (string-equal
1027 speedbar-initial-expansion-list-name "GUD")
1028 (speedbar-change-initial-expansion-list "GUD")))
1029 (message-box "No symbol \"%s\" in current context." expr))))
1030
1031(defun gdb-speedbar-update ()
1032 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
1033 (not (gdb-pending-p 'gdb-speedbar-timer)))
1034 ;; Dummy command to update speedbar even when idle.
1035 (gdb-input (list "-environment-pwd" 'gdb-speedbar-timer-fn))
1036 ;; Keep gdb-pending-triggers non-nil till end.
1037 (gdb-add-pending 'gdb-speedbar-timer)))
1038
1039(defun gdb-speedbar-timer-fn ()
1040 (if gdb-speedbar-auto-raise
1041 (raise-frame speedbar-frame))
1042 (gdb-delete-pending 'gdb-speedbar-timer)
1043 (speedbar-timer-fn))
1044
1045(defun gdb-var-evaluate-expression-handler (varnum changed)
1046 (goto-char (point-min))
1047 (re-search-forward ".*value=\\(\".*\"\\)" nil t)
1048 (let ((var (assoc varnum gdb-var-list)))
1049 (when var
1050 (if changed (setcar (nthcdr 5 var) 'changed))
1051 (setcar (nthcdr 4 var) (read (match-string 1)))))
1052 (gdb-speedbar-update))
1053
1054; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
1055(defun gdb-var-list-children (varnum)
1056 (gdb-input
1057 (list (concat "-var-update " varnum) 'ignore))
1058 (gdb-input
1059 (list (concat "-var-list-children --all-values "
1060 varnum)
1061 `(lambda () (gdb-var-list-children-handler ,varnum)))))
1062
1063(defun gdb-var-list-children-handler (varnum)
1064 (let* ((var-list nil)
1065 (output (bindat-get-field (gdb-json-partial-output "child")))
1066 (children (bindat-get-field output 'children)))
1067 (catch 'child-already-watched
1068 (dolist (var gdb-var-list)
1069 (if (string-equal varnum (car var))
1070 (progn
1071 ;; With dynamic varobjs numchild may have increased.
1072 (setcar (nthcdr 2 var) (bindat-get-field output 'numchild))
1073 (push var var-list)
1074 (dolist (child children)
1075 (let ((varchild (list (bindat-get-field child 'name)
1076 (bindat-get-field child 'exp)
1077 (bindat-get-field child 'numchild)
1078 (bindat-get-field child 'type)
1079 (bindat-get-field child 'value)
1080 nil
1081 (bindat-get-field child 'has_more))))
1082 (if (assoc (car varchild) gdb-var-list)
1083 (throw 'child-already-watched nil))
1084 (push varchild var-list))))
1085 (push var var-list)))
1086 (setq gdb-var-list (nreverse var-list))))
1087 (gdb-speedbar-update))
1088
1089(defun gdb-var-set-format (format)
1090 "Set the output format for a variable displayed in the speedbar."
1091 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1092 (varnum (car var)))
1093 (gdb-input
1094 (list (concat "-var-set-format " varnum " " format) 'ignore))
1095 (gdb-var-update)))
1096
1097(defun gdb-var-delete-1 (var varnum)
1098 (gdb-input
1099 (list (concat "-var-delete " varnum) 'ignore))
1100 (setq gdb-var-list (delq var gdb-var-list))
1101 (dolist (varchild gdb-var-list)
1102 (if (string-match (concat (car var) "\\.") (car varchild))
1103 (setq gdb-var-list (delq varchild gdb-var-list)))))
1104
1105(defun gdb-var-delete ()
1106 "Delete watch expression at point from the speedbar."
1107 (interactive)
1108 (let ((text (speedbar-line-text)))
1109 (string-match "\\(\\S-+\\)" text)
1110 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1111 (varnum (car var)))
1112 (if (string-match "\\." (car var))
1113 (message-box "Can only delete a root expression")
1114 (gdb-var-delete-1 var varnum)))))
1115
1116(defun gdb-var-delete-children (varnum)
1117 "Delete children of variable object at point from the speedbar."
1118 (gdb-input
1119 (list (concat "-var-delete -c " varnum) 'ignore)))
1120
1121(defun gdb-edit-value (text token indent)
1122 "Assign a value to a variable displayed in the speedbar."
1123 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1124 (varnum (car var)) (value))
1125 (setq value (read-string "New value: "))
1126 (gdb-input
1127 (list (concat "-var-assign " varnum " " value)
1128 `(lambda () (gdb-edit-value-handler ,value))))))
1129
1130(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)")
1131
1132(defun gdb-edit-value-handler (value)
1133 (goto-char (point-min))
1134 (if (re-search-forward gdb-error-regexp nil t)
1135 (message-box "Invalid number or expression (%s)" value)))
1136
1137; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
1138(defun gdb-var-update ()
1139 (if (not (gdb-pending-p 'gdb-var-update))
1140 (gdb-input
1141 (list "-var-update --all-values *" 'gdb-var-update-handler)))
1142 (gdb-add-pending 'gdb-var-update))
1143
1144(defun gdb-var-update-handler ()
1145 (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist)))
1146 (dolist (var gdb-var-list)
1147 (setcar (nthcdr 5 var) nil))
1148 (let ((temp-var-list gdb-var-list))
1149 (dolist (change changelist)
1150 (let* ((varnum (bindat-get-field change 'name))
1151 (var (assoc varnum gdb-var-list))
1152 (new-num (bindat-get-field change 'new_num_children)))
1153 (when var
1154 (let ((scope (bindat-get-field change 'in_scope))
1155 (has-more (bindat-get-field change 'has_more)))
1156 (cond ((string-equal scope "false")
1157 (if gdb-delete-out-of-scope
1158 (gdb-var-delete-1 var varnum)
1159 (setcar (nthcdr 5 var) 'out-of-scope)))
1160 ((string-equal scope "true")
1161 (setcar (nthcdr 6 var) has-more)
1162 (when (and (or (not has-more)
1163 (string-equal has-more "0"))
1164 (not new-num)
1165 (string-equal (nth 2 var) "0"))
1166 (setcar (nthcdr 4 var)
1167 (bindat-get-field change 'value))
1168 (setcar (nthcdr 5 var) 'changed)))
1169 ((string-equal scope "invalid")
1170 (gdb-var-delete-1 var varnum)))))
1171 (let ((var-list nil) var1
1172 (children (bindat-get-field change 'new_children)))
1173 (if new-num
1174 (progn
1175 (setq var1 (pop temp-var-list))
1176 (while var1
1177 (if (string-equal varnum (car var1))
1178 (let ((new (string-to-number new-num))
1179 (previous (string-to-number (nth 2 var1))))
1180 (setcar (nthcdr 2 var1) new-num)
1181 (push var1 var-list)
1182 (cond ((> new previous)
1183 ;; Add new children to list.
1184 (dotimes (dummy previous)
1185 (push (pop temp-var-list) var-list))
1186 (dolist (child children)
1187 (let ((varchild
1188 (list (bindat-get-field child 'name)
1189 (bindat-get-field child 'exp)
1190 (bindat-get-field child 'numchild)
1191 (bindat-get-field child 'type)
1192 (bindat-get-field child 'value)
1193 'changed
1194 (bindat-get-field child 'has_more))))
1195 (push varchild var-list))))
1196 ;; Remove deleted children from list.
1197 ((< new previous)
1198 (dotimes (dummy new)
1199 (push (pop temp-var-list) var-list))
1200 (dotimes (dummy (- previous new))
1201 (pop temp-var-list)))))
1202 (push var1 var-list))
1203 (setq var1 (pop temp-var-list)))
1204 (setq gdb-var-list (nreverse var-list)))))))))
1205 (setq gdb-pending-triggers
1206 (delq 'gdb-var-update gdb-pending-triggers))
1207 (gdb-speedbar-update))
1208
1209(defun gdb-speedbar-expand-node (text token indent)
1210 "Expand the node the user clicked on.
1211TEXT is the text of the button we clicked on, a + or - item.
1212TOKEN is data related to this node.
1213INDENT is the current indentation depth."
1214 (cond ((string-match "+" text) ;expand this node
1215 (let* ((var (assoc token gdb-var-list))
1216 (expr (nth 1 var)) (children (nth 2 var)))
1217 (if (or (<= (string-to-number children) gdb-max-children)
1218 (y-or-n-p
1219 (format "%s has %s children. Continue? " expr children)))
1220 (gdb-var-list-children token))))
1221 ((string-match "-" text) ;contract this node
1222 (dolist (var gdb-var-list)
1223 (if (string-match (concat token "\\.") (car var))
1224 (setq gdb-var-list (delq var gdb-var-list))))
1225 (gdb-var-delete-children token)
1226 (speedbar-change-expand-button-char ?+)
1227 (speedbar-delete-subblock indent))
1228 (t (error "Ooops... not sure what to do")))
1229 (speedbar-center-buffer-smartly))
1230
1231(defun gdb-get-target-string ()
1232 (with-current-buffer gud-comint-buffer
1233 gud-target-name))
1234
1235
1236;;
1237;; gdb buffers.
1238;;
1239;; Each buffer has a TYPE -- a symbol that identifies the function
1240;; of that particular buffer.
1241;;
1242;; The usual gdb interaction buffer is given the type `gdbmi' and
1243;; is constructed specially.
1244;;
1245;; Others are constructed by gdb-get-buffer-create and
1246;; named according to the rules set forth in the gdb-buffer-rules
1247
1248(defvar gdb-buffer-rules '())
1249
1250(defun gdb-rules-name-maker (rules-entry)
1251 (cadr rules-entry))
1252(defun gdb-rules-buffer-mode (rules-entry)
1253 (nth 2 rules-entry))
1254(defun gdb-rules-update-trigger (rules-entry)
1255 (nth 3 rules-entry))
1256
1257(defun gdb-update-buffer-name ()
1258 "Rename current buffer according to name-maker associated with
1259it in `gdb-buffer-rules'."
1260 (let ((f (gdb-rules-name-maker (assoc gdb-buffer-type
1261 gdb-buffer-rules))))
1262 (when f (rename-buffer (funcall f)))))
1263
1264(defun gdb-current-buffer-rules ()
1265 "Get `gdb-buffer-rules' entry for current buffer type."
1266 (assoc gdb-buffer-type gdb-buffer-rules))
1267
1268(defun gdb-current-buffer-thread ()
1269 "Get thread object of current buffer from `gdb-threads-list'.
1270
1271When current buffer is not bound to any thread, return main
1272thread."
1273 (cdr (assoc gdb-thread-number gdb-threads-list)))
1274
1275(defun gdb-current-buffer-frame ()
1276 "Get current stack frame object for thread of current buffer."
1277 (bindat-get-field (gdb-current-buffer-thread) 'frame))
1278
1279(defun gdb-buffer-type (buffer)
1280 "Get value of `gdb-buffer-type' for BUFFER."
1281 (with-current-buffer buffer
1282 gdb-buffer-type))
1283
1284(defun gdb-buffer-shows-main-thread-p ()
1285 "Return t if current GDB buffer shows main selected thread and
1286is not bound to it."
1287 (current-buffer)
1288 (not (local-variable-p 'gdb-thread-number)))
1289
1290(defun gdb-get-buffer (buffer-type &optional thread)
1291 "Get a specific GDB buffer.
1292
1293In that buffer, `gdb-buffer-type' must be equal to BUFFER-TYPE
1294and `gdb-thread-number' (if provided) must be equal to THREAD."
1295 (catch 'found
1296 (dolist (buffer (buffer-list) nil)
1297 (with-current-buffer buffer
1298 (when (and (eq gdb-buffer-type buffer-type)
1299 (or (not thread)
1300 (equal gdb-thread-number thread)))
1301 (throw 'found buffer))))))
1302
1303(defun gdb-get-buffer-create (buffer-type &optional thread)
1304 "Create a new GDB buffer of the type specified by BUFFER-TYPE.
1305The buffer-type should be one of the cars in `gdb-buffer-rules'.
1306
1307If THREAD is non-nil, it is assigned to `gdb-thread-number'
1308buffer-local variable of the new buffer.
1309
1310Buffer mode and name are selected according to buffer type.
1311
1312If buffer has trigger associated with it in `gdb-buffer-rules',
1313this trigger is subscribed to `gdb-buf-publisher' and called with
1314'update argument."
1315 (or (gdb-get-buffer buffer-type thread)
1316 (let ((rules (assoc buffer-type gdb-buffer-rules))
1317 (new (generate-new-buffer "limbo")))
1318 (with-current-buffer new
1319 (let ((mode (gdb-rules-buffer-mode rules))
1320 (trigger (gdb-rules-update-trigger rules)))
1321 (when mode (funcall mode))
1322 (setq gdb-buffer-type buffer-type)
1323 (when thread
1324 (set (make-local-variable 'gdb-thread-number) thread))
1325 (set (make-local-variable 'gud-minor-mode)
1326 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
1327 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1328 (rename-buffer (funcall (gdb-rules-name-maker rules)))
1329 (when trigger
1330 (gdb-add-subscriber gdb-buf-publisher
1331 (cons (current-buffer)
1332 (gdb-bind-function-to-buffer trigger (current-buffer))))
1333 (funcall trigger 'start))
1334 (current-buffer))))))
1335
1336(defun gdb-bind-function-to-buffer (expr buffer)
1337 "Return a function which will evaluate EXPR in BUFFER."
1338 `(lambda (&rest args)
1339 (with-current-buffer ,buffer
1340 (apply ',expr args))))
1341
1342;; Used to define all gdb-frame-*-buffer functions except
1343;; `gdb-frame-io-buffer'
1344(defmacro def-gdb-frame-for-buffer (name buffer &optional doc)
1345 "Define a function NAME which shows gdb BUFFER in a separate frame.
1346
1347DOC is an optional documentation string."
1348 `(defun ,name (&optional thread)
1349 ,(when doc doc)
1350 (interactive)
1351 (let ((special-display-regexps (append special-display-regexps '(".*")))
1352 (special-display-frame-alist gdb-frame-parameters))
1353 (display-buffer (gdb-get-buffer-create ,buffer thread)))))
1354
1355(defmacro def-gdb-display-buffer (name buffer &optional doc)
1356 "Define a function NAME which shows gdb BUFFER.
1357
1358DOC is an optional documentation string."
1359 `(defun ,name (&optional thread)
1360 ,(when doc doc)
1361 (interactive)
1362 (gdb-display-buffer
1363 (gdb-get-buffer-create ,buffer thread) t)))
1364
1365;; Used to display windows with thread-bound buffers
1366(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc
1367 split-horizontal)
1368 `(defun ,name (&optional thread)
1369 ,(when doc doc)
1370 (message thread)
1371 (gdb-preempt-existing-or-display-buffer
1372 (gdb-get-buffer-create ,buffer thread)
1373 ,split-horizontal)))
1374
1375;; This assoc maps buffer type symbols to rules. Each rule is a list of
1376;; at least one and possible more functions. The functions have these
1377;; roles in defining a buffer type:
1378;;
1379;; NAME - Return a name for this buffer type.
1380;;
1381;; The remaining function(s) are optional:
1382;;
1383;; MODE - called in a new buffer with no arguments, should establish
1384;; the proper mode for the buffer.
1385;;
1386
1387(defun gdb-set-buffer-rules (buffer-type &rest rules)
1388 (let ((binding (assoc buffer-type gdb-buffer-rules)))
1389 (if binding
1390 (setcdr binding rules)
1391 (push (cons buffer-type rules)
1392 gdb-buffer-rules))))
1393
1394(defun gdb-parent-mode ()
1395 "Generic mode to derive all other GDB buffer modes from."
1396 (kill-all-local-variables)
1397 (setq buffer-read-only t)
1398 (buffer-disable-undo)
1399 ;; Delete buffer from gdb-buf-publisher when it's killed
1400 ;; (if it has an associated update trigger)
1401 (add-hook
1402 'kill-buffer-hook
1403 (function
1404 (lambda ()
1405 (let ((trigger (gdb-rules-update-trigger
1406 (gdb-current-buffer-rules))))
1407 (when trigger
1408 (gdb-delete-subscriber
1409 gdb-buf-publisher
1410 ;; This should match gdb-add-subscriber done in
1411 ;; gdb-get-buffer-create
1412 (cons (current-buffer)
1413 (gdb-bind-function-to-buffer trigger (current-buffer))))))))
1414 nil t))
1415
1416;; Partial-output buffer : This accumulates output from a command executed on
1417;; behalf of emacs (rather than the user).
1418;;
1419(gdb-set-buffer-rules 'gdb-partial-output-buffer
1420 'gdb-partial-output-name)
1421
1422(defun gdb-partial-output-name ()
1423 (concat " *partial-output-"
1424 (gdb-get-target-string)
1425 "*"))
1426
1427
1428(gdb-set-buffer-rules 'gdb-inferior-io
1429 'gdb-inferior-io-name
1430 'gdb-inferior-io-mode)
1431
1432(defun gdb-inferior-io-name ()
1433 (concat "*input/output of "
1434 (gdb-get-target-string)
1435 "*"))
1436
1437(defun gdb-display-io-buffer ()
1438 "Display IO of debugged program in a separate window."
1439 (interactive)
1440 (gdb-display-buffer
1441 (gdb-get-buffer-create 'gdb-inferior-io) t))
1442
1443(defconst gdb-frame-parameters
1444 '((height . 14) (width . 80)
1445 (unsplittable . t)
1446 (tool-bar-lines . nil)
1447 (menu-bar-lines . nil)
1448 (minibuffer . nil)))
1449
1450(defun gdb-frame-io-buffer ()
1451 "Display IO of debugged program in a new frame."
1452 (interactive)
1453 (let ((special-display-regexps (append special-display-regexps '(".*")))
1454 (special-display-frame-alist gdb-frame-parameters))
1455 (display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))
1456
1457(defvar gdb-inferior-io-mode-map
1458 (let ((map (make-sparse-keymap)))
1459 (define-key map "\C-c\C-c" 'gdb-io-interrupt)
1460 (define-key map "\C-c\C-z" 'gdb-io-stop)
1461 (define-key map "\C-c\C-\\" 'gdb-io-quit)
1462 (define-key map "\C-c\C-d" 'gdb-io-eof)
1463 (define-key map "\C-d" 'gdb-io-eof)
1464 map))
1465
1466;; We want to use comint because it has various nifty and familiar features.
1467(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
1468 "Major mode for gdb inferior-io.
1469
1470The following commands are available:
1471\\{gdb-inferior-io-mode-map}"
1472
1473 :syntax-table nil :abbrev-table nil
1474
1475(make-comint-in-buffer "gdb-inferior" (current-buffer) nil))
1476
1477(defun gdb-inferior-filter (proc string)
1478 (unless (string-equal string "")
1479 (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t))
1480 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
1481 (comint-output-filter proc string)))
1482
1483(defun gdb-io-interrupt ()
1484 "Interrupt the program being debugged."
1485 (interactive)
1486 (interrupt-process
1487 (get-buffer-process gud-comint-buffer) comint-ptyp))
1488
1489(defun gdb-io-quit ()
1490 "Send quit signal to the program being debugged."
1491 (interactive)
1492 (quit-process
1493 (get-buffer-process gud-comint-buffer) comint-ptyp))
1494
1495(defun gdb-io-stop ()
1496 "Stop the program being debugged."
1497 (interactive)
1498 (stop-process
1499 (get-buffer-process gud-comint-buffer) comint-ptyp))
1500
1501(defun gdb-io-eof ()
1502 "Send end-of-file to the program being debugged."
1503 (interactive)
1504 (process-send-eof
1505 (get-buffer-process gud-comint-buffer)))
1506
1507(defun gdb-clear-inferior-io ()
1508 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
1509 (erase-buffer)))
1510
1511
1512(defconst breakpoint-xpm-data
1513 "/* XPM */
1514static char *magick[] = {
1515/* columns rows colors chars-per-pixel */
1516\"10 10 2 1\",
1517\" c red\",
1518\"+ c None\",
1519/* pixels */
1520\"+++ +++\",
1521\"++ ++\",
1522\"+ +\",
1523\" \",
1524\" \",
1525\" \",
1526\" \",
1527\"+ +\",
1528\"++ ++\",
1529\"+++ +++\",
1530};"
1531 "XPM data used for breakpoint icon.")
1532
1533(defconst breakpoint-enabled-pbm-data
1534 "P1
153510 10\",
15360 0 0 0 1 1 1 1 0 0 0 0
15370 0 0 1 1 1 1 1 1 0 0 0
15380 0 1 1 1 1 1 1 1 1 0 0
15390 1 1 1 1 1 1 1 1 1 1 0
15400 1 1 1 1 1 1 1 1 1 1 0
15410 1 1 1 1 1 1 1 1 1 1 0
15420 1 1 1 1 1 1 1 1 1 1 0
15430 0 1 1 1 1 1 1 1 1 0 0
15440 0 0 1 1 1 1 1 1 0 0 0
15450 0 0 0 1 1 1 1 0 0 0 0"
1546 "PBM data used for enabled breakpoint icon.")
1547
1548(defconst breakpoint-disabled-pbm-data
1549 "P1
155010 10\",
15510 0 1 0 1 0 1 0 0 0
15520 1 0 1 0 1 0 1 0 0
15531 0 1 0 1 0 1 0 1 0
15540 1 0 1 0 1 0 1 0 1
15551 0 1 0 1 0 1 0 1 0
15560 1 0 1 0 1 0 1 0 1
15571 0 1 0 1 0 1 0 1 0
15580 1 0 1 0 1 0 1 0 1
15590 0 1 0 1 0 1 0 1 0
15600 0 0 1 0 1 0 1 0 0"
1561 "PBM data used for disabled breakpoint icon.")
1562
1563(defvar breakpoint-enabled-icon nil
1564 "Icon for enabled breakpoint in display margin.")
1565
1566(defvar breakpoint-disabled-icon nil
1567 "Icon for disabled breakpoint in display margin.")
1568
1569(declare-function define-fringe-bitmap "fringe.c"
1570 (bitmap bits &optional height width align))
1571
1572(and (display-images-p)
1573 ;; Bitmap for breakpoint in fringe
1574 (define-fringe-bitmap 'breakpoint
1575 "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
1576 ;; Bitmap for gud-overlay-arrow in fringe
1577 (define-fringe-bitmap 'hollow-right-triangle
1578 "\xe0\x90\x88\x84\x84\x88\x90\xe0"))
1579
1580(defface breakpoint-enabled
1581 '((t
1582 :foreground "red1"
1583 :weight bold))
1584 "Face for enabled breakpoint icon in fringe."
1585 :group 'gdb)
1586
1587(defface breakpoint-disabled
1588 '((((class color) (min-colors 88)) :foreground "grey70")
1589 ;; Ensure that on low-color displays that we end up something visible.
1590 (((class color) (min-colors 8) (background light))
1591 :foreground "black")
1592 (((class color) (min-colors 8) (background dark))
1593 :foreground "white")
1594 (((type tty) (class mono))
1595 :inverse-video t)
1596 (t :background "gray"))
1597 "Face for disabled breakpoint icon in fringe."
1598 :group 'gdb)
1599
1600
1601(defun gdb-send (proc string)
1602 "A comint send filter for gdb."
1603 (with-current-buffer gud-comint-buffer
1604 (let ((inhibit-read-only t))
1605 (remove-text-properties (point-min) (point-max) '(face))))
1606 ;; mimic <RET> key to repeat previous command in GDB
1607 (if (not (string= "" string))
1608 (setq gdb-last-command string)
1609 (if gdb-last-command (setq string gdb-last-command)))
1610 (if gdb-enable-debug
1611 (push (cons 'mi-send (concat string "\n")) gdb-debug-log))
1612 (if (string-match "^-" string)
1613 ;; MI command
1614 (progn
1615 (setq gdb-first-done-or-error t)
1616 (process-send-string proc (concat string "\n")))
1617 ;; CLI command
1618 (if (string-match "\\\\$" string)
1619 (setq gdb-continuation (concat gdb-continuation string "\n"))
1620 (setq gdb-first-done-or-error t)
1621 (process-send-string proc (concat "-interpreter-exec console \""
1622 gdb-continuation string "\"\n"))
1623 (setq gdb-continuation nil))))
1624
1625(defun gdb-input (item)
1626 (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log))
1627 (setq gdb-token-number (1+ gdb-token-number))
1628 (setcar item (concat (number-to-string gdb-token-number) (car item)))
1629 (push (cons gdb-token-number (car (cdr item))) gdb-handler-alist)
1630 (process-send-string (get-buffer-process gud-comint-buffer)
1631 (concat (car item) "\n")))
1632
1633;; NOFRAME is used for gud execution control commands
1634(defun gdb-current-context-command (command)
1635 "Add --thread to gdb COMMAND when needed."
1636 (if (and gdb-thread-number
1637 (string-equal gdb-version "7.0+"))
1638 (concat command " --thread " gdb-thread-number)
1639 command))
1640
1641(defun gdb-current-context-buffer-name (name)
1642 "Add thread information and asterisks to string NAME.
1643
1644If `gdb-thread-number' is nil, just wrap NAME in asterisks."
1645 (concat "*" name
1646 (if (local-variable-p 'gdb-thread-number)
1647 (format " (bound to thread %s)" gdb-thread-number)
1648 "")
1649 "*"))
1650
1651(defun gdb-current-context-mode-name (mode)
1652 "Add thread information to MODE which is to be used as
1653`mode-name'."
1654 (concat mode
1655 (if gdb-thread-number
1656 (format " [thread %s]" gdb-thread-number)
1657 "")))
1658
1659
1660(defcustom gud-gdb-command-name "gdb -i=mi"
1661 "Default command to execute an executable under the GDB debugger."
1662 :type 'string
1663 :group 'gdb)
1664
1665(defun gdb-resync()
1666 (setq gud-running nil)
1667 (setq gdb-output-sink 'user)
1668 (setq gdb-pending-triggers nil))
1669
1670(defun gdb-update ()
1671 "Update buffers showing status of debug session."
1672 (when gdb-first-prompt
1673 (gdb-force-mode-line-update
1674 (propertize "initializing..." 'face font-lock-variable-name-face))
1675 (gdb-init-1)
1676 (setq gdb-first-prompt nil))
1677
1678 (gdb-get-main-selected-frame)
1679 ;; We may need to update gdb-threads-list so we can use
1680 (gdb-get-buffer-create 'gdb-threads-buffer)
1681 ;; gdb-break-list is maintained in breakpoints handler
1682 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
1683
1684 (gdb-emit-signal gdb-buf-publisher 'update)
1685
1686 (gdb-get-changed-registers)
1687
1688 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
1689 (dolist (var gdb-var-list)
1690 (setcar (nthcdr 5 var) nil))
1691 (gdb-var-update)))
1692
1693;; gdb-setq-thread-number and gdb-update-gud-running are decoupled
1694;; because we may need to update current gud-running value without
1695;; changing current thread (see gdb-running)
1696(defun gdb-setq-thread-number (number)
1697 "Only this function must be used to change `gdb-thread-number'
1698value to NUMBER, because `gud-running' and `gdb-frame-number'
1699need to be updated appropriately when current thread changes."
1700 ;; GDB 6.8 and earlier always output thread-id="0" when stopping.
1701 (unless (string-equal number "0") (setq gdb-thread-number number))
1702 (setq gdb-frame-number "0")
1703 (gdb-update-gud-running))
1704
1705(defun gdb-update-gud-running ()
1706 "Set `gud-running' according to the state of current thread.
1707
1708`gdb-frame-number' is set to 0 if current thread is now stopped.
1709
1710Note that when `gdb-gud-control-all-threads' is t, `gud-running'
1711cannot be reliably used to determine whether or not execution
1712control buttons should be shown in menu or toolbar. Use
1713`gdb-running-threads-count' and `gdb-stopped-threads-count'
1714instead.
1715
1716For all-stop mode, thread information is unavailable while target
1717is running."
1718 (let ((old-value gud-running))
1719 (setq gud-running
1720 (string= (bindat-get-field (gdb-current-buffer-thread) 'state)
1721 "running"))
1722 ;; Set frame number to "0" when _current_ threads stops
1723 (when (and (gdb-current-buffer-thread)
1724 (not (eq gud-running old-value)))
1725 (setq gdb-frame-number "0"))))
1726
1727(defun gdb-show-run-p ()
1728 "Return t if \"Run/continue\" should be shown on the toolbar."
1729 (or (not gdb-active-process)
1730 (and (or
1731 (not gdb-gud-control-all-threads)
1732 (not gdb-non-stop))
1733 (not gud-running))
1734 (and gdb-gud-control-all-threads
1735 (> gdb-stopped-threads-count 0))))
1736
1737(defun gdb-show-stop-p ()
1738 "Return t if \"Stop\" should be shown on the toolbar."
1739 (or (and (or
1740 (not gdb-gud-control-all-threads)
1741 (not gdb-non-stop))
1742 gud-running)
1743 (and gdb-gud-control-all-threads
1744 (> gdb-running-threads-count 0))))
1745
1746;; GUD displays the selected GDB frame. This might might not be the current
1747;; GDB frame (after up, down etc). If no GDB frame is visible but the last
1748;; visited breakpoint is, use that window.
1749(defun gdb-display-source-buffer (buffer)
1750 (let* ((last-window (if gud-last-last-frame
1751 (get-buffer-window
1752 (gud-find-file (car gud-last-last-frame)))))
1753 (source-window (or last-window
1754 (if (and gdb-source-window
1755 (window-live-p gdb-source-window))
1756 gdb-source-window))))
1757 (when source-window
1758 (setq gdb-source-window source-window)
1759 (set-window-buffer source-window buffer))
1760 source-window))
1761
1762(defun gdb-car< (a b)
1763 (< (car a) (car b)))
1764
1765(defvar gdbmi-record-list
1766 '((gdb-gdb . "(gdb) \n")
1767 (gdb-done . "\\([0-9]*\\)\\^done,?\\(.*?\\)\n")
1768 (gdb-starting . "\\([0-9]*\\)\\^running\n")
1769 (gdb-error . "\\([0-9]*\\)\\^error,\\(.*?\\)\n")
1770 (gdb-console . "~\\(\".*?\"\\)\n")
1771 (gdb-internals . "&\\(\".*?\"\\)\n")
1772 (gdb-stopped . "\\*stopped,?\\(.*?\\)\n")
1773 (gdb-running . "\\*running,\\(.*?\n\\)")
1774 (gdb-thread-created . "=thread-created,\\(.*?\n\\)")
1775 (gdb-thread-selected . "=thread-selected,\\(.*?\\)\n")
1776 (gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")
1777 (gdb-ignored-notification . "=[-[:alpha:]]+,?\\(.*?\\)\n")
1778 (gdb-shell . "\\(\\(?:^.+\n\\)+\\)")))
1779
1780(defun gud-gdbmi-marker-filter (string)
1781 "Filter GDB/MI output."
1782
1783 ;; Record transactions if logging is enabled.
1784 (when gdb-enable-debug
1785 (push (cons 'recv string) gdb-debug-log)
1786 (if (and gdb-debug-log-max
1787 (> (length gdb-debug-log) gdb-debug-log-max))
1788 (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil)))
1789
1790 ;; Recall the left over gud-marker-acc from last time
1791 (setq gud-marker-acc (concat gud-marker-acc string))
1792
1793 ;; Start accumulating output for the GUD buffer
1794 (setq gdb-filter-output "")
1795 (let ((output-record) (output-record-list))
1796
1797 ;; Process all the complete markers in this chunk.
1798 (dolist (gdbmi-record gdbmi-record-list)
1799 (while (string-match (cdr gdbmi-record) gud-marker-acc)
1800 (push (list (match-beginning 0)
1801 (car gdbmi-record)
1802 (match-string 1 gud-marker-acc)
1803 (match-string 2 gud-marker-acc)
1804 (match-end 0))
1805 output-record-list)
1806 (setq gud-marker-acc
1807 (concat (substring gud-marker-acc 0 (match-beginning 0))
1808 ;; Pad with spaces to preserve position.
1809 (make-string (length (match-string 0 gud-marker-acc)) 32)
1810 (substring gud-marker-acc (match-end 0))))))
1811
1812 (setq output-record-list (sort output-record-list 'gdb-car<))
1813
1814 (dolist (output-record output-record-list)
1815 (let ((record-type (cadr output-record))
1816 (arg1 (nth 2 output-record))
1817 (arg2 (nth 3 output-record)))
1818 (if (eq record-type 'gdb-error)
1819 (gdb-done-or-error arg2 arg1 'error)
1820 (if (eq record-type 'gdb-done)
1821 (gdb-done-or-error arg2 arg1 'done)
1822 ;; Suppress "No registers." since GDB 6.8 and earlier duplicates MI
1823 ;; error message on internal stream. Don't print to GUD buffer.
1824 (unless (and (eq record-type 'gdb-internals)
1825 (string-equal (read arg1) "No registers.\n"))
1826 (funcall record-type arg1))))))
1827
1828 (setq gdb-output-sink 'user)
1829 ;; Remove padding.
1830 (string-match "^ *" gud-marker-acc)
1831 (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))
1832
1833 gdb-filter-output))
1834
1835(defun gdb-gdb (output-field))
1836
1837(defun gdb-shell (output-field)
1838 (let ((gdb-output-sink gdb-output-sink))
1839 (setq gdb-filter-output
1840 (concat output-field gdb-filter-output))))
1841
1842(defun gdb-ignored-notification (output-field))
1843
1844;; gdb-invalidate-threads is defined to accept 'update-threads signal
1845(defun gdb-thread-created (output-field))
1846(defun gdb-thread-exited (output-field)
1847 "Handle =thread-exited async record: unset `gdb-thread-number'
1848 if current thread exited and update threads list."
1849 (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id)))
1850 (if (string= gdb-thread-number thread-id)
1851 (gdb-setq-thread-number nil))
1852 ;; When we continue current thread and it quickly exits,
1853 ;; gdb-pending-triggers left after gdb-running disallow us to
1854 ;; properly call -thread-info without --thread option. Thus we
1855 ;; need to use gdb-wait-for-pending.
1856 (gdb-wait-for-pending
1857 (gdb-emit-signal gdb-buf-publisher 'update-threads))))
1858
1859(defun gdb-thread-selected (output-field)
1860 "Handler for =thread-selected MI output record.
1861
1862Sets `gdb-thread-number' to new id."
1863 (let* ((result (gdb-json-string output-field))
1864 (thread-id (bindat-get-field result 'id)))
1865 (gdb-setq-thread-number thread-id)
1866 ;; Typing `thread N` in GUD buffer makes GDB emit `^done` followed
1867 ;; by `=thread-selected` notification. `^done` causes `gdb-update`
1868 ;; as usually. Things happen to fast and second call (from
1869 ;; gdb-thread-selected handler) gets cut off by our beloved
1870 ;; gdb-pending-triggers.
1871 ;; Solution is `gdb-wait-for-pending` macro: it guarantees that its
1872 ;; body will get executed when `gdb-pending-triggers` is empty.
1873 (gdb-wait-for-pending
1874 (gdb-update))))
1875
1876(defun gdb-running (output-field)
1877 (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'thread-id)))
1878 ;; We reset gdb-frame-number to nil if current thread has gone
1879 ;; running. This can't be done in gdb-thread-list-handler-custom
1880 ;; because we need correct gdb-frame-number by the time
1881 ;; -thread-info command is sent.
1882 (when (or (string-equal thread-id "all")
1883 (string-equal thread-id gdb-thread-number))
1884 (setq gdb-frame-number nil)))
1885 (setq gdb-inferior-status "running")
1886 (gdb-force-mode-line-update
1887 (propertize gdb-inferior-status 'face font-lock-type-face))
1888 (when (not gdb-non-stop)
1889 (setq gud-running t))
1890 (setq gdb-active-process t)
1891 (gdb-emit-signal gdb-buf-publisher 'update-threads))
1892
1893(defun gdb-starting (output-field)
1894 ;; CLI commands don't emit ^running at the moment so use gdb-running too.
1895 (setq gdb-inferior-status "running")
1896 (gdb-force-mode-line-update
1897 (propertize gdb-inferior-status 'face font-lock-type-face))
1898 (setq gdb-active-process t)
1899 (setq gud-running t)
1900 ;; GDB doesn't seem to respond to -thread-info before first stop or
1901 ;; thread exit (even in non-stop mode), so this is useless.
1902 ;; Behaviour may change in the future.
1903 (gdb-emit-signal gdb-buf-publisher 'update-threads))
1904
1905;; -break-insert -t didn't give a reason before gdb 6.9
1906
1907(defun gdb-stopped (output-field)
1908 "Given the contents of *stopped MI async record, select new
1909current thread and update GDB buffers."
1910 ;; Reason is available with target-async only
1911 (let* ((result (gdb-json-string output-field))
1912 (reason (bindat-get-field result 'reason))
1913 (thread-id (bindat-get-field result 'thread-id)))
1914
1915 ;; -data-list-register-names needs to be issued for any stopped
1916 ;; thread
1917 (when (not gdb-register-names)
1918 (gdb-input
1919 (list (concat "-data-list-register-names"
1920 (if (string-equal gdb-version "7.0+")
1921 (concat" --thread " thread-id)))
1922 'gdb-register-names-handler)))
1923
1924;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler
1925;;; because synchronous GDB doesn't give these fields with CLI.
1926;;; (when file
1927;;; (setq
1928;;; ;; Extract the frame position from the marker.
1929;;; gud-last-frame (cons file
1930;;; (string-to-number
1931;;; (match-string 6 gud-marker-acc)))))
1932
1933 (setq gdb-inferior-status (or reason "unknown"))
1934 (gdb-force-mode-line-update
1935 (propertize gdb-inferior-status 'face font-lock-warning-face))
1936 (if (string-equal reason "exited-normally")
1937 (setq gdb-active-process nil))
1938
1939 ;; Select new current thread.
1940
1941 ;; Don't switch if we have no reasons selected
1942 (when gdb-switch-reasons
1943 ;; Switch from another stopped thread only if we have
1944 ;; gdb-switch-when-another-stopped:
1945 (when (or gdb-switch-when-another-stopped
1946 (not (string= "stopped"
1947 (bindat-get-field (gdb-current-buffer-thread) 'state))))
1948 ;; Switch if current reason has been selected or we have no
1949 ;; reasons
1950 (if (or (eq gdb-switch-reasons t)
1951 (member reason gdb-switch-reasons))
1952 (when (not (string-equal gdb-thread-number thread-id))
1953 (message (concat "Switched to thread " thread-id))
1954 (gdb-setq-thread-number thread-id))
1955 (message (format "Thread %s stopped" thread-id)))))
1956
1957 ;; Print "(gdb)" to GUD console
1958 (when gdb-first-done-or-error
1959 (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
1960
1961 ;; In non-stop, we update information as soon as another thread gets
1962 ;; stopped
1963 (when (or gdb-first-done-or-error
1964 gdb-non-stop)
1965 ;; In all-stop this updates gud-running properly as well.
1966 (gdb-update)
1967 (setq gdb-first-done-or-error nil))
1968 (run-hook-with-args 'gdb-stopped-hooks result)))
1969
1970;; Remove the trimmings from log stream containing debugging messages
1971;; being produced by GDB's internals, use warning face and send to GUD
1972;; buffer.
1973(defun gdb-internals (output-field)
1974 (setq gdb-filter-output
1975 (gdb-concat-output
1976 gdb-filter-output
1977 (let ((error-message
1978 (read output-field)))
1979 (put-text-property
1980 0 (length error-message)
1981 'face font-lock-warning-face
1982 error-message)
1983 error-message))))
1984
1985;; Remove the trimmings from the console stream and send to GUD buffer
1986;; (frontend MI commands should not print to this stream)
1987(defun gdb-console (output-field)
1988 (setq gdb-filter-output
1989 (gdb-concat-output
1990 gdb-filter-output
1991 (read output-field))))
1992
1993(defun gdb-done-or-error (output-field token-number type)
1994 (if (string-equal token-number "")
1995 ;; Output from command entered by user
1996 (progn
1997 (setq gdb-output-sink 'user)
1998 (setq token-number nil)
1999 ;; MI error - send to minibuffer
2000 (when (eq type 'error)
2001 ;; Skip "msg=" from `output-field'
2002 (message (read (substring output-field 4)))
2003 ;; Don't send to the console twice. (If it is a console error
2004 ;; it is also in the console stream.)
2005 (setq output-field nil)))
2006 ;; Output from command from frontend.
2007 (setq gdb-output-sink 'emacs))
2008
2009 (gdb-clear-partial-output)
2010 (when gdb-first-done-or-error
2011 (unless (or token-number gud-running)
2012 (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
2013 (gdb-update)
2014 (setq gdb-first-done-or-error nil))
2015
2016 (setq gdb-filter-output
2017 (gdb-concat-output gdb-filter-output output-field))
2018
2019 (if token-number
2020 (progn
2021 (with-current-buffer
2022 (gdb-get-buffer-create 'gdb-partial-output-buffer)
2023 (funcall
2024 (cdr (assoc (string-to-number token-number) gdb-handler-alist))))
2025 (setq gdb-handler-alist
2026 (assq-delete-all token-number gdb-handler-alist)))))
2027
2028(defun gdb-concat-output (so-far new)
2029 (let ((sink gdb-output-sink))
2030 (cond
2031 ((eq sink 'user) (concat so-far new))
2032 ((eq sink 'emacs)
2033 (gdb-append-to-partial-output new)
2034 so-far))))
2035
2036(defun gdb-append-to-partial-output (string)
2037 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
2038 (goto-char (point-max))
2039 (insert string)))
2040
2041(defun gdb-clear-partial-output ()
2042 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
2043 (erase-buffer)))
2044
2045(defun gdb-jsonify-buffer (&optional fix-key fix-list)
2046 "Prepare GDB/MI output in current buffer for parsing with `json-read'.
2047
2048Field names are wrapped in double quotes and equal signs are
2049replaced with semicolons.
2050
2051If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from
2052partial output. This is used to get rid of useless keys in lists
2053in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
2054-break-info are examples of MI commands which issue such
2055responses.
2056
2057If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with
2058\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken
2059-break-info output when it contains breakpoint script field
2060incompatible with GDB/MI output syntax."
2061 (save-excursion
2062 (goto-char (point-min))
2063 (when fix-key
2064 (save-excursion
2065 (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t)
2066 (replace-match "" nil nil nil 1))))
2067 (when fix-list
2068 (save-excursion
2069 ;; Find positions of braces which enclose broken list
2070 (while (re-search-forward (concat fix-list "={\"") nil t)
2071 (let ((p1 (goto-char (- (point) 2)))
2072 (p2 (progn (forward-sexp)
2073 (1- (point)))))
2074 ;; Replace braces with brackets
2075 (save-excursion
2076 (goto-char p1)
2077 (delete-char 1)
2078 (insert "[")
2079 (goto-char p2)
2080 (delete-char 1)
2081 (insert "]"))))))
2082 (goto-char (point-min))
2083 (insert "{")
2084 (while (re-search-forward
2085 "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t)
2086 (replace-match "\"\\1\":\\2" nil nil))
2087 (goto-char (point-max))
2088 (insert "}")))
2089
2090(defun gdb-json-read-buffer (&optional fix-key fix-list)
2091 "Prepare and parse GDB/MI output in current buffer with `json-read'.
2092
2093FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
2094 (gdb-jsonify-buffer fix-key fix-list)
2095 (save-excursion
2096 (goto-char (point-min))
2097 (let ((json-array-type 'list))
2098 (json-read))))
2099
2100(defun gdb-json-string (string &optional fix-key fix-list)
2101 "Prepare and parse STRING containing GDB/MI output with `json-read'.
2102
2103FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
2104 (with-temp-buffer
2105 (insert string)
2106 (gdb-json-read-buffer fix-key fix-list)))
2107
2108(defun gdb-json-partial-output (&optional fix-key fix-list)
2109 "Prepare and parse gdb-partial-output-buffer with `json-read'.
2110
2111FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'."
2112 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
2113 (gdb-json-read-buffer fix-key fix-list)))
2114
2115(defun gdb-line-posns (line)
2116 "Return a pair of LINE beginning and end positions."
2117 (let ((offset (1+ (- line (line-number-at-pos)))))
2118 (cons
2119 (line-beginning-position offset)
2120 (line-end-position offset))))
2121
2122(defmacro gdb-mark-line (line variable)
2123 "Set VARIABLE marker to point at beginning of LINE.
2124
2125If current window has no fringes, inverse colors on LINE.
2126
2127Return position where LINE begins."
2128 `(save-excursion
2129 (let* ((posns (gdb-line-posns ,line))
2130 (start-posn (car posns))
2131 (end-posn (cdr posns)))
2132 (set-marker ,variable (copy-marker start-posn))
2133 (when (not (> (car (window-fringes)) 0))
2134 (put-text-property start-posn end-posn
2135 'font-lock-face '(:inverse-video t)))
2136 start-posn)))
2137
2138(defun gdb-pad-string (string padding)
2139 (format (concat "%" (number-to-string padding) "s") string))
2140
2141;; gdb-table struct is a way to programmatically construct simple
2142;; tables. It help to reliably align columns of data in GDB buffers
2143;; and provides
2144(defstruct
2145 gdb-table
2146 (column-sizes nil)
2147 (rows nil)
2148 (row-properties nil)
2149 (right-align nil))
2150
2151(defun gdb-mapcar* (function &rest seqs)
2152 "Apply FUNCTION to each element of SEQS, and make a list of the results.
2153If there are several SEQS, FUNCTION is called with that many
2154arugments, and mapping stops as sson as the shortest list runs
2155out."
2156 (let ((shortest (apply #'min (mapcar #'length seqs))))
2157 (mapcar (lambda (i)
2158 (apply function
2159 (mapcar
2160 (lambda (seq)
2161 (nth i seq))
2162 seqs)))
2163 (number-sequence 0 (1- shortest)))))
2164
2165(defun gdb-table-add-row (table row &optional properties)
2166 "Add ROW of string to TABLE and recalculate column sizes.
2167
2168When non-nil, PROPERTIES will be added to the whole row when
2169calling `gdb-table-string'."
2170 (let ((rows (gdb-table-rows table))
2171 (row-properties (gdb-table-row-properties table))
2172 (column-sizes (gdb-table-column-sizes table))
2173 (right-align (gdb-table-right-align table)))
2174 (when (not column-sizes)
2175 (setf (gdb-table-column-sizes table)
2176 (make-list (length row) 0)))
2177 (setf (gdb-table-rows table)
2178 (append rows (list row)))
2179 (setf (gdb-table-row-properties table)
2180 (append row-properties (list properties)))
2181 (setf (gdb-table-column-sizes table)
2182 (gdb-mapcar* (lambda (x s)
2183 (let ((new-x
2184 (max (abs x) (string-width (or s "")))))
2185 (if right-align new-x (- new-x))))
2186 (gdb-table-column-sizes table)
2187 row))
2188 ;; Avoid trailing whitespace at eol
2189 (if (not (gdb-table-right-align table))
2190 (setcar (last (gdb-table-column-sizes table)) 0))))
2191
2192(defun gdb-table-string (table &optional sep)
2193 "Return TABLE as a string with columns separated with SEP."
2194 (let ((column-sizes (gdb-table-column-sizes table))
2195 (res ""))
2196 (mapconcat
2197 'identity
2198 (gdb-mapcar*
2199 (lambda (row properties)
2200 (apply 'propertize
2201 (mapconcat 'identity
2202 (gdb-mapcar* (lambda (s x) (gdb-pad-string s x))
2203 row column-sizes)
2204 sep)
2205 properties))
2206 (gdb-table-rows table)
2207 (gdb-table-row-properties table))
2208 "\n")))
2209
2210;; bindat-get-field goes deep, gdb-get-many-fields goes wide
2211(defun gdb-get-many-fields (struct &rest fields)
2212 "Return a list of FIELDS values from STRUCT."
2213 (let ((values))
2214 (dolist (field fields values)
2215 (setq values (append values (list (bindat-get-field struct field)))))))
2216
2217(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
2218 handler-name
2219 &optional signal-list)
2220 "Define a trigger TRIGGER-NAME which sends GDB-COMMAND and sets
2221HANDLER-NAME as its handler. HANDLER-NAME is bound to current
2222buffer with `gdb-bind-function-to-buffer'.
2223
2224If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the
2225defined trigger is called with an argument from SIGNAL-LIST. It's
2226not recommended to define triggers with empty SIGNAL-LIST.
2227Normally triggers should respond at least to 'update signal.
2228
2229Normally the trigger defined by this command must be called from
2230the buffer where HANDLER-NAME must work. This should be done so
2231that buffer-local thread number may be used in GDB-COMMAND (by
2232calling `gdb-current-context-command').
2233`gdb-bind-function-to-buffer' is used to achieve this, see
2234`gdb-get-buffer-create'.
2235
2236Triggers defined by this command are meant to be used as a
2237trigger argument when describing buffer types with
2238`gdb-set-buffer-rules'."
2239 `(defun ,trigger-name (&optional signal)
2240 (when
2241 (or (not ,signal-list)
2242 (memq signal ,signal-list))
2243 (when (not (gdb-pending-p
2244 (cons (current-buffer) ',trigger-name)))
2245 (gdb-input
2246 (list ,gdb-command
2247 (gdb-bind-function-to-buffer ',handler-name (current-buffer))))
2248 (gdb-add-pending (cons (current-buffer) ',trigger-name))))))
2249
2250;; Used by disassembly buffer only, the rest use
2251;; def-gdb-trigger-and-handler
2252(defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun
2253 &optional nopreserve)
2254 "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN.
2255
2256Handlers are normally called from the buffers they put output in.
2257
2258Delete ((current-buffer) . TRIGGER-NAME) from
2259`gdb-pending-triggers', erase current buffer and evaluate
2260CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called.
2261
2262If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
2263 `(defun ,handler-name ()
2264 (gdb-delete-pending (cons (current-buffer) ',trigger-name))
2265 (let* ((buffer-read-only nil)
2266 (window (get-buffer-window (current-buffer) 0))
2267 (start (window-start window))
2268 (p (window-point window)))
2269 (erase-buffer)
2270 (,custom-defun)
2271 (gdb-update-buffer-name)
2272 ,(when (not nopreserve)
2273 '(set-window-start window start)
2274 '(set-window-point window p)))))
2275
2276(defmacro def-gdb-trigger-and-handler (trigger-name gdb-command
2277 handler-name custom-defun
2278 &optional signal-list)
2279 "Define trigger and handler.
2280
2281TRIGGER-NAME trigger is defined to send GDB-COMMAND. See
2282`def-gdb-auto-update-trigger'.
2283
2284HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
2285`def-gdb-auto-update-handler'."
2286 `(progn
2287 (def-gdb-auto-update-trigger ,trigger-name
2288 ,gdb-command
2289 ,handler-name ,signal-list)
2290 (def-gdb-auto-update-handler ,handler-name
2291 ,trigger-name ,custom-defun)))
2292
2293
2294
2295;; Breakpoint buffer : This displays the output of `-break-list'.
2296(def-gdb-trigger-and-handler
2297 gdb-invalidate-breakpoints "-break-list"
2298 gdb-breakpoints-list-handler gdb-breakpoints-list-handler-custom
2299 '(start update))
2300
2301(gdb-set-buffer-rules
2302 'gdb-breakpoints-buffer
2303 'gdb-breakpoints-buffer-name
2304 'gdb-breakpoints-mode
2305 'gdb-invalidate-breakpoints)
2306
2307(defun gdb-breakpoints-list-handler-custom ()
2308 (let ((breakpoints-list (bindat-get-field
2309 (gdb-json-partial-output "bkpt" "script")
2310 'BreakpointTable 'body))
2311 (table (make-gdb-table)))
2312 (setq gdb-breakpoints-list nil)
2313 (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Addr" "Hits" "What"))
2314 (dolist (breakpoint breakpoints-list)
2315 (add-to-list 'gdb-breakpoints-list
2316 (cons (bindat-get-field breakpoint 'number)
2317 breakpoint))
2318 (let ((at (bindat-get-field breakpoint 'at))
2319 (pending (bindat-get-field breakpoint 'pending))
2320 (func (bindat-get-field breakpoint 'func))
2321 (type (bindat-get-field breakpoint 'type)))
2322 (gdb-table-add-row table
2323 (list
2324 (bindat-get-field breakpoint 'number)
2325 type
2326 (bindat-get-field breakpoint 'disp)
2327 (let ((flag (bindat-get-field breakpoint 'enabled)))
2328 (if (string-equal flag "y")
2329 (propertize "y" 'font-lock-face font-lock-warning-face)
2330 (propertize "n" 'font-lock-face font-lock-comment-face)))
2331 (bindat-get-field breakpoint 'addr)
2332 (bindat-get-field breakpoint 'times)
2333 (if (string-match ".*watchpoint" type)
2334 (bindat-get-field breakpoint 'what)
2335 (or pending at
2336 (concat "in "
2337 (propertize func 'font-lock-face font-lock-function-name-face)
2338 (gdb-frame-location breakpoint)))))
2339 ;; Add clickable properties only for breakpoints with file:line
2340 ;; information
2341 (append (list 'gdb-breakpoint breakpoint)
2342 (when func '(help-echo "mouse-2, RET: visit breakpoint"
2343 mouse-face highlight))))))
2344 (insert (gdb-table-string table " "))
2345 (gdb-place-breakpoints)))
2346
2347;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
2348(defun gdb-place-breakpoints ()
2349 (let ((flag) (bptno))
2350 ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
2351 (dolist (buffer (buffer-list))
2352 (with-current-buffer buffer
2353 (if (and (eq gud-minor-mode 'gdbmi)
2354 (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name))))
2355 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
2356 (dolist (breakpoint gdb-breakpoints-list)
2357 (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is
2358 ; an associative list
2359 (line (bindat-get-field breakpoint 'line)))
2360 (when line
2361 (let ((file (bindat-get-field breakpoint 'fullname))
2362 (flag (bindat-get-field breakpoint 'enabled))
2363 (bptno (bindat-get-field breakpoint 'number)))
2364 (unless (file-exists-p file)
2365 (setq file (cdr (assoc bptno gdb-location-alist))))
2366 (if (and file
2367 (not (string-equal file "File not found")))
2368 (with-current-buffer
2369 (find-file-noselect file 'nowarn)
2370 (gdb-init-buffer)
2371 ;; Only want one breakpoint icon at each location.
2372 (gdb-put-breakpoint-icon (string-equal flag "y") bptno
2373 (string-to-number line)))
2374 (gdb-input
2375 (list (concat "list " file ":1")
2376 'ignore))
2377 (gdb-input
2378 (list "-file-list-exec-source-file"
2379 `(lambda () (gdb-get-location
2380 ,bptno ,line ,flag)))))))))))
2381
2382(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
2383
2384(defun gdb-get-location (bptno line flag)
2385 "Find the directory containing the relevant source file.
2386Put in buffer and place breakpoint icon."
2387 (goto-char (point-min))
2388 (catch 'file-not-found
2389 (if (re-search-forward gdb-source-file-regexp nil t)
2390 (delete (cons bptno "File not found") gdb-location-alist)
2391 (push (cons bptno (match-string 1)) gdb-location-alist)
2392 (gdb-resync)
2393 (unless (assoc bptno gdb-location-alist)
2394 (push (cons bptno "File not found") gdb-location-alist)
2395 (message-box "Cannot find source file for breakpoint location.
2396Add directory to search path for source files using the GDB command, dir."))
2397 (throw 'file-not-found nil))
2398 (with-current-buffer (find-file-noselect (match-string 1))
2399 (gdb-init-buffer)
2400 ;; only want one breakpoint icon at each location
2401 (gdb-put-breakpoint-icon (eq flag ?y) bptno (string-to-number line)))))
2402
2403(add-hook 'find-file-hook 'gdb-find-file-hook)
2404
2405(defun gdb-find-file-hook ()
2406 "Set up buffer for debugging if file is part of the source code
2407of the current session."
2408 (if (and (buffer-name gud-comint-buffer)
2409 ;; in case gud or gdb-ui is just loaded
2410 gud-comint-buffer
2411 (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
2412 'gdbmi))
2413 (if (member buffer-file-name gdb-source-file-list)
2414 (with-current-buffer (find-buffer-visiting buffer-file-name)
2415 (gdb-init-buffer)))))
2416
2417(declare-function gud-remove "gdb-mi" t t) ; gud-def
2418(declare-function gud-break "gdb-mi" t t) ; gud-def
2419(declare-function fringe-bitmaps-at-pos "fringe.c" (&optional pos window))
2420
2421(defun gdb-mouse-set-clear-breakpoint (event)
2422 "Set/clear breakpoint in left fringe/margin at mouse click.
2423If not in a source or disassembly buffer just set point."
2424 (interactive "e")
2425 (mouse-minibuffer-check event)
2426 (let ((posn (event-end event)))
2427 (with-selected-window (posn-window posn)
2428 (if (or (buffer-file-name) (eq major-mode 'gdb-disassembly-mode))
2429 (if (numberp (posn-point posn))
2430 (save-excursion
2431 (goto-char (posn-point posn))
2432 (if (or (posn-object posn)
2433 (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
2434 'breakpoint))
2435 (gud-remove nil)
2436 (gud-break nil)))))
2437 (posn-set-point posn))))
2438
2439(defun gdb-mouse-toggle-breakpoint-margin (event)
2440 "Enable/disable breakpoint in left margin with mouse click."
2441 (interactive "e")
2442 (mouse-minibuffer-check event)
2443 (let ((posn (event-end event)))
2444 (if (numberp (posn-point posn))
2445 (with-selected-window (posn-window posn)
2446 (save-excursion
2447 (goto-char (posn-point posn))
2448 (if (posn-object posn)
2449 (gud-basic-call
2450 (let ((bptno (get-text-property
2451 0 'gdb-bptno (car (posn-string posn)))))
2452 (concat
2453 (if (get-text-property
2454 0 'gdb-enabled (car (posn-string posn)))
2455 "-break-disable "
2456 "-break-enable ")
2457 bptno)))))))))
2458
2459(defun gdb-mouse-toggle-breakpoint-fringe (event)
2460 "Enable/disable breakpoint in left fringe with mouse click."
2461 (interactive "e")
2462 (mouse-minibuffer-check event)
2463 (let* ((posn (event-end event))
2464 (pos (posn-point posn))
2465 obj)
2466 (when (numberp pos)
2467 (with-selected-window (posn-window posn)
2468 (with-current-buffer (window-buffer (selected-window))
2469 (goto-char pos)
2470 (dolist (overlay (overlays-in pos pos))
2471 (when (overlay-get overlay 'put-break)
2472 (setq obj (overlay-get overlay 'before-string))))
2473 (when (stringp obj)
2474 (gud-basic-call
2475 (concat
2476 (if (get-text-property 0 'gdb-enabled obj)
2477 "-break-disable "
2478 "-break-enable ")
2479 (get-text-property 0 'gdb-bptno obj)))))))))
2480
2481(defun gdb-breakpoints-buffer-name ()
2482 (concat "*breakpoints of " (gdb-get-target-string) "*"))
2483
2484(def-gdb-display-buffer
2485 gdb-display-breakpoints-buffer
2486 'gdb-breakpoints-buffer
2487 "Display status of user-settable breakpoints.")
2488
2489(def-gdb-frame-for-buffer
2490 gdb-frame-breakpoints-buffer
2491 'gdb-breakpoints-buffer
2492 "Display status of user-settable breakpoints in a new frame.")
2493
2494(defvar gdb-breakpoints-mode-map
2495 (let ((map (make-sparse-keymap))
2496 (menu (make-sparse-keymap "Breakpoints")))
2497 (define-key menu [quit] '("Quit" . gdb-delete-frame-or-window))
2498 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
2499 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
2500 (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
2501 (suppress-keymap map)
2502 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
2503 (define-key map " " 'gdb-toggle-breakpoint)
2504 (define-key map "D" 'gdb-delete-breakpoint)
2505 ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons.
2506 (define-key map "q" 'gdb-delete-frame-or-window)
2507 (define-key map "\r" 'gdb-goto-breakpoint)
2508 (define-key map "\t" '(lambda ()
2509 (interactive)
2510 (gdb-set-window-buffer
2511 (gdb-get-buffer-create 'gdb-threads-buffer) t)))
2512 (define-key map [mouse-2] 'gdb-goto-breakpoint)
2513 (define-key map [follow-link] 'mouse-face)
2514 map))
2515
2516(defun gdb-delete-frame-or-window ()
2517 "Delete frame if there is only one window. Otherwise delete the window."
2518 (interactive)
2519 (if (one-window-p) (delete-frame)
2520 (delete-window)))
2521
2522;;from make-mode-line-mouse-map
2523(defun gdb-make-header-line-mouse-map (mouse function) "\
2524Return a keymap with single entry for mouse key MOUSE on the header line.
2525MOUSE is defined to run function FUNCTION with no args in the buffer
2526corresponding to the mode line clicked."
2527 (let ((map (make-sparse-keymap)))
2528 (define-key map (vector 'header-line mouse) function)
2529 (define-key map (vector 'header-line 'down-mouse-1) 'ignore)
2530 map))
2531
2532(defmacro gdb-propertize-header (name buffer help-echo mouse-face face)
2533 `(propertize ,name
2534 'help-echo ,help-echo
2535 'mouse-face ',mouse-face
2536 'face ',face
2537 'local-map
2538 (gdb-make-header-line-mouse-map
2539 'mouse-1
2540 (lambda (event) (interactive "e")
2541 (save-selected-window
2542 (select-window (posn-window (event-start event)))
2543 (gdb-set-window-buffer
2544 (gdb-get-buffer-create ',buffer) t) )))))
2545
2546
2547;; uses "-thread-info". Needs GDB 7.0 onwards.
2548;;; Threads view
2549
2550(defun gdb-threads-buffer-name ()
2551 (concat "*threads of " (gdb-get-target-string) "*"))
2552
2553(def-gdb-display-buffer
2554 gdb-display-threads-buffer
2555 'gdb-threads-buffer
2556 "Display GDB threads.")
2557
2558(def-gdb-frame-for-buffer
2559 gdb-frame-threads-buffer
2560 'gdb-threads-buffer
2561 "Display GDB threads in a new frame.")
2562
2563(def-gdb-trigger-and-handler
2564 gdb-invalidate-threads (gdb-current-context-command "-thread-info")
2565 gdb-thread-list-handler gdb-thread-list-handler-custom
2566 '(start update update-threads))
2567
2568(gdb-set-buffer-rules
2569 'gdb-threads-buffer
2570 'gdb-threads-buffer-name
2571 'gdb-threads-mode
2572 'gdb-invalidate-threads)
2573
2574(defvar gdb-threads-font-lock-keywords
2575 '(("in \\([^ ]+\\)" (1 font-lock-function-name-face))
2576 (" \\(stopped\\)" (1 font-lock-warning-face))
2577 (" \\(running\\)" (1 font-lock-string-face))
2578 ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face)))
2579 "Font lock keywords used in `gdb-threads-mode'.")
2580
2581(defvar gdb-threads-mode-map
2582 (let ((map (make-sparse-keymap)))
2583 (define-key map "\r" 'gdb-select-thread)
2584 (define-key map "f" 'gdb-display-stack-for-thread)
2585 (define-key map "F" 'gdb-frame-stack-for-thread)
2586 (define-key map "l" 'gdb-display-locals-for-thread)
2587 (define-key map "L" 'gdb-frame-locals-for-thread)
2588 (define-key map "r" 'gdb-display-registers-for-thread)
2589 (define-key map "R" 'gdb-frame-registers-for-thread)
2590 (define-key map "d" 'gdb-display-disassembly-for-thread)
2591 (define-key map "D" 'gdb-frame-disassembly-for-thread)
2592 (define-key map "i" 'gdb-interrupt-thread)
2593 (define-key map "c" 'gdb-continue-thread)
2594 (define-key map "s" 'gdb-step-thread)
2595 (define-key map "\t" '(lambda ()
2596 (interactive)
2597 (gdb-set-window-buffer
2598 (gdb-get-buffer-create 'gdb-breakpoints-buffer) t)))
2599 (define-key map [mouse-2] 'gdb-select-thread)
2600 (define-key map [follow-link] 'mouse-face)
2601 map))
2602
2603(defvar gdb-threads-header
2604 (list
2605 (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
2606 "mouse-1: select" mode-line-highlight mode-line-inactive)
2607 " "
2608 (gdb-propertize-header "Threads" gdb-threads-buffer
2609 nil nil mode-line)))
2610
2611(define-derived-mode gdb-threads-mode gdb-parent-mode "Threads"
2612 "Major mode for GDB threads.
2613
2614\\{gdb-threads-mode-map}"
2615 (setq gdb-thread-position (make-marker))
2616 (add-to-list 'overlay-arrow-variable-list 'gdb-thread-position)
2617 (setq header-line-format gdb-threads-header)
2618 (set (make-local-variable 'font-lock-defaults)
2619 '(gdb-threads-font-lock-keywords))
2620 (run-mode-hooks 'gdb-threads-mode-hook)
2621 'gdb-invalidate-threads)
2622
2623(defun gdb-thread-list-handler-custom ()
2624 (let ((threads-list (bindat-get-field (gdb-json-partial-output) 'threads))
2625 (table (make-gdb-table))
2626 (marked-line nil))
2627 (setq gdb-threads-list nil)
2628 (setq gdb-running-threads-count 0)
2629 (setq gdb-stopped-threads-count 0)
2630 (set-marker gdb-thread-position nil)
2631
2632 (dolist (thread (reverse threads-list))
2633 (let ((running (string-equal (bindat-get-field thread 'state) "running")))
2634 (add-to-list 'gdb-threads-list
2635 (cons (bindat-get-field thread 'id)
2636 thread))
2637 (if running
2638 (incf gdb-running-threads-count)
2639 (incf gdb-stopped-threads-count))
2640
2641 (gdb-table-add-row table
2642 (list
2643 (bindat-get-field thread 'id)
2644 (concat
2645 (if gdb-thread-buffer-verbose-names
2646 (concat (bindat-get-field thread 'target-id) " ") "")
2647 (bindat-get-field thread 'state)
2648 ;; Include frame information for stopped threads
2649 (if (not running)
2650 (concat
2651 " in " (bindat-get-field thread 'frame 'func)
2652 (if gdb-thread-buffer-arguments
2653 (concat
2654 " ("
2655 (let ((args (bindat-get-field thread 'frame 'args)))
2656 (mapconcat
2657 (lambda (arg)
2658 (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value))))
2659 args ","))
2660 ")")
2661 "")
2662 (if gdb-thread-buffer-locations
2663 (gdb-frame-location (bindat-get-field thread 'frame)) "")
2664 (if gdb-thread-buffer-addresses
2665 (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
2666 "")))
2667 (list
2668 'gdb-thread thread
2669 'mouse-face 'highlight
2670 'help-echo "mouse-2, RET: select thread")))
2671 (when (string-equal gdb-thread-number
2672 (bindat-get-field thread 'id))
2673 (setq marked-line (length gdb-threads-list))))
2674 (insert (gdb-table-string table " "))
2675 (when marked-line
2676 (gdb-mark-line marked-line gdb-thread-position)))
2677 ;; We update gud-running here because we need to make sure that
2678 ;; gdb-threads-list is up-to-date
2679 (gdb-update-gud-running)
2680 (gdb-emit-signal gdb-buf-publisher 'update-disassembly))
2681
2682(defmacro def-gdb-thread-buffer-command (name custom-defun &optional doc)
2683 "Define a NAME command which will act upon thread on the current line.
2684
2685CUSTOM-DEFUN may use locally bound `thread' variable, which will
2686be the value of 'gdb-thread property of the current line. If
2687'gdb-thread is nil, error is signaled."
2688 `(defun ,name (&optional event)
2689 ,(when doc doc)
2690 (interactive (list last-input-event))
2691 (if event (posn-set-point (event-end event)))
2692 (save-excursion
2693 (beginning-of-line)
2694 (let ((thread (get-text-property (point) 'gdb-thread)))
2695 (if thread
2696 ,custom-defun
2697 (error "Not recognized as thread line"))))))
2698
2699(defmacro def-gdb-thread-buffer-simple-command (name buffer-command &optional doc)
2700 "Define a NAME which will call BUFFER-COMMAND with id of thread
2701on the current line."
2702 `(def-gdb-thread-buffer-command ,name
2703 (,buffer-command (bindat-get-field thread 'id))
2704 ,doc))
2705
2706(def-gdb-thread-buffer-command gdb-select-thread
2707 (let ((new-id (bindat-get-field thread 'id)))
2708 (gdb-setq-thread-number new-id)
2709 (gdb-input (list (concat "-thread-select " new-id) 'ignore))
2710 (gdb-update))
2711 "Select the thread at current line of threads buffer.")
2712
2713(def-gdb-thread-buffer-simple-command
2714 gdb-display-stack-for-thread
2715 gdb-preemptively-display-stack-buffer
2716 "Display stack buffer for the thread at current line.")
2717
2718(def-gdb-thread-buffer-simple-command
2719 gdb-display-locals-for-thread
2720 gdb-preemptively-display-locals-buffer
2721 "Display locals buffer for the thread at current line.")
2722
2723(def-gdb-thread-buffer-simple-command
2724 gdb-display-registers-for-thread
2725 gdb-preemptively-display-registers-buffer
2726 "Display registers buffer for the thread at current line.")
2727
2728(def-gdb-thread-buffer-simple-command
2729 gdb-display-disassembly-for-thread
2730 gdb-preemptively-display-disassembly-buffer
2731 "Display disassembly buffer for the thread at current line.")
2732
2733(def-gdb-thread-buffer-simple-command
2734 gdb-frame-stack-for-thread
2735 gdb-frame-stack-buffer
2736 "Display a new frame with stack buffer for the thread at
2737current line.")
2738
2739(def-gdb-thread-buffer-simple-command
2740 gdb-frame-locals-for-thread
2741 gdb-frame-locals-buffer
2742 "Display a new frame with locals buffer for the thread at
2743current line.")
2744
2745(def-gdb-thread-buffer-simple-command
2746 gdb-frame-registers-for-thread
2747 gdb-frame-registers-buffer
2748 "Display a new frame with registers buffer for the thread at
2749current line.")
2750
2751(def-gdb-thread-buffer-simple-command
2752 gdb-frame-disassembly-for-thread
2753 gdb-frame-disassembly-buffer
2754 "Display a new frame with disassembly buffer for the thread at
2755current line.")
2756
2757(defmacro def-gdb-thread-buffer-gud-command (name gud-command &optional doc)
2758 "Define a NAME which will execute GUD-COMMAND with
2759`gdb-thread-number' locally bound to id of thread on the current
2760line."
2761 `(def-gdb-thread-buffer-command ,name
2762 (if gdb-non-stop
2763 (let ((gdb-thread-number (bindat-get-field thread 'id))
2764 (gdb-gud-control-all-threads nil))
2765 (call-interactively #',gud-command))
2766 (error "Available in non-stop mode only, customize `gdb-non-stop-setting'"))
2767 ,doc))
2768
2769(def-gdb-thread-buffer-gud-command
2770 gdb-interrupt-thread
2771 gud-stop-subjob
2772 "Interrupt thread at current line.")
2773
2774(def-gdb-thread-buffer-gud-command
2775 gdb-continue-thread
2776 gud-cont
2777 "Continue thread at current line.")
2778
2779(def-gdb-thread-buffer-gud-command
2780 gdb-step-thread
2781 gud-step
2782 "Step thread at current line.")
2783
2784
2785;;; Memory view
2786
2787(defcustom gdb-memory-rows 8
2788 "Number of data rows in memory window."
2789 :type 'integer
2790 :group 'gud
2791 :version "23.2")
2792
2793(defcustom gdb-memory-columns 4
2794 "Number of data columns in memory window."
2795 :type 'integer
2796 :group 'gud
2797 :version "23.2")
2798
2799(defcustom gdb-memory-format "x"
2800 "Display format of data items in memory window."
2801 :type '(choice (const :tag "Hexadecimal" "x")
2802 (const :tag "Signed decimal" "d")
2803 (const :tag "Unsigned decimal" "u")
2804 (const :tag "Octal" "o")
2805 (const :tag "Binary" "t"))
2806 :group 'gud
2807 :version "22.1")
2808
2809(defcustom gdb-memory-unit 4
2810 "Unit size of data items in memory window."
2811 :type '(choice (const :tag "Byte" 1)
2812 (const :tag "Halfword" 2)
2813 (const :tag "Word" 4)
2814 (const :tag "Giant word" 8))
2815 :group 'gud
2816 :version "23.2")
2817
2818(def-gdb-trigger-and-handler
2819 gdb-invalidate-memory
2820 (format "-data-read-memory %s %s %d %d %d"
2821 gdb-memory-address
2822 gdb-memory-format
2823 gdb-memory-unit
2824 gdb-memory-rows
2825 gdb-memory-columns)
2826 gdb-read-memory-handler
2827 gdb-read-memory-custom
2828 '(start update))
2829
2830(gdb-set-buffer-rules
2831 'gdb-memory-buffer
2832 'gdb-memory-buffer-name
2833 'gdb-memory-mode
2834 'gdb-invalidate-memory)
2835
2836(defun gdb-memory-column-width (size format)
2837 "Return length of string with memory unit of SIZE in FORMAT.
2838
2839SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as
2840in `gdb-memory-format'."
2841 (let ((format-base (cdr (assoc format
2842 '(("x" . 16)
2843 ("d" . 10) ("u" . 10)
2844 ("o" . 8)
2845 ("t" . 2))))))
2846 (if format-base
2847 (let ((res (ceiling (log (expt 2.0 (* size 8)) format-base))))
2848 (cond ((string-equal format "x")
2849 (+ 2 res)) ; hexadecimal numbers have 0x in front
2850 ((or (string-equal format "d")
2851 (string-equal format "o"))
2852 (1+ res))
2853 (t res)))
2854 (error "Unknown format"))))
2855
2856(defun gdb-read-memory-custom ()
2857 (let* ((res (gdb-json-partial-output))
2858 (err-msg (bindat-get-field res 'msg)))
2859 (if (not err-msg)
2860 (let ((memory (bindat-get-field res 'memory)))
2861 (setq gdb-memory-address (bindat-get-field res 'addr))
2862 (setq gdb-memory-next-page (bindat-get-field res 'next-page))
2863 (setq gdb-memory-prev-page (bindat-get-field res 'prev-page))
2864 (setq gdb-memory-last-address gdb-memory-address)
2865 (dolist (row memory)
2866 (insert (concat (bindat-get-field row 'addr) ":"))
2867 (dolist (column (bindat-get-field row 'data))
2868 (insert (gdb-pad-string column
2869 (+ 2 (gdb-memory-column-width
2870 gdb-memory-unit
2871 gdb-memory-format)))))
2872 (newline)))
2873 ;; Show last page instead of empty buffer when out of bounds
2874 (progn
2875 (let ((gdb-memory-address gdb-memory-last-address))
2876 (gdb-invalidate-memory 'update)
2877 (error err-msg))))))
2878
2879(defvar gdb-memory-mode-map
2880 (let ((map (make-sparse-keymap)))
2881 (suppress-keymap map t)
2882 (define-key map "q" 'kill-this-buffer)
2883 (define-key map "n" 'gdb-memory-show-next-page)
2884 (define-key map "p" 'gdb-memory-show-previous-page)
2885 (define-key map "a" 'gdb-memory-set-address)
2886 (define-key map "t" 'gdb-memory-format-binary)
2887 (define-key map "o" 'gdb-memory-format-octal)
2888 (define-key map "u" 'gdb-memory-format-unsigned)
2889 (define-key map "d" 'gdb-memory-format-signed)
2890 (define-key map "x" 'gdb-memory-format-hexadecimal)
2891 (define-key map "b" 'gdb-memory-unit-byte)
2892 (define-key map "h" 'gdb-memory-unit-halfword)
2893 (define-key map "w" 'gdb-memory-unit-word)
2894 (define-key map "g" 'gdb-memory-unit-giant)
2895 (define-key map "R" 'gdb-memory-set-rows)
2896 (define-key map "C" 'gdb-memory-set-columns)
2897 map))
2898
2899(defun gdb-memory-set-address-event (event)
2900 "Handle a click on address field in memory buffer header."
2901 (interactive "e")
2902 (save-selected-window
2903 (select-window (posn-window (event-start event)))
2904 (gdb-memory-set-address)))
2905
2906;; Non-event version for use within keymap
2907(defun gdb-memory-set-address ()
2908 "Set the start memory address."
2909 (interactive)
2910 (let ((arg (read-from-minibuffer "Memory address: ")))
2911 (setq gdb-memory-address arg))
2912 (gdb-invalidate-memory 'update))
2913
2914(defmacro def-gdb-set-positive-number (name variable echo-string &optional doc)
2915 "Define a function NAME which reads new VAR value from minibuffer."
2916 `(defun ,name (event)
2917 ,(when doc doc)
2918 (interactive "e")
2919 (save-selected-window
2920 (select-window (posn-window (event-start event)))
2921 (let* ((arg (read-from-minibuffer ,echo-string))
2922 (count (string-to-number arg)))
2923 (if (<= count 0)
2924 (error "Positive number only")
2925 (customize-set-variable ',variable count)
2926 (gdb-invalidate-memory 'update))))))
2927
2928(def-gdb-set-positive-number
2929 gdb-memory-set-rows
2930 gdb-memory-rows
2931 "Rows: "
2932 "Set the number of data rows in memory window.")
2933
2934(def-gdb-set-positive-number
2935 gdb-memory-set-columns
2936 gdb-memory-columns
2937 "Columns: "
2938 "Set the number of data columns in memory window.")
2939
2940(defmacro def-gdb-memory-format (name format doc)
2941 "Define a function NAME to switch memory buffer to use FORMAT.
2942
2943DOC is an optional documentation string."
2944 `(defun ,name () ,(when doc doc)
2945 (interactive)
2946 (customize-set-variable 'gdb-memory-format ,format)
2947 (gdb-invalidate-memory 'update)))
2948
2949(def-gdb-memory-format
2950 gdb-memory-format-binary "t"
2951 "Set the display format to binary.")
2952
2953(def-gdb-memory-format
2954 gdb-memory-format-octal "o"
2955 "Set the display format to octal.")
2956
2957(def-gdb-memory-format
2958 gdb-memory-format-unsigned "u"
2959 "Set the display format to unsigned decimal.")
2960
2961(def-gdb-memory-format
2962 gdb-memory-format-signed "d"
2963 "Set the display format to decimal.")
2964
2965(def-gdb-memory-format
2966 gdb-memory-format-hexadecimal "x"
2967 "Set the display format to hexadecimal.")
2968
2969(defvar gdb-memory-format-map
2970 (let ((map (make-sparse-keymap)))
2971 (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)
2972 map)
2973 "Keymap to select format in the header line.")
2974
2975(defvar gdb-memory-format-menu (make-sparse-keymap "Format")
2976 "Menu of display formats in the header line.")
2977
2978(define-key gdb-memory-format-menu [binary]
2979 '(menu-item "Binary" gdb-memory-format-binary
2980 :button (:radio . (equal gdb-memory-format "t"))))
2981(define-key gdb-memory-format-menu [octal]
2982 '(menu-item "Octal" gdb-memory-format-octal
2983 :button (:radio . (equal gdb-memory-format "o"))))
2984(define-key gdb-memory-format-menu [unsigned]
2985 '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
2986 :button (:radio . (equal gdb-memory-format "u"))))
2987(define-key gdb-memory-format-menu [signed]
2988 '(menu-item "Signed Decimal" gdb-memory-format-signed
2989 :button (:radio . (equal gdb-memory-format "d"))))
2990(define-key gdb-memory-format-menu [hexadecimal]
2991 '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
2992 :button (:radio . (equal gdb-memory-format "x"))))
2993
2994(defun gdb-memory-format-menu (event)
2995 (interactive "@e")
2996 (x-popup-menu event gdb-memory-format-menu))
2997
2998(defun gdb-memory-format-menu-1 (event)
2999 (interactive "e")
3000 (save-selected-window
3001 (select-window (posn-window (event-start event)))
3002 (let* ((selection (gdb-memory-format-menu event))
3003 (binding (and selection (lookup-key gdb-memory-format-menu
3004 (vector (car selection))))))
3005 (if binding (call-interactively binding)))))
3006
3007(defmacro def-gdb-memory-unit (name unit-size doc)
3008 "Define a function NAME to switch memory unit size to UNIT-SIZE.
3009
3010DOC is an optional documentation string."
3011 `(defun ,name () ,(when doc doc)
3012 (interactive)
3013 (customize-set-variable 'gdb-memory-unit ,unit-size)
3014 (gdb-invalidate-memory 'update)))
3015
3016(def-gdb-memory-unit gdb-memory-unit-giant 8
3017 "Set the unit size to giant words (eight bytes).")
3018
3019(def-gdb-memory-unit gdb-memory-unit-word 4
3020 "Set the unit size to words (four bytes).")
3021
3022(def-gdb-memory-unit gdb-memory-unit-halfword 2
3023 "Set the unit size to halfwords (two bytes).")
3024
3025(def-gdb-memory-unit gdb-memory-unit-byte 1
3026 "Set the unit size to bytes.")
3027
3028(defmacro def-gdb-memory-show-page (name address-var &optional doc)
3029 "Define a function NAME which show new address in memory buffer.
3030
3031The defined function switches Memory buffer to show address
3032stored in ADDRESS-VAR variable.
3033
3034DOC is an optional documentation string."
3035 `(defun ,name
3036 ,(when doc doc)
3037 (interactive)
3038 (let ((gdb-memory-address ,address-var))
3039 (gdb-invalidate-memory))))
3040
3041(def-gdb-memory-show-page gdb-memory-show-previous-page
3042 gdb-memory-prev-page)
3043
3044(def-gdb-memory-show-page gdb-memory-show-next-page
3045 gdb-memory-next-page)
3046
3047(defvar gdb-memory-unit-map
3048 (let ((map (make-sparse-keymap)))
3049 (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)
3050 map)
3051 "Keymap to select units in the header line.")
3052
3053(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit")
3054 "Menu of units in the header line.")
3055
3056(define-key gdb-memory-unit-menu [giantwords]
3057 '(menu-item "Giant words" gdb-memory-unit-giant
3058 :button (:radio . (equal gdb-memory-unit 8))))
3059(define-key gdb-memory-unit-menu [words]
3060 '(menu-item "Words" gdb-memory-unit-word
3061 :button (:radio . (equal gdb-memory-unit 4))))
3062(define-key gdb-memory-unit-menu [halfwords]
3063 '(menu-item "Halfwords" gdb-memory-unit-halfword
3064 :button (:radio . (equal gdb-memory-unit 2))))
3065(define-key gdb-memory-unit-menu [bytes]
3066 '(menu-item "Bytes" gdb-memory-unit-byte
3067 :button (:radio . (equal gdb-memory-unit 1))))
3068
3069(defun gdb-memory-unit-menu (event)
3070 (interactive "@e")
3071 (x-popup-menu event gdb-memory-unit-menu))
3072
3073(defun gdb-memory-unit-menu-1 (event)
3074 (interactive "e")
3075 (save-selected-window
3076 (select-window (posn-window (event-start event)))
3077 (let* ((selection (gdb-memory-unit-menu event))
3078 (binding (and selection (lookup-key gdb-memory-unit-menu
3079 (vector (car selection))))))
3080 (if binding (call-interactively binding)))))
3081
3082(defvar gdb-memory-font-lock-keywords
3083 '(;; <__function.name+n>
3084 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face))
3085 )
3086 "Font lock keywords used in `gdb-memory-mode'.")
3087
3088(defvar gdb-memory-header
3089 '(:eval
3090 (concat
3091 "Start address["
3092 (propertize "-"
3093 'face font-lock-warning-face
3094 'help-echo "mouse-1: decrement address"
3095 'mouse-face 'mode-line-highlight
3096 'local-map (gdb-make-header-line-mouse-map
3097 'mouse-1
3098 #'gdb-memory-show-previous-page))
3099 "|"
3100 (propertize "+"
3101 'face font-lock-warning-face
3102 'help-echo "mouse-1: increment address"
3103 'mouse-face 'mode-line-highlight
3104 'local-map (gdb-make-header-line-mouse-map
3105 'mouse-1
3106 #'gdb-memory-show-next-page))
3107 "]: "
3108 (propertize gdb-memory-address
3109 'face font-lock-warning-face
3110 'help-echo "mouse-1: set start address"
3111 'mouse-face 'mode-line-highlight
3112 'local-map (gdb-make-header-line-mouse-map
3113 'mouse-1
3114 #'gdb-memory-set-address-event))
3115 " Rows: "
3116 (propertize (number-to-string gdb-memory-rows)
3117 'face font-lock-warning-face
3118 'help-echo "mouse-1: set number of columns"
3119 'mouse-face 'mode-line-highlight
3120 'local-map (gdb-make-header-line-mouse-map
3121 'mouse-1
3122 #'gdb-memory-set-rows))
3123 " Columns: "
3124 (propertize (number-to-string gdb-memory-columns)
3125 'face font-lock-warning-face
3126 'help-echo "mouse-1: set number of columns"
3127 'mouse-face 'mode-line-highlight
3128 'local-map (gdb-make-header-line-mouse-map
3129 'mouse-1
3130 #'gdb-memory-set-columns))
3131 " Display Format: "
3132 (propertize gdb-memory-format
3133 'face font-lock-warning-face
3134 'help-echo "mouse-3: select display format"
3135 'mouse-face 'mode-line-highlight
3136 'local-map gdb-memory-format-map)
3137 " Unit Size: "
3138 (propertize (number-to-string gdb-memory-unit)
3139 'face font-lock-warning-face
3140 'help-echo "mouse-3: select unit size"
3141 'mouse-face 'mode-line-highlight
3142 'local-map gdb-memory-unit-map)))
3143 "Header line used in `gdb-memory-mode'.")
3144
3145(define-derived-mode gdb-memory-mode gdb-parent-mode "Memory"
3146 "Major mode for examining memory.
3147
3148\\{gdb-memory-mode-map}"
3149 (setq header-line-format gdb-memory-header)
3150 (set (make-local-variable 'font-lock-defaults)
3151 '(gdb-memory-font-lock-keywords))
3152 (run-mode-hooks 'gdb-memory-mode-hook)
3153 'gdb-invalidate-memory)
3154
3155(defun gdb-memory-buffer-name ()
3156 (concat "*memory of " (gdb-get-target-string) "*"))
3157
3158(def-gdb-display-buffer
3159 gdb-display-memory-buffer
3160 'gdb-memory-buffer
3161 "Display memory contents.")
3162
3163(defun gdb-frame-memory-buffer ()
3164 "Display memory contents in a new frame."
3165 (interactive)
3166 (let* ((special-display-regexps (append special-display-regexps '(".*")))
3167 (special-display-frame-alist
3168 `((left-fringe . 0)
3169 (right-fringe . 0)
3170 (width . 83)
3171 ,@gdb-frame-parameters)))
3172 (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
3173
3174
3175;;; Disassembly view
3176
3177(defun gdb-disassembly-buffer-name ()
3178 (gdb-current-context-buffer-name
3179 (concat "disassembly of " (gdb-get-target-string))))
3180
3181(def-gdb-display-buffer
3182 gdb-display-disassembly-buffer
3183 'gdb-disassembly-buffer
3184 "Display disassembly for current stack frame.")
3185
3186(def-gdb-preempt-display-buffer
3187 gdb-preemptively-display-disassembly-buffer
3188 'gdb-disassembly-buffer)
3189
3190(def-gdb-frame-for-buffer
3191 gdb-frame-disassembly-buffer
3192 'gdb-disassembly-buffer
3193 "Display disassembly in a new frame.")
3194
3195(def-gdb-auto-update-trigger gdb-invalidate-disassembly
3196 (let* ((frame (gdb-current-buffer-frame))
3197 (file (bindat-get-field frame 'fullname))
3198 (line (bindat-get-field frame 'line)))
3199 (when file
3200 (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)))
3201 gdb-disassembly-handler
3202 ;; We update disassembly only after we have actual frame information
3203 ;; about all threads, so no there's `update' signal in this list
3204 '(start update-disassembly))
3205
3206(def-gdb-auto-update-handler
3207 gdb-disassembly-handler
3208 gdb-invalidate-disassembly
3209 gdb-disassembly-handler-custom
3210 t)
3211
3212(gdb-set-buffer-rules
3213 'gdb-disassembly-buffer
3214 'gdb-disassembly-buffer-name
3215 'gdb-disassembly-mode
3216 'gdb-invalidate-disassembly)
3217
3218(defvar gdb-disassembly-font-lock-keywords
3219 '(;; <__function.name+n>
3220 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
3221 (1 font-lock-function-name-face))
3222 ;; 0xNNNNNNNN <__function.name+n>: opcode
3223 ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)"
3224 (4 font-lock-keyword-face))
3225 ;; %register(at least i386)
3226 ("%\\sw+" . font-lock-variable-name-face)
3227 ("^\\(Dump of assembler code for function\\) \\(.+\\):"
3228 (1 font-lock-comment-face)
3229 (2 font-lock-function-name-face))
3230 ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face))
3231 "Font lock keywords used in `gdb-disassembly-mode'.")
3232
3233(defvar gdb-disassembly-mode-map
3234 ;; TODO
3235 (let ((map (make-sparse-keymap)))
3236 (suppress-keymap map)
3237 (define-key map "q" 'kill-this-buffer)
3238 map))
3239
3240(define-derived-mode gdb-disassembly-mode gdb-parent-mode "Disassembly"
3241 "Major mode for GDB disassembly information.
3242
3243\\{gdb-disassembly-mode-map}"
3244 ;; TODO Rename overlay variable for disassembly mode
3245 (add-to-list 'overlay-arrow-variable-list 'gdb-disassembly-position)
3246 (setq fringes-outside-margins t)
3247 (set (make-local-variable 'gdb-disassembly-position) (make-marker))
3248 (set (make-local-variable 'font-lock-defaults)
3249 '(gdb-disassembly-font-lock-keywords))
3250 (run-mode-hooks 'gdb-disassembly-mode-hook)
3251 'gdb-invalidate-disassembly)
3252
3253(defun gdb-disassembly-handler-custom ()
3254 (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns))
3255 (address (bindat-get-field (gdb-current-buffer-frame) 'addr))
3256 (pos 1)
3257 (table (make-gdb-table))
3258 (marked-line nil))
3259 (dolist (instr instructions)
3260 (gdb-table-add-row table
3261 (list
3262 (bindat-get-field instr 'address)
3263 (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset)))
3264 (bindat-get-field instr 'inst)))
3265 (when (string-equal (bindat-get-field instr 'address)
3266 address)
3267 (progn
3268 (setq marked-line (length (gdb-table-rows table)))
3269 (setq fringe-indicator-alist
3270 (if (string-equal gdb-frame-number "0")
3271 nil
3272 '((overlay-arrow . hollow-right-triangle)))))))
3273 (insert (gdb-table-string table " "))
3274 (gdb-disassembly-place-breakpoints)
3275 ;; Mark current position with overlay arrow and scroll window to
3276 ;; that point
3277 (when marked-line
3278 (let ((window (get-buffer-window (current-buffer) 0)))
3279 (set-window-point window (gdb-mark-line marked-line gdb-disassembly-position))))
3280 (setq mode-name
3281 (gdb-current-context-mode-name
3282 (concat "Disassembly: "
3283 (bindat-get-field (gdb-current-buffer-frame) 'func))))))
3284
3285(defun gdb-disassembly-place-breakpoints ()
3286 (gdb-remove-breakpoint-icons (point-min) (point-max))
3287 (dolist (breakpoint gdb-breakpoints-list)
3288 (let* ((breakpoint (cdr breakpoint))
3289 (bptno (bindat-get-field breakpoint 'number))
3290 (flag (bindat-get-field breakpoint 'enabled))
3291 (address (bindat-get-field breakpoint 'addr)))
3292 (save-excursion
3293 (goto-char (point-min))
3294 (if (re-search-forward (concat "^" address) nil t)
3295 (gdb-put-breakpoint-icon (string-equal flag "y") bptno))))))
3296
3297
3298(defvar gdb-breakpoints-header
3299 (list
3300 (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
3301 nil nil mode-line)
3302 " "
3303 (gdb-propertize-header "Threads" gdb-threads-buffer
3304 "mouse-1: select" mode-line-highlight mode-line-inactive)))
3305
3306;;; Breakpoints view
3307(define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints"
3308 "Major mode for gdb breakpoints.
3309
3310\\{gdb-breakpoints-mode-map}"
3311 (setq header-line-format gdb-breakpoints-header)
3312 (run-mode-hooks 'gdb-breakpoints-mode-hook)
3313 'gdb-invalidate-breakpoints)
3314
3315(defun gdb-toggle-breakpoint ()
3316 "Enable/disable breakpoint at current line of breakpoints buffer."
3317 (interactive)
3318 (save-excursion
3319 (beginning-of-line)
3320 (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
3321 (if breakpoint
3322 (gud-basic-call
3323 (concat (if (string-equal "y" (bindat-get-field breakpoint 'enabled))
3324 "-break-disable "
3325 "-break-enable ")
3326 (bindat-get-field breakpoint 'number)))
3327 (error "Not recognized as break/watchpoint line")))))
3328
3329(defun gdb-delete-breakpoint ()
3330 "Delete the breakpoint at current line of breakpoints buffer."
3331 (interactive)
3332 (save-excursion
3333 (beginning-of-line)
3334 (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
3335 (if breakpoint
3336 (gud-basic-call (concat "-break-delete " (bindat-get-field breakpoint 'number)))
3337 (error "Not recognized as break/watchpoint line")))))
3338
3339(defun gdb-goto-breakpoint (&optional event)
3340 "Go to the location of breakpoint at current line of
3341breakpoints buffer."
3342 (interactive (list last-input-event))
3343 (if event (posn-set-point (event-end event)))
3344 ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer.
3345 (let ((window (get-buffer-window gud-comint-buffer)))
3346 (if window (save-selected-window (select-window window))))
3347 (save-excursion
3348 (beginning-of-line)
3349 (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
3350 (if breakpoint
3351 (let ((bptno (bindat-get-field breakpoint 'number))
3352 (file (bindat-get-field breakpoint 'fullname))
3353 (line (bindat-get-field breakpoint 'line)))
3354 (save-selected-window
3355 (let* ((buffer (find-file-noselect
3356 (if (file-exists-p file) file
3357 (cdr (assoc bptno gdb-location-alist)))))
3358 (window (or (gdb-display-source-buffer buffer)
3359 (display-buffer buffer))))
3360 (setq gdb-source-window window)
3361 (with-current-buffer buffer
3362 (goto-char (point-min))
3363 (forward-line (1- (string-to-number line)))
3364 (set-window-point window (point))))))
3365 (error "Not recognized as break/watchpoint line")))))
3366
3367
3368;; Frames buffer. This displays a perpetually correct bactrack trace.
3369;;
3370(def-gdb-trigger-and-handler
3371 gdb-invalidate-frames (gdb-current-context-command "-stack-list-frames")
3372 gdb-stack-list-frames-handler gdb-stack-list-frames-custom
3373 '(start update))
3374
3375(gdb-set-buffer-rules
3376 'gdb-stack-buffer
3377 'gdb-stack-buffer-name
3378 'gdb-frames-mode
3379 'gdb-invalidate-frames)
3380
3381(defun gdb-frame-location (frame)
3382 "Return \" of file:line\" or \" of library\" for structure FRAME.
3383
3384FRAME must have either \"file\" and \"line\" members or \"from\"
3385member."
3386 (let ((file (bindat-get-field frame 'file))
3387 (line (bindat-get-field frame 'line))
3388 (from (bindat-get-field frame 'from)))
3389 (let ((res (or (and file line (concat file ":" line))
3390 from)))
3391 (if res (concat " of " res) ""))))
3392
3393(defun gdb-stack-list-frames-custom ()
3394 (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack))
3395 (table (make-gdb-table)))
3396 (set-marker gdb-stack-position nil)
3397 (dolist (frame stack)
3398 (gdb-table-add-row table
3399 (list
3400 (bindat-get-field frame 'level)
3401 "in"
3402 (concat
3403 (bindat-get-field frame 'func)
3404 (if gdb-stack-buffer-locations
3405 (gdb-frame-location frame) "")
3406 (if gdb-stack-buffer-addresses
3407 (concat " at " (bindat-get-field frame 'addr)) "")))
3408 `(mouse-face highlight
3409 help-echo "mouse-2, RET: Select frame"
3410 gdb-frame ,frame)))
3411 (insert (gdb-table-string table " ")))
3412 (when (and gdb-frame-number
3413 (gdb-buffer-shows-main-thread-p))
3414 (gdb-mark-line (1+ (string-to-number gdb-frame-number))
3415 gdb-stack-position))
3416 (setq mode-name
3417 (gdb-current-context-mode-name "Frames")))
3418
3419(defun gdb-stack-buffer-name ()
3420 (gdb-current-context-buffer-name
3421 (concat "stack frames of " (gdb-get-target-string))))
3422
3423(def-gdb-display-buffer
3424 gdb-display-stack-buffer
3425 'gdb-stack-buffer
3426 "Display backtrace of current stack.")
3427
3428(def-gdb-preempt-display-buffer
3429 gdb-preemptively-display-stack-buffer
3430 'gdb-stack-buffer nil t)
3431
3432(def-gdb-frame-for-buffer
3433 gdb-frame-stack-buffer
3434 'gdb-stack-buffer
3435 "Display backtrace of current stack in a new frame.")
3436
3437(defvar gdb-frames-mode-map
3438 (let ((map (make-sparse-keymap)))
3439 (suppress-keymap map)
3440 (define-key map "q" 'kill-this-buffer)
3441 (define-key map "\r" 'gdb-select-frame)
3442 (define-key map [mouse-2] 'gdb-select-frame)
3443 (define-key map [follow-link] 'mouse-face)
3444 map))
3445
3446(defvar gdb-frames-font-lock-keywords
3447 '(("in \\([^ ]+\\)" (1 font-lock-function-name-face)))
3448 "Font lock keywords used in `gdb-frames-mode'.")
3449
3450(define-derived-mode gdb-frames-mode gdb-parent-mode "Frames"
3451 "Major mode for gdb call stack.
3452
3453\\{gdb-frames-mode-map}"
3454 (setq gdb-stack-position (make-marker))
3455 (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
3456 (setq truncate-lines t) ;; Make it easier to see overlay arrow.
3457 (set (make-local-variable 'font-lock-defaults)
3458 '(gdb-frames-font-lock-keywords))
3459 (run-mode-hooks 'gdb-frames-mode-hook)
3460 'gdb-invalidate-frames)
3461
3462(defun gdb-select-frame (&optional event)
3463 "Select the frame and display the relevant source."
3464 (interactive (list last-input-event))
3465 (if event (posn-set-point (event-end event)))
3466 (let ((frame (get-text-property (point) 'gdb-frame)))
3467 (if frame
3468 (if (gdb-buffer-shows-main-thread-p)
3469 (let ((new-level (bindat-get-field frame 'level)))
3470 (setq gdb-frame-number new-level)
3471 (gdb-input (list (concat "-stack-select-frame " new-level) 'ignore))
3472 (gdb-update))
3473 (error "Could not select frame for non-current thread"))
3474 (error "Not recognized as frame line"))))
3475
3476
3477;; Locals buffer.
3478;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
3479(def-gdb-trigger-and-handler
3480 gdb-invalidate-locals
3481 (concat (gdb-current-context-command "-stack-list-locals") " --simple-values")
3482 gdb-locals-handler gdb-locals-handler-custom
3483 '(start update))
3484
3485(gdb-set-buffer-rules
3486 'gdb-locals-buffer
3487 'gdb-locals-buffer-name
3488 'gdb-locals-mode
3489 'gdb-invalidate-locals)
3490
3491(defvar gdb-locals-watch-map
3492 (let ((map (make-sparse-keymap)))
3493 (suppress-keymap map)
3494 (define-key map "\r" 'gud-watch)
3495 (define-key map [mouse-2] 'gud-watch)
3496 map)
3497 "Keymap to create watch expression of a complex data type local variable.")
3498
3499(defvar gdb-edit-locals-map-1
3500 (let ((map (make-sparse-keymap)))
3501 (suppress-keymap map)
3502 (define-key map "\r" 'gdb-edit-locals-value)
3503 (define-key map [mouse-2] 'gdb-edit-locals-value)
3504 map)
3505 "Keymap to edit value of a simple data type local variable.")
3506
3507(defun gdb-edit-locals-value (&optional event)
3508 "Assign a value to a variable displayed in the locals buffer."
3509 (interactive (list last-input-event))
3510 (save-excursion
3511 (if event (posn-set-point (event-end event)))
3512 (beginning-of-line)
3513 (let* ((var (bindat-get-field
3514 (get-text-property (point) 'gdb-local-variable) 'name))
3515 (value (read-string (format "New value (%s): " var))))
3516 (gud-basic-call
3517 (concat "-gdb-set variable " var " = " value)))))
3518
3519;; Dont display values of arrays or structures.
3520;; These can be expanded using gud-watch.
3521(defun gdb-locals-handler-custom ()
3522 (let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals))
3523 (table (make-gdb-table)))
3524 (dolist (local locals-list)
3525 (let ((name (bindat-get-field local 'name))
3526 (value (bindat-get-field local 'value))
3527 (type (bindat-get-field local 'type)))
3528 (if (or (not value)
3529 (string-match "\\0x" value))
3530 (add-text-properties 0 (length name)
3531 `(mouse-face highlight
3532 help-echo "mouse-2: create watch expression"
3533 local-map ,gdb-locals-watch-map)
3534 name)
3535 (add-text-properties 0 (length value)
3536 `(mouse-face highlight
3537 help-echo "mouse-2: edit value"
3538 local-map ,gdb-edit-locals-map-1)
3539 value))
3540 (gdb-table-add-row
3541 table
3542 (list
3543 (propertize type 'font-lock-face font-lock-type-face)
3544 (propertize name 'font-lock-face font-lock-variable-name-face)
3545 value)
3546 `(gdb-local-variable ,local))))
3547 (insert (gdb-table-string table " "))
3548 (setq mode-name
3549 (gdb-current-context-mode-name
3550 (concat "Locals: " (bindat-get-field (gdb-current-buffer-frame) 'func))))))
3551
3552(defvar gdb-locals-header
3553 (list
3554 (gdb-propertize-header "Locals" gdb-locals-buffer
3555 nil nil mode-line)
3556 " "
3557 (gdb-propertize-header "Registers" gdb-registers-buffer
3558 "mouse-1: select" mode-line-highlight mode-line-inactive)))
3559
3560(defvar gdb-locals-mode-map
3561 (let ((map (make-sparse-keymap)))
3562 (suppress-keymap map)
3563 (define-key map "q" 'kill-this-buffer)
3564 (define-key map "\t" '(lambda ()
3565 (interactive)
3566 (gdb-set-window-buffer
3567 (gdb-get-buffer-create
3568 'gdb-registers-buffer
3569 gdb-thread-number) t)))
3570 map))
3571
3572(define-derived-mode gdb-locals-mode gdb-parent-mode "Locals"
3573 "Major mode for gdb locals.
3574
3575\\{gdb-locals-mode-map}"
3576 (setq header-line-format gdb-locals-header)
3577 (run-mode-hooks 'gdb-locals-mode-hook)
3578 'gdb-invalidate-locals)
3579
3580(defun gdb-locals-buffer-name ()
3581 (gdb-current-context-buffer-name
3582 (concat "locals of " (gdb-get-target-string))))
3583
3584(def-gdb-display-buffer
3585 gdb-display-locals-buffer
3586 'gdb-locals-buffer
3587 "Display local variables of current stack and their values.")
3588
3589(def-gdb-preempt-display-buffer
3590 gdb-preemptively-display-locals-buffer
3591 'gdb-locals-buffer nil t)
3592
3593(def-gdb-frame-for-buffer
3594 gdb-frame-locals-buffer
3595 'gdb-locals-buffer
3596 "Display local variables of current stack and their values in a new frame.")
3597
3598
3599;; Registers buffer.
3600
3601(def-gdb-trigger-and-handler
3602 gdb-invalidate-registers
3603 (concat (gdb-current-context-command "-data-list-register-values") " x")
3604 gdb-registers-handler
3605 gdb-registers-handler-custom
3606 '(start update))
3607
3608(gdb-set-buffer-rules
3609 'gdb-registers-buffer
3610 'gdb-registers-buffer-name
3611 'gdb-registers-mode
3612 'gdb-invalidate-registers)
3613
3614(defun gdb-registers-handler-custom ()
3615 (when gdb-register-names
3616 (let ((register-values (bindat-get-field (gdb-json-partial-output) 'register-values))
3617 (table (make-gdb-table)))
3618 (dolist (register register-values)
3619 (let* ((register-number (bindat-get-field register 'number))
3620 (value (bindat-get-field register 'value))
3621 (register-name (nth (string-to-number register-number)
3622 gdb-register-names)))
3623 (gdb-table-add-row
3624 table
3625 (list
3626 (propertize register-name 'font-lock-face font-lock-variable-name-face)
3627 (if (member register-number gdb-changed-registers)
3628 (propertize value 'font-lock-face font-lock-warning-face)
3629 value))
3630 `(mouse-face highlight
3631 help-echo "mouse-2: edit value"
3632 gdb-register-name ,register-name))))
3633 (insert (gdb-table-string table " ")))
3634 (setq mode-name
3635 (gdb-current-context-mode-name "Registers"))))
3636
3637(defun gdb-edit-register-value (&optional event)
3638 "Assign a value to a register displayed in the registers buffer."
3639 (interactive (list last-input-event))
3640 (save-excursion
3641 (if event (posn-set-point (event-end event)))
3642 (beginning-of-line)
3643 (let* ((var (bindat-get-field
3644 (get-text-property (point) 'gdb-register-name)))
3645 (value (read-string (format "New value (%s): " var))))
3646 (gud-basic-call
3647 (concat "-gdb-set variable $" var " = " value)))))
3648
3649(defvar gdb-registers-mode-map
3650 (let ((map (make-sparse-keymap)))
3651 (suppress-keymap map)
3652 (define-key map "\r" 'gdb-edit-register-value)
3653 (define-key map [mouse-2] 'gdb-edit-register-value)
3654 (define-key map "q" 'kill-this-buffer)
3655 (define-key map "\t" '(lambda ()
3656 (interactive)
3657 (gdb-set-window-buffer
3658 (gdb-get-buffer-create
3659 'gdb-locals-buffer
3660 gdb-thread-number) t)))
3661 map))
3662
3663(defvar gdb-registers-header
3664 (list
3665 (gdb-propertize-header "Locals" gdb-locals-buffer
3666 "mouse-1: select" mode-line-highlight mode-line-inactive)
3667 " "
3668 (gdb-propertize-header "Registers" gdb-registers-buffer
3669 nil nil mode-line)))
3670
3671(define-derived-mode gdb-registers-mode gdb-parent-mode "Registers"
3672 "Major mode for gdb registers.
3673
3674\\{gdb-registers-mode-map}"
3675 (setq header-line-format gdb-registers-header)
3676 (run-mode-hooks 'gdb-registers-mode-hook)
3677 'gdb-invalidate-registers)
3678
3679(defun gdb-registers-buffer-name ()
3680 (gdb-current-context-buffer-name
3681 (concat "registers of " (gdb-get-target-string))))
3682
3683(def-gdb-display-buffer
3684 gdb-display-registers-buffer
3685 'gdb-registers-buffer
3686 "Display integer register contents.")
3687
3688(def-gdb-preempt-display-buffer
3689 gdb-preemptively-display-registers-buffer
3690 'gdb-registers-buffer nil t)
3691
3692(def-gdb-frame-for-buffer
3693 gdb-frame-registers-buffer
3694 'gdb-registers-buffer
3695 "Display integer register contents in a new frame.")
3696
3697;; Needs GDB 6.4 onwards (used to fail with no stack).
3698(defun gdb-get-changed-registers ()
3699 (if (and (gdb-get-buffer 'gdb-registers-buffer)
3700 (not (gdb-pending-p 'gdb-get-changed-registers)))
3701 (progn
3702 (gdb-input
3703 (list
3704 "-data-list-changed-registers"
3705 'gdb-changed-registers-handler))
3706 (gdb-add-pending 'gdb-get-changed-registers))))
3707
3708(defun gdb-changed-registers-handler ()
3709 (gdb-delete-pending 'gdb-get-changed-registers)
3710 (setq gdb-changed-registers nil)
3711 (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers))
3712 (push register-number gdb-changed-registers)))
3713
3714(defun gdb-register-names-handler ()
3715 ;; Don't use gdb-pending-triggers because this handler is called
3716 ;; only once (in gdb-init-1)
3717 (setq gdb-register-names nil)
3718 (dolist (register-name (bindat-get-field (gdb-json-partial-output) 'register-names))
3719 (push register-name gdb-register-names))
3720 (setq gdb-register-names (reverse gdb-register-names)))
3721
3722
3723(defun gdb-get-source-file-list ()
3724 "Create list of source files for current GDB session.
3725If buffers already exist for any of these files, gud-minor-mode
3726is set in them."
3727 (goto-char (point-min))
3728 (while (re-search-forward gdb-source-file-regexp nil t)
3729 (push (match-string 1) gdb-source-file-list))
3730 (dolist (buffer (buffer-list))
3731 (with-current-buffer buffer
3732 (when (member buffer-file-name gdb-source-file-list)
3733 (gdb-init-buffer))))
3734 (gdb-force-mode-line-update
3735 (propertize "ready" 'face font-lock-variable-name-face)))
3736
3737(defun gdb-get-main-selected-frame ()
3738 "Trigger for `gdb-frame-handler' which uses main current
3739thread. Called from `gdb-update'."
3740 (if (not (gdb-pending-p 'gdb-get-main-selected-frame))
3741 (progn
3742 (gdb-input
3743 (list (gdb-current-context-command "-stack-info-frame") 'gdb-frame-handler))
3744 (gdb-add-pending 'gdb-get-main-selected-frame))))
3745
3746(defun gdb-frame-handler ()
3747 "Sets `gdb-selected-frame' and `gdb-selected-file' to show
3748overlay arrow in source buffer."
3749 (gdb-delete-pending 'gdb-get-main-selected-frame)
3750 (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame)))
3751 (when frame
3752 (setq gdb-selected-frame (bindat-get-field frame 'func))
3753 (setq gdb-selected-file (bindat-get-field frame 'fullname))
3754 (setq gdb-frame-number (bindat-get-field frame 'level))
3755 (setq gdb-frame-address (bindat-get-field frame 'addr))
3756 (let ((line (bindat-get-field frame 'line)))
3757 (setq gdb-selected-line (and line (string-to-number line)))
3758 (when (and gdb-selected-file gdb-selected-line)
3759 (setq gud-last-frame (cons gdb-selected-file gdb-selected-line))
3760 (gud-display-frame)))
3761 (if gud-overlay-arrow-position
3762 (let ((buffer (marker-buffer gud-overlay-arrow-position))
3763 (position (marker-position gud-overlay-arrow-position)))
3764 (when buffer
3765 (with-current-buffer buffer
3766 (setq fringe-indicator-alist
3767 (if (string-equal gdb-frame-number "0")
3768 nil
3769 '((overlay-arrow . hollow-right-triangle))))
3770 (setq gud-overlay-arrow-position (make-marker))
3771 (set-marker gud-overlay-arrow-position position))))))))
3772
3773(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
3774
3775(defun gdb-get-prompt ()
3776 "Find prompt for GDB session."
3777 (goto-char (point-min))
3778 (setq gdb-prompt-name nil)
3779 (re-search-forward gdb-prompt-name-regexp nil t)
3780 (setq gdb-prompt-name (match-string 1))
3781 ;; Insert first prompt.
3782 (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
3783
3784;;;; Window management
3785(defun gdb-display-buffer (buf dedicated &optional frame)
3786 "Show buffer BUF.
3787
3788If BUF is already displayed in some window, show it, deiconifying
3789the frame if necessary. Otherwise, find least recently used
3790window and show BUF there, if the window is not used for GDB
3791already, in which case that window is splitted first."
3792 (let ((answer (get-buffer-window buf (or frame 0))))
3793 (if answer
3794 (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary.
3795 (let ((window (get-lru-window)))
3796 (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
3797 'gdbmi)
3798 (let* ((largest (get-largest-window))
3799 (cur-size (window-height largest)))
3800 (setq answer (split-window largest))
3801 (set-window-buffer answer buf)
3802 (set-window-dedicated-p answer dedicated)
3803 answer)
3804 (set-window-buffer window buf)
3805 window)))))
3806
3807(defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal)
3808 "Find window displaying a buffer with the same
3809`gdb-buffer-type' as BUF and show BUF there. If no such window
3810exists, just call `gdb-display-buffer' for BUF. If the window
3811found is already dedicated, split window according to
3812SPLIT-HORIZONTAL and show BUF in the new window."
3813 (if buf
3814 (when (not (get-buffer-window buf))
3815 (let* ((buf-type (gdb-buffer-type buf))
3816 (existing-window
3817 (get-window-with-predicate
3818 #'(lambda (w)
3819 (and (eq buf-type
3820 (gdb-buffer-type (window-buffer w)))
3821 (not (window-dedicated-p w)))))))
3822 (if existing-window
3823 (set-window-buffer existing-window buf)
3824 (let ((dedicated-window
3825 (get-window-with-predicate
3826 #'(lambda (w)
3827 (eq buf-type
3828 (gdb-buffer-type (window-buffer w)))))))
3829 (if dedicated-window
3830 (set-window-buffer
3831 (split-window dedicated-window nil split-horizontal) buf)
3832 (gdb-display-buffer buf t))))))
3833 (error "Null buffer")))
3834
3835;;; Shared keymap initialization:
3836
3837(let ((menu (make-sparse-keymap "GDB-Windows")))
3838 (define-key gud-menu-map [displays]
3839 `(menu-item "GDB-Windows" ,menu
3840 :visible (eq gud-minor-mode 'gdbmi)))
3841 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
3842 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
3843 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
3844 (define-key menu [disassembly]
3845 '("Disassembly" . gdb-display-disassembly-buffer))
3846 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
3847 (define-key menu [inferior]
3848 '("IO" . gdb-display-io-buffer))
3849 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
3850 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
3851 (define-key menu [breakpoints]
3852 '("Breakpoints" . gdb-display-breakpoints-buffer)))
3853
3854(let ((menu (make-sparse-keymap "GDB-Frames")))
3855 (define-key gud-menu-map [frames]
3856 `(menu-item "GDB-Frames" ,menu
3857 :visible (eq gud-minor-mode 'gdbmi)))
3858 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
3859 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
3860 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
3861 (define-key menu [disassembly] '("Disassembly" . gdb-frame-disassembly-buffer))
3862 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
3863 (define-key menu [inferior]
3864 '("IO" . gdb-frame-io-buffer))
3865 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
3866 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
3867 (define-key menu [breakpoints]
3868 '("Breakpoints" . gdb-frame-breakpoints-buffer)))
3869
3870(let ((menu (make-sparse-keymap "GDB-MI")))
3871 (define-key menu [gdb-customize]
3872 '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
3873 :help "Customize Gdb Graphical Mode options."))
3874 (define-key menu [gdb-many-windows]
3875 '(menu-item "Display Other Windows" gdb-many-windows
3876 :help "Toggle display of locals, stack and breakpoint information"
3877 :button (:toggle . gdb-many-windows)))
3878 (define-key menu [gdb-restore-windows]
3879 '(menu-item "Restore Window Layout" gdb-restore-windows
3880 :help "Restore standard layout for debug session."))
3881 (define-key menu [sep1]
3882 '(menu-item "--"))
3883 (define-key menu [all-threads]
3884 '(menu-item "GUD controls all threads"
3885 (lambda ()
3886 (interactive)
3887 (setq gdb-gud-control-all-threads t))
3888 :help "GUD start/stop commands apply to all threads"
3889 :button (:radio . gdb-gud-control-all-threads)))
3890 (define-key menu [current-thread]
3891 '(menu-item "GUD controls current thread"
3892 (lambda ()
3893 (interactive)
3894 (setq gdb-gud-control-all-threads nil))
3895 :help "GUD start/stop commands apply to current thread only"
3896 :button (:radio . (not gdb-gud-control-all-threads))))
3897 (define-key menu [sep2]
3898 '(menu-item "--"))
3899 (define-key menu [gdb-customize-reasons]
3900 '(menu-item "Customize switching..."
3901 (lambda ()
3902 (interactive)
3903 (customize-option 'gdb-switch-reasons))))
3904 (define-key menu [gdb-switch-when-another-stopped]
3905 (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped gdb-switch-when-another-stopped
3906 "Automatically switch to stopped thread"
3907 "GDB thread switching %s"
3908 "Switch to stopped thread"))
3909 (define-key gud-menu-map [mi]
3910 `(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi))))
3911
3912;; TODO Fit these into tool-bar-local-item-from-menu call in gud.el.
3913;; GDB-MI menu will need to be moved to gud.el. We can't use
3914;; tool-bar-local-item-from-menu here because it appends new buttons
3915;; to toolbar from right to left while we want our A/T throttle to
3916;; show up right before Run button.
3917(define-key-after gud-tool-bar-map [all-threads]
3918 '(menu-item "Switch to non-stop/A mode" gdb-control-all-threads
3919 :image (find-image '((:type xpm :file "gud/thread.xpm")))
3920 :visible (and (eq gud-minor-mode 'gdbmi)
3921 gdb-non-stop
3922 (not gdb-gud-control-all-threads)))
3923 'run)
3924
3925(define-key-after gud-tool-bar-map [current-thread]
3926 '(menu-item "Switch to non-stop/T mode" gdb-control-current-thread
3927 :image (find-image '((:type xpm :file "gud/all.xpm")))
3928 :visible (and (eq gud-minor-mode 'gdbmi)
3929 gdb-non-stop
3930 gdb-gud-control-all-threads))
3931 'all-threads)
3932
3933(defun gdb-frame-gdb-buffer ()
3934 "Display GUD buffer in a new frame."
3935 (interactive)
3936 (let ((special-display-regexps (append special-display-regexps '(".*")))
3937 (special-display-frame-alist
3938 (remove '(menu-bar-lines) (remove '(tool-bar-lines)
3939 gdb-frame-parameters)))
3940 (same-window-regexps nil))
3941 (display-buffer gud-comint-buffer)))
3942
3943(defun gdb-display-gdb-buffer ()
3944 "Display GUD buffer."
3945 (interactive)
3946 (let ((same-window-regexps nil))
3947 (select-window (display-buffer gud-comint-buffer nil 0))))
3948
3949(defun gdb-set-window-buffer (name &optional ignore-dedicated)
3950 "Set buffer of selected window to NAME and dedicate window.
3951
3952When IGNORE-DEDICATED is non-nil, buffer is set even if selected
3953window is dedicated."
3954 (when ignore-dedicated
3955 (set-window-dedicated-p (selected-window) nil))
3956 (set-window-buffer (selected-window) (get-buffer name))
3957 (set-window-dedicated-p (selected-window) t))
3958
3959(defun gdb-setup-windows ()
3960 "Layout the window pattern for `gdb-many-windows'."
3961 (gdb-display-locals-buffer)
3962 (gdb-display-stack-buffer)
3963 (delete-other-windows)
3964 (gdb-display-breakpoints-buffer)
3965 (delete-other-windows)
3966 ; Don't dedicate.
3967 (pop-to-buffer gud-comint-buffer)
3968 (split-window nil ( / ( * (window-height) 3) 4))
3969 (split-window nil ( / (window-height) 3))
3970 (split-window-horizontally)
3971 (other-window 1)
3972 (gdb-set-window-buffer (gdb-locals-buffer-name))
3973 (other-window 1)
3974 (switch-to-buffer
3975 (if gud-last-last-frame
3976 (gud-find-file (car gud-last-last-frame))
3977 (if gdb-main-file
3978 (gud-find-file gdb-main-file)
3979 ;; Put buffer list in window if we
3980 ;; can't find a source file.
3981 (list-buffers-noselect))))
3982 (setq gdb-source-window (selected-window))
3983 (split-window-horizontally)
3984 (other-window 1)
3985 (gdb-set-window-buffer
3986 (gdb-get-buffer-create 'gdb-inferior-io))
3987 (other-window 1)
3988 (gdb-set-window-buffer (gdb-stack-buffer-name))
3989 (split-window-horizontally)
3990 (other-window 1)
3991 (gdb-set-window-buffer (if gdb-show-threads-by-default
3992 (gdb-threads-buffer-name)
3993 (gdb-breakpoints-buffer-name)))
3994 (other-window 1))
3995
3996(defcustom gdb-many-windows nil
3997 "If nil just pop up the GUD buffer unless `gdb-show-main' is t.
3998In this case it starts with two windows: one displaying the GUD
3999buffer and the other with the source file with the main routine
4000of the debugged program. Non-nil means display the layout shown for
4001`gdb'."
4002 :type 'boolean
4003 :group 'gdb
4004 :version "22.1")
4005
4006(defun gdb-many-windows (arg)
4007 "Toggle the number of windows in the basic arrangement.
4008With arg, display additional buffers iff arg is positive."
4009 (interactive "P")
4010 (setq gdb-many-windows
4011 (if (null arg)
4012 (not gdb-many-windows)
4013 (> (prefix-numeric-value arg) 0)))
4014 (message (format "Display of other windows %sabled"
4015 (if gdb-many-windows "en" "dis")))
4016 (if (and gud-comint-buffer
4017 (buffer-name gud-comint-buffer))
4018 (condition-case nil
4019 (gdb-restore-windows)
4020 (error nil))))
4021
4022(defun gdb-restore-windows ()
4023 "Restore the basic arrangement of windows used by gdb.
4024This arrangement depends on the value of `gdb-many-windows'."
4025 (interactive)
4026 (pop-to-buffer gud-comint-buffer) ;Select the right window and frame.
4027 (delete-other-windows)
4028 (if gdb-many-windows
4029 (gdb-setup-windows)
4030 (when (or gud-last-last-frame gdb-show-main)
4031 (split-window)
4032 (other-window 1)
4033 (switch-to-buffer
4034 (if gud-last-last-frame
4035 (gud-find-file (car gud-last-last-frame))
4036 (gud-find-file gdb-main-file)))
4037 (setq gdb-source-window (selected-window))
4038 (other-window 1))))
4039
4040(defun gdb-reset ()
4041 "Exit a debugging session cleanly.
4042Kills the gdb buffers, and resets variables and the source buffers."
4043 (dolist (buffer (buffer-list))
4044 (unless (eq buffer gud-comint-buffer)
4045 (with-current-buffer buffer
4046 (if (eq gud-minor-mode 'gdbmi)
4047 (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name))
4048 (kill-buffer nil)
4049 (gdb-remove-breakpoint-icons (point-min) (point-max) t)
4050 (setq gud-minor-mode nil)
4051 (kill-local-variable 'tool-bar-map)
4052 (kill-local-variable 'gdb-define-alist))))))
4053 (setq gdb-disassembly-position nil)
4054 (setq overlay-arrow-variable-list
4055 (delq 'gdb-disassembly-position overlay-arrow-variable-list))
4056 (setq fringe-indicator-alist '((overlay-arrow . right-triangle)))
4057 (setq gdb-stack-position nil)
4058 (setq overlay-arrow-variable-list
4059 (delq 'gdb-stack-position overlay-arrow-variable-list))
4060 (setq gdb-thread-position nil)
4061 (setq overlay-arrow-variable-list
4062 (delq 'gdb-thread-position overlay-arrow-variable-list))
4063 (if (boundp 'speedbar-frame) (speedbar-timer-fn))
4064 (setq gud-running nil)
4065 (setq gdb-active-process nil)
4066 (remove-hook 'after-save-hook 'gdb-create-define-alist t))
4067
4068(defun gdb-get-source-file ()
4069 "Find the source file where the program starts and display it with related
4070buffers, if required."
4071 (goto-char (point-min))
4072 (if (re-search-forward gdb-source-file-regexp nil t)
4073 (setq gdb-main-file (match-string 1)))
4074 (if gdb-many-windows
4075 (gdb-setup-windows)
4076 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
4077 (if gdb-show-main
4078 (let ((pop-up-windows t))
4079 (display-buffer (gud-find-file gdb-main-file))))))
4080
4081;;from put-image
4082(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
4083 "Put string PUTSTRING in front of POS in the current buffer.
4084PUTSTRING is displayed by putting an overlay into the current buffer with a
4085`before-string' string that has a `display' property whose value is
4086PUTSTRING."
4087 (let ((string (make-string 1 ?x))
4088 (buffer (current-buffer)))
4089 (setq putstring (copy-sequence putstring))
4090 (let ((overlay (make-overlay pos pos buffer))
4091 (prop (or dprop
4092 (list (list 'margin 'left-margin) putstring))))
4093 (put-text-property 0 1 'display prop string)
4094 (if sprops
4095 (add-text-properties 0 1 sprops string))
4096 (overlay-put overlay 'put-break t)
4097 (overlay-put overlay 'before-string string))))
4098
4099;;from remove-images
4100(defun gdb-remove-strings (start end &optional buffer)
4101 "Remove strings between START and END in BUFFER.
4102Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
4103BUFFER nil or omitted means use the current buffer."
4104 (unless buffer
4105 (setq buffer (current-buffer)))
4106 (dolist (overlay (overlays-in start end))
4107 (when (overlay-get overlay 'put-break)
4108 (delete-overlay overlay))))
4109
4110(defun gdb-put-breakpoint-icon (enabled bptno &optional line)
4111 (let* ((posns (gdb-line-posns (or line (line-number-at-pos))))
4112 (start (- (car posns) 1))
4113 (end (+ (cdr posns) 1))
4114 (putstring (if enabled "B" "b"))
4115 (source-window (get-buffer-window (current-buffer) 0)))
4116 (add-text-properties
4117 0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt")
4118 putstring)
4119 (if enabled
4120 (add-text-properties
4121 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
4122 (add-text-properties
4123 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring))
4124 (gdb-remove-breakpoint-icons start end)
4125 (if (display-images-p)
4126 (if (>= (or left-fringe-width
4127 (if source-window (car (window-fringes source-window)))
4128 gdb-buffer-fringe-width) 8)
4129 (gdb-put-string
4130 nil (1+ start)
4131 `(left-fringe breakpoint
4132 ,(if enabled
4133 'breakpoint-enabled
4134 'breakpoint-disabled))
4135 'gdb-bptno bptno
4136 'gdb-enabled enabled)
4137 (when (< left-margin-width 2)
4138 (save-current-buffer
4139 (setq left-margin-width 2)
4140 (if source-window
4141 (set-window-margins
4142 source-window
4143 left-margin-width right-margin-width))))
4144 (put-image
4145 (if enabled
4146 (or breakpoint-enabled-icon
4147 (setq breakpoint-enabled-icon
4148 (find-image `((:type xpm :data
4149 ,breakpoint-xpm-data
4150 :ascent 100 :pointer hand)
4151 (:type pbm :data
4152 ,breakpoint-enabled-pbm-data
4153 :ascent 100 :pointer hand)))))
4154 (or breakpoint-disabled-icon
4155 (setq breakpoint-disabled-icon
4156 (find-image `((:type xpm :data
4157 ,breakpoint-xpm-data
4158 :conversion disabled
4159 :ascent 100 :pointer hand)
4160 (:type pbm :data
4161 ,breakpoint-disabled-pbm-data
4162 :ascent 100 :pointer hand))))))
4163 (+ start 1)
4164 putstring
4165 'left-margin))
4166 (when (< left-margin-width 2)
4167 (save-current-buffer
4168 (setq left-margin-width 2)
4169 (let ((window (get-buffer-window (current-buffer) 0)))
4170 (if window
4171 (set-window-margins
4172 window left-margin-width right-margin-width)))))
4173 (gdb-put-string
4174 (propertize putstring
4175 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled))
4176 (1+ start)))))
4177
4178(defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
4179 (gdb-remove-strings start end)
4180 (if (display-images-p)
4181 (remove-images start end))
4182 (when remove-margin
4183 (setq left-margin-width 0)
4184 (let ((window (get-buffer-window (current-buffer) 0)))
4185 (if window
4186 (set-window-margins
4187 window left-margin-width right-margin-width)))))
4188
4189(provide 'gdb-mi)
4190
4191;; arch-tag: 1b41ea2b-f364-4cec-8f35-e02e4fe01912
4192;;; gdb-mi.el ends here
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
new file mode 100644
index 00000000000..6a8ca89cda5
--- /dev/null
+++ b/lisp/progmodes/gdb-ui.el
@@ -0,0 +1,4129 @@
1;;; gdb-ui.el --- User Interface for running GDB
2
3;; Author: Nick Roberts <nickrob@gnu.org>
4;; Maintainer: FSF
5;; Keywords: unix, tools
6
7;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
8;; Free Software Foundation, Inc.
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; This mode acts as a graphical user interface to GDB. You can interact with
28;; GDB through the GUD buffer in the usual way, but there are also further
29;; buffers which control the execution and describe the state of your program.
30;; It separates the input/output of your program from that of GDB, if
31;; required, and watches expressions in the speedbar. It also uses features of
32;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar
33;; (see the GDB Graphical Interface section in the Emacs info manual).
34
35;; By default, M-x gdb will start the debugger.
36
37;; This file has evolved from gdba.el that was included with GDB 5.0 and
38;; written by Tom Lord and Jim Kingdon. It uses GDB's annotation interface.
39;; You don't need to know about annotations to use this mode as a debugger,
40;; but if you are interested developing the mode itself, see the Annotations
41;; section in the GDB info manual.
42
43;; GDB developers plan to make the annotation interface obsolete. A new
44;; interface called GDB/MI (machine interface) has been designed to replace it.
45;; Some GDB/MI commands are used in this file through the CLI command
46;; 'interpreter mi <mi-command>'. To help with the process of fully migrating
47;; Emacs from annotations to GDB/MI, there is an experimental package called
48;; gdb-mi in the Emacs Lisp Package Archive ("http://tromey.com/elpa/"). It
49;; comprises of modified gud.el and a file called gdb-mi.el which replaces
50;; gdb-ui.el. When installed, this overrides the current files and invoking
51;; M-x gdb will use GDB/MI directly (starts with "gdb -i=mi"). When deleted
52;; ('d' followed by 'x' in Package Menu mode), the files are deleted and old
53;; functionality restored. This provides a convenient way to review the
54;; current status/contribute to its improvement. For someone who just wants to
55;; use GDB, however, the current mode in Emacs 22 is a much better option.
56;; There is also a file, also called gdb-mi.el, a version of which is included
57;; the GDB distribution. This will probably only work with versions
58;; distributed with GDB 6.5 or later. Unlike the version in ELPA it works on
59;; top of gdb-ui.el and you can only start it with M-x gdbmi.
60
61;; This mode SHOULD WORK WITH GDB 5.0 or later but you will NEED AT LEAST
62;; GDB 6.0 to use watch expressions. It works best with GDB 6.4 or later
63;; where watch expressions will update more quickly.
64
65;;; Windows Platforms:
66
67;; If you are using Emacs and GDB on Windows you will need to flush the buffer
68;; explicitly in your program if you want timely display of I/O in Emacs.
69;; Alternatively you can make the output stream unbuffered, for example, by
70;; using a macro:
71
72;; #ifdef UNBUFFERED
73;; setvbuf (stdout, (char *) NULL, _IONBF, 0);
74;; #endif
75
76;; and compiling with -DUNBUFFERED while debugging.
77
78;; If you are using Cygwin GDB and find that the source is not being displayed
79;; in Emacs when you step through it, possible solutions are to:
80
81;; 1) Use Cygwin X Windows and Cygwin Emacs.
82;; (Since 22.1 Emacs builds under Cygwin.)
83;; 2) Use MinGW GDB instead.
84;; 3) Use cygwin-mount.el
85
86;;; Mac OSX:
87
88;; GDB in Emacs on Mac OSX works best with FSF GDB as Apple have made
89;; some changes to the version that they include as part of Mac OSX.
90;; This requires GDB version 7.0 or later (estimated release date June 2009)
91;; as earlier versions don not compile on Mac OSX.
92
93;;; Known Bugs:
94
95;; 1) Cannot handle multiple debug sessions.
96;; 2) If you wish to call procedures from your program in GDB
97;; e.g "call myproc ()", "p mysquare (5)" then use level 2 annotations
98;; "gdb --annotate=2 myprog" to keep source buffer/selected frame fixed.
99;; 3) After detaching from a process, clicking on the "GO" icon on toolbar
100;; (gud-go) sends "continue" to GDB (should be "run").
101
102;;; TODO:
103
104;; 1) Use MI command -data-read-memory for memory window.
105;; 2) Use tree-buffer.el (from ECB) instead of the speedbar for
106;; watch-expressions? Handling of watch-expressions needs to be
107;; overhauled to work for large arrays/structures by creating variable
108;; objects for visible watch-expressions only.
109;; 3) Mark breakpoint locations on scroll-bar of source buffer?
110
111;;; Code:
112
113(require 'gud)
114(require 'json)
115(require 'bindat)
116
117(defvar tool-bar-map)
118(defvar speedbar-initial-expansion-list-name)
119(defvar speedbar-frame)
120
121(defvar gdb-pc-address nil "Initialization for Assembler buffer.
122Set to \"main\" at start if `gdb-show-main' is t.")
123(defvar gdb-frame-address nil "Identity of frame for watch expression.")
124(defvar gdb-previous-frame-pc-address nil)
125(defvar gdb-memory-address "main")
126(defvar gdb-previous-frame nil)
127(defvar gdb-selected-frame nil)
128(defvar gdb-frame-number nil)
129(defvar gdb-current-language nil)
130(defvar gdb-var-list nil
131 "List of variables in watch window.
132Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP)
133where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame
134address for root variables.")
135(defvar gdb-main-file nil "Source file from which program execution begins.")
136(defvar gud-old-arrow nil)
137(defvar gdb-thread-indicator nil)
138(defvar gdb-overlay-arrow-position nil)
139(defvar gdb-stack-position nil)
140(defvar gdb-server-prefix nil)
141(defvar gdb-flush-pending-output nil)
142(defvar gdb-location-alist nil
143 "Alist of breakpoint numbers and full filenames. Only used for files that
144Emacs can't find.")
145(defvar gdb-active-process nil
146 "GUD tooltips display variable values when t, and macro definitions otherwise.")
147(defvar gdb-recording nil
148 "If t, then record session for playback and reverse execution")
149(defvar gdb-error "Non-nil when GDB is reporting an error.")
150(defvar gdb-macro-info nil
151 "Non-nil if GDB knows that the inferior includes preprocessor macro info.")
152(defvar gdb-buffer-fringe-width nil)
153(defvar gdb-signalled nil)
154(defvar gdb-source-window nil)
155(defvar gdb-inferior-status nil)
156(defvar gdb-continuation nil)
157(defvar gdb-look-up-stack nil)
158(defvar gdb-frame-begin nil
159 "Non-nil when GDB generates frame-begin annotation.")
160(defvar gdb-printing t)
161(defvar gdb-parent-bptno-enabled nil)
162(defvar gdb-ready nil)
163(defvar gdb-stack-update nil)
164(defvar gdb-early-user-input nil)
165
166(defvar gdb-buffer-type nil
167 "One of the symbols bound in `gdb-buffer-rules'.")
168(make-variable-buffer-local 'gdb-buffer-type)
169
170(defvar gdb-input-queue ()
171 "A list of gdb command objects.")
172
173(defvar gdb-prompting nil
174 "True when gdb is idle with no pending input.")
175
176(defvar gdb-output-sink nil
177 "The disposition of the output of the current gdb command.
178Possible values are these symbols:
179
180 `user' -- gdb output should be copied to the GUD buffer
181 for the user to see.
182
183 `inferior' -- gdb output should be copied to the inferior-io buffer.
184
185 `pre-emacs' -- output should be ignored util the post-prompt
186 annotation is received. Then the output-sink
187 becomes:...
188 `emacs' -- output should be collected in the partial-output-buffer
189 for subsequent processing by a command. This is the
190 disposition of output generated by commands that
191 gdb mode sends to gdb on its own behalf.
192 `post-emacs' -- ignore output until the prompt annotation is
193 received, then go to USER disposition.
194
195gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two
196\(`user' and `emacs').")
197
198(defvar gdb-current-item nil
199 "The most recent command item sent to gdb.")
200
201(defvar gdb-pending-triggers '()
202 "A list of trigger functions that have run later than their output handlers.")
203
204(defvar gdb-first-post-prompt nil)
205(defvar gdb-version nil)
206(defvar gdb-locals-font-lock-keywords nil)
207(defvar gdb-source-file-list nil
208 "List of source files for the current executable.")
209(defconst gdb-error-regexp "\\^error,msg=\"\\(.+\\)\"")
210
211(defvar gdb-locals-font-lock-keywords-1
212 '(;; var = (struct struct_tag) value
213 ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)"
214 (1 font-lock-variable-name-face)
215 (3 font-lock-keyword-face)
216 (4 font-lock-type-face))
217 ;; var = (type) value
218 ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)"
219 (1 font-lock-variable-name-face)
220 (3 font-lock-type-face))
221 ;; var = val
222 ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]"
223 (1 font-lock-variable-name-face)))
224 "Font lock keywords used in `gdb-local-mode'.")
225
226(defvar gdb-locals-font-lock-keywords-2
227 '(;; var = type value
228 ( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)"
229 (1 font-lock-variable-name-face)
230 (3 font-lock-type-face)))
231 "Font lock keywords used in `gdb-local-mode'.")
232
233;; Variables for GDB 6.4+
234(defvar gdb-register-names nil "List of register names.")
235(defvar gdb-changed-registers nil
236 "List of changed register numbers (strings).")
237
238;;;###autoload
239(defun gdb (command-line)
240 "Run gdb on program FILE in buffer *gud-FILE*.
241The directory containing FILE becomes the initial working
242directory and source-file directory for your debugger.
243
244If `gdb-many-windows' is nil (the default value) then gdb just
245pops up the GUD buffer unless `gdb-show-main' is t. In this case
246it starts with two windows: one displaying the GUD buffer and the
247other with the source file with the main routine of the inferior.
248
249If `gdb-many-windows' is t, regardless of the value of
250`gdb-show-main', the layout below will appear unless
251`gdb-use-separate-io-buffer' is nil when the source buffer
252occupies the full width of the frame. Keybindings are shown in
253some of the buffers.
254
255Watch expressions appear in the speedbar/slowbar.
256
257The following commands help control operation :
258
259`gdb-many-windows' - Toggle the number of windows gdb uses.
260`gdb-restore-windows' - To restore the window layout.
261
262See Info node `(emacs)GDB Graphical Interface' for a more
263detailed description of this mode.
264
265+----------------------------------------------------------------------+
266| GDB Toolbar |
267+-----------------------------------+----------------------------------+
268| GUD buffer (I/O of GDB) | Locals buffer |
269|-----------------------------------+----------------------------------+
270| | |
271| Source buffer | I/O buffer for debugged program |
272| | |
273|-----------------------------------+----------------------------------+
274| Stack buffer | Breakpoints/threads buffer |
275+-----------------------------------+----------------------------------+
276
277The option \"--annotate=3\" must be included in this value. To
278run GDB in text command mode, use `gud-gdb'. You need to use
279text command mode to debug multiple programs within one Emacs
280session."
281 (interactive (list (gud-query-cmdline 'gdb)))
282
283 (when (and gud-comint-buffer
284 (buffer-name gud-comint-buffer)
285 (get-buffer-process gud-comint-buffer)
286 (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
287 (gdb-restore-windows)
288 (error
289 "Multiple debugging requires restarting in text command mode"))
290
291 (gud-common-init command-line nil 'gud-gdba-marker-filter)
292 (set (make-local-variable 'gud-minor-mode) 'gdba)
293 (setq comint-input-sender 'gdb-send)
294
295 (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
296 (gud-def gud-tbreak "tbreak %f:%l" "\C-t"
297 "Set temporary breakpoint at current line.")
298 (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line.")
299 (gud-def gud-step "step %p" "\C-s" "Step one source line with display.")
300 (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.")
301 (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).")
302 (gud-def gud-nexti "nexti %p" nil "Step one instruction (skip functions).")
303 (gud-def gud-cont "continue" "\C-r" "Continue with display.")
304 (gud-def gud-finish "finish" "\C-f" "Finish executing current function.")
305 (gud-def gud-jump
306 (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l"))
307 "\C-j" "Set execution address to current line.")
308
309 (gud-def gud-rstep "reverse-step %p" nil "Reverse step one source line with display.")
310 (gud-def gud-rstepi "reverse-stepi %p" nil "Reverse step one instruction with display.")
311 (gud-def gud-rnext "reverse-next %p" nil "Reverse step one line (skip functions).")
312 (gud-def gud-rnexti "reverse-nexti %p" nil "Reverse step one instruction (skip functions).")
313 (gud-def gud-rcont "reverse-continue" nil "Reverse continue with display.")
314 (gud-def gud-rfinish "reverse-finish" nil "Reverse finish executing current function.")
315
316 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
317 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
318 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
319 (gud-def gud-pstar "print* %e" nil
320 "Evaluate C dereferenced pointer expression at point.")
321
322 ;; For debugging Emacs only.
323 (gud-def gud-pv "pv1 %e" "\C-v" "Print the value of the lisp variable.")
324
325 (gud-def gud-until "until %l" "\C-u" "Continue to current line.")
326 (gud-def gud-run "run" nil "Run the program.")
327
328 (local-set-key "\C-i" 'gud-gdb-complete-command)
329 (setq comint-prompt-regexp "^(.*gdb[+]?) *")
330 (setq paragraph-start comint-prompt-regexp)
331 (setq gdb-output-sink 'user)
332 (setq gdb-first-prompt t)
333 (setq gud-running nil)
334 (setq gdb-ready nil)
335 (setq gdb-stack-update nil)
336 (setq gdb-flush-pending-output nil)
337 (setq gdb-early-user-input nil)
338 (setq gud-filter-pending-text nil)
339 (gdb-thread-identification)
340 (run-hooks 'gdb-mode-hook))
341
342;; Keep as an alias for compatibility with Emacs 22.1.
343;;;###autoload
344(defalias 'gdba 'gdb)
345
346(defgroup gdb nil
347 "Gdb Graphical Mode options specifically for running Gdb in Emacs."
348 :group 'processes
349 :group 'tools)
350
351(defcustom gdb-debug-log-max 128
352 "Maximum size of `gdb-debug-log'. If nil, size is unlimited."
353 :group 'gdb
354 :type '(choice (integer :tag "Number of elements")
355 (const :tag "Unlimited" nil))
356 :version "22.1")
357
358(defvar gdb-debug-log nil
359 "List of commands sent to and replies received from GDB.
360Most recent commands are listed first. This list stores only the last
361`gdb-debug-log-max' values. This variable is used to debug GDB-UI.")
362
363;;;###autoload
364(defcustom gdb-enable-debug nil
365 "Non-nil means record the process input and output in `gdb-debug-log'."
366 :type 'boolean
367 :group 'gdb
368 :version "22.1")
369
370(defcustom gdb-cpp-define-alist-program "gcc -E -dM -"
371 "Shell command for generating a list of defined macros in a source file.
372This list is used to display the #define directive associated
373with an identifier as a tooltip. It works in a debug session with
374GDB, when `gud-tooltip-mode' is t.
375
376Set `gdb-cpp-define-alist-flags' for any include paths or
377predefined macros."
378 :type 'string
379 :group 'gdb
380 :version "22.1")
381
382(defcustom gdb-cpp-define-alist-flags ""
383 "Preprocessor flags for `gdb-cpp-define-alist-program'."
384 :type 'string
385 :group 'gdb
386 :version "22.1")
387
388(defcustom gdb-create-source-file-list t
389 "Non-nil means create a list of files from which the executable was built.
390Set this to nil if the GUD buffer displays \"initializing...\" in the mode
391line for a long time when starting, possibly because your executable was
392built from a large number of files. This allows quicker initialization
393but means that these files are not automatically enabled for debugging,
394e.g., you won't be able to click in the fringe to set a breakpoint until
395execution has already stopped there."
396 :type 'boolean
397 :group 'gdb
398 :version "23.1")
399
400(defcustom gdb-show-main nil
401 "Non-nil means display source file containing the main routine at startup.
402Also display the main routine in the disassembly buffer if present."
403 :type 'boolean
404 :group 'gdb
405 :version "22.1")
406
407(defcustom gdb-many-windows nil
408 "If nil, just pop up the GUD buffer unless `gdb-show-main' is t.
409In this case start with two windows: one displaying the GUD
410buffer and the other with the source file with the main routine
411of the debugged program. Non-nil means display the layout shown
412for `gdba'."
413 :type 'boolean
414 :group 'gdb
415 :version "22.1")
416
417(defcustom gdb-use-separate-io-buffer nil
418 "Non-nil means display output from the debugged program in a separate buffer."
419 :type 'boolean
420 :group 'gdb
421 :version "22.1")
422
423(defun gdb-force-mode-line-update (status)
424 (let ((buffer gud-comint-buffer))
425 (if (and buffer (buffer-name buffer))
426 (with-current-buffer buffer
427 (setq mode-line-process
428 (format ":%s [%s]"
429 (process-status (get-buffer-process buffer)) status))
430 ;; Force mode line redisplay soon.
431 (force-mode-line-update)))))
432
433(defun gdb-enable-debug (arg)
434 "Toggle logging of transaction between Emacs and Gdb.
435The log is stored in `gdb-debug-log' as an alist with elements
436whose cons is send, send-item or recv and whose cdr is the string
437being transferred. This list may grow up to a size of
438`gdb-debug-log-max' after which the oldest element (at the end of
439the list) is deleted every time a new one is added (at the front)."
440 (interactive "P")
441 (setq gdb-enable-debug
442 (if (null arg)
443 (not gdb-enable-debug)
444 (> (prefix-numeric-value arg) 0)))
445 (message (format "Logging of transaction %sabled"
446 (if gdb-enable-debug "en" "dis"))))
447
448(defun gdb-many-windows (arg)
449 "Toggle the number of windows in the basic arrangement.
450With prefix argument ARG, display additional buffers if ARG is positive,
451otherwise use a single window."
452 (interactive "P")
453 (setq gdb-many-windows
454 (if (null arg)
455 (not gdb-many-windows)
456 (> (prefix-numeric-value arg) 0)))
457 (message (format "Display of other windows %sabled"
458 (if gdb-many-windows "en" "dis")))
459 (if (and gud-comint-buffer
460 (buffer-name gud-comint-buffer))
461 (condition-case nil
462 (gdb-restore-windows)
463 (error nil))))
464
465(defun gdb-use-separate-io-buffer (arg)
466 "Toggle separate IO for debugged program.
467With prefix argument ARG, use separate IO if ARG is positive,
468otherwise do not."
469 (interactive "P")
470 (setq gdb-use-separate-io-buffer
471 (if (null arg)
472 (not gdb-use-separate-io-buffer)
473 (> (prefix-numeric-value arg) 0)))
474 (message (format "Separate IO %sabled"
475 (if gdb-use-separate-io-buffer "en" "dis")))
476 (if (and gud-comint-buffer
477 (buffer-name gud-comint-buffer))
478 (condition-case nil
479 (if gdb-use-separate-io-buffer
480 (if gdb-many-windows (gdb-restore-windows))
481 (kill-buffer (gdb-inferior-io-name)))
482 (error nil))))
483
484(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")
485
486(defun gdb-create-define-alist ()
487 "Create an alist of #define directives for GUD tooltips."
488 (let* ((file (buffer-file-name))
489 (output
490 (with-output-to-string
491 (with-current-buffer standard-output
492 (and file
493 (file-exists-p file)
494 ;; call-process doesn't work with remote file names.
495 (not (file-remote-p default-directory))
496 (call-process shell-file-name file
497 (list t nil) nil "-c"
498 (concat gdb-cpp-define-alist-program " "
499 gdb-cpp-define-alist-flags))))))
500 (define-list (split-string output "\n" t)) (name))
501 (setq gdb-define-alist nil)
502 (dolist (define define-list)
503 (setq name (nth 1 (split-string define "[( ]")))
504 (push (cons name define) gdb-define-alist))))
505
506(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
507(defvar tooltip-use-echo-area)
508
509(defun gdb-tooltip-print (expr)
510 (tooltip-show
511 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
512 (goto-char (point-min))
513 (let ((string
514 (if (search-forward "=" nil t)
515 (concat expr (buffer-substring (- (point) 2) (point-max)))
516 (buffer-string))))
517 ;; remove newline for gud-tooltip-echo-area
518 (substring string 0 (- (length string) 1))))
519 (or gud-tooltip-echo-area tooltip-use-echo-area
520 (not (display-graphic-p)))))
521
522;; If expr is a macro for a function don't print because of possible dangerous
523;; side-effects. Also printing a function within a tooltip generates an
524;; unexpected starting annotation (phase error).
525(defun gdb-tooltip-print-1 (expr)
526 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
527 (goto-char (point-min))
528 (if (search-forward "expands to: " nil t)
529 (unless (looking-at "\\S-+.*(.*).*")
530 (gdb-enqueue-input
531 (list (concat gdb-server-prefix "print " expr "\n")
532 `(lambda () (gdb-tooltip-print ,expr))))))))
533
534(defconst gdb-source-file-regexp "\\(.+?\\), \\|\\([^, \n].*$\\)")
535
536(defun gdb-init-buffer ()
537 (set (make-local-variable 'gud-minor-mode)
538 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
539 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
540 (when gud-tooltip-mode
541 (make-local-variable 'gdb-define-alist)
542 (gdb-create-define-alist)
543 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))
544
545(defun gdb-set-gud-minor-mode-existing-buffers ()
546 "Create list of source files for current GDB session."
547 (goto-char (point-min))
548 (when (search-forward "read in on demand:" nil t)
549 (while (re-search-forward gdb-source-file-regexp nil t)
550 (push (file-name-nondirectory (or (match-string 1) (match-string 2)))
551 gdb-source-file-list))
552 (dolist (buffer (buffer-list))
553 (with-current-buffer buffer
554 (when (and buffer-file-name
555 (member (file-name-nondirectory buffer-file-name)
556 gdb-source-file-list))
557 (gdb-init-buffer)))))
558 (gdb-force-mode-line-update
559 (propertize "ready" 'face font-lock-variable-name-face)))
560
561(defun gdb-find-watch-expression ()
562 (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
563 (varnum (car var)) expr array)
564 (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum)
565 (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet
566 (component-list (split-string (match-string 2 varnum) "\\." t)))
567 (setq expr (nth 1 var1))
568 (setq varnumlet (car var1))
569 (dolist (component component-list)
570 (setq var2 (assoc varnumlet gdb-var-list))
571 (setq expr (concat expr
572 (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2))
573 (concat "[" component "]")
574 (concat "." component))))
575 (setq varnumlet (concat varnumlet "." component)))
576 expr)))
577
578(defun gdb-toggle-recording ()
579"Start/stop recording of debug session."
580 (interactive)
581 (if gud-running
582 (message-box "Recording cannot be started or stopped while your program is still running")
583 (gdb-enqueue-input
584 (list (concat gdb-server-prefix
585 (if gdb-recording "record stop\n" "target record\n"))
586 'gdb-recording-handler))))
587
588;; Convenience function for tool bar.
589(defalias 'gdb-toggle-recording-1 'gdb-toggle-recording)
590
591(defun gdb-recording-handler ()
592 (goto-char (point-min))
593 (if (re-search-forward "current architecture doesn't support record function" nil t)
594 (message-box "Not enabled. The current architecture doesn't support the process record function.")
595 (goto-char (point-min))
596 (if (re-search-forward "Undefined target command" nil t)
597 (message-box "Not enabled. Process record requires GDB 7.0 onwards.")
598 (goto-char (point-min))
599 (if (re-search-forward "the program is not being run" nil t)
600 (message-box "Not enabled. Starting process recording requires an active target (running process).")
601 (setq gdb-recording (not gdb-recording))
602 ;; Actually forcing the tool-bar to update.
603 (force-mode-line-update)))))
604
605(defun gdb-init-1 ()
606 (gud-def gud-break (if (not (string-match "Machine" mode-name))
607 (gud-call "break %f:%l" arg)
608 (save-excursion
609 (beginning-of-line)
610 (forward-char 2)
611 (gud-call "break *%a" arg)))
612 "\C-b" "Set breakpoint at current line or address.")
613 ;;
614 (gud-def gud-remove (if (not (string-match "Machine" mode-name))
615 (gud-call "clear %f:%l" arg)
616 (save-excursion
617 (beginning-of-line)
618 (forward-char 2)
619 (gud-call "clear *%a" arg)))
620 "\C-d" "Remove breakpoint at current line or address.")
621 ;;
622 (gud-def gud-until (if (not (string-match "Machine" mode-name))
623 (gud-call "until %f:%l" arg)
624 (save-excursion
625 (beginning-of-line)
626 (forward-char 2)
627 (gud-call "until *%a" arg)))
628 "\C-u" "Continue to current line or address.")
629 ;;
630 (gud-def gud-go (gud-call (if gdb-active-process "continue" "run") arg)
631 nil "Start or continue execution.")
632
633 ;; For debugging Emacs only.
634 (gud-def gud-pp
635 (gud-call
636 (concat
637 "pp1 " (if (eq (buffer-local-value
638 'major-mode (window-buffer)) 'speedbar-mode)
639 (gdb-find-watch-expression) "%e")) arg)
640 nil "Print the Emacs s-expression.")
641
642 (define-key gud-minor-mode-map [left-margin mouse-1]
643 'gdb-mouse-set-clear-breakpoint)
644 (define-key gud-minor-mode-map [left-fringe mouse-1]
645 'gdb-mouse-set-clear-breakpoint)
646 (define-key gud-minor-mode-map [left-margin C-mouse-1]
647 'gdb-mouse-toggle-breakpoint-margin)
648 (define-key gud-minor-mode-map [left-fringe C-mouse-1]
649 'gdb-mouse-toggle-breakpoint-fringe)
650
651 (define-key gud-minor-mode-map [left-margin drag-mouse-1]
652 'gdb-mouse-until)
653 (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
654 'gdb-mouse-until)
655 (define-key gud-minor-mode-map [left-margin mouse-3]
656 'gdb-mouse-until)
657 (define-key gud-minor-mode-map [left-fringe mouse-3]
658 'gdb-mouse-until)
659
660 (define-key gud-minor-mode-map [left-margin C-drag-mouse-1]
661 'gdb-mouse-jump)
662 (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1]
663 'gdb-mouse-jump)
664 (define-key gud-minor-mode-map [left-fringe C-mouse-3]
665 'gdb-mouse-jump)
666 (define-key gud-minor-mode-map [left-margin C-mouse-3]
667 'gdb-mouse-jump)
668
669 ;; (re-)initialize
670 (setq gdb-pc-address (if gdb-show-main "main" nil))
671 (setq gdb-previous-frame-pc-address nil
672 gdb-memory-address "main"
673 gdb-previous-frame nil
674 gdb-selected-frame nil
675 gdb-current-language nil
676 gdb-frame-number nil
677 gdb-var-list nil
678 gdb-main-file nil
679 gdb-first-post-prompt t
680 gdb-prompting nil
681 gdb-input-queue nil
682 gdb-current-item nil
683 gdb-pending-triggers nil
684 gdb-output-sink 'user
685 gdb-server-prefix "server "
686 gdb-location-alist nil
687 gdb-source-file-list nil
688 gdb-error nil
689 gdb-macro-info nil
690 gdb-buffer-fringe-width (car (window-fringes))
691 gdb-debug-log nil
692 gdb-signalled nil
693 gdb-source-window nil
694 gdb-inferior-status nil
695 gdb-continuation nil
696 gdb-look-up-stack nil
697 gdb-frame-begin nil
698 gdb-printing t
699 gud-old-arrow nil
700 gdb-thread-indicator nil
701 gdb-register-names nil
702 gdb-recording nil)
703
704 (setq gdb-buffer-type 'gdba)
705
706 (if gdb-use-separate-io-buffer (gdb-clear-inferior-io))
707
708 ;; Hack to see test for GDB 6.4+ (-stack-info-frame was implemented in 6.4)
709 (gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n"
710 'gdb-get-version)))
711
712(defun gdb-init-2 ()
713 (if (eq window-system 'w32)
714 (gdb-enqueue-input (list "set new-console off\n" 'ignore)))
715 (gdb-enqueue-input (list "set height 0\n" 'ignore))
716 (gdb-enqueue-input (list "set width 0\n" 'ignore))
717
718 (if (string-equal gdb-version "pre-6.4")
719 (if gdb-create-source-file-list
720 (gdb-enqueue-input (list (concat gdb-server-prefix "info sources\n")
721 'gdb-set-gud-minor-mode-existing-buffers))
722 (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-1))
723 ; Needs GDB 6.2 onwards.
724 (if gdb-create-source-file-list
725 (gdb-enqueue-input
726 (list "server interpreter mi \"-file-list-exec-source-files\"\n"
727 'gdb-set-gud-minor-mode-existing-buffers-1)))
728 (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)
729 ; Needs GDB 7.0 onwards.
730 (gdb-enqueue-input
731 (list "server interpreter mi -enable-pretty-printing\n" 'ignore)))
732
733 ;; Find source file and compilation directory here.
734 ;; Works for C, C++, Fortran and Ada but not Java (GDB 6.4)
735 (gdb-enqueue-input (list "server list\n" 'ignore))
736 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore))
737 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info)))
738
739(defun gdb-get-version ()
740 (goto-char (point-min))
741 (if (re-search-forward "Undefined\\( mi\\)* command:" nil t)
742 (setq gdb-version "pre-6.4")
743 (setq gdb-version "6.4+"))
744 (gdb-init-2))
745
746(defmacro gdb-if-arrow (arrow-position &rest body)
747 `(if ,arrow-position
748 (let ((buffer (marker-buffer ,arrow-position)) (line))
749 (if (equal buffer (window-buffer (posn-window end)))
750 (with-current-buffer buffer
751 (when (or (equal start end)
752 (equal (posn-point start)
753 (marker-position ,arrow-position)))
754 ,@body))))))
755
756(defun gdb-mouse-until (event)
757 "Continue running until a source line past the current line.
758The destination source line can be selected either by clicking
759with mouse-3 on the fringe/margin or dragging the arrow
760with mouse-1 (default bindings)."
761 (interactive "e")
762 (let ((start (event-start event))
763 (end (event-end event)))
764 (gdb-if-arrow gud-overlay-arrow-position
765 (setq line (line-number-at-pos (posn-point end)))
766 (gud-call (concat "until " (number-to-string line))))
767 (gdb-if-arrow gdb-overlay-arrow-position
768 (save-excursion
769 (goto-char (point-min))
770 (forward-line (1- (line-number-at-pos (posn-point end))))
771 (forward-char 2)
772 (gud-call (concat "until *%a"))))))
773
774(defun gdb-mouse-jump (event)
775 "Set execution address/line.
776The destination source line can be selected either by clicking with C-mouse-3
777on the fringe/margin or dragging the arrow with C-mouse-1 (default bindings).
778Unlike `gdb-mouse-until' the destination address can be before the current
779line, and no execution takes place."
780 (interactive "e")
781 (let ((start (event-start event))
782 (end (event-end event)))
783 (gdb-if-arrow gud-overlay-arrow-position
784 (setq line (line-number-at-pos (posn-point end)))
785 (progn
786 (gud-call (concat "tbreak " (number-to-string line)))
787 (gud-call (concat "jump " (number-to-string line)))))
788 (gdb-if-arrow gdb-overlay-arrow-position
789 (save-excursion
790 (goto-char (point-min))
791 (forward-line (1- (line-number-at-pos (posn-point end))))
792 (forward-char 2)
793 (progn
794 (gud-call (concat "tbreak *%a"))
795 (gud-call (concat "jump *%a")))))))
796
797(defcustom gdb-speedbar-auto-raise nil
798 "If non-nil raise speedbar every time display of watch expressions is\
799 updated."
800 :type 'boolean
801 :group 'gdb
802 :version "22.1")
803
804(defun gdb-speedbar-auto-raise (arg)
805 "Toggle automatic raising of the speedbar for watch expressions.
806With prefix argument ARG, automatically raise speedbar if ARG is
807positive, otherwise don't automatically raise it."
808 (interactive "P")
809 (setq gdb-speedbar-auto-raise
810 (if (null arg)
811 (not gdb-speedbar-auto-raise)
812 (> (prefix-numeric-value arg) 0)))
813 (message (format "Auto raising %sabled"
814 (if gdb-speedbar-auto-raise "en" "dis"))))
815
816(defcustom gdb-use-colon-colon-notation nil
817 "If non-nil use FUN::VAR format to display variables in the speedbar."
818 :type 'boolean
819 :group 'gdb
820 :version "22.1")
821
822(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
823(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)
824
825(declare-function tooltip-identifier-from-point "tooltip" (point))
826
827(defun gud-watch (&optional arg event)
828 "Watch expression at point.
829With arg, enter name of variable to be watched in the minibuffer."
830 (interactive (list current-prefix-arg last-input-event))
831 (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer)))
832 (if (memq minor-mode '(gdbmi gdba))
833 (progn
834 (if event (posn-set-point (event-end event)))
835 (require 'tooltip)
836 (save-selected-window
837 (let ((expr
838 (if arg
839 (completing-read "Name of variable: "
840 'gud-gdb-complete-command)
841 (if (and transient-mark-mode mark-active)
842 (buffer-substring (region-beginning) (region-end))
843 (concat (if (eq major-mode 'gdb-registers-mode) "$")
844 (tooltip-identifier-from-point (point)))))))
845 (set-text-properties 0 (length expr) nil expr)
846 (gdb-enqueue-input
847 (list
848 (if (eq minor-mode 'gdba)
849 (concat
850 "server interpreter mi \"-var-create - * " expr "\"\n")
851 (concat"-var-create - * " expr "\n"))
852 `(lambda () (gdb-var-create-handler ,expr)))))))
853 (message "gud-watch is a no-op in this mode."))))
854
855(defun gdb-var-create-handler (expr)
856 (let* ((result (gdb-json-partial-output)))
857 (if (not (bindat-get-field result 'msg))
858 (let ((var
859 (list (bindat-get-field result 'name)
860 (if (and (string-equal gdb-current-language "c")
861 gdb-use-colon-colon-notation gdb-selected-frame)
862 (setq expr (concat gdb-selected-frame "::" expr))
863 expr)
864 (bindat-get-field result 'numchild)
865 (bindat-get-field result 'type)
866 (bindat-get-field result 'value)
867 nil
868 (bindat-get-field result 'has_more)
869 gdb-frame-address)))
870 (push var gdb-var-list)
871 (speedbar 1)
872 (unless (string-equal
873 speedbar-initial-expansion-list-name "GUD")
874 (speedbar-change-initial-expansion-list "GUD")))
875 (message-box "No symbol \"%s\" in current context." expr))))
876
877(defun gdb-speedbar-update ()
878 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
879 (not (member 'gdb-speedbar-timer gdb-pending-triggers)))
880 ;; Dummy command to update speedbar even when idle.
881 (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))
882 ;; Keep gdb-pending-triggers non-nil till end.
883 (push 'gdb-speedbar-timer gdb-pending-triggers)))
884
885(defun gdb-speedbar-timer-fn ()
886 (if gdb-speedbar-auto-raise
887 (raise-frame speedbar-frame))
888 (setq gdb-pending-triggers
889 (delq 'gdb-speedbar-timer gdb-pending-triggers))
890 (speedbar-timer-fn))
891
892(defun gdb-var-evaluate-expression-handler (varnum changed)
893 (goto-char (point-min))
894 (re-search-forward "\\(.+\\)\\^done,value=\\(\".*\"\\)" nil t)
895 (setq gdb-pending-triggers
896 (delq (string-to-number (match-string 1)) gdb-pending-triggers))
897 (let ((var (assoc varnum gdb-var-list)))
898 (when var
899 (if changed (setcar (nthcdr 5 var) 'changed))
900 (setcar (nthcdr 4 var) (read (match-string 2)))))
901 (gdb-speedbar-update))
902
903(defun gdb-var-list-children (varnum)
904 (gdb-enqueue-input
905 (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n")
906 `(lambda () (gdb-var-list-children-handler ,varnum)))))
907
908(defconst gdb-var-list-children-regexp
909 "child={.*?name=\"\\(.*?\\)\".*?,exp=\"\\(.*?\\)\".*?,\
910numchild=\"\\(.*?\\)\"\\(}\\|.*?,\\(type=\"\\(.*?\\)\"\\)?.*?}\\)")
911
912(defun gdb-var-list-children-handler (varnum)
913 (goto-char (point-min))
914 (let ((var-list nil))
915 (catch 'child-already-watched
916 (dolist (var gdb-var-list)
917 (if (string-equal varnum (car var))
918 (progn
919 (push var var-list)
920 (while (re-search-forward gdb-var-list-children-regexp nil t)
921 (let ((varchild (list (match-string 1)
922 (match-string 2)
923 (match-string 3)
924 (match-string 6)
925 nil nil)))
926 (if (assoc (car varchild) gdb-var-list)
927 (throw 'child-already-watched nil))
928 (push varchild var-list)
929 (gdb-enqueue-input
930 (list
931 (concat
932 "server interpreter mi \"0-var-evaluate-expression "
933 (car varchild) "\"\n")
934 `(lambda () (gdb-var-evaluate-expression-handler
935 ,(car varchild) nil)))))))
936 (push var var-list)))
937 (setq gdb-var-list (nreverse var-list)))))
938
939(defun gdb-var-update ()
940 (when (not (member 'gdb-var-update gdb-pending-triggers))
941 (gdb-enqueue-input
942 (list "server interpreter mi \"-var-update *\"\n"
943 'gdb-var-update-handler))
944 (push 'gdb-var-update gdb-pending-triggers)))
945
946(defconst gdb-var-update-regexp
947 "{.*?name=\"\\(.*?\\)\".*?,in_scope=\"\\(.*?\\)\".*?,\
948type_changed=\".*?\".*?}")
949
950(defun gdb-var-update-handler ()
951 (dolist (var gdb-var-list)
952 (setcar (nthcdr 5 var) nil))
953 (goto-char (point-min))
954 (let ((n 0))
955 (while (re-search-forward gdb-var-update-regexp nil t)
956 (let ((varnum (match-string 1)))
957 (if (string-equal (match-string 2) "false")
958 (let ((var (assoc varnum gdb-var-list)))
959 (if var (setcar (nthcdr 5 var) 'out-of-scope)))
960 (setq n (1+ n))
961 (push n gdb-pending-triggers)
962 (gdb-enqueue-input
963 (list
964 (concat "server interpreter mi \"" (number-to-string n)
965 "-var-evaluate-expression " varnum "\"\n")
966 `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))))))
967 (setq gdb-pending-triggers
968 (delq 'gdb-var-update gdb-pending-triggers)))
969
970(defun gdb-var-set-format (format)
971 "Set the output format for a variable displayed in the speedbar."
972 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
973 (varnum (car var)))
974 (gdb-enqueue-input
975 (list
976 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
977 (concat "server interpreter mi \"-var-set-format "
978 varnum " " format "\"\n")
979 (concat "-var-set-format " varnum " " format "\n"))
980 `(lambda () (gdb-var-set-format-handler ,varnum))))))
981
982(defconst gdb-var-set-format-regexp
983 "format=\"\\(.*?\\)\",.*value=\"\\(.*?\\)\"")
984
985(defun gdb-var-set-format-handler (varnum)
986 (goto-char (point-min))
987 (if (re-search-forward gdb-var-set-format-regexp nil t)
988 (let ((var (assoc varnum gdb-var-list)))
989 (setcar (nthcdr 4 var) (match-string 2))
990 (gdb-var-update-1))))
991
992(defun gdb-var-delete-1 (var varnum)
993 (gdb-enqueue-input
994 (list
995 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
996 (concat "server interpreter mi \"-var-delete " varnum "\"\n")
997 (concat "-var-delete " varnum "\n"))
998 'ignore))
999 (setq gdb-var-list (delq var gdb-var-list))
1000 (dolist (varchild gdb-var-list)
1001 (if (string-match (concat (car var) "\\.") (car varchild))
1002 (setq gdb-var-list (delq varchild gdb-var-list)))))
1003
1004(defun gdb-var-delete ()
1005 "Delete watch expression at point from the speedbar."
1006 (interactive)
1007 (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
1008 '(gdbmi gdba))
1009 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1010 (varnum (car var)))
1011 (if (string-match "\\." (car var))
1012 (message-box "Can only delete a root expression")
1013 (gdb-var-delete-1 var varnum)))))
1014
1015(defun gdb-var-delete-children (varnum)
1016 "Delete children of variable object at point from the speedbar."
1017 (gdb-enqueue-input
1018 (list
1019 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1020 (concat "server interpreter mi \"-var-delete -c " varnum "\"\n")
1021 (concat "-var-delete -c " varnum "\n")) 'ignore)))
1022
1023(defun gdb-edit-value (text token indent)
1024 "Assign a value to a variable displayed in the speedbar."
1025 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1026 (varnum (car var)) (value))
1027 (setq value (read-string "New value: "))
1028 (gdb-enqueue-input
1029 (list
1030 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1031 (concat "server interpreter mi \"-var-assign "
1032 varnum " " value "\"\n")
1033 (concat "-var-assign " varnum " " value "\n"))
1034 `(lambda () (gdb-edit-value-handler ,value))))))
1035
1036(defun gdb-edit-value-handler (value)
1037 (goto-char (point-min))
1038 (if (re-search-forward gdb-error-regexp nil t)
1039 (message-box "Invalid number or expression (%s)" value)))
1040
1041(defcustom gdb-show-changed-values t
1042 "If non-nil change the face of out of scope variables and changed values.
1043Out of scope variables are suppressed with `shadow' face.
1044Changed values are highlighted with the face `font-lock-warning-face'."
1045 :type 'boolean
1046 :group 'gdb
1047 :version "22.1")
1048
1049(defcustom gdb-max-children 40
1050 "Maximum number of children before expansion requires confirmation."
1051 :type 'integer
1052 :group 'gdb
1053 :version "22.1")
1054
1055(defcustom gdb-delete-out-of-scope t
1056 "If non-nil delete watch expressions automatically when they go out of scope."
1057 :type 'boolean
1058 :group 'gdb
1059 :version "22.2")
1060
1061(defun gdb-speedbar-expand-node (text token indent)
1062 "Expand the node the user clicked on.
1063TEXT is the text of the button we clicked on, a + or - item.
1064TOKEN is data related to this node.
1065INDENT is the current indentation depth."
1066 (if (and gud-comint-buffer (buffer-name gud-comint-buffer))
1067 (progn
1068 (cond ((string-match "+" text) ;expand this node
1069 (let* ((var (assoc token gdb-var-list))
1070 (expr (nth 1 var)) (children (nth 2 var)))
1071 (if (or (<= (string-to-number children) gdb-max-children)
1072 (y-or-n-p
1073 (format
1074 "%s has %s children. Continue? " expr children)))
1075 (if (and (eq (buffer-local-value
1076 'gud-minor-mode gud-comint-buffer) 'gdba)
1077 (string-equal gdb-version "pre-6.4"))
1078 (gdb-var-list-children token)
1079 (gdb-var-list-children-1 token)))))
1080 ((string-match "-" text) ;contract this node
1081 (dolist (var gdb-var-list)
1082 (if (string-match (concat token "\\.") (car var))
1083 (setq gdb-var-list (delq var gdb-var-list))))
1084 (gdb-var-delete-children token)
1085 (speedbar-change-expand-button-char ?+)
1086 (speedbar-delete-subblock indent))
1087 (t (error "Ooops... not sure what to do")))
1088 (speedbar-center-buffer-smartly))
1089 (message-box "GUD session has been killed")))
1090
1091(defun gdb-get-target-string ()
1092 (with-current-buffer gud-comint-buffer
1093 gud-target-name))
1094
1095
1096;;
1097;; gdb buffers.
1098;;
1099;; Each buffer has a TYPE -- a symbol that identifies the function
1100;; of that particular buffer.
1101;;
1102;; The usual gdb interaction buffer is given the type `gdba' and
1103;; is constructed specially.
1104;;
1105;; Others are constructed by gdb-get-buffer-create and
1106;; named according to the rules set forth in the gdb-buffer-rules-assoc
1107
1108(defvar gdb-buffer-rules-assoc '())
1109
1110(defun gdb-get-buffer (key)
1111 "Return the gdb buffer tagged with type KEY.
1112The key should be one of the cars in `gdb-buffer-rules-assoc'."
1113 (save-excursion
1114 (gdb-look-for-tagged-buffer key (buffer-list))))
1115
1116(defun gdb-get-buffer-create (key)
1117 "Create a new gdb buffer of the type specified by KEY.
1118The key should be one of the cars in `gdb-buffer-rules-assoc'."
1119 (or (gdb-get-buffer key)
1120 (let* ((rules (assoc key gdb-buffer-rules-assoc))
1121 (name (funcall (gdb-rules-name-maker rules)))
1122 (new (get-buffer-create name)))
1123 (with-current-buffer new
1124 (let ((trigger))
1125 (if (cdr (cdr rules))
1126 (setq trigger (funcall (car (cdr (cdr rules))))))
1127 (setq gdb-buffer-type key)
1128 (set (make-local-variable 'gud-minor-mode)
1129 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
1130 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1131 (if trigger (funcall trigger)))
1132 new))))
1133
1134(defun gdb-rules-name-maker (rules) (car (cdr rules)))
1135
1136(defun gdb-look-for-tagged-buffer (key bufs)
1137 (let ((retval nil))
1138 (while (and (not retval) bufs)
1139 (set-buffer (car bufs))
1140 (if (eq gdb-buffer-type key)
1141 (setq retval (car bufs)))
1142 (setq bufs (cdr bufs)))
1143 retval))
1144
1145;;
1146;; This assoc maps buffer type symbols to rules. Each rule is a list of
1147;; at least one and possible more functions. The functions have these
1148;; roles in defining a buffer type:
1149;;
1150;; NAME - Return a name for this buffer type.
1151;;
1152;; The remaining function(s) are optional:
1153;;
1154;; MODE - called in a new buffer with no arguments, should establish
1155;; the proper mode for the buffer.
1156;;
1157
1158(defun gdb-set-buffer-rules (buffer-type &rest rules)
1159 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc)))
1160 (if binding
1161 (setcdr binding rules)
1162 (push (cons buffer-type rules)
1163 gdb-buffer-rules-assoc))))
1164
1165;; GUD buffers are an exception to the rules
1166(gdb-set-buffer-rules 'gdba 'error)
1167
1168;; Partial-output buffer : This accumulates output from a command executed on
1169;; behalf of emacs (rather than the user).
1170;;
1171(gdb-set-buffer-rules 'gdb-partial-output-buffer
1172 'gdb-partial-output-name)
1173
1174(defun gdb-partial-output-name ()
1175 (concat " *partial-output-"
1176 (gdb-get-target-string)
1177 "*"))
1178
1179
1180(gdb-set-buffer-rules 'gdb-inferior-io
1181 'gdb-inferior-io-name
1182 'gdb-inferior-io-mode)
1183
1184(defun gdb-inferior-io-name ()
1185 (concat "*input/output of "
1186 (gdb-get-target-string)
1187 "*"))
1188
1189(defun gdb-display-separate-io-buffer ()
1190 "Display IO of debugged program in a separate window."
1191 (interactive)
1192 (if gdb-use-separate-io-buffer
1193 (gdb-display-buffer
1194 (gdb-get-buffer-create 'gdb-inferior-io) t)))
1195
1196(defconst gdb-frame-parameters
1197 '((height . 14) (width . 80)
1198 (unsplittable . t)
1199 (tool-bar-lines . nil)
1200 (menu-bar-lines . nil)
1201 (minibuffer . nil)))
1202
1203(defun gdb-frame-separate-io-buffer ()
1204 "Display IO of debugged program in a new frame."
1205 (interactive)
1206 (if gdb-use-separate-io-buffer
1207 (let ((special-display-regexps (append special-display-regexps '(".*")))
1208 (special-display-frame-alist gdb-frame-parameters))
1209 (display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))))
1210
1211(defvar gdb-inferior-io-mode-map
1212 (let ((map (make-sparse-keymap)))
1213 (define-key map "\C-c\C-c" 'gdb-separate-io-interrupt)
1214 (define-key map "\C-c\C-z" 'gdb-separate-io-stop)
1215 (define-key map "\C-c\C-\\" 'gdb-separate-io-quit)
1216 (define-key map "\C-c\C-d" 'gdb-separate-io-eof)
1217 (define-key map "\C-d" 'gdb-separate-io-eof)
1218 map))
1219
1220(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
1221 "Major mode for gdb inferior-io."
1222 :syntax-table nil :abbrev-table nil
1223 ;; We want to use comint because it has various nifty and familiar
1224 ;; features. We don't need a process, but comint wants one, so create
1225 ;; a dummy one.
1226 (make-comint-in-buffer
1227 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
1228 (current-buffer) "hexl")
1229 (setq comint-input-sender 'gdb-inferior-io-sender))
1230
1231(defun gdb-inferior-io-sender (proc string)
1232 ;; PROC is the pseudo-process created to satisfy comint.
1233 (with-current-buffer (process-buffer proc)
1234 (setq proc (get-buffer-process gud-comint-buffer))
1235 (process-send-string proc string)
1236 (process-send-string proc "\n")))
1237
1238(defun gdb-separate-io-interrupt ()
1239 "Interrupt the program being debugged."
1240 (interactive)
1241 (interrupt-process
1242 (get-buffer-process gud-comint-buffer) comint-ptyp))
1243
1244(defun gdb-separate-io-quit ()
1245 "Send quit signal to the program being debugged."
1246 (interactive)
1247 (quit-process
1248 (get-buffer-process gud-comint-buffer) comint-ptyp))
1249
1250(defun gdb-separate-io-stop ()
1251 "Stop the program being debugged."
1252 (interactive)
1253 (stop-process
1254 (get-buffer-process gud-comint-buffer) comint-ptyp))
1255
1256(defun gdb-separate-io-eof ()
1257 "Send end-of-file to the program being debugged."
1258 (interactive)
1259 (process-send-eof
1260 (get-buffer-process gud-comint-buffer)))
1261
1262
1263;; gdb communications
1264;;
1265
1266;; INPUT: things sent to gdb
1267;;
1268;; The queues are lists. Each element is either a string (indicating user or
1269;; user-like input) or a list of the form:
1270;;
1271;; (INPUT-STRING HANDLER-FN)
1272;;
1273;; The handler function will be called from the partial-output buffer when the
1274;; command completes. This is the way to write commands which invoke gdb
1275;; commands autonomously.
1276;;
1277;; These lists are consumed tail first.
1278;;
1279
1280(defun gdb-send (proc string)
1281 "A comint send filter for gdb.
1282This filter may simply queue input for a later time."
1283 (if gdb-ready
1284 (progn
1285 (with-current-buffer gud-comint-buffer
1286 (let ((inhibit-read-only t))
1287 (remove-text-properties (point-min) (point-max) '(face))))
1288 (if gud-running
1289 (progn
1290 (let ((item (concat string "\n")))
1291 (if gdb-enable-debug (push (cons 'send item) gdb-debug-log))
1292 (process-send-string proc item)))
1293 (if (string-match "\\\\\\'" string)
1294 (setq gdb-continuation (concat gdb-continuation string "\n"))
1295 (let ((item (concat
1296 gdb-continuation string
1297 (if (not comint-input-sender-no-newline) "\n"))))
1298 (gdb-enqueue-input item)
1299 (setq gdb-continuation nil)))))
1300 (push (concat string "\n") gdb-early-user-input)))
1301
1302;; Note: Stuff enqueued here will be sent to the next prompt, even if it
1303;; is a query, or other non-top-level prompt.
1304
1305(defun gdb-enqueue-input (item)
1306 (if (not gud-running)
1307 (if gdb-prompting
1308 (progn
1309 (gdb-send-item item)
1310 (setq gdb-prompting nil))
1311 (push item gdb-input-queue))))
1312
1313(defun gdb-dequeue-input ()
1314 (let ((queue gdb-input-queue))
1315 (if queue
1316 (let ((last (car (last queue))))
1317 (unless (nbutlast queue) (setq gdb-input-queue '()))
1318 last)
1319 ;; This should be nil here anyway but set it just to make sure.
1320 (setq gdb-pending-triggers nil))))
1321
1322(defun gdb-send-item (item)
1323 (setq gdb-flush-pending-output nil)
1324 (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log))
1325 (setq gdb-current-item item)
1326 (let ((process (get-buffer-process gud-comint-buffer)))
1327 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1328 (if (stringp item)
1329 (progn
1330 (setq gdb-output-sink 'user)
1331 (process-send-string process item))
1332 (progn
1333 (gdb-clear-partial-output)
1334 (setq gdb-output-sink 'pre-emacs)
1335 (process-send-string process
1336 (car item))))
1337 ;; case: eq gud-minor-mode 'gdbmi
1338 (gdb-clear-partial-output)
1339 (setq gdb-output-sink 'emacs)
1340 (process-send-string process (car item)))))
1341
1342;;
1343;; output -- things gdb prints to emacs
1344;;
1345;; GDB output is a stream interrupted by annotations.
1346;; Annotations can be recognized by their beginning
1347;; with \C-j\C-z\C-z<tag><opt>\C-j
1348;;
1349;; The tag is a string obeying symbol syntax.
1350;;
1351;; The optional part `<opt>' can be either the empty string
1352;; or a space followed by more data relating to the annotation.
1353;; For example, the SOURCE annotation is followed by a filename,
1354;; line number and various useless goo. This data must not include
1355;; any newlines.
1356;;
1357
1358(defcustom gud-gdb-command-name "gdb --annotate=3"
1359 "Default command to execute an executable under the GDB debugger.
1360The option \"--annotate=3\" must be included in this value if you
1361want the GDB Graphical Interface."
1362 :type 'string
1363 :group 'gud
1364 :version "22.1")
1365
1366(defvar gdb-annotation-rules
1367 '(("pre-prompt" gdb-pre-prompt)
1368 ("prompt" gdb-prompt)
1369 ("commands" gdb-subprompt)
1370 ("overload-choice" gdb-subprompt)
1371 ("query" gdb-subprompt)
1372 ;; Need this prompt for GDB 6.1
1373 ("nquery" gdb-subprompt)
1374 ("prompt-for-continue" gdb-subprompt)
1375 ("post-prompt" gdb-post-prompt)
1376 ("source" gdb-source)
1377 ("starting" gdb-starting)
1378 ("exited" gdb-exited)
1379 ("signalled" gdb-signalled)
1380 ("signal" gdb-signal)
1381 ("breakpoint" gdb-stopping)
1382 ("watchpoint" gdb-stopping)
1383 ("frame-begin" gdb-frame-begin)
1384 ("stopped" gdb-stopped)
1385 ("error-begin" gdb-error)
1386 ("error" gdb-error)
1387 ("new-thread" (lambda (ignored)
1388 (gdb-get-buffer-create 'gdb-threads-buffer)))
1389 ("thread-changed" gdb-thread-changed))
1390 "An assoc mapping annotation tags to functions which process them.")
1391
1392(defun gdb-resync()
1393 (setq gdb-flush-pending-output t)
1394 (setq gud-running nil)
1395 (gdb-force-mode-line-update
1396 (propertize "stopped" 'face font-lock-warning-face))
1397 (setq gdb-output-sink 'user)
1398 (setq gdb-input-queue nil)
1399 (setq gdb-pending-triggers nil)
1400 (setq gdb-prompting t))
1401
1402(defconst gdb-source-spec-regexp
1403 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x0*\\([a-f0-9]*\\)")
1404
1405;; Do not use this except as an annotation handler.
1406(defun gdb-source (args)
1407 (string-match gdb-source-spec-regexp args)
1408 ;; Extract the frame position from the marker.
1409 (setq gud-last-frame
1410 (cons
1411 (match-string 1 args)
1412 (string-to-number (match-string 2 args))))
1413 (setq gdb-pc-address (match-string 3 args))
1414 ;; cover for auto-display output which comes *before*
1415 ;; stopped annotation
1416 (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user)))
1417
1418(defun gdb-pre-prompt (ignored)
1419 "An annotation handler for `pre-prompt'.
1420This terminates the collection of output from a previous command if that
1421happens to be in effect."
1422 (setq gdb-error nil)
1423 (let ((sink gdb-output-sink))
1424 (cond
1425 ((eq sink 'user) t)
1426 ((eq sink 'emacs)
1427 (setq gdb-output-sink 'post-emacs))
1428 (t
1429 (gdb-resync)
1430 (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
1431
1432(defun gdb-prompt (ignored)
1433 "An annotation handler for `prompt'.
1434This sends the next command (if any) to gdb."
1435 (when gdb-first-prompt
1436 (gdb-force-mode-line-update
1437 (propertize "initializing..." 'face font-lock-variable-name-face))
1438 (gdb-init-1)
1439 (setq gdb-first-prompt nil))
1440 (let ((sink gdb-output-sink))
1441 (cond
1442 ((eq sink 'user) t)
1443 ((eq sink 'post-emacs)
1444 (setq gdb-output-sink 'user)
1445 (let ((handler
1446 (car (cdr gdb-current-item))))
1447 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1448 (funcall handler))))
1449 (t
1450 (gdb-resync)
1451 (error "Phase error in gdb-prompt (got %s)" sink))))
1452 (let ((input (gdb-dequeue-input)))
1453 (if input
1454 (gdb-send-item input)
1455 (progn
1456 (setq gdb-prompting t)
1457 (gud-display-frame)
1458 (setq gdb-early-user-input (nreverse gdb-early-user-input))
1459 (while gdb-early-user-input
1460 (gdb-enqueue-input (car gdb-early-user-input))
1461 (setq gdb-early-user-input (cdr gdb-early-user-input)))))))
1462
1463(defun gdb-subprompt (ignored)
1464 "An annotation handler for non-top-level prompts."
1465 (setq gdb-prompting t))
1466
1467(defun gdb-starting (ignored)
1468 "An annotation handler for `starting'.
1469This says that I/O for the subprocess is now the program being debugged,
1470not GDB."
1471 (setq gdb-active-process t)
1472 (setq gdb-printing t)
1473 (let ((sink gdb-output-sink))
1474 (cond
1475 ((eq sink 'user)
1476 (progn
1477 (setq gud-running t)
1478 (setq gdb-stack-update t)
1479 ;; Temporarily set gud-running to nil to force "info stack" onto queue.
1480 (let ((gud-running nil))
1481 (gdb-invalidate-frames)
1482 (unless (or gdb-register-names
1483 (string-equal gdb-version "pre-6.4"))
1484 (gdb-enqueue-input
1485 (list "server interpreter mi -data-list-register-names\n"
1486 'gdb-get-register-names))))
1487 (setq gdb-inferior-status "running")
1488 (setq gdb-signalled nil)
1489 (gdb-force-mode-line-update
1490 (propertize gdb-inferior-status 'face font-lock-type-face))
1491 (gdb-remove-text-properties)
1492 (setq gud-old-arrow gud-overlay-arrow-position)
1493 (setq gud-overlay-arrow-position nil)
1494 (setq gdb-overlay-arrow-position nil)
1495 (setq gdb-stack-position nil)
1496 (if gdb-use-separate-io-buffer
1497 (setq gdb-output-sink 'inferior))))
1498 (t
1499 (gdb-resync)
1500 (error "Unexpected `starting' annotation")))))
1501
1502(defun gdb-signal (ignored)
1503 (setq gdb-inferior-status "signal")
1504 (gdb-force-mode-line-update
1505 (propertize gdb-inferior-status 'face font-lock-warning-face))
1506 (gdb-stopping ignored))
1507
1508(defun gdb-stopping (ignored)
1509 "An annotation handler for `breakpoint' and other annotations.
1510They say that I/O for the subprocess is now GDB, not the program
1511being debugged."
1512 (if gdb-use-separate-io-buffer
1513 (let ((sink gdb-output-sink))
1514 (cond
1515 ((eq sink 'inferior)
1516 (setq gdb-output-sink 'user))
1517 (t
1518 (gdb-resync)
1519 (error "Unexpected stopping annotation"))))))
1520
1521(defun gdb-exited (ignored)
1522 "An annotation handler for `exited' and `signalled'.
1523They say that I/O for the subprocess is now GDB, not the program
1524being debugged and that the program is no longer running. This
1525function is used to change the focus of GUD tooltips to #define
1526directives."
1527 (setq gdb-active-process nil)
1528 (setq gud-overlay-arrow-position nil)
1529 (setq gdb-overlay-arrow-position nil)
1530 (setq gdb-stack-position nil)
1531 (setq gud-old-arrow nil)
1532 (setq gdb-inferior-status "exited")
1533 (gdb-force-mode-line-update
1534 (propertize gdb-inferior-status 'face font-lock-warning-face))
1535 (gdb-stopping ignored))
1536
1537(defun gdb-signalled (ignored)
1538 (setq gdb-signalled t))
1539
1540(defun gdb-frame-begin (ignored)
1541 (setq gdb-frame-begin t)
1542 (setq gdb-printing nil)
1543 (let ((sink gdb-output-sink))
1544 (cond
1545 ((eq sink 'inferior)
1546 (setq gdb-output-sink 'user))
1547 ((eq sink 'user) t)
1548 ((eq sink 'emacs) t)
1549 (t
1550 (gdb-resync)
1551 (error "Unexpected frame-begin annotation (%S)" sink)))))
1552
1553(defcustom gdb-same-frame (not focus-follows-mouse)
1554 "Non-nil means pop up GUD buffer in same frame."
1555 :group 'gdb
1556 :type 'boolean
1557 :version "22.1")
1558
1559(defcustom gdb-find-source-frame nil
1560 "Non-nil means try to find a source frame further up stack e.g after signal."
1561 :group 'gdb
1562 :type 'boolean
1563 :version "22.1")
1564
1565(defun gdb-find-source-frame (arg)
1566 "Toggle looking for a source frame further up call stack.
1567The code associated with current (innermost) frame may not have
1568been compiled with debug information, e.g., C library routine.
1569With prefix argument ARG, look for a source frame further up
1570stack to display in the source buffer if ARG is positive,
1571otherwise don't look further up."
1572 (interactive "P")
1573 (setq gdb-find-source-frame
1574 (if (null arg)
1575 (not gdb-find-source-frame)
1576 (> (prefix-numeric-value arg) 0)))
1577 (message (format "Looking for source frame %sabled"
1578 (if gdb-find-source-frame "en" "dis"))))
1579
1580(defun gdb-stopped (ignored)
1581 "An annotation handler for `stopped'.
1582It is just like `gdb-stopping', except that if we already set the output
1583sink to `user' in `gdb-stopping', that is fine."
1584 (setq gud-running nil)
1585 (unless (or gud-overlay-arrow-position gud-last-frame)
1586 (if (and gdb-frame-begin gdb-printing)
1587 (setq gud-overlay-arrow-position gud-old-arrow)
1588 ;;Pop up GUD buffer to display current frame when it doesn't have source
1589 ;;information i.e if not compiled with -g as with libc routines generally.
1590 (if gdb-same-frame
1591 (gdb-display-gdb-buffer)
1592 (gdb-frame-gdb-buffer))
1593 (if gdb-find-source-frame
1594 ;;Try to find source further up stack e.g after signal.
1595 (setq gdb-look-up-stack
1596 (if (gdb-get-buffer 'gdb-stack-buffer)
1597 'keep
1598 (progn
1599 (gdb-get-buffer-create 'gdb-stack-buffer)
1600 (gdb-invalidate-frames)
1601 'delete))))))
1602 (unless (member gdb-inferior-status '("exited" "signal"))
1603 (setq gdb-active-process t) ;Just for attaching case.
1604 (setq gdb-inferior-status "stopped")
1605 (gdb-force-mode-line-update
1606 (propertize gdb-inferior-status 'face font-lock-warning-face)))
1607 (let ((sink gdb-output-sink))
1608 (cond
1609 ((eq sink 'inferior)
1610 (setq gdb-output-sink 'user))
1611 ((eq sink 'user) t)
1612 (t
1613 (gdb-resync)
1614 (error "Unexpected stopped annotation"))))
1615 (if gdb-signalled (gdb-exited ignored)))
1616
1617(defun gdb-error (ignored)
1618 (setq gdb-error (not gdb-error)))
1619
1620(defun gdb-thread-changed (ignored)
1621 (gdb-frames-force-update))
1622
1623(defun gdb-post-prompt (ignored)
1624 "An annotation handler for `post-prompt'.
1625This begins the collection of output from the current command if that
1626happens to be appropriate."
1627 ;; Don't add to queue if there outstanding items or gdb-version is not known
1628 ;; yet.
1629 (unless (or gdb-pending-triggers gdb-first-post-prompt)
1630 (gdb-get-selected-frame)
1631 (gdb-invalidate-frames)
1632 ;; Regenerate breakpoints buffer in case it has been inadvertantly deleted.
1633 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
1634 (gdb-invalidate-breakpoints)
1635 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler
1636 ;; so gdb-pc-address is updated.
1637 ;; (gdb-invalidate-assembler)
1638
1639 (if (string-equal gdb-version "pre-6.4")
1640 (gdb-invalidate-registers)
1641 (gdb-get-changed-registers)
1642 (gdb-invalidate-registers-1))
1643
1644 (gdb-invalidate-memory)
1645 (if (string-equal gdb-version "pre-6.4")
1646 (gdb-invalidate-locals)
1647 (gdb-invalidate-locals-1))
1648
1649 (gdb-invalidate-threads)
1650 (unless (or (null gdb-var-list)
1651 (eq system-type 'darwin)) ;Breaks on Darwin's GDB-5.3.
1652 ;; FIXME: with GDB-6 on Darwin, this might very well work.
1653 ;; Only needed/used with speedbar/watch expressions.
1654 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
1655 (if (string-equal gdb-version "pre-6.4")
1656 (gdb-var-update)
1657 (gdb-var-update-1)))))
1658 (setq gdb-first-post-prompt nil)
1659 (let ((sink gdb-output-sink))
1660 (cond
1661 ((eq sink 'user) t)
1662 ((eq sink 'pre-emacs)
1663 (setq gdb-output-sink 'emacs))
1664 (t
1665 (gdb-resync)
1666 (error "Phase error in gdb-post-prompt (got %s)" sink)))))
1667
1668(defconst gdb-buffer-list
1669'(gdb-stack-buffer gdb-locals-buffer gdb-registers-buffer gdb-threads-buffer))
1670
1671(defun gdb-remove-text-properties ()
1672 (dolist (buffertype gdb-buffer-list)
1673 (let ((buffer (gdb-get-buffer buffertype)))
1674 (if buffer
1675 (with-current-buffer buffer
1676 (let ((inhibit-read-only t))
1677 (remove-text-properties
1678 (point-min) (point-max) '(mouse-face nil help-echo nil))))))))
1679
1680;; GUD displays the selected GDB frame. This might might not be the current
1681;; GDB frame (after up, down etc). If no GDB frame is visible but the last
1682;; visited breakpoint is, use that window.
1683(defun gdb-display-source-buffer (buffer)
1684 (let* ((last-window (if gud-last-last-frame
1685 (get-buffer-window
1686 (gud-find-file (car gud-last-last-frame)))))
1687 (source-window (or last-window
1688 (if (and gdb-source-window
1689 (window-live-p gdb-source-window))
1690 gdb-source-window))))
1691 (when source-window
1692 (setq gdb-source-window source-window)
1693 (set-window-buffer source-window buffer))
1694 source-window))
1695
1696;; Derived from gud-gdb-marker-regexp
1697(defvar gdb-fullname-regexp
1698 (concat "\\(.:?[^" ":" "\n]*\\)" ":" "\\([0-9]*\\)" ":" ".*"))
1699
1700(defun gud-gdba-marker-filter (string)
1701 "A gud marker filter for gdb. Handle a burst of output from GDB."
1702 (if gdb-flush-pending-output
1703 nil
1704 (when gdb-enable-debug
1705 (push (cons 'recv string) gdb-debug-log)
1706 (if (and gdb-debug-log-max
1707 (> (length gdb-debug-log) gdb-debug-log-max))
1708 (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil)))
1709 ;; Recall the left over gud-marker-acc from last time.
1710 (setq gud-marker-acc (concat gud-marker-acc string))
1711 ;; Start accumulating output for the GUD buffer.
1712 (let ((output ""))
1713 ;;
1714 ;; Process all the complete markers in this chunk.
1715 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
1716 (let ((annotation (match-string 1 gud-marker-acc))
1717 (before (substring gud-marker-acc 0 (match-beginning 0)))
1718 (after (substring gud-marker-acc (match-end 0))))
1719 ;;
1720 ;; Parse the tag from the annotation, and maybe its arguments.
1721 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
1722 (let* ((annotation-type (match-string 1 annotation))
1723 (annotation-arguments (match-string 2 annotation))
1724 (annotation-rule (assoc annotation-type
1725 gdb-annotation-rules)))
1726
1727 ;; Stuff prior to the match is just ordinary output.
1728 ;; It is either concatenated to OUTPUT or directed
1729 ;; elsewhere.
1730 (setq output (gdb-concat-output output before))
1731
1732 ;; Take that stuff off the gud-marker-acc.
1733 (setq gud-marker-acc after)
1734
1735 ;; Call the handler for this annotation.
1736 (if annotation-rule
1737 (funcall (car (cdr annotation-rule))
1738 annotation-arguments))
1739
1740 ;; Else the annotation is not recognized. Ignore it silently,
1741 ;; so that GDB can add new annotations without causing
1742 ;; us to blow up.
1743 )))
1744
1745 ;; Does the remaining text end in a partial line?
1746 ;; If it does, then keep part of the gud-marker-acc until we get more.
1747 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1748 gud-marker-acc)
1749 (progn
1750 ;; Everything before the potential marker start can be output.
1751 (setq output
1752 (gdb-concat-output output
1753 (substring gud-marker-acc 0
1754 (match-beginning 0))))
1755 ;;
1756 ;; Everything after, we save, to combine with later input.
1757 (setq gud-marker-acc (substring gud-marker-acc
1758 (match-beginning 0))))
1759 ;;
1760 ;; In case we know the gud-marker-acc contains no partial annotations:
1761 (progn
1762 (setq output (gdb-concat-output output gud-marker-acc))
1763 (setq gud-marker-acc "")))
1764 output)))
1765
1766(defun gdb-concat-output (so-far new)
1767 (if gdb-error
1768 (put-text-property 0 (length new) 'face font-lock-warning-face new))
1769 (let ((sink gdb-output-sink))
1770 (cond
1771 ((eq sink 'user) (concat so-far new))
1772 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
1773 ((eq sink 'emacs)
1774 (gdb-append-to-partial-output new)
1775 so-far)
1776 ((eq sink 'inferior)
1777 (gdb-append-to-inferior-io new)
1778 so-far)
1779 (t
1780 (gdb-resync)
1781 (error "Bogon output sink %S" sink)))))
1782
1783(defun gdb-append-to-partial-output (string)
1784 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1785 (goto-char (point-max))
1786 (insert string)))
1787
1788(defun gdb-clear-partial-output ()
1789 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1790 (erase-buffer)))
1791
1792(defun gdb-append-to-inferior-io (string)
1793 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
1794 (goto-char (point-max))
1795 (insert-before-markers string))
1796 (if (not (string-equal string ""))
1797 (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t)))
1798
1799(defun gdb-clear-inferior-io ()
1800 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
1801 (erase-buffer)))
1802
1803(defun gdb-jsonify-buffer (&optional fix-key fix-list)
1804 "Prepare GDB/MI output in current buffer for parsing with `json-read'.
1805
1806Field names are wrapped in double quotes and equal signs are
1807replaced with semicolons.
1808
1809If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from
1810partial output. This is used to get rid of useless keys in lists
1811in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
1812-break-info are examples of MI commands which issue such
1813responses.
1814
1815If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with
1816\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken
1817-break-info output when it contains breakpoint script field
1818incompatible with GDB/MI output syntax."
1819 (save-excursion
1820 (goto-char (point-min))
1821 ;; Sometimes missing symbol information precedes "^done" record.
1822 (re-search-forward "[[:ascii:]]*?\\^done," nil t)
1823 (replace-match "")
1824 (re-search-forward "(gdb) \n" nil t)
1825 (replace-match "")
1826 (goto-char (point-min))
1827 (when fix-key
1828 (save-excursion
1829 (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t)
1830 (replace-match "" nil nil nil 1))))
1831 (when fix-list
1832 (save-excursion
1833 ;; Find positions of braces which enclose broken list
1834 (while (re-search-forward (concat fix-list "={\"") nil t)
1835 (let ((p1 (goto-char (- (point) 2)))
1836 (p2 (progn (forward-sexp)
1837 (1- (point)))))
1838 ;; Replace braces with brackets
1839 (save-excursion
1840 (goto-char p1)
1841 (delete-char 1)
1842 (insert "[")
1843 (goto-char p2)
1844 (delete-char 1)
1845 (insert "]"))))))
1846 (goto-char (point-min))
1847 (insert "{")
1848 (while (re-search-forward
1849 "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t)
1850 (replace-match "\"\\1\":\\2" nil nil))
1851 (goto-char (point-max))
1852 (insert "}")))
1853
1854(defun gdb-json-read-buffer (&optional fix-key fix-list)
1855 "Prepare and parse GDB/MI output in current buffer with `json-read'.
1856
1857FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
1858 (gdb-jsonify-buffer fix-key fix-list)
1859 (save-excursion
1860 (goto-char (point-min))
1861 (let ((json-array-type 'list))
1862 (json-read))))
1863
1864(defun gdb-json-partial-output (&optional fix-key fix-list)
1865 "Prepare and parse gdb-partial-output-buffer with `json-read'.
1866
1867FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'."
1868 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1869 (gdb-json-read-buffer fix-key fix-list)))
1870
1871
1872;; One trick is to have a command who's output is always available in a buffer
1873;; of it's own, and is always up to date. We build several buffers of this
1874;; type.
1875;;
1876;; There are two aspects to this: gdb has to tell us when the output for that
1877;; command might have changed, and we have to be able to run the command
1878;; behind the user's back.
1879;;
1880;; The output phasing associated with the variable gdb-output-sink
1881;; help us to run commands behind the user's back.
1882;;
1883;; Below is the code for specificly managing buffers of output from one
1884;; command.
1885;;
1886
1887;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1888;; It adds an input for the command we are tracking. It should be the
1889;; annotation rule binding of whatever gdb sends to tell us this command
1890;; might have changed it's output.
1891;;
1892;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1893;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1894;; input in the input queue (see comment about ``gdb communications'' above).
1895
1896(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command
1897 output-handler)
1898 `(defun ,name (&optional ignored)
1899 (if (and ,demand-predicate
1900 (not (member ',name
1901 gdb-pending-triggers)))
1902 (progn
1903 (gdb-enqueue-input
1904 (list ,gdb-command ',output-handler))
1905 (push ',name gdb-pending-triggers)))))
1906
1907(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
1908 `(defun ,name ()
1909 (setq gdb-pending-triggers
1910 (delq ',trigger
1911 gdb-pending-triggers))
1912 (let ((buf (gdb-get-buffer ',buf-key)))
1913 (and buf
1914 (with-current-buffer buf
1915 (let* ((window (get-buffer-window buf 0))
1916 (start (window-start window))
1917 (p (if window (window-point window) (point)))
1918 (buffer-read-only nil))
1919 (erase-buffer)
1920 (insert-buffer-substring (gdb-get-buffer-create
1921 'gdb-partial-output-buffer))
1922 (if window
1923 (progn
1924 (set-window-start window start)
1925 (set-window-point window p))
1926 (goto-char p))))))
1927 ;; put customisation here
1928 (,custom-defun)))
1929
1930(defmacro def-gdb-auto-updated-buffer (buffer-key
1931 trigger-name gdb-command
1932 output-handler-name custom-defun)
1933 `(progn
1934 (def-gdb-auto-update-trigger ,trigger-name
1935 ;; The demand predicate:
1936 (gdb-get-buffer ',buffer-key)
1937 ,gdb-command
1938 ,output-handler-name)
1939 (def-gdb-auto-update-handler ,output-handler-name
1940 ,trigger-name ,buffer-key ,custom-defun)))
1941
1942
1943;;
1944;; Breakpoint buffer : This displays the output of `info breakpoints'.
1945;;
1946(gdb-set-buffer-rules 'gdb-breakpoints-buffer
1947 'gdb-breakpoints-buffer-name
1948 'gdb-breakpoints-mode)
1949
1950(def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1951 ;; This defines the auto update rule for buffers of type
1952 ;; `gdb-breakpoints-buffer'.
1953 ;;
1954 ;; It defines a function to serve as the annotation handler that
1955 ;; handles the `foo-invalidated' message. That function is called:
1956 gdb-invalidate-breakpoints
1957 ;;
1958 ;; To update the buffer, this command is sent to gdb.
1959 "server info breakpoints\n"
1960 ;;
1961 ;; This also defines a function to be the handler for the output
1962 ;; from the command above. That function will copy the output into
1963 ;; the appropriately typed buffer. That function will be called:
1964 gdb-info-breakpoints-handler
1965 ;; buffer specific functions
1966 gdb-info-breakpoints-custom)
1967
1968(defconst breakpoint-xpm-data
1969 "/* XPM */
1970static char *magick[] = {
1971/* columns rows colors chars-per-pixel */
1972\"10 10 2 1\",
1973\" c red\",
1974\"+ c None\",
1975/* pixels */
1976\"+++ +++\",
1977\"++ ++\",
1978\"+ +\",
1979\" \",
1980\" \",
1981\" \",
1982\" \",
1983\"+ +\",
1984\"++ ++\",
1985\"+++ +++\",
1986};"
1987 "XPM data used for breakpoint icon.")
1988
1989(defconst breakpoint-enabled-pbm-data
1990 "P1
199110 10\",
19920 0 0 0 1 1 1 1 0 0 0 0
19930 0 0 1 1 1 1 1 1 0 0 0
19940 0 1 1 1 1 1 1 1 1 0 0
19950 1 1 1 1 1 1 1 1 1 1 0
19960 1 1 1 1 1 1 1 1 1 1 0
19970 1 1 1 1 1 1 1 1 1 1 0
19980 1 1 1 1 1 1 1 1 1 1 0
19990 0 1 1 1 1 1 1 1 1 0 0
20000 0 0 1 1 1 1 1 1 0 0 0
20010 0 0 0 1 1 1 1 0 0 0 0"
2002 "PBM data used for enabled breakpoint icon.")
2003
2004(defconst breakpoint-disabled-pbm-data
2005 "P1
200610 10\",
20070 0 1 0 1 0 1 0 0 0
20080 1 0 1 0 1 0 1 0 0
20091 0 1 0 1 0 1 0 1 0
20100 1 0 1 0 1 0 1 0 1
20111 0 1 0 1 0 1 0 1 0
20120 1 0 1 0 1 0 1 0 1
20131 0 1 0 1 0 1 0 1 0
20140 1 0 1 0 1 0 1 0 1
20150 0 1 0 1 0 1 0 1 0
20160 0 0 1 0 1 0 1 0 0"
2017 "PBM data used for disabled breakpoint icon.")
2018
2019(defvar breakpoint-enabled-icon nil
2020 "Icon for enabled breakpoint in display margin.")
2021
2022(defvar breakpoint-disabled-icon nil
2023 "Icon for disabled breakpoint in display margin.")
2024
2025(declare-function define-fringe-bitmap "fringe.c"
2026 (bitmap bits &optional height width align))
2027
2028(and (display-images-p)
2029 ;; Bitmap for breakpoint in fringe
2030 (define-fringe-bitmap 'breakpoint
2031 "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
2032 ;; Bitmap for gud-overlay-arrow in fringe
2033 (define-fringe-bitmap 'hollow-right-triangle
2034 "\xe0\x90\x88\x84\x84\x88\x90\xe0"))
2035
2036(defface breakpoint-enabled
2037 '((t
2038 :foreground "red1"
2039 :weight bold))
2040 "Face for enabled breakpoint icon in fringe."
2041 :group 'gdb)
2042
2043(defface breakpoint-disabled
2044 '((((class color) (min-colors 88)) :foreground "grey70")
2045 ;; Ensure that on low-color displays that we end up something visible.
2046 (((class color) (min-colors 8) (background light))
2047 :foreground "black")
2048 (((class color) (min-colors 8) (background dark))
2049 :foreground "white")
2050 (((type tty) (class mono))
2051 :inverse-video t)
2052 (t :background "gray"))
2053 "Face for disabled breakpoint icon in fringe."
2054 :group 'gdb)
2055
2056(defconst gdb-breakpoint-regexp
2057 "\\(?:\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\|\\([0-9]+\\.[0-9]+\\)\\)\\s-+\\(.\\)\\s-+")
2058
2059;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
2060(defun gdb-info-breakpoints-custom ()
2061 (let ((flag) (bptno))
2062 ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
2063 (dolist (buffer (buffer-list))
2064 (with-current-buffer buffer
2065 (if (and (memq gud-minor-mode '(gdba gdbmi))
2066 (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name))))
2067 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
2068 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
2069 (save-excursion
2070 (let ((buffer-read-only nil))
2071 (goto-char (point-min))
2072 (while (< (point) (- (point-max) 1))
2073 (forward-line 1)
2074 (if (looking-at gdb-breakpoint-regexp)
2075 (progn
2076 (setq bptno (or (match-string 1) (match-string 2)))
2077 (setq flag (char-after (match-beginning 3)))
2078 (if (match-string 1)
2079 (setq gdb-parent-bptno-enabled (eq flag ?y)))
2080 (add-text-properties
2081 (match-beginning 3) (match-end 3)
2082 (if (eq flag ?y)
2083 '(face font-lock-warning-face)
2084 '(face font-lock-type-face)))
2085 (let ((bl (point))
2086 (el (line-end-position)))
2087 (when (re-search-forward " in \\(.*\\) at" el t)
2088 (add-text-properties
2089 (match-beginning 1) (match-end 1)
2090 '(face font-lock-function-name-face)))
2091 (if (re-search-forward
2092 ".*\\s-+\\(\\S-+\\):\\([0-9]+\\)$" el t)
2093 (let ((line (match-string 2))
2094 (file (match-string 1)))
2095 (add-text-properties bl el
2096 '(mouse-face highlight
2097 help-echo "mouse-2, RET: visit breakpoint"))
2098 (unless (file-exists-p file)
2099 (setq file (cdr (assoc bptno gdb-location-alist))))
2100 (if (and file
2101 (not (string-equal file "File not found")))
2102 (with-current-buffer
2103 (find-file-noselect file 'nowarn)
2104 (gdb-init-buffer)
2105 ;; Only want one breakpoint icon at each
2106 ;; location.
2107 (save-excursion
2108 (goto-char (point-min))
2109 (forward-line (1- (string-to-number line)))
2110 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
2111 (gdb-enqueue-input
2112 (list
2113 (concat gdb-server-prefix "list "
2114 (match-string-no-properties 1) ":1\n")
2115 'ignore))
2116 (gdb-enqueue-input
2117 (list (concat gdb-server-prefix "info source\n")
2118 `(lambda () (gdb-get-location
2119 ,bptno ,line ,flag))))))
2120 (if (re-search-forward
2121 "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
2122 el t)
2123 (add-text-properties
2124 (match-beginning 1) (match-end 1)
2125 '(face font-lock-function-name-face))
2126 (end-of-line)
2127 (re-search-backward "\\s-\\(\\S-*\\)"
2128 bl t)
2129 (add-text-properties
2130 (match-beginning 1) (match-end 1)
2131 '(face font-lock-variable-name-face)))))))
2132 (end-of-line))))))
2133 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))
2134
2135 ;; Breakpoints buffer is always present. Hack to just update
2136 ;; current frame if there's been no execution.
2137 (if gdb-stack-update
2138 (setq gdb-stack-update nil)
2139 (if (gdb-get-buffer 'gdb-stack-buffer) (gdb-info-stack-custom))))
2140
2141(declare-function gud-remove "gdb-ui" t t) ; gud-def
2142(declare-function gud-break "gdb-ui" t t) ; gud-def
2143(declare-function fringe-bitmaps-at-pos "fringe.c" (&optional pos window))
2144
2145(defun gdb-mouse-set-clear-breakpoint (event)
2146 "Set/clear breakpoint in left fringe/margin at mouse click.
2147If not in a source or disassembly buffer just set point."
2148 (interactive "e")
2149 (mouse-minibuffer-check event)
2150 (let ((posn (event-end event)))
2151 (with-selected-window (posn-window posn)
2152 (if (or (buffer-file-name) (eq major-mode 'gdb-assembler-mode))
2153 (if (numberp (posn-point posn))
2154 (save-excursion
2155 (goto-char (posn-point posn))
2156 (if (or (posn-object posn)
2157 (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
2158 'breakpoint))
2159 (gud-remove nil)
2160 (gud-break nil)))))
2161 (posn-set-point posn))))
2162
2163(defun gdb-mouse-toggle-breakpoint-margin (event)
2164 "Enable/disable breakpoint in left margin with mouse click."
2165 (interactive "e")
2166 (mouse-minibuffer-check event)
2167 (let ((posn (event-end event)))
2168 (if (numberp (posn-point posn))
2169 (with-selected-window (posn-window posn)
2170 (save-excursion
2171 (goto-char (posn-point posn))
2172 (if (posn-object posn)
2173 (let* ((bptno (get-text-property
2174 0 'gdb-bptno (car (posn-string posn)))))
2175 (string-match "\\([0-9+]\\)*" bptno)
2176 (gdb-enqueue-input
2177 (list
2178 (concat gdb-server-prefix
2179 (if (get-text-property
2180 0 'gdb-enabled (car (posn-string posn)))
2181 "disable "
2182 "enable ")
2183 (match-string 1 bptno) "\n")
2184 'ignore)))))))))
2185
2186(defun gdb-mouse-toggle-breakpoint-fringe (event)
2187 "Enable/disable breakpoint in left fringe with mouse click."
2188 (interactive "e")
2189 (mouse-minibuffer-check event)
2190 (let* ((posn (event-end event))
2191 (pos (posn-point posn))
2192 obj)
2193 (when (numberp pos)
2194 (with-selected-window (posn-window posn)
2195 (with-current-buffer (window-buffer (selected-window))
2196 (goto-char pos)
2197 (dolist (overlay (overlays-in pos pos))
2198 (when (overlay-get overlay 'put-break)
2199 (setq obj (overlay-get overlay 'before-string))))
2200 (when (stringp obj)
2201 (let* ((bptno (get-text-property 0 'gdb-bptno obj)))
2202 (string-match "\\([0-9+]\\)*" bptno)
2203 (gdb-enqueue-input
2204 (list
2205 (concat gdb-server-prefix
2206 (if (get-text-property 0 'gdb-enabled obj)
2207 "disable "
2208 "enable ")
2209 (match-string 1 bptno) "\n")
2210 'ignore)))))))))
2211
2212(defun gdb-breakpoints-buffer-name ()
2213 (with-current-buffer gud-comint-buffer
2214 (concat "*breakpoints of " (gdb-get-target-string) "*")))
2215
2216(defun gdb-display-breakpoints-buffer ()
2217 "Display status of user-settable breakpoints."
2218 (interactive)
2219 (gdb-display-buffer
2220 (gdb-get-buffer-create 'gdb-breakpoints-buffer) t))
2221
2222(defun gdb-frame-breakpoints-buffer ()
2223 "Display status of user-settable breakpoints in a new frame."
2224 (interactive)
2225 (let ((special-display-regexps (append special-display-regexps '(".*")))
2226 (special-display-frame-alist gdb-frame-parameters))
2227 (display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer))))
2228
2229(defvar gdb-breakpoints-mode-map
2230 (let ((map (make-sparse-keymap))
2231 (menu (make-sparse-keymap "Breakpoints")))
2232 (define-key menu [quit] '("Quit" . gdb-delete-frame-or-window))
2233 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
2234 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
2235 (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
2236 (suppress-keymap map)
2237 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
2238 (define-key map " " 'gdb-toggle-breakpoint)
2239 (define-key map "D" 'gdb-delete-breakpoint)
2240 ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons.
2241 (define-key map "q" 'gdb-delete-frame-or-window)
2242 (define-key map "\r" 'gdb-goto-breakpoint)
2243 (define-key map [mouse-2] 'gdb-goto-breakpoint)
2244 (define-key map [follow-link] 'mouse-face)
2245 map))
2246
2247(defun gdb-delete-frame-or-window ()
2248 "Delete frame if there is only one window. Otherwise delete the window."
2249 (interactive)
2250 (if (one-window-p) (delete-frame)
2251 (delete-window)))
2252
2253;;from make-mode-line-mouse-map
2254(defun gdb-make-header-line-mouse-map (mouse function) "\
2255Return a keymap with single entry for mouse key MOUSE on the header line.
2256MOUSE is defined to run function FUNCTION with no args in the buffer
2257corresponding to the mode line clicked."
2258 (let ((map (make-sparse-keymap)))
2259 (define-key map (vector 'header-line mouse) function)
2260 (define-key map (vector 'header-line 'down-mouse-1) 'ignore)
2261 map))
2262
2263(defmacro gdb-propertize-header (name buffer help-echo mouse-face face)
2264 `(propertize ,name
2265 'help-echo ,help-echo
2266 'mouse-face ',mouse-face
2267 'face ',face
2268 'local-map
2269 (gdb-make-header-line-mouse-map
2270 'mouse-1
2271 (lambda (event) (interactive "e")
2272 (save-selected-window
2273 (select-window (posn-window (event-start event)))
2274 (set-window-dedicated-p (selected-window) nil)
2275 (switch-to-buffer
2276 (gdb-get-buffer-create ',buffer))
2277 (setq header-line-format(gdb-set-header ',buffer))
2278 (set-window-dedicated-p (selected-window) t))))))
2279
2280(defun gdb-set-header (buffer)
2281 (cond ((eq buffer 'gdb-locals-buffer)
2282 (list
2283 (gdb-propertize-header "Locals" gdb-locals-buffer
2284 nil nil mode-line)
2285 " "
2286 (gdb-propertize-header "Registers" gdb-registers-buffer
2287 "mouse-1: select" mode-line-highlight mode-line-inactive)))
2288 ((eq buffer 'gdb-registers-buffer)
2289 (list
2290 (gdb-propertize-header "Locals" gdb-locals-buffer
2291 "mouse-1: select" mode-line-highlight mode-line-inactive)
2292 " "
2293 (gdb-propertize-header "Registers" gdb-registers-buffer
2294 nil nil mode-line)))
2295 ((eq buffer 'gdb-breakpoints-buffer)
2296 (list
2297 (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
2298 nil nil mode-line)
2299 " "
2300 (gdb-propertize-header "Threads" gdb-threads-buffer
2301 "mouse-1: select" mode-line-highlight mode-line-inactive)))
2302 ((eq buffer 'gdb-threads-buffer)
2303 (list
2304 (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
2305 "mouse-1: select" mode-line-highlight mode-line-inactive)
2306 " "
2307 (gdb-propertize-header "Threads" gdb-threads-buffer
2308 nil nil mode-line)))))
2309
2310(defvar gdb-breakpoints-header
2311 (list
2312 (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
2313 nil nil mode-line)
2314 " "
2315 (gdb-propertize-header "Threads" gdb-threads-buffer
2316 "mouse-1: select" mode-line-highlight mode-line-inactive)))
2317
2318(defun gdb-breakpoints-mode ()
2319 "Major mode for gdb breakpoints.
2320
2321\\{gdb-breakpoints-mode-map}"
2322 (kill-all-local-variables)
2323 (setq major-mode 'gdb-breakpoints-mode)
2324 (setq mode-name "Breakpoints")
2325 (use-local-map gdb-breakpoints-mode-map)
2326 (setq buffer-read-only t)
2327 (buffer-disable-undo)
2328 (setq header-line-format gdb-breakpoints-header)
2329 (run-mode-hooks 'gdb-breakpoints-mode-hook)
2330 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2331 'gdb-invalidate-breakpoints
2332 'gdbmi-invalidate-breakpoints))
2333
2334(defun gdb-toggle-breakpoint ()
2335 "Enable/disable breakpoint at current line."
2336 (interactive)
2337 (save-excursion
2338 (beginning-of-line 1)
2339 (if (looking-at gdb-breakpoint-regexp)
2340 (gdb-enqueue-input
2341 (list
2342 (concat gdb-server-prefix
2343 (if (eq ?y (char-after (match-beginning 3)))
2344 "disable "
2345 "enable ")
2346 (or (match-string 1) (match-string 2)) "\n") 'ignore))
2347 (error "Not recognized as break/watchpoint line"))))
2348
2349(defun gdb-delete-breakpoint ()
2350 "Delete the breakpoint at current line."
2351 (interactive)
2352 (save-excursion
2353 (beginning-of-line 1)
2354 (if (looking-at gdb-breakpoint-regexp)
2355 (if (match-string 1)
2356 (gdb-enqueue-input
2357 (list
2358 (concat gdb-server-prefix "delete " (match-string 1) "\n")
2359 'ignore))
2360 (message-box "This breakpoint cannot be deleted on its own."))
2361 (error "Not recognized as break/watchpoint line"))))
2362
2363(defun gdb-goto-breakpoint (&optional event)
2364 "Display the breakpoint location specified at current line."
2365 (interactive (list last-input-event))
2366 (if event (posn-set-point (event-end event)))
2367 (save-excursion
2368 (beginning-of-line 1)
2369 (if (looking-at "\\([0-9]+\\.?[0-9]*\\) .*\\s-+\\(\\S-+\\):\\([0-9]+\\)$")
2370 (let ((bptno (match-string 1))
2371 (file (match-string 2))
2372 (line (match-string 3)))
2373 (save-selected-window
2374 (let* ((buffer (find-file-noselect
2375 (if (file-exists-p file) file
2376 (cdr (assoc bptno gdb-location-alist)))))
2377 (window (or (gdb-display-source-buffer buffer)
2378 (display-buffer buffer))))
2379 (setq gdb-source-window window)
2380 (with-current-buffer buffer
2381 (goto-char (point-min))
2382 (forward-line (1- (string-to-number line)))
2383 (set-window-point window (point))))))
2384 (error "No location specified."))))
2385
2386
2387;; Frames buffer. This displays a perpetually correct backtrace
2388;; (from the command `where').
2389;;
2390;; Alas, if your stack is deep, it is costly.
2391;;
2392(defcustom gdb-max-frames 40
2393 "Maximum number of frames displayed in call stack."
2394 :type 'integer
2395 :group 'gdb
2396 :version "22.1")
2397
2398(gdb-set-buffer-rules 'gdb-stack-buffer
2399 'gdb-stack-buffer-name
2400 'gdb-frames-mode)
2401
2402(def-gdb-auto-updated-buffer gdb-stack-buffer
2403 gdb-invalidate-frames
2404 (concat "server info stack " (number-to-string gdb-max-frames) "\n")
2405 gdb-info-stack-handler
2406 gdb-info-stack-custom)
2407
2408;; This may be more important for embedded targets where unwinding the
2409;; stack may take a long time.
2410(defadvice gdb-invalidate-frames (around gdb-invalidate-frames-advice
2411 (&optional ignored) activate compile)
2412 "Only queue \"info stack\" if execution has occurred."
2413 (if gdb-stack-update ad-do-it))
2414
2415(defun gdb-info-stack-custom ()
2416 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
2417 (let (move-to)
2418 (save-excursion
2419 (unless (eq gdb-look-up-stack 'delete)
2420 (let ((buffer-read-only nil)
2421 bl el)
2422 (goto-char (point-min))
2423 (while (< (point) (point-max))
2424 (setq bl (line-beginning-position)
2425 el (line-end-position))
2426 (when (looking-at "#")
2427 (add-text-properties bl el
2428 '(mouse-face highlight
2429 help-echo "mouse-2, RET: Select frame")))
2430 (goto-char bl)
2431 (when (looking-at "^#\\([0-9]+\\)")
2432 (when (string-equal (match-string 1) gdb-frame-number)
2433 (if (gud-tool-bar-item-visible-no-fringe)
2434 (progn
2435 (put-text-property bl (+ bl 4)
2436 'face '(:inverse-video t))
2437 (setq move-to bl))
2438 (or gdb-stack-position
2439 (setq gdb-stack-position (make-marker)))
2440 (set-marker gdb-stack-position (point))
2441 (setq move-to gdb-stack-position)))
2442 (when (re-search-forward "\\([^ ]+\\) (" el t)
2443 (put-text-property (match-beginning 1) (match-end 1)
2444 'face font-lock-function-name-face)
2445 (setq bl (match-end 0))
2446 (while (re-search-forward "<\\([^>]+\\)>" el t)
2447 (put-text-property (match-beginning 1) (match-end 1)
2448 'face font-lock-function-name-face))
2449 (goto-char bl)
2450 (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t)
2451 (put-text-property (match-beginning 1) (match-end 1)
2452 'face font-lock-variable-name-face))))
2453 (forward-line 1))
2454 (forward-line -1)
2455 (when (looking-at "(More stack frames follow...)")
2456 (add-text-properties
2457 (match-beginning 0) (match-end 0)
2458 '(mouse-face highlight
2459 gdb-max-frames t
2460 help-echo
2461 "mouse-2, RET: customize gdb-max-frames to see more frames"
2462 )))))
2463 (when gdb-look-up-stack
2464 (goto-char (point-min))
2465 (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t)
2466 (let ((start (line-beginning-position))
2467 (file (match-string 1))
2468 (line (match-string 2)))
2469 (re-search-backward "^#*\\([0-9]+\\)" start t)
2470 (gdb-enqueue-input
2471 (list (concat gdb-server-prefix "frame "
2472 (match-string 1) "\n") 'gdb-set-hollow))
2473 (gdb-enqueue-input
2474 (list (concat gdb-server-prefix "frame 0\n") 'ignore))))))
2475 (when move-to
2476 (let ((window (get-buffer-window (current-buffer) 0)))
2477 (when window
2478 (with-selected-window window
2479 (goto-char move-to)
2480 (unless (pos-visible-in-window-p)
2481 (recenter '(center)))))))))
2482 (if (eq gdb-look-up-stack 'delete)
2483 (kill-buffer (gdb-get-buffer 'gdb-stack-buffer)))
2484 (setq gdb-look-up-stack nil))
2485
2486(defun gdb-set-hollow ()
2487 (if gud-last-last-frame
2488 (with-current-buffer (gud-find-file (car gud-last-last-frame))
2489 (setq fringe-indicator-alist
2490 '((overlay-arrow . hollow-right-triangle))))))
2491
2492(defun gdb-stack-buffer-name ()
2493 (with-current-buffer gud-comint-buffer
2494 (concat "*stack frames of " (gdb-get-target-string) "*")))
2495
2496(defun gdb-display-stack-buffer ()
2497 "Display backtrace of current stack."
2498 (interactive)
2499 (gdb-display-buffer
2500 (gdb-get-buffer-create 'gdb-stack-buffer) t))
2501
2502(defun gdb-frame-stack-buffer ()
2503 "Display backtrace of current stack in a new frame."
2504 (interactive)
2505 (let ((special-display-regexps (append special-display-regexps '(".*")))
2506 (special-display-frame-alist gdb-frame-parameters))
2507 (display-buffer (gdb-get-buffer-create 'gdb-stack-buffer))))
2508
2509(defvar gdb-frames-mode-map
2510 (let ((map (make-sparse-keymap)))
2511 (suppress-keymap map)
2512 (define-key map "q" 'kill-this-buffer)
2513 (define-key map "\r" 'gdb-frames-select)
2514 (define-key map "F" 'gdb-frames-force-update)
2515 (define-key map [mouse-2] 'gdb-frames-select)
2516 (define-key map [follow-link] 'mouse-face)
2517 map))
2518
2519(declare-function gdbmi-invalidate-frames "ext:gdb-mi" nil t)
2520
2521(defun gdb-frames-force-update ()
2522 "Force update of call stack.
2523Use when the displayed call stack gets out of sync with the
2524actual one, e.g after using the Gdb command \"return\" or setting
2525$pc directly from the GUD buffer. This command isn't normally needed."
2526 (interactive)
2527 (setq gdb-stack-update t)
2528 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2529 (gdb-invalidate-frames)
2530 (gdbmi-invalidate-frames)))
2531
2532(defun gdb-frames-mode ()
2533 "Major mode for gdb call stack.
2534
2535\\{gdb-frames-mode-map}"
2536 (kill-all-local-variables)
2537 (setq major-mode 'gdb-frames-mode)
2538 (setq mode-name "Frames")
2539 (setq gdb-stack-position nil)
2540 (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
2541 (setq truncate-lines t) ;; Make it easier to see overlay arrow.
2542 (setq buffer-read-only t)
2543 (buffer-disable-undo)
2544 (gdb-thread-identification)
2545 (use-local-map gdb-frames-mode-map)
2546 (run-mode-hooks 'gdb-frames-mode-hook)
2547 (setq gdb-stack-update t)
2548 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2549 'gdb-invalidate-frames
2550 'gdbmi-invalidate-frames))
2551
2552(defun gdb-get-frame-number ()
2553 (save-excursion
2554 (end-of-line)
2555 (let* ((start (line-beginning-position))
2556 (pos (re-search-backward "^#*\\([0-9]+\\)" start t))
2557 (n (or (and pos (match-string 1)) "0")))
2558 n)))
2559
2560(defun gdb-frames-select (&optional event)
2561 "Select the frame and display the relevant source."
2562 (interactive (list last-input-event))
2563 (if event (posn-set-point (event-end event)))
2564 (if (get-text-property (point) 'gdb-max-frames)
2565 (progn
2566 (message-box "After setting gdb-max-frames, you need to enter\n\
2567another GDB command e.g pwd, to see new frames")
2568 (customize-variable-other-window 'gdb-max-frames))
2569 (gdb-enqueue-input
2570 (list (concat gdb-server-prefix "frame "
2571 (gdb-get-frame-number) "\n") 'ignore))))
2572
2573
2574;; Threads buffer. This displays a selectable thread list.
2575;;
2576(gdb-set-buffer-rules 'gdb-threads-buffer
2577 'gdb-threads-buffer-name
2578 'gdb-threads-mode)
2579
2580(def-gdb-auto-updated-buffer gdb-threads-buffer
2581 gdb-invalidate-threads
2582 (concat gdb-server-prefix "info threads\n")
2583 gdb-info-threads-handler
2584 gdb-info-threads-custom)
2585
2586(defun gdb-info-threads-custom ()
2587 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
2588 (let ((buffer-read-only nil))
2589 (save-excursion
2590 (goto-char (point-min))
2591 (if (re-search-forward "\\* \\([0-9]+\\)" nil t)
2592 (setq gdb-thread-indicator
2593 (propertize (concat " [" (match-string 1) "]")
2594 ; FIXME: this help-echo doesn't work
2595 'help-echo "thread id")))
2596 (goto-char (point-min))
2597 (while (< (point) (point-max))
2598 (unless (looking-at "No ")
2599 (add-text-properties (line-beginning-position) (line-end-position)
2600 '(mouse-face highlight
2601 help-echo "mouse-2, RET: select thread")))
2602 (forward-line 1))))))
2603
2604(defun gdb-threads-buffer-name ()
2605 (with-current-buffer gud-comint-buffer
2606 (concat "*threads of " (gdb-get-target-string) "*")))
2607
2608(defun gdb-display-threads-buffer ()
2609 "Display IDs of currently known threads."
2610 (interactive)
2611 (gdb-display-buffer
2612 (gdb-get-buffer-create 'gdb-threads-buffer) t))
2613
2614(defun gdb-frame-threads-buffer ()
2615 "Display IDs of currently known threads in a new frame."
2616 (interactive)
2617 (let ((special-display-regexps (append special-display-regexps '(".*")))
2618 (special-display-frame-alist gdb-frame-parameters))
2619 (display-buffer (gdb-get-buffer-create 'gdb-threads-buffer))))
2620
2621(defvar gdb-threads-mode-map
2622 (let ((map (make-sparse-keymap)))
2623 (suppress-keymap map)
2624 (define-key map "q" 'kill-this-buffer)
2625 (define-key map "\r" 'gdb-threads-select)
2626 (define-key map [mouse-2] 'gdb-threads-select)
2627 (define-key map [follow-link] 'mouse-face)
2628 map))
2629
2630(defvar gdb-threads-font-lock-keywords
2631 '((") +\\([^ ]+\\) (" (1 font-lock-function-name-face))
2632 ("in \\([^ ]+\\) (" (1 font-lock-function-name-face))
2633 ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face)))
2634 "Font lock keywords used in `gdb-threads-mode'.")
2635
2636(defun gdb-threads-mode ()
2637 "Major mode for gdb threads.
2638
2639\\{gdb-threads-mode-map}"
2640 (kill-all-local-variables)
2641 (setq major-mode 'gdb-threads-mode)
2642 (setq mode-name "Threads")
2643 (setq buffer-read-only t)
2644 (buffer-disable-undo)
2645 (setq header-line-format gdb-breakpoints-header)
2646 (use-local-map gdb-threads-mode-map)
2647 (set (make-local-variable 'font-lock-defaults)
2648 '(gdb-threads-font-lock-keywords))
2649 (run-mode-hooks 'gdb-threads-mode-hook)
2650 ;; Force "info threads" onto queue.
2651 (lambda () (let ((gud-running nil)) (gdb-invalidate-threads))))
2652
2653(defun gdb-get-thread-number ()
2654 (save-excursion
2655 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
2656 (match-string-no-properties 1)))
2657
2658(defun gdb-threads-select (&optional event)
2659 "Select the thread and display the relevant source."
2660 (interactive (list last-input-event))
2661 (if event (posn-set-point (event-end event)))
2662 (setq gdb-stack-update t)
2663 (gdb-enqueue-input
2664 (list (concat gdb-server-prefix "thread "
2665 (gdb-get-thread-number) "\n") 'ignore))
2666 (gud-display-frame))
2667
2668(defun gdb-thread-identification ()
2669 (setq mode-line-buffer-identification
2670 (list (car mode-line-buffer-identification)
2671 '(gdb-thread-indicator gdb-thread-indicator))))
2672
2673;; Registers buffer.
2674;;
2675(defcustom gdb-all-registers nil
2676 "Non-nil means include floating-point registers."
2677 :type 'boolean
2678 :group 'gdb
2679 :version "22.1")
2680
2681(gdb-set-buffer-rules 'gdb-registers-buffer
2682 'gdb-registers-buffer-name
2683 'gdb-registers-mode)
2684
2685(def-gdb-auto-updated-buffer gdb-registers-buffer
2686 gdb-invalidate-registers
2687 (concat
2688 gdb-server-prefix "info " (if gdb-all-registers "all-") "registers\n")
2689 gdb-info-registers-handler
2690 gdb-info-registers-custom)
2691
2692(defun gdb-info-registers-custom ()
2693 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
2694 (save-excursion
2695 (let ((buffer-read-only nil)
2696 start end)
2697 (goto-char (point-min))
2698 (while (< (point) (point-max))
2699 (setq start (line-beginning-position))
2700 (setq end (line-end-position))
2701 (when (looking-at "^[^ ]+")
2702 (unless (string-equal (match-string 0) "The")
2703 (put-text-property start (match-end 0)
2704 'face font-lock-variable-name-face)
2705 (add-text-properties start end
2706 '(help-echo "mouse-2: edit value"
2707 mouse-face highlight))))
2708 (forward-line 1))))))
2709
2710(defun gdb-edit-register-value (&optional event)
2711 (interactive (list last-input-event))
2712 (save-excursion
2713 (if event (posn-set-point (event-end event)))
2714 (beginning-of-line)
2715 (let* ((register (current-word))
2716 (value (read-string (format "New value (%s): " register))))
2717 (gdb-enqueue-input
2718 (list (concat gdb-server-prefix "set $" register "=" value "\n")
2719 'ignore)))))
2720
2721(defvar gdb-registers-mode-map
2722 (let ((map (make-sparse-keymap)))
2723 (suppress-keymap map)
2724 (define-key map "\r" 'gdb-edit-register-value)
2725 (define-key map [mouse-2] 'gdb-edit-register-value)
2726 (define-key map " " 'gdb-all-registers)
2727 (define-key map "q" 'kill-this-buffer)
2728 map))
2729
2730(defvar gdb-locals-header
2731 (list
2732 (gdb-propertize-header "Locals" gdb-locals-buffer
2733 nil nil mode-line)
2734 " "
2735 (gdb-propertize-header "Registers" gdb-registers-buffer
2736 "mouse-1: select" mode-line-highlight mode-line-inactive)))
2737
2738
2739(defun gdb-registers-mode ()
2740 "Major mode for gdb registers.
2741
2742\\{gdb-registers-mode-map}"
2743 (kill-all-local-variables)
2744 (setq major-mode 'gdb-registers-mode)
2745 (setq mode-name "Registers")
2746 (setq header-line-format gdb-locals-header)
2747 (setq buffer-read-only t)
2748 (buffer-disable-undo)
2749 (gdb-thread-identification)
2750 (use-local-map gdb-registers-mode-map)
2751 (run-mode-hooks 'gdb-registers-mode-hook)
2752 (if (string-equal gdb-version "pre-6.4")
2753 (progn
2754 (if gdb-all-registers (setq mode-name "Registers:All"))
2755 'gdb-invalidate-registers)
2756 'gdb-invalidate-registers-1))
2757
2758(defun gdb-registers-buffer-name ()
2759 (with-current-buffer gud-comint-buffer
2760 (concat "*registers of " (gdb-get-target-string) "*")))
2761
2762(defun gdb-display-registers-buffer ()
2763 "Display integer register contents."
2764 (interactive)
2765 (gdb-display-buffer
2766 (gdb-get-buffer-create 'gdb-registers-buffer) t))
2767
2768(defun gdb-frame-registers-buffer ()
2769 "Display integer register contents in a new frame."
2770 (interactive)
2771 (let ((special-display-regexps (append special-display-regexps '(".*")))
2772 (special-display-frame-alist gdb-frame-parameters))
2773 (display-buffer (gdb-get-buffer-create 'gdb-registers-buffer))))
2774
2775(defun gdb-all-registers ()
2776 "Toggle the display of floating-point registers (pre GDB 6.4 only)."
2777 (interactive)
2778 (when (string-equal gdb-version "pre-6.4")
2779 (if gdb-all-registers
2780 (progn
2781 (setq gdb-all-registers nil)
2782 (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer)
2783 (setq mode-name "Registers")))
2784 (setq gdb-all-registers t)
2785 (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer)
2786 (setq mode-name "Registers:All")))
2787 (message (format "Display of floating-point registers %sabled"
2788 (if gdb-all-registers "en" "dis")))
2789 (gdb-invalidate-registers)))
2790
2791
2792;; Memory buffer.
2793;;
2794(defcustom gdb-memory-repeat-count 32
2795 "Number of data items in memory window."
2796 :type 'integer
2797 :group 'gdb
2798 :version "22.1")
2799
2800(defcustom gdb-memory-format "x"
2801 "Display format of data items in memory window."
2802 :type '(choice (const :tag "Hexadecimal" "x")
2803 (const :tag "Signed decimal" "d")
2804 (const :tag "Unsigned decimal" "u")
2805 (const :tag "Octal" "o")
2806 (const :tag "Binary" "t"))
2807 :group 'gdb
2808 :version "22.1")
2809
2810(defcustom gdb-memory-unit "w"
2811 "Unit size of data items in memory window."
2812 :type '(choice (const :tag "Byte" "b")
2813 (const :tag "Halfword" "h")
2814 (const :tag "Word" "w")
2815 (const :tag "Giant word" "g"))
2816 :group 'gdb
2817 :version "22.1")
2818
2819(gdb-set-buffer-rules 'gdb-memory-buffer
2820 'gdb-memory-buffer-name
2821 'gdb-memory-mode)
2822
2823(def-gdb-auto-updated-buffer gdb-memory-buffer
2824 gdb-invalidate-memory
2825 (concat gdb-server-prefix "x/" (number-to-string gdb-memory-repeat-count)
2826 gdb-memory-format gdb-memory-unit " " gdb-memory-address "\n")
2827 gdb-read-memory-handler
2828 gdb-read-memory-custom)
2829
2830(defun gdb-read-memory-custom ()
2831 (save-excursion
2832 (goto-char (point-min))
2833 (if (looking-at "0x[[:xdigit:]]+")
2834 (setq gdb-memory-address (match-string 0)))))
2835
2836(defvar gdb-memory-mode-map
2837 (let ((map (make-sparse-keymap)))
2838 (suppress-keymap map)
2839 (define-key map "S" 'gdb-memory-set-address)
2840 (define-key map "N" 'gdb-memory-set-repeat-count)
2841 (define-key map "q" 'kill-this-buffer)
2842 map))
2843
2844(defun gdb-memory-set-address (&optional event)
2845 "Set the start memory address."
2846 (interactive)
2847 (let ((arg (read-from-minibuffer "Start address: ")))
2848 (setq gdb-memory-address arg))
2849 (gdb-invalidate-memory))
2850
2851(defun gdb-memory-set-repeat-count (&optional event)
2852 "Set the number of data items in memory window."
2853 (interactive)
2854 (let* ((arg (read-from-minibuffer "Repeat count: "))
2855 (count (string-to-number arg)))
2856 (if (<= count 0)
2857 (error "Positive numbers only")
2858 (customize-set-variable 'gdb-memory-repeat-count count)
2859 (gdb-invalidate-memory))))
2860
2861(defun gdb-memory-format-binary ()
2862 "Set the display format to binary."
2863 (interactive)
2864 (customize-set-variable 'gdb-memory-format "t")
2865 (gdb-invalidate-memory))
2866
2867(defun gdb-memory-format-octal ()
2868 "Set the display format to octal."
2869 (interactive)
2870 (customize-set-variable 'gdb-memory-format "o")
2871 (gdb-invalidate-memory))
2872
2873(defun gdb-memory-format-unsigned ()
2874 "Set the display format to unsigned decimal."
2875 (interactive)
2876 (customize-set-variable 'gdb-memory-format "u")
2877 (gdb-invalidate-memory))
2878
2879(defun gdb-memory-format-signed ()
2880 "Set the display format to decimal."
2881 (interactive)
2882 (customize-set-variable 'gdb-memory-format "d")
2883 (gdb-invalidate-memory))
2884
2885(defun gdb-memory-format-hexadecimal ()
2886 "Set the display format to hexadecimal."
2887 (interactive)
2888 (customize-set-variable 'gdb-memory-format "x")
2889 (gdb-invalidate-memory))
2890
2891(defvar gdb-memory-format-map
2892 (let ((map (make-sparse-keymap)))
2893 (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)
2894 map)
2895 "Keymap to select format in the header line.")
2896
2897(defvar gdb-memory-format-menu (make-sparse-keymap "Format")
2898 "Menu of display formats in the header line.")
2899
2900(define-key gdb-memory-format-menu [binary]
2901 '(menu-item "Binary" gdb-memory-format-binary
2902 :button (:radio . (equal gdb-memory-format "t"))))
2903(define-key gdb-memory-format-menu [octal]
2904 '(menu-item "Octal" gdb-memory-format-octal
2905 :button (:radio . (equal gdb-memory-format "o"))))
2906(define-key gdb-memory-format-menu [unsigned]
2907 '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
2908 :button (:radio . (equal gdb-memory-format "u"))))
2909(define-key gdb-memory-format-menu [signed]
2910 '(menu-item "Signed Decimal" gdb-memory-format-signed
2911 :button (:radio . (equal gdb-memory-format "d"))))
2912(define-key gdb-memory-format-menu [hexadecimal]
2913 '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
2914 :button (:radio . (equal gdb-memory-format "x"))))
2915
2916(defun gdb-memory-format-menu (event)
2917 (interactive "@e")
2918 (x-popup-menu event gdb-memory-format-menu))
2919
2920(defun gdb-memory-format-menu-1 (event)
2921 (interactive "e")
2922 (save-selected-window
2923 (select-window (posn-window (event-start event)))
2924 (let* ((selection (gdb-memory-format-menu event))
2925 (binding (and selection (lookup-key gdb-memory-format-menu
2926 (vector (car selection))))))
2927 (if binding (call-interactively binding)))))
2928
2929(defun gdb-memory-unit-giant ()
2930 "Set the unit size to giant words (eight bytes)."
2931 (interactive)
2932 (customize-set-variable 'gdb-memory-unit "g")
2933 (gdb-invalidate-memory))
2934
2935(defun gdb-memory-unit-word ()
2936 "Set the unit size to words (four bytes)."
2937 (interactive)
2938 (customize-set-variable 'gdb-memory-unit "w")
2939 (gdb-invalidate-memory))
2940
2941(defun gdb-memory-unit-halfword ()
2942 "Set the unit size to halfwords (two bytes)."
2943 (interactive)
2944 (customize-set-variable 'gdb-memory-unit "h")
2945 (gdb-invalidate-memory))
2946
2947(defun gdb-memory-unit-byte ()
2948 "Set the unit size to bytes."
2949 (interactive)
2950 (customize-set-variable 'gdb-memory-unit "b")
2951 (gdb-invalidate-memory))
2952
2953(defvar gdb-memory-unit-map
2954 (let ((map (make-sparse-keymap)))
2955 (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)
2956 map)
2957 "Keymap to select units in the header line.")
2958
2959(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit")
2960 "Menu of units in the header line.")
2961
2962(define-key gdb-memory-unit-menu [giantwords]
2963 '(menu-item "Giant words" gdb-memory-unit-giant
2964 :button (:radio . (equal gdb-memory-unit "g"))))
2965(define-key gdb-memory-unit-menu [words]
2966 '(menu-item "Words" gdb-memory-unit-word
2967 :button (:radio . (equal gdb-memory-unit "w"))))
2968(define-key gdb-memory-unit-menu [halfwords]
2969 '(menu-item "Halfwords" gdb-memory-unit-halfword
2970 :button (:radio . (equal gdb-memory-unit "h"))))
2971(define-key gdb-memory-unit-menu [bytes]
2972 '(menu-item "Bytes" gdb-memory-unit-byte
2973 :button (:radio . (equal gdb-memory-unit "b"))))
2974
2975(defun gdb-memory-unit-menu (event)
2976 (interactive "@e")
2977 (x-popup-menu event gdb-memory-unit-menu))
2978
2979(defun gdb-memory-unit-menu-1 (event)
2980 (interactive "e")
2981 (save-selected-window
2982 (select-window (posn-window (event-start event)))
2983 (let* ((selection (gdb-memory-unit-menu event))
2984 (binding (and selection (lookup-key gdb-memory-unit-menu
2985 (vector (car selection))))))
2986 (if binding (call-interactively binding)))))
2987
2988(defvar gdb-memory-font-lock-keywords
2989 '(;; <__function.name+n>
2990 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face))
2991 )
2992 "Font lock keywords used in `gdb-memory-mode'.")
2993
2994(defun gdb-memory-mode ()
2995 "Major mode for examining memory.
2996
2997\\{gdb-memory-mode-map}"
2998 (kill-all-local-variables)
2999 (setq major-mode 'gdb-memory-mode)
3000 (setq mode-name "Memory")
3001 (setq buffer-read-only t)
3002 (buffer-disable-undo)
3003 (use-local-map gdb-memory-mode-map)
3004 (setq header-line-format
3005 '(:eval
3006 (concat
3007 "Start address["
3008 (propertize
3009 "-"
3010 'face font-lock-warning-face
3011 'help-echo "mouse-1: decrement address"
3012 'mouse-face 'mode-line-highlight
3013 'local-map
3014 (gdb-make-header-line-mouse-map
3015 'mouse-1
3016 (lambda () (interactive)
3017 (let ((gdb-memory-address
3018 ;; Let GDB do the arithmetic.
3019 (concat
3020 gdb-memory-address " - "
3021 (number-to-string
3022 (* gdb-memory-repeat-count
3023 (cond ((string= gdb-memory-unit "b") 1)
3024 ((string= gdb-memory-unit "h") 2)
3025 ((string= gdb-memory-unit "w") 4)
3026 ((string= gdb-memory-unit "g") 8)))))))
3027 (gdb-invalidate-memory)))))
3028 "|"
3029 (propertize "+"
3030 'face font-lock-warning-face
3031 'help-echo "mouse-1: increment address"
3032 'mouse-face 'mode-line-highlight
3033 'local-map (gdb-make-header-line-mouse-map
3034 'mouse-1
3035 (lambda () (interactive)
3036 (let ((gdb-memory-address nil))
3037 (gdb-invalidate-memory)))))
3038 "]: "
3039 (propertize gdb-memory-address
3040 'face font-lock-warning-face
3041 'help-echo "mouse-1: set start address"
3042 'mouse-face 'mode-line-highlight
3043 'local-map (gdb-make-header-line-mouse-map
3044 'mouse-1
3045 #'gdb-memory-set-address))
3046 " Repeat Count: "
3047 (propertize (number-to-string gdb-memory-repeat-count)
3048 'face font-lock-warning-face
3049 'help-echo "mouse-1: set repeat count"
3050 'mouse-face 'mode-line-highlight
3051 'local-map (gdb-make-header-line-mouse-map
3052 'mouse-1
3053 #'gdb-memory-set-repeat-count))
3054 " Display Format: "
3055 (propertize gdb-memory-format
3056 'face font-lock-warning-face
3057 'help-echo "mouse-3: select display format"
3058 'mouse-face 'mode-line-highlight
3059 'local-map gdb-memory-format-map)
3060 " Unit Size: "
3061 (propertize gdb-memory-unit
3062 'face font-lock-warning-face
3063 'help-echo "mouse-3: select unit size"
3064 'mouse-face 'mode-line-highlight
3065 'local-map gdb-memory-unit-map))))
3066 (set (make-local-variable 'font-lock-defaults)
3067 '(gdb-memory-font-lock-keywords))
3068 (run-mode-hooks 'gdb-memory-mode-hook)
3069 'gdb-invalidate-memory)
3070
3071(defun gdb-memory-buffer-name ()
3072 (with-current-buffer gud-comint-buffer
3073 (concat "*memory of " (gdb-get-target-string) "*")))
3074
3075(defun gdb-display-memory-buffer ()
3076 "Display memory contents."
3077 (interactive)
3078 (gdb-display-buffer
3079 (gdb-get-buffer-create 'gdb-memory-buffer) t))
3080
3081(defun gdb-frame-memory-buffer ()
3082 "Display memory contents in a new frame."
3083 (interactive)
3084 (let* ((special-display-regexps (append special-display-regexps '(".*")))
3085 (special-display-frame-alist
3086 (cons '(left-fringe . 0)
3087 (cons '(right-fringe . 0)
3088 (cons '(width . 83) gdb-frame-parameters)))))
3089 (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
3090
3091
3092;; Locals buffer.
3093;;
3094(gdb-set-buffer-rules 'gdb-locals-buffer
3095 'gdb-locals-buffer-name
3096 'gdb-locals-mode)
3097
3098(def-gdb-auto-update-trigger gdb-invalidate-locals
3099 (gdb-get-buffer 'gdb-locals-buffer)
3100 "server info locals\n"
3101 gdb-info-locals-handler)
3102
3103(defvar gdb-locals-watch-map
3104 (let ((map (make-sparse-keymap)))
3105 (suppress-keymap map)
3106 (define-key map "\r" (lambda () (interactive)
3107 (beginning-of-line)
3108 (gud-watch)))
3109 (define-key map [mouse-2] (lambda (event) (interactive "e")
3110 (mouse-set-point event)
3111 (beginning-of-line)
3112 (gud-watch)))
3113 map)
3114 "Keymap to create watch expression of a complex data type local variable.")
3115
3116(defconst gdb-struct-string
3117 (concat (propertize "[struct/union]"
3118 'mouse-face 'highlight
3119 'help-echo "mouse-2: create watch expression"
3120 'local-map gdb-locals-watch-map) "\n"))
3121
3122(defconst gdb-array-string
3123 (concat " " (propertize "[array]"
3124 'mouse-face 'highlight
3125 'help-echo "mouse-2: create watch expression"
3126 'local-map gdb-locals-watch-map) "\n"))
3127
3128;; Abbreviate for arrays and structures.
3129;; These can be expanded using gud-display.
3130(defun gdb-info-locals-handler ()
3131 (setq gdb-pending-triggers (delq 'gdb-invalidate-locals
3132 gdb-pending-triggers))
3133 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
3134 (with-current-buffer buf
3135 (goto-char (point-min))
3136 ;; Need this in case "set print pretty" is on.
3137 (while (re-search-forward "^[ }].*\n" nil t)
3138 (replace-match "" nil nil))
3139 (goto-char (point-min))
3140 (while (re-search-forward "{\\(.*=.*\n\\|\n\\)" nil t)
3141 (replace-match gdb-struct-string nil nil))
3142 (goto-char (point-min))
3143 (while (re-search-forward "\\s-*{[^.].*\n" nil t)
3144 (replace-match gdb-array-string nil nil))))
3145 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
3146 (and buf
3147 (with-current-buffer buf
3148 (let* ((window (get-buffer-window buf 0))
3149 (start (window-start window))
3150 (p (window-point window))
3151 (buffer-read-only nil))
3152 (erase-buffer)
3153 (insert-buffer-substring (gdb-get-buffer-create
3154 'gdb-partial-output-buffer))
3155 (set-window-start window start)
3156 (set-window-point window p)))))
3157 (run-hooks 'gdb-info-locals-hook))
3158
3159(defvar gdb-locals-mode-map
3160 (let ((map (make-sparse-keymap)))
3161 (suppress-keymap map)
3162 (define-key map "q" 'kill-this-buffer)
3163 map))
3164
3165(defun gdb-locals-mode ()
3166 "Major mode for gdb locals.
3167
3168\\{gdb-locals-mode-map}"
3169 (kill-all-local-variables)
3170 (setq major-mode 'gdb-locals-mode)
3171 (setq mode-name (concat "Locals:" gdb-selected-frame))
3172 (use-local-map gdb-locals-mode-map)
3173 (setq buffer-read-only t)
3174 (buffer-disable-undo)
3175 (setq header-line-format gdb-locals-header)
3176 (gdb-thread-identification)
3177 (set (make-local-variable 'font-lock-defaults)
3178 '(gdb-locals-font-lock-keywords))
3179 (run-mode-hooks 'gdb-locals-mode-hook)
3180 (if (and (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3181 (string-equal gdb-version "pre-6.4"))
3182 'gdb-invalidate-locals
3183 'gdb-invalidate-locals-1))
3184
3185(defun gdb-locals-buffer-name ()
3186 (with-current-buffer gud-comint-buffer
3187 (concat "*locals of " (gdb-get-target-string) "*")))
3188
3189(defun gdb-display-locals-buffer ()
3190 "Display local variables of current stack and their values."
3191 (interactive)
3192 (gdb-display-buffer
3193 (gdb-get-buffer-create 'gdb-locals-buffer) t))
3194
3195(defun gdb-frame-locals-buffer ()
3196 "Display local variables of current stack and their values in a new frame."
3197 (interactive)
3198 (let ((special-display-regexps (append special-display-regexps '(".*")))
3199 (special-display-frame-alist gdb-frame-parameters))
3200 (display-buffer (gdb-get-buffer-create 'gdb-locals-buffer))))
3201
3202
3203;;;; Window management
3204(defun gdb-display-buffer (buf dedicated &optional frame)
3205 (let ((answer (get-buffer-window buf (or frame 0))))
3206 (if answer
3207 (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary.
3208 (let ((window (get-lru-window)))
3209 (if (memq (buffer-local-value 'gud-minor-mode (window-buffer window))
3210 '(gdba gdbmi))
3211 (let* ((largest (get-largest-window))
3212 (cur-size (window-height largest)))
3213 (setq answer (split-window largest))
3214 (set-window-buffer answer buf)
3215 (set-window-dedicated-p answer dedicated)
3216 answer)
3217 (set-window-buffer window buf)
3218 window)))))
3219
3220
3221;;; Shared keymap initialization:
3222
3223(let ((menu (make-sparse-keymap "GDB-Windows")))
3224 (define-key gud-menu-map [displays]
3225 `(menu-item "GDB-Windows" ,menu
3226 :help "Open a GDB-UI buffer in a new window."
3227 :visible (memq gud-minor-mode '(gdbmi gdba))))
3228 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
3229 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
3230 (define-key menu [inferior]
3231 '(menu-item "Separate IO" gdb-display-separate-io-buffer
3232 :enable gdb-use-separate-io-buffer))
3233 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
3234 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
3235 (define-key menu [disassembly]
3236 '("Disassembly" . gdb-display-assembler-buffer))
3237 (define-key menu [breakpoints]
3238 '("Breakpoints" . gdb-display-breakpoints-buffer))
3239 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
3240 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)))
3241
3242(let ((menu (make-sparse-keymap "GDB-Frames")))
3243 (define-key gud-menu-map [frames]
3244 `(menu-item "GDB-Frames" ,menu
3245 :help "Open a GDB-UI buffer in a new frame."
3246 :visible (memq gud-minor-mode '(gdbmi gdba))))
3247 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
3248 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
3249 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
3250 (define-key menu [inferior]
3251 '(menu-item "Separate IO" gdb-frame-separate-io-buffer
3252 :enable gdb-use-separate-io-buffer))
3253 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
3254 (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer))
3255 (define-key menu [breakpoints]
3256 '("Breakpoints" . gdb-frame-breakpoints-buffer))
3257 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
3258 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)))
3259
3260(let ((menu (make-sparse-keymap "GDB-UI/MI")))
3261 (define-key gud-menu-map [ui]
3262 `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI")
3263 ,menu :visible (memq gud-minor-mode '(gdbmi gdba))))
3264 (define-key menu [gdb-customize]
3265 '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
3266 :help "Customize Gdb Graphical Mode options."))
3267 (define-key menu [gdb-find-source-frame]
3268 '(menu-item "Look For Source Frame" gdb-find-source-frame
3269 :visible (eq gud-minor-mode 'gdba)
3270 :help "Toggle looking for source frame further up call stack."
3271 :button (:toggle . gdb-find-source-frame)))
3272 (define-key menu [gdb-use-separate-io]
3273 '(menu-item "Separate IO" gdb-use-separate-io-buffer
3274 :visible (eq gud-minor-mode 'gdba)
3275 :help "Toggle separate IO for debugged program."
3276 :button (:toggle . gdb-use-separate-io-buffer)))
3277 (define-key menu [gdb-many-windows]
3278 '(menu-item "Display Other Windows" gdb-many-windows
3279 :help "Toggle display of locals, stack and breakpoint information"
3280 :button (:toggle . gdb-many-windows)))
3281 (define-key menu [gdb-restore-windows]
3282 '(menu-item "Restore Window Layout" gdb-restore-windows
3283 :help "Restore standard layout for debug session.")))
3284
3285(defun gdb-frame-gdb-buffer ()
3286 "Display GUD buffer in a new frame."
3287 (interactive)
3288 (let ((special-display-regexps (append special-display-regexps '(".*")))
3289 (special-display-frame-alist
3290 (remove '(menu-bar-lines) (remove '(tool-bar-lines)
3291 gdb-frame-parameters)))
3292 (same-window-regexps nil))
3293 (display-buffer gud-comint-buffer)))
3294
3295(defun gdb-display-gdb-buffer ()
3296 "Display GUD buffer."
3297 (interactive)
3298 (let ((same-window-regexps nil))
3299 (select-window (display-buffer gud-comint-buffer nil 0))))
3300
3301(defun gdb-set-window-buffer (name)
3302 (set-window-buffer (selected-window) (get-buffer name))
3303 (set-window-dedicated-p (selected-window) t))
3304
3305(defun gdb-setup-windows ()
3306 "Layout the window pattern for `gdb-many-windows'."
3307 (gdb-display-locals-buffer)
3308 (gdb-display-stack-buffer)
3309 (delete-other-windows)
3310 (gdb-display-breakpoints-buffer)
3311 (delete-other-windows)
3312 ; Don't dedicate.
3313 (pop-to-buffer gud-comint-buffer)
3314 (split-window nil ( / ( * (window-height) 3) 4))
3315 (split-window nil ( / (window-height) 3))
3316 (split-window-horizontally)
3317 (other-window 1)
3318 (gdb-set-window-buffer (gdb-locals-buffer-name))
3319 (other-window 1)
3320 (switch-to-buffer
3321 (if gud-last-last-frame
3322 (gud-find-file (car gud-last-last-frame))
3323 (if gdb-main-file
3324 (gud-find-file gdb-main-file)
3325 ;; Put buffer list in window if we
3326 ;; can't find a source file.
3327 (list-buffers-noselect))))
3328 (setq gdb-source-window (selected-window))
3329 (when gdb-use-separate-io-buffer
3330 (split-window-horizontally)
3331 (other-window 1)
3332 (gdb-set-window-buffer
3333 (gdb-get-buffer-create 'gdb-inferior-io)))
3334 (other-window 1)
3335 (gdb-set-window-buffer (gdb-stack-buffer-name))
3336 (split-window-horizontally)
3337 (other-window 1)
3338 (gdb-set-window-buffer (gdb-breakpoints-buffer-name))
3339 (other-window 1))
3340
3341(defun gdb-restore-windows ()
3342 "Restore the basic arrangement of windows used by gdba.
3343This arrangement depends on the value of `gdb-many-windows'."
3344 (interactive)
3345 (pop-to-buffer gud-comint-buffer) ;Select the right window and frame.
3346 (delete-other-windows)
3347 (if gdb-many-windows
3348 (gdb-setup-windows)
3349 (when (or gud-last-last-frame gdb-show-main)
3350 (split-window)
3351 (other-window 1)
3352 (switch-to-buffer
3353 (if gud-last-last-frame
3354 (gud-find-file (car gud-last-last-frame))
3355 (gud-find-file gdb-main-file)))
3356 (setq gdb-source-window (selected-window))
3357 (other-window 1))))
3358
3359(defun gdb-reset ()
3360 "Exit a debugging session cleanly.
3361Kills the gdb buffers, and resets variables and the source buffers."
3362 (dolist (buffer (buffer-list))
3363 (unless (eq buffer gud-comint-buffer)
3364 (with-current-buffer buffer
3365 (if (memq gud-minor-mode '(gdbmi gdba))
3366 (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name))
3367 (kill-buffer nil)
3368 (gdb-remove-breakpoint-icons (point-min) (point-max) t)
3369 (setq gud-minor-mode nil)
3370 (kill-local-variable 'tool-bar-map)
3371 (kill-local-variable 'gdb-define-alist))))))
3372 (setq gdb-overlay-arrow-position nil)
3373 (setq overlay-arrow-variable-list
3374 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
3375 (setq fringe-indicator-alist '((overlay-arrow . right-triangle)))
3376 (setq gdb-stack-position nil)
3377 (setq overlay-arrow-variable-list
3378 (delq 'gdb-stack-position overlay-arrow-variable-list))
3379 (if (boundp 'speedbar-frame) (speedbar-timer-fn))
3380 (setq gud-running nil)
3381 (setq gdb-active-process nil)
3382 (setq gdb-var-list nil)
3383 (remove-hook 'after-save-hook 'gdb-create-define-alist t))
3384
3385(defun gdb-source-info ()
3386 "Find the source file where the program starts and display it with related
3387buffers."
3388 (goto-char (point-min))
3389 (if (and (search-forward "Located in " nil t)
3390 (looking-at "\\S-+"))
3391 (setq gdb-main-file (match-string 0)))
3392 (goto-char (point-min))
3393 (if (search-forward "Includes preprocessor macro info." nil t)
3394 (setq gdb-macro-info t))
3395 (if gdb-many-windows
3396 (gdb-setup-windows)
3397 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
3398 (if (and gdb-show-main gdb-main-file)
3399 (let ((pop-up-windows t))
3400 (display-buffer (gud-find-file gdb-main-file)))))
3401 (setq gdb-ready t))
3402
3403(defun gdb-get-location (bptno line flag)
3404 "Find the directory containing the relevant source file.
3405Put in buffer and place breakpoint icon."
3406 (goto-char (point-min))
3407 (catch 'file-not-found
3408 (if (search-forward "Located in " nil t)
3409 (when (looking-at "\\S-+")
3410 (delete (cons bptno "File not found") gdb-location-alist)
3411 (push (cons bptno (match-string 0)) gdb-location-alist))
3412 (gdb-resync)
3413 (unless (assoc bptno gdb-location-alist)
3414 (push (cons bptno "File not found") gdb-location-alist)
3415 (message-box "Cannot find source file for breakpoint location.\n\
3416Add directory to search path for source files using the GDB command, dir."))
3417 (throw 'file-not-found nil))
3418 (with-current-buffer
3419 (find-file-noselect (match-string 0))
3420 (gdb-init-buffer)
3421 ;; only want one breakpoint icon at each location
3422 (save-excursion
3423 (goto-char (point-min))
3424 (forward-line (1- (string-to-number line)))
3425 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))
3426
3427(add-hook 'find-file-hook 'gdb-find-file-hook)
3428
3429(defun gdb-find-file-hook ()
3430 "Set up buffer for debugging if file is part of the source code
3431of the current session."
3432 (if (and (buffer-name gud-comint-buffer)
3433 ;; in case gud or gdb-ui is just loaded
3434 gud-comint-buffer
3435 (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
3436 '(gdba gdbmi)))
3437 ;;Pre GDB 6.3 "info sources" doesn't give absolute file name.
3438 (if (member (if (string-equal gdb-version "pre-6.4")
3439 (file-name-nondirectory buffer-file-name)
3440 buffer-file-name)
3441 gdb-source-file-list)
3442 (with-current-buffer (find-buffer-visiting buffer-file-name)
3443 (gdb-init-buffer)))))
3444
3445;;from put-image
3446(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
3447 "Put string PUTSTRING in front of POS in the current buffer.
3448PUTSTRING is displayed by putting an overlay into the current buffer with a
3449`before-string' string that has a `display' property whose value is
3450PUTSTRING."
3451 (let ((string (make-string 1 ?x))
3452 (buffer (current-buffer)))
3453 (setq putstring (copy-sequence putstring))
3454 (let ((overlay (make-overlay pos pos buffer))
3455 (prop (or dprop
3456 (list (list 'margin 'left-margin) putstring))))
3457 (put-text-property 0 1 'display prop string)
3458 (if sprops
3459 (add-text-properties 0 1 sprops string))
3460 (overlay-put overlay 'put-break t)
3461 (overlay-put overlay 'before-string string))))
3462
3463;;from remove-images
3464(defun gdb-remove-strings (start end &optional buffer)
3465 "Remove strings between START and END in BUFFER.
3466Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
3467BUFFER nil or omitted means use the current buffer."
3468 (unless buffer
3469 (setq buffer (current-buffer)))
3470 (dolist (overlay (overlays-in start end))
3471 (when (overlay-get overlay 'put-break)
3472 (delete-overlay overlay))))
3473
3474(defun gdb-put-breakpoint-icon (enabled bptno)
3475 (if (string-match "[0-9+]+\\." bptno)
3476 (setq enabled gdb-parent-bptno-enabled))
3477 (let ((start (- (line-beginning-position) 1))
3478 (end (+ (line-end-position) 1))
3479 (putstring (if enabled "B" "b"))
3480 (source-window (get-buffer-window (current-buffer) 0)))
3481 (add-text-properties
3482 0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt")
3483 putstring)
3484 (if enabled
3485 (add-text-properties
3486 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
3487 (add-text-properties
3488 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring))
3489 (gdb-remove-breakpoint-icons start end)
3490 (if (display-images-p)
3491 (if (>= (or left-fringe-width
3492 (if source-window (car (window-fringes source-window)))
3493 gdb-buffer-fringe-width) 8)
3494 (gdb-put-string
3495 nil (1+ start)
3496 `(left-fringe breakpoint
3497 ,(if enabled
3498 'breakpoint-enabled
3499 'breakpoint-disabled))
3500 'gdb-bptno bptno
3501 'gdb-enabled enabled)
3502 (when (< left-margin-width 2)
3503 (save-current-buffer
3504 (setq left-margin-width 2)
3505 (if source-window
3506 (set-window-margins
3507 source-window
3508 left-margin-width right-margin-width))))
3509 (put-image
3510 (if enabled
3511 (or breakpoint-enabled-icon
3512 (setq breakpoint-enabled-icon
3513 (find-image `((:type xpm :data
3514 ,breakpoint-xpm-data
3515 :ascent 100 :pointer hand)
3516 (:type pbm :data
3517 ,breakpoint-enabled-pbm-data
3518 :ascent 100 :pointer hand)))))
3519 (or breakpoint-disabled-icon
3520 (setq breakpoint-disabled-icon
3521 (find-image `((:type xpm :data
3522 ,breakpoint-xpm-data
3523 :conversion disabled
3524 :ascent 100 :pointer hand)
3525 (:type pbm :data
3526 ,breakpoint-disabled-pbm-data
3527 :ascent 100 :pointer hand))))))
3528 (+ start 1)
3529 putstring
3530 'left-margin))
3531 (when (< left-margin-width 2)
3532 (save-current-buffer
3533 (setq left-margin-width 2)
3534 (let ((window (get-buffer-window (current-buffer) 0)))
3535 (if window
3536 (set-window-margins
3537 window left-margin-width right-margin-width)))))
3538 (gdb-put-string
3539 (propertize putstring
3540 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled))
3541 (1+ start)))))
3542
3543(defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
3544 (gdb-remove-strings start end)
3545 (if (display-images-p)
3546 (remove-images start end))
3547 (when remove-margin
3548 (setq left-margin-width 0)
3549 (let ((window (get-buffer-window (current-buffer) 0)))
3550 (if window
3551 (set-window-margins
3552 window left-margin-width right-margin-width)))))
3553
3554
3555;;
3556;; Assembler buffer.
3557;;
3558(gdb-set-buffer-rules 'gdb-assembler-buffer
3559 'gdb-assembler-buffer-name
3560 'gdb-assembler-mode)
3561
3562;; We can't use def-gdb-auto-update-handler because we don't want to use
3563;; window-start but keep the overlay arrow/current line visible.
3564(defun gdb-assembler-handler ()
3565 (setq gdb-pending-triggers
3566 (delq 'gdb-invalidate-assembler
3567 gdb-pending-triggers))
3568 (let ((buf (gdb-get-buffer 'gdb-assembler-buffer)))
3569 (and buf
3570 (with-current-buffer buf
3571 (let* ((window (get-buffer-window buf 0))
3572 (p (window-point window))
3573 (buffer-read-only nil))
3574 (erase-buffer)
3575 (insert-buffer-substring (gdb-get-buffer-create
3576 'gdb-partial-output-buffer))
3577 (set-window-point window p)))))
3578 ;; put customisation here
3579 (gdb-assembler-custom))
3580
3581(defun gdb-assembler-custom ()
3582 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
3583 (pos 1) (address) (flag) (bptno))
3584 (with-current-buffer buffer
3585 (save-excursion
3586 (if (not (equal gdb-pc-address "main"))
3587 (progn
3588 (goto-char (point-min))
3589 (if (and gdb-pc-address
3590 (search-forward gdb-pc-address nil t))
3591 (progn
3592 (setq pos (point))
3593 (beginning-of-line)
3594 (setq fringe-indicator-alist
3595 (if (string-equal gdb-frame-number "0")
3596 nil
3597 '((overlay-arrow . hollow-right-triangle))))
3598 (or gdb-overlay-arrow-position
3599 (setq gdb-overlay-arrow-position (make-marker)))
3600 (set-marker gdb-overlay-arrow-position (point))))))
3601 ;; remove all breakpoint-icons in assembler buffer before updating.
3602 (gdb-remove-breakpoint-icons (point-min) (point-max))))
3603 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
3604 (goto-char (point-min))
3605 (while (< (point) (- (point-max) 1))
3606 (forward-line 1)
3607 (when (looking-at
3608 "\\([0-9]+\\.?[0-9]*\\).*?\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)")
3609 (setq bptno (match-string 1))
3610 (setq flag (char-after (match-beginning 2)))
3611 (setq address (match-string 3))
3612 (with-current-buffer buffer
3613 (save-excursion
3614 (goto-char (point-min))
3615 (if (re-search-forward (concat "^0x0*" address) nil t)
3616 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))
3617 (if (not (equal gdb-pc-address "main"))
3618 (with-current-buffer buffer
3619 (set-window-point (get-buffer-window buffer 0) pos)))))
3620
3621(defvar gdb-assembler-mode-map
3622 (let ((map (make-sparse-keymap)))
3623 (suppress-keymap map)
3624 (define-key map "q" 'kill-this-buffer)
3625 map))
3626
3627(defvar gdb-assembler-font-lock-keywords
3628 '(;; <__function.name+n>
3629 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
3630 (1 font-lock-function-name-face))
3631 ;; 0xNNNNNNNN <__function.name+n>: opcode
3632 ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)"
3633 (4 font-lock-keyword-face))
3634 ;; %register(at least i386)
3635 ("%\\sw+" . font-lock-variable-name-face)
3636 ("^\\(Dump of assembler code for function\\) \\(.+\\):"
3637 (1 font-lock-comment-face)
3638 (2 font-lock-function-name-face))
3639 ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face))
3640 "Font lock keywords used in `gdb-assembler-mode'.")
3641
3642(defun gdb-assembler-mode ()
3643 "Major mode for viewing code assembler.
3644
3645\\{gdb-assembler-mode-map}"
3646 (kill-all-local-variables)
3647 (setq major-mode 'gdb-assembler-mode)
3648 (setq mode-name (concat "Machine:" gdb-selected-frame))
3649 (setq gdb-overlay-arrow-position nil)
3650 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
3651 (setq fringes-outside-margins t)
3652 (setq buffer-read-only t)
3653 (buffer-disable-undo)
3654 (gdb-thread-identification)
3655 (use-local-map gdb-assembler-mode-map)
3656 (gdb-invalidate-assembler)
3657 (set (make-local-variable 'font-lock-defaults)
3658 '(gdb-assembler-font-lock-keywords))
3659 (run-mode-hooks 'gdb-assembler-mode-hook)
3660 'gdb-invalidate-assembler)
3661
3662(defun gdb-assembler-buffer-name ()
3663 (with-current-buffer gud-comint-buffer
3664 (concat "*disassembly of " (gdb-get-target-string) "*")))
3665
3666(defun gdb-display-assembler-buffer ()
3667 "Display disassembly view."
3668 (interactive)
3669 (setq gdb-previous-frame nil)
3670 (gdb-display-buffer
3671 (gdb-get-buffer-create 'gdb-assembler-buffer) t))
3672
3673(defun gdb-frame-assembler-buffer ()
3674 "Display disassembly view in a new frame."
3675 (interactive)
3676 (setq gdb-previous-frame nil)
3677 (let ((special-display-regexps (append special-display-regexps '(".*")))
3678 (special-display-frame-alist gdb-frame-parameters))
3679 (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer))))
3680
3681;; modified because if gdb-pc-address has changed value a new command
3682;; must be enqueued to update the buffer with the new output
3683(defun gdb-invalidate-assembler (&optional ignored)
3684 (if (gdb-get-buffer 'gdb-assembler-buffer)
3685 (progn
3686 (unless (and gdb-selected-frame
3687 (string-equal gdb-selected-frame gdb-previous-frame))
3688 (if (or (not (member 'gdb-invalidate-assembler
3689 gdb-pending-triggers))
3690 (not (equal (string-to-number gdb-pc-address)
3691 (string-to-number
3692 gdb-previous-frame-pc-address))))
3693 (progn
3694 ;; take previous disassemble command, if any, off the queue
3695 (with-current-buffer gud-comint-buffer
3696 (let ((queue gdb-input-queue))
3697 (dolist (item queue)
3698 (if (equal (cdr item) '(gdb-assembler-handler))
3699 (setq gdb-input-queue
3700 (delete item gdb-input-queue))))))
3701 (gdb-enqueue-input
3702 (list
3703 (concat gdb-server-prefix "disassemble " gdb-pc-address "\n")
3704 'gdb-assembler-handler))
3705 (push 'gdb-invalidate-assembler gdb-pending-triggers)
3706 (setq gdb-previous-frame-pc-address gdb-pc-address)
3707 (setq gdb-previous-frame gdb-selected-frame)))))))
3708
3709(defun gdb-get-selected-frame ()
3710 (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
3711 (progn
3712 (if (string-equal gdb-version "pre-6.4")
3713 (gdb-enqueue-input
3714 (list (concat gdb-server-prefix "info frame\n")
3715 'gdb-frame-handler))
3716 (gdb-enqueue-input
3717 (list "server interpreter mi -stack-info-frame\n"
3718 'gdb-frame-handler-1)))
3719 (push 'gdb-get-selected-frame gdb-pending-triggers))))
3720
3721(defun gdb-frame-handler ()
3722 (setq gdb-pending-triggers
3723 (delq 'gdb-get-selected-frame gdb-pending-triggers))
3724 (goto-char (point-min))
3725 (when (re-search-forward
3726 "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t)
3727 (setq gdb-frame-number (match-string 1))
3728 (setq gdb-frame-address (match-string 2)))
3729 (goto-char (point-min))
3730 (when (re-search-forward ".*=\\s-+\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\
3731\\(?: (\\(\\S-+?\\):[0-9]+?)\\)*; "
3732 nil t)
3733 (setq gdb-selected-frame (match-string 2))
3734 (if (gdb-get-buffer 'gdb-locals-buffer)
3735 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
3736 (setq mode-name (concat "Locals:" gdb-selected-frame))))
3737 (if (gdb-get-buffer 'gdb-assembler-buffer)
3738 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
3739 (setq mode-name (concat "Machine:" gdb-selected-frame))))
3740 (setq gdb-pc-address (match-string 1))
3741 (if (and (match-string 3) gud-overlay-arrow-position)
3742 (let ((buffer (marker-buffer gud-overlay-arrow-position))
3743 (position (marker-position gud-overlay-arrow-position)))
3744 (when (and buffer
3745 (string-equal (file-name-nondirectory
3746 (buffer-file-name buffer))
3747 (file-name-nondirectory (match-string 3))))
3748 (with-current-buffer buffer
3749 (setq fringe-indicator-alist
3750 (if (string-equal gdb-frame-number "0")
3751 nil
3752 '((overlay-arrow . hollow-right-triangle))))
3753 (set-marker gud-overlay-arrow-position position))))))
3754 (goto-char (point-min))
3755 (if (re-search-forward " source language \\(\\S-+\\)\." nil t)
3756 (setq gdb-current-language (match-string 1)))
3757 (gdb-invalidate-assembler))
3758
3759
3760;; Code specific to GDB 6.4
3761(defconst gdb-source-file-regexp-1 "fullname=\"\\(.*?\\)\"")
3762
3763(defun gdb-set-gud-minor-mode-existing-buffers-1 ()
3764 "Create list of source files for current GDB session.
3765If buffers already exist for any of these files, `gud-minor-mode'
3766is set in them."
3767 (goto-char (point-min))
3768 (while (re-search-forward gdb-source-file-regexp-1 nil t)
3769 (push (match-string 1) gdb-source-file-list))
3770 (dolist (buffer (buffer-list))
3771 (with-current-buffer buffer
3772 (when (member buffer-file-name gdb-source-file-list)
3773 (gdb-init-buffer))))
3774 (gdb-force-mode-line-update
3775 (propertize "ready" 'face font-lock-variable-name-face)))
3776
3777;; Used for -stack-info-frame but could be used for -stack-list-frames too.
3778(defconst gdb-stack-list-frames-regexp
3779".*?level=\"\\(.*?\\)\".*?,addr=\"\\(.*?\\)\".*?,func=\"\\(.*?\\)\",\
3780\\(?:.*?file=\".*?\".*?,fullname=\"\\(.*?\\)\".*?,line=\"\\(.*?\\)\".*?}\\|\
3781from=\"\\(.*?\\)\"\\)")
3782
3783(defun gdb-frame-handler-1 ()
3784 (setq gdb-pending-triggers
3785 (delq 'gdb-get-selected-frame gdb-pending-triggers))
3786 (goto-char (point-min))
3787 (when (re-search-forward gdb-stack-list-frames-regexp nil t)
3788 (setq gdb-frame-number (match-string 1))
3789 (setq gdb-pc-address (match-string 2))
3790 (setq gdb-selected-frame (match-string 3))
3791 (if (gdb-get-buffer 'gdb-locals-buffer)
3792 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
3793 (setq mode-name (concat "Locals:" gdb-selected-frame))))
3794 (if (gdb-get-buffer 'gdb-assembler-buffer)
3795 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
3796 (setq mode-name (concat "Machine:" gdb-selected-frame)))))
3797 (if (and (match-string 4) (match-string 5) gud-overlay-arrow-position)
3798 (let ((buffer (marker-buffer gud-overlay-arrow-position))
3799 (position (marker-position gud-overlay-arrow-position)))
3800 (when (and buffer
3801 (string-equal (file-name-nondirectory
3802 (buffer-file-name buffer))
3803 (file-name-nondirectory (match-string 4))))
3804 (with-current-buffer buffer
3805 (setq fringe-indicator-alist
3806 (if (string-equal gdb-frame-number "0")
3807 nil
3808 '((overlay-arrow . hollow-right-triangle))))
3809 (set-marker gud-overlay-arrow-position position)))))
3810 (gdb-invalidate-assembler))
3811
3812; Uses "-var-list-children --all-values". Needs GDB 6.4 onwards.
3813(defun gdb-var-list-children-1 (varnum)
3814 (gdb-enqueue-input
3815 (list
3816 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3817 (concat "server interpreter mi \"-var-list-children --all-values \\\""
3818 varnum "\\\"\"\n")
3819 (concat "-var-list-children --all-values \"" varnum "\"\n"))
3820 `(lambda () (gdb-var-list-children-handler-1 ,varnum)))))
3821
3822(defun gdb-var-list-children-handler-1 (varnum)
3823 (let* ((var-list nil)
3824 (output (bindat-get-field (gdb-json-partial-output "child")))
3825 (children (bindat-get-field output 'children)))
3826 (catch 'child-already-watched
3827 (dolist (var gdb-var-list)
3828 (if (string-equal varnum (car var))
3829 (progn
3830 ;; With dynamic varobjs numchild may have increased.
3831 (setcar (nthcdr 2 var) (bindat-get-field output 'numchild))
3832 (push var var-list)
3833 (dolist (child children)
3834 (let ((varchild (list (bindat-get-field child 'name)
3835 (bindat-get-field child 'exp)
3836 (bindat-get-field child 'numchild)
3837 (bindat-get-field child 'type)
3838 (bindat-get-field child 'value)
3839 nil
3840 (bindat-get-field child 'has_more))))
3841 (if (assoc (car varchild) gdb-var-list)
3842 (throw 'child-already-watched nil))
3843 (push varchild var-list))))
3844 (push var var-list)))
3845 (setq gdb-var-list (nreverse var-list))))
3846 (gdb-speedbar-update))
3847
3848; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
3849(defun gdb-var-update-1 ()
3850 (if (not (member 'gdb-var-update gdb-pending-triggers))
3851 (progn
3852 (gdb-enqueue-input
3853 (list
3854 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3855 "server interpreter mi \"-var-update --all-values *\"\n"
3856 "-var-update --all-values *\n")
3857 'gdb-var-update-handler-1))
3858 (push 'gdb-var-update gdb-pending-triggers))))
3859
3860(defun gdb-var-update-handler-1 ()
3861 (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist)))
3862 (dolist (var gdb-var-list)
3863 (setcar (nthcdr 5 var) nil))
3864 (let ((temp-var-list gdb-var-list))
3865 (dolist (change changelist)
3866 (let* ((varnum (bindat-get-field change 'name))
3867 (var (assoc varnum gdb-var-list))
3868 (new-num (bindat-get-field change 'new_num_children)))
3869 (when var
3870 (let ((scope (bindat-get-field change 'in_scope))
3871 (has-more (bindat-get-field change 'has_more)))
3872 (cond ((string-equal scope "false")
3873 (if gdb-delete-out-of-scope
3874 (gdb-var-delete-1 var varnum)
3875 (setcar (nthcdr 5 var) 'out-of-scope)))
3876 ((string-equal scope "true")
3877 (setcar (nthcdr 6 var) has-more)
3878 (when (and (or (not has-more)
3879 (string-equal has-more "0"))
3880 (not new-num)
3881 (string-equal (nth 2 var) "0"))
3882 (setcar (nthcdr 4 var)
3883 (bindat-get-field change 'value))
3884 (setcar (nthcdr 5 var) 'changed)))
3885 ((string-equal scope "invalid")
3886 (gdb-var-delete-1 var varnum)))))
3887 (let ((var-list nil) var1
3888 (children (bindat-get-field change 'new_children)))
3889 (if new-num
3890 (progn
3891 (setq var1 (pop temp-var-list))
3892 (while var1
3893 (if (string-equal varnum (car var1))
3894 (let ((new (string-to-number new-num))
3895 (previous (string-to-number (nth 2 var1))))
3896 (setcar (nthcdr 2 var1) new-num)
3897 (push var1 var-list)
3898 (cond ((> new previous)
3899 ;; Add new children to list.
3900 (dotimes (dummy previous)
3901 (push (pop temp-var-list) var-list))
3902 (dolist (child children)
3903 (let ((varchild
3904 (list (bindat-get-field child 'name)
3905 (bindat-get-field child 'exp)
3906 (bindat-get-field child 'numchild)
3907 (bindat-get-field child 'type)
3908 (bindat-get-field child 'value)
3909 'changed
3910 (bindat-get-field child 'has_more))))
3911 (push varchild var-list))))
3912 ;; Remove deleted children from list.
3913 ((< new previous)
3914 (dotimes (dummy new)
3915 (push (pop temp-var-list) var-list))
3916 (dotimes (dummy (- previous new))
3917 (pop temp-var-list)))))
3918 (push var1 var-list))
3919 (setq var1 (pop temp-var-list)))
3920 (setq gdb-var-list (nreverse var-list)))))))))
3921 (setq gdb-pending-triggers
3922 (delq 'gdb-var-update gdb-pending-triggers))
3923 (gdb-speedbar-update))
3924
3925;; Registers buffer.
3926;;
3927(gdb-set-buffer-rules 'gdb-registers-buffer
3928 'gdb-registers-buffer-name
3929 'gdb-registers-mode)
3930
3931(def-gdb-auto-update-trigger gdb-invalidate-registers-1
3932 (gdb-get-buffer 'gdb-registers-buffer)
3933 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3934 "server interpreter mi \"-data-list-register-values x\"\n"
3935 "-data-list-register-values x\n")
3936 gdb-data-list-register-values-handler)
3937
3938(defconst gdb-data-list-register-values-regexp
3939 "{.*?number=\"\\(.*?\\)\".*?,value=\"\\(.*?\\)\".*?}")
3940
3941(defun gdb-data-list-register-values-handler ()
3942 (setq gdb-pending-triggers (delq 'gdb-invalidate-registers-1
3943 gdb-pending-triggers))
3944 (goto-char (point-min))
3945 (if (re-search-forward gdb-error-regexp nil t)
3946 (let ((err (match-string 1)))
3947 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
3948 (let ((buffer-read-only nil))
3949 (erase-buffer)
3950 (put-text-property 0 (length err) 'face font-lock-warning-face err)
3951 (insert err)
3952 (goto-char (point-min)))))
3953 (let ((register-list (reverse gdb-register-names))
3954 (register nil) (register-string nil) (register-values nil))
3955 (goto-char (point-min))
3956 (while (re-search-forward gdb-data-list-register-values-regexp nil t)
3957 (setq register (pop register-list))
3958 (setq register-string (concat register "\t" (match-string 2) "\n"))
3959 (if (member (match-string 1) gdb-changed-registers)
3960 (put-text-property 0 (length register-string)
3961 'face 'font-lock-warning-face
3962 register-string))
3963 (setq register-values
3964 (concat register-values register-string)))
3965 (let ((buf (gdb-get-buffer 'gdb-registers-buffer)))
3966 (with-current-buffer buf
3967 (let* ((window (get-buffer-window buf 0))
3968 (start (window-start window))
3969 (p (if window (window-point window) (point)))
3970 (buffer-read-only nil))
3971 (erase-buffer)
3972 (insert register-values)
3973 (if window
3974 (progn
3975 (set-window-start window start)
3976 (set-window-point window p))
3977 (goto-char p)))))))
3978 (gdb-data-list-register-values-custom))
3979
3980(defun gdb-data-list-register-values-custom ()
3981 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
3982 (save-excursion
3983 (let ((buffer-read-only nil)
3984 start end)
3985 (goto-char (point-min))
3986 (while (< (point) (point-max))
3987 (setq start (line-beginning-position))
3988 (setq end (line-end-position))
3989 (when (looking-at "^[^\t]+")
3990 (unless (string-equal (match-string 0) "No registers.")
3991 (put-text-property start (match-end 0)
3992 'face font-lock-variable-name-face)
3993 (add-text-properties start end
3994 '(help-echo "mouse-2: edit value"
3995 mouse-face highlight))))
3996 (forward-line 1))))))
3997
3998;; Needs GDB 6.4 onwards (used to fail with no stack).
3999(defun gdb-get-changed-registers ()
4000 (if (and (gdb-get-buffer 'gdb-registers-buffer)
4001 (not (member 'gdb-get-changed-registers gdb-pending-triggers)))
4002 (progn
4003 (gdb-enqueue-input
4004 (list
4005 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
4006 "server interpreter mi -data-list-changed-registers\n"
4007 "-data-list-changed-registers\n")
4008 'gdb-get-changed-registers-handler))
4009 (push 'gdb-get-changed-registers gdb-pending-triggers))))
4010
4011(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"")
4012
4013(defun gdb-get-changed-registers-handler ()
4014 (setq gdb-pending-triggers
4015 (delq 'gdb-get-changed-registers gdb-pending-triggers))
4016 (setq gdb-changed-registers nil)
4017 (goto-char (point-min))
4018 (while (re-search-forward gdb-data-list-register-names-regexp nil t)
4019 (push (match-string 1) gdb-changed-registers)))
4020
4021
4022;; Locals buffer.
4023;;
4024;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
4025(gdb-set-buffer-rules 'gdb-locals-buffer
4026 'gdb-locals-buffer-name
4027 'gdb-locals-mode)
4028
4029(def-gdb-auto-update-trigger gdb-invalidate-locals-1
4030 (gdb-get-buffer 'gdb-locals-buffer)
4031 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
4032 "server interpreter mi -\"stack-list-locals --simple-values\"\n"
4033 "-stack-list-locals --simple-values\n")
4034 gdb-stack-list-locals-handler)
4035
4036(defconst gdb-stack-list-locals-regexp
4037 "{.*?name=\"\\(.*?\\)\".*?,type=\"\\(.*?\\)\"")
4038
4039(defvar gdb-locals-watch-map-1
4040 (let ((map (make-sparse-keymap)))
4041 (suppress-keymap map)
4042 (define-key map "\r" 'gud-watch)
4043 (define-key map [mouse-2] 'gud-watch)
4044 map)
4045 "Keymap to create watch expression of a complex data type local variable.")
4046
4047(defvar gdb-edit-locals-map-1
4048 (let ((map (make-sparse-keymap)))
4049 (suppress-keymap map)
4050 (define-key map "\r" 'gdb-edit-locals-value)
4051 (define-key map [mouse-2] 'gdb-edit-locals-value)
4052 map)
4053 "Keymap to edit value of a simple data type local variable.")
4054
4055(defun gdb-edit-locals-value (&optional event)
4056 "Assign a value to a variable displayed in the locals buffer."
4057 (interactive (list last-input-event))
4058 (save-excursion
4059 (if event (posn-set-point (event-end event)))
4060 (beginning-of-line)
4061 (let* ((var (current-word))
4062 (value (read-string (format "New value (%s): " var))))
4063 (gdb-enqueue-input
4064 (list (concat gdb-server-prefix "set variable " var " = " value "\n")
4065 'ignore)))))
4066
4067;; Dont display values of arrays or structures.
4068;; These can be expanded using gud-watch.
4069(defun gdb-stack-list-locals-handler ()
4070 (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1
4071 gdb-pending-triggers))
4072 (goto-char (point-min))
4073 (if (re-search-forward gdb-error-regexp nil t)
4074 (let ((err (match-string 1)))
4075 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
4076 (let ((buffer-read-only nil))
4077 (erase-buffer)
4078 (insert err)
4079 (goto-char (point-min)))))
4080 (let (local locals-list)
4081 (goto-char (point-min))
4082 (while (re-search-forward gdb-stack-list-locals-regexp nil t)
4083 (let ((local (list (match-string 1)
4084 (match-string 2)
4085 nil)))
4086 (if (looking-at ",value=\\(\".*\"\\).*?}")
4087 (setcar (nthcdr 2 local) (read (match-string 1))))
4088 (push local locals-list)))
4089 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
4090 (and buf (with-current-buffer buf
4091 (let* ((window (get-buffer-window buf 0))
4092 (start (window-start window))
4093 (p (if window (window-point window) (point)))
4094 (buffer-read-only nil) (name) (value))
4095 (erase-buffer)
4096 (dolist (local locals-list)
4097 (setq name (car local))
4098 (setq value (nth 2 local))
4099 (if (or (not value)
4100 (string-match "^\\0x" value))
4101 (add-text-properties 0 (length name)
4102 `(mouse-face highlight
4103 help-echo "mouse-2: create watch expression"
4104 local-map ,gdb-locals-watch-map-1)
4105 name)
4106 (add-text-properties 0 (length value)
4107 `(mouse-face highlight
4108 help-echo "mouse-2: edit value"
4109 local-map ,gdb-edit-locals-map-1)
4110 value))
4111 (insert
4112 (concat name "\t" (nth 1 local)
4113 "\t" value "\n")))
4114 (if window
4115 (progn
4116 (set-window-start window start)
4117 (set-window-point window p))
4118 (goto-char p)))))))))
4119
4120(defun gdb-get-register-names ()
4121 "Create a list of register names."
4122 (goto-char (point-min))
4123 (while (re-search-forward gdb-data-list-register-names-regexp nil t)
4124 (push (match-string 1) gdb-register-names)))
4125
4126(provide 'gdb-ui)
4127
4128;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352
4129;;; gdb-ui.el ends here
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 9b8947a616a..5741e4e187a 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -43,8 +43,10 @@
43(require 'comint) 43(require 'comint)
44 44
45(defvar gdb-active-process) 45(defvar gdb-active-process)
46(defvar gdb-recording)
46(defvar gdb-define-alist) 47(defvar gdb-define-alist)
47(defvar gdb-macro-info) 48(defvar gdb-macro-info)
49(defvar gdb-server-prefix)
48(defvar gdb-show-changed-values) 50(defvar gdb-show-changed-values)
49(defvar gdb-source-window) 51(defvar gdb-source-window)
50(defvar gdb-var-list) 52(defvar gdb-var-list)
@@ -124,51 +126,77 @@ Used to grey out relevant toolbar icons.")
124 (throw 'info-found nil)))) 126 (throw 'info-found nil))))
125 nil 0) 127 nil 0)
126 (select-frame (make-frame))) 128 (select-frame (make-frame)))
127 (if (eq gud-minor-mode 'gdbmi) 129 (if (memq gud-minor-mode '(gdbmi gdba))
128 (info "(emacs)GDB Graphical Interface") 130 (info "(emacs)GDB Graphical Interface")
129 (info "(emacs)Debuggers")))) 131 (info "(emacs)Debuggers"))))
130 132
131(defun gud-tool-bar-item-visible-no-fringe () 133(defun gud-tool-bar-item-visible-no-fringe ()
132 (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) 134 (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode)
133 (and (eq gud-minor-mode 'gdbmi) 135 (and (memq gud-minor-mode '(gdbmi gdba))
134 (> (car (window-fringes)) 0))))) 136 (> (car (window-fringes)) 0)))))
135 137
136(declare-function gdb-gud-context-command "gdb-mi.el")
137
138(defun gud-stop-subjob () 138(defun gud-stop-subjob ()
139 (interactive) 139 (interactive)
140 (with-current-buffer gud-comint-buffer 140 (with-current-buffer gud-comint-buffer
141 (cond ((string-equal gud-target-name "emacs") 141 (if (string-equal gud-target-name "emacs")
142 (comint-stop-subjob)) 142 (comint-stop-subjob)
143 ((eq gud-minor-mode 'jdb) 143 (if (eq gud-minor-mode 'jdb)
144 (gud-call "suspend")) 144 (gud-call "suspend")
145 ((eq gud-minor-mode 'gdbmi) 145 (comint-interrupt-subjob)))))
146 (gud-call (gdb-gud-context-command "-exec-interrupt")))
147 (t
148 (comint-interrupt-subjob)))))
149 146
150(easy-mmode-defmap gud-menu-map 147(easy-mmode-defmap gud-menu-map
151 '(([help] "Info (debugger)" . gud-goto-info) 148 '(([help] "Info (debugger)" . gud-goto-info)
149 ([rfinish] menu-item "Reverse Finish Function" gud-rfinish
150 :enable (not gud-running)
151 :visible (and gdb-recording
152 (eq gud-minor-mode 'gdba)))
153 ([rstepi] menu-item "Reverse Step Instruction" gud-rstepi
154 :enable (not gud-running)
155 :visible (and gdb-recording
156 (eq gud-minor-mode 'gdba)))
157 ([rnexti] menu-item "Reverse Next Instruction" gud-rnexti
158 :enable (not gud-running)
159 :visible (and gdb-recording
160 (eq gud-minor-mode 'gdba)))
161 ([rstep] menu-item "Reverse Step Line" gud-rstep
162 :enable (not gud-running)
163 :visible (and gdb-recording
164 (eq gud-minor-mode 'gdba)))
165 ([rnext] menu-item "Reverse Next Line" gud-rnext
166 :enable (not gud-running)
167 :visible (and gdb-recording
168 (eq gud-minor-mode 'gdba)))
169 ([rcont] menu-item "Reverse Continue" gud-rcont
170 :enable (not gud-running)
171 :visible (and gdb-recording
172 (eq gud-minor-mode 'gdba)))
173 ([recstart] menu-item "Start Recording" gdb-toggle-recording-1
174 :visible (and (not gdb-recording)
175 (eq gud-minor-mode 'gdba)))
176 ([recstop] menu-item "Stop Recording" gdb-toggle-recording
177 :visible (and gdb-recording
178 (eq gud-minor-mode 'gdba)))
152 ([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode 179 ([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode
153 :enable (and (not emacs-basic-display) 180 :enable (and (not emacs-basic-display)
154 (display-graphic-p) 181 (display-graphic-p)
155 (fboundp 'x-show-tip)) 182 (fboundp 'x-show-tip))
156 :visible (memq gud-minor-mode 183 :visible (memq gud-minor-mode
157 '(gdbmi dbx sdb xdb pdb)) 184 '(gdbmi gdba dbx sdb xdb pdb))
158 :button (:toggle . gud-tooltip-mode)) 185 :button (:toggle . gud-tooltip-mode))
159 ([refresh] "Refresh" . gud-refresh) 186 ([refresh] "Refresh" . gud-refresh)
160 ([run] menu-item "Run" gud-run 187 ([run] menu-item "Run" gud-run
161 :enable (not gud-running) 188 :enable (not gud-running)
162 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) 189 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
163 ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go 190 ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go
164 :visible (and (eq gud-minor-mode 'gdbmi) 191 :visible (and (not gud-running)
165 (gdb-show-run-p))) 192 (eq gud-minor-mode 'gdba)))
166 ([stop] menu-item "Stop" gud-stop-subjob 193 ([stop] menu-item "Stop" gud-stop-subjob
167 :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) 194 :visible (or (not (memq gud-minor-mode '(gdba pdb)))
168 (gdb-show-stop-p))) 195 (and gud-running
196 (eq gud-minor-mode 'gdba))))
169 ([until] menu-item "Continue to selection" gud-until 197 ([until] menu-item "Continue to selection" gud-until
170 :enable (not gud-running) 198 :enable (not gud-running)
171 :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) 199 :visible (and (memq gud-minor-mode '(gdbmi gdba gdb perldb))
172 (gud-tool-bar-item-visible-no-fringe))) 200 (gud-tool-bar-item-visible-no-fringe)))
173 ([remove] menu-item "Remove Breakpoint" gud-remove 201 ([remove] menu-item "Remove Breakpoint" gud-remove
174 :enable (not gud-running) 202 :enable (not gud-running)
@@ -176,52 +204,50 @@ Used to grey out relevant toolbar icons.")
176 ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak 204 ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
177 :enable (not gud-running) 205 :enable (not gud-running)
178 :visible (memq gud-minor-mode 206 :visible (memq gud-minor-mode
179 '(gdbmi gdb sdb xdb))) 207 '(gdbmi gdba gdb sdb xdb)))
180 ([break] menu-item "Set Breakpoint" gud-break 208 ([break] menu-item "Set Breakpoint" gud-break
181 :enable (not gud-running) 209 :enable (not gud-running)
182 :visible (gud-tool-bar-item-visible-no-fringe)) 210 :visible (gud-tool-bar-item-visible-no-fringe))
183 ([up] menu-item "Up Stack" gud-up 211 ([up] menu-item "Up Stack" gud-up
184 :enable (not gud-running) 212 :enable (not gud-running)
185 :visible (memq gud-minor-mode 213 :visible (memq gud-minor-mode
186 '(gdbmi gdb dbx xdb jdb pdb))) 214 '(gdbmi gdba gdb dbx xdb jdb pdb)))
187 ([down] menu-item "Down Stack" gud-down 215 ([down] menu-item "Down Stack" gud-down
188 :enable (not gud-running) 216 :enable (not gud-running)
189 :visible (memq gud-minor-mode 217 :visible (memq gud-minor-mode
190 '(gdbmi gdb dbx xdb jdb pdb))) 218 '(gdbmi gdba gdb dbx xdb jdb pdb)))
191 ([pp] menu-item "Print S-expression" gud-pp 219 ([pp] menu-item "Print S-expression" gud-pp
192 :enable (and (not gud-running) 220 :enable (and (not gud-running)
193 gdb-active-process) 221 gdb-active-process)
194 :visible (and (string-equal 222 :visible (and (string-equal
195 (buffer-local-value 223 (buffer-local-value
196 'gud-target-name gud-comint-buffer) "emacs") 224 'gud-target-name gud-comint-buffer) "emacs")
197 (eq gud-minor-mode 'gdbmi))) 225 (eq gud-minor-mode 'gdba)))
198 ([print*] menu-item (if (eq gud-minor-mode 'jdb) 226 ([print*] menu-item "Print Dereference" gud-pstar
199 "Dump object"
200 "Print Dereference") gud-pstar
201 :enable (not gud-running) 227 :enable (not gud-running)
202 :visible (memq gud-minor-mode '(gdbmi gdb jdb))) 228 :visible (memq gud-minor-mode '(gdbmi gdba gdb)))
203 ([print] menu-item "Print Expression" gud-print 229 ([print] menu-item "Print Expression" gud-print
204 :enable (not gud-running)) 230 :enable (not gud-running))
205 ([watch] menu-item "Watch Expression" gud-watch 231 ([watch] menu-item "Watch Expression" gud-watch
206 :enable (not gud-running) 232 :enable (not gud-running)
207 :visible (eq gud-minor-mode 'gdbmi)) 233 :visible (memq gud-minor-mode '(gdbmi gdba)))
208 ([finish] menu-item "Finish Function" gud-finish 234 ([finish] menu-item "Finish Function" gud-finish
209 :enable (not gud-running) 235 :enable (not gud-running)
210 :visible (memq gud-minor-mode 236 :visible (memq gud-minor-mode
211 '(gdbmi gdb xdb jdb pdb))) 237 '(gdbmi gdba gdb xdb jdb pdb)))
212 ([stepi] menu-item "Step Instruction" gud-stepi 238 ([stepi] menu-item "Step Instruction" gud-stepi
213 :enable (not gud-running) 239 :enable (not gud-running)
214 :visible (memq gud-minor-mode '(gdbmi gdb dbx))) 240 :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx)))
215 ([nexti] menu-item "Next Instruction" gud-nexti 241 ([nexti] menu-item "Next Instruction" gud-nexti
216 :enable (not gud-running) 242 :enable (not gud-running)
217 :visible (memq gud-minor-mode '(gdbmi gdb dbx))) 243 :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx)))
218 ([step] menu-item "Step Line" gud-step 244 ([step] menu-item "Step Line" gud-step
219 :enable (not gud-running)) 245 :enable (not gud-running))
220 ([next] menu-item "Next Line" gud-next 246 ([next] menu-item "Next Line" gud-next
221 :enable (not gud-running)) 247 :enable (not gud-running))
222 ([cont] menu-item "Continue" gud-cont 248 ([cont] menu-item "Continue" gud-cont
223 :enable (not gud-running) 249 :enable (not gud-running)
224 :visible (not (eq gud-minor-mode 'gdbmi)))) 250 :visible (not (eq gud-minor-mode 'gdba))))
225 "Menu for `gud-mode'." 251 "Menu for `gud-mode'."
226 :name "Gud") 252 :name "Gud")
227 253
@@ -243,22 +269,21 @@ Used to grey out relevant toolbar icons.")
243 . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next)) 269 . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next))
244 ([menu-bar until] menu-item 270 ([menu-bar until] menu-item
245 ,(propertize "until" 'face 'font-lock-doc-face) gud-until 271 ,(propertize "until" 'face 'font-lock-doc-face) gud-until
246 :visible (memq gud-minor-mode '(gdbmi gdb perldb))) 272 :visible (memq gud-minor-mode '(gdbmi gdba gdb perldb)))
247 ([menu-bar cont] menu-item 273 ([menu-bar cont] menu-item
248 ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont 274 ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont
249 :visible (not (eq gud-minor-mode 'gdbmi))) 275 :visible (not (eq gud-minor-mode 'gdba)))
250 ([menu-bar run] menu-item 276 ([menu-bar run] menu-item
251 ,(propertize "run" 'face 'font-lock-doc-face) gud-run 277 ,(propertize "run" 'face 'font-lock-doc-face) gud-run
252 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) 278 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
253 ([menu-bar go] menu-item 279 ([menu-bar go] menu-item
254 ,(propertize " go " 'face 'font-lock-doc-face) gud-go 280 ,(propertize " go " 'face 'font-lock-doc-face) gud-go
255 :visible (and (eq gud-minor-mode 'gdbmi) 281 :visible (and (not gud-running)
256 (gdb-show-run-p))) 282 (eq gud-minor-mode 'gdba)))
257 ([menu-bar stop] menu-item 283 ([menu-bar stop] menu-item
258 ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob 284 ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob
259 :visible (or (and (eq gud-minor-mode 'gdbmi) 285 :visible (and gud-running
260 (gdb-show-stop-p)) 286 (eq gud-minor-mode 'gdba)))
261 (not (eq gud-minor-mode 'gdbmi))))
262 ([menu-bar print] 287 ([menu-bar print]
263 . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) 288 . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print))
264 ([menu-bar tools] . undefined) 289 ([menu-bar tools] . undefined)
@@ -297,6 +322,14 @@ Used to grey out relevant toolbar icons.")
297 (gud-stepi . "gud/stepi") 322 (gud-stepi . "gud/stepi")
298 (gud-up . "gud/up") 323 (gud-up . "gud/up")
299 (gud-down . "gud/down") 324 (gud-down . "gud/down")
325 (gdb-toggle-recording-1 . "gud/recstart")
326 (gdb-toggle-recording . "gud/recstop")
327 (gud-rcont . "gud/rcont")
328 (gud-rnext . "gud/rnext")
329 (gud-rstep . "gud/rstep")
330 (gud-rfinish . "gud/rfinish")
331 (gud-rnexti . "gud/rnexti")
332 (gud-rstepi . "gud/rstepi")
300 (gud-goto-info . "info")) 333 (gud-goto-info . "info"))
301 map) 334 map)
302 (tool-bar-local-item-from-menu 335 (tool-bar-local-item-from-menu
@@ -321,7 +354,7 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
321 (setq directories (cdr directories))) 354 (setq directories (cdr directories)))
322 result))) 355 result)))
323 356
324(declare-function gdb-create-define-alist "gdb-mi" ()) 357(declare-function gdb-create-define-alist "gdb-ui" ())
325 358
326(defun gud-find-file (file) 359(defun gud-find-file (file)
327 ;; Don't get confused by double slashes in the name that comes from GDB. 360 ;; Don't get confused by double slashes in the name that comes from GDB.
@@ -337,7 +370,7 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
337 (set (make-local-variable 'gud-minor-mode) minor-mode) 370 (set (make-local-variable 'gud-minor-mode) minor-mode)
338 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) 371 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
339 (when (and gud-tooltip-mode 372 (when (and gud-tooltip-mode
340 (eq gud-minor-mode 'gdbmi)) 373 (memq gud-minor-mode '(gdbmi gdba)))
341 (make-local-variable 'gdb-define-alist) 374 (make-local-variable 'gdb-define-alist)
342 (unless gdb-define-alist (gdb-create-define-alist)) 375 (unless gdb-define-alist (gdb-create-define-alist))
343 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)) 376 (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
@@ -466,21 +499,21 @@ The value t means that there is no stack, and we are in display-file mode.")
466 499
467(defvar gud-speedbar-menu-items 500(defvar gud-speedbar-menu-items
468 '(["Jump to stack frame" speedbar-edit-line 501 '(["Jump to stack frame" speedbar-edit-line
469 :visible (not (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 502 :visible (not (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
470 'gdbmi))] 503 '(gdbmi gdba)))]
471 ["Edit value" speedbar-edit-line 504 ["Edit value" speedbar-edit-line
472 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 505 :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
473 'gdbmi)] 506 '(gdbmi gdba))]
474 ["Delete expression" gdb-var-delete 507 ["Delete expression" gdb-var-delete
475 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 508 :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
476 'gdbmi)] 509 '(gdbmi gdba))]
477 ["Auto raise frame" gdb-speedbar-auto-raise 510 ["Auto raise frame" gdb-speedbar-auto-raise
478 :style toggle :selected gdb-speedbar-auto-raise 511 :style toggle :selected gdb-speedbar-auto-raise
479 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 512 :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
480 'gdbmi)] 513 '(gdbmi gdba))]
481 ("Output Format" 514 ("Output Format"
482 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 515 :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
483 'gdbmi) 516 '(gdbmi gdba))
484 ["Binary" (gdb-var-set-format "binary") t] 517 ["Binary" (gdb-var-set-format "binary") t]
485 ["Natural" (gdb-var-set-format "natural") t] 518 ["Natural" (gdb-var-set-format "natural") t]
486 ["Hexadecimal" (gdb-var-set-format "hexadecimal") t])) 519 ["Hexadecimal" (gdb-var-set-format "hexadecimal") t]))
@@ -509,7 +542,7 @@ required by the caller."
509 (start (window-start window)) 542 (start (window-start window))
510 (p (window-point window))) 543 (p (window-point window)))
511 (cond 544 (cond
512 ((eq minor-mode 'gdbmi) 545 ((memq minor-mode '(gdbmi gdba))
513 (erase-buffer) 546 (erase-buffer)
514 (insert "Watch Expressions:\n") 547 (insert "Watch Expressions:\n")
515 (let ((var-list gdb-var-list) parent) 548 (let ((var-list gdb-var-list) parent)
@@ -599,7 +632,7 @@ required by the caller."
599 (car frame) 632 (car frame)
600 'speedbar-file-face 633 'speedbar-file-face
601 'speedbar-highlight-face 634 'speedbar-highlight-face
602 (cond ((memq minor-mode '(gdbmi gdb)) 635 (cond ((memq minor-mode '(gdbmi gdba gdb))
603 'gud-gdb-goto-stackframe) 636 'gud-gdb-goto-stackframe)
604 (t (error "Should never be here"))) 637 (t (error "Should never be here")))
605 frame t)))) 638 frame t))))
@@ -656,6 +689,8 @@ The option \"--fullname\" must be included in this value."
656 ;; Set the accumulator to the remaining text. 689 ;; Set the accumulator to the remaining text.
657 gud-marker-acc (substring gud-marker-acc (match-end 0)))) 690 gud-marker-acc (substring gud-marker-acc (match-end 0))))
658 691
692 ;; Check for annotations and change gud-minor-mode to 'gdba if
693 ;; they are found.
659 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) 694 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
660 (let ((match (match-string 1 gud-marker-acc))) 695 (let ((match (match-string 1 gud-marker-acc)))
661 696
@@ -719,10 +754,10 @@ The option \"--fullname\" must be included in this value."
719(defvar gud-filter-pending-text nil 754(defvar gud-filter-pending-text nil
720 "Non-nil means this is text that has been saved for later in `gud-filter'.") 755 "Non-nil means this is text that has been saved for later in `gud-filter'.")
721 756
722;; If in gdb mode, gdb-mi is loaded. 757;; If in gdba mode, gdb-ui is loaded.
723(declare-function gdb-restore-windows "gdb-mi" ()) 758(declare-function gdb-restore-windows "gdb-ui" ())
724 759
725;; The old gdb command (text command mode). The new one is in gdb-mi.el. 760;; The old gdb command (text command mode). The new one is in gdb-ui.el.
726;;;###autoload 761;;;###autoload
727(defun gud-gdb (command-line) 762(defun gud-gdb (command-line)
728 "Run gdb on program FILE in buffer *gud-FILE*. 763 "Run gdb on program FILE in buffer *gud-FILE*.
@@ -733,10 +768,10 @@ directory and source-file directory for your debugger."
733 (when (and gud-comint-buffer 768 (when (and gud-comint-buffer
734 (buffer-name gud-comint-buffer) 769 (buffer-name gud-comint-buffer)
735 (get-buffer-process gud-comint-buffer) 770 (get-buffer-process gud-comint-buffer)
736 (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdbmi))) 771 (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
737 (gdb-restore-windows) 772 (gdb-restore-windows)
738 (error 773 (error
739 "Multiple debugging requires restarting in text command mode")) 774 "Multiple debugging requires restarting in text command mode"))
740 775
741 (gud-common-init command-line nil 'gud-gdb-marker-filter) 776 (gud-common-init command-line nil 'gud-gdb-marker-filter)
742 (set (make-local-variable 'gud-minor-mode) 'gdb) 777 (set (make-local-variable 'gud-minor-mode) 'gdb)
@@ -2607,7 +2642,7 @@ It is saved for when this flag is not set.")
2607(defvar gud-overlay-arrow-position nil) 2642(defvar gud-overlay-arrow-position nil)
2608(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) 2643(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position)
2609 2644
2610(declare-function gdb-reset "gdb-mi" ()) 2645(declare-function gdb-reset "gdb-ui" ())
2611 2646
2612(defun gud-sentinel (proc msg) 2647(defun gud-sentinel (proc msg)
2613 (cond ((null (buffer-name (process-buffer proc))) 2648 (cond ((null (buffer-name (process-buffer proc)))
@@ -2619,14 +2654,14 @@ It is saved for when this flag is not set.")
2619 (string-equal speedbar-initial-expansion-list-name "GUD")) 2654 (string-equal speedbar-initial-expansion-list-name "GUD"))
2620 (speedbar-change-initial-expansion-list 2655 (speedbar-change-initial-expansion-list
2621 speedbar-previously-used-expansion-list-name)) 2656 speedbar-previously-used-expansion-list-name))
2622 (if (eq gud-minor-mode-type 'gdbmi) 2657 (if (memq gud-minor-mode-type '(gdbmi gdba))
2623 (gdb-reset) 2658 (gdb-reset)
2624 (gud-reset))) 2659 (gud-reset)))
2625 ((memq (process-status proc) '(signal exit)) 2660 ((memq (process-status proc) '(signal exit))
2626 ;; Stop displaying an arrow in a source file. 2661 ;; Stop displaying an arrow in a source file.
2627 (setq gud-overlay-arrow-position nil) 2662 (setq gud-overlay-arrow-position nil)
2628 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 2663 (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
2629 'gdbmi) 2664 '(gdba gdbmi))
2630 (gdb-reset) 2665 (gdb-reset)
2631 (gud-reset)) 2666 (gud-reset))
2632 (let* ((obuf (current-buffer))) 2667 (let* ((obuf (current-buffer)))
@@ -2657,9 +2692,7 @@ It is saved for when this flag is not set.")
2657(defun gud-kill-buffer-hook () 2692(defun gud-kill-buffer-hook ()
2658 (setq gud-minor-mode-type gud-minor-mode) 2693 (setq gud-minor-mode-type gud-minor-mode)
2659 (condition-case nil 2694 (condition-case nil
2660 (progn 2695 (kill-process (get-buffer-process (current-buffer)))
2661 (kill-process (get-buffer-process (current-buffer)))
2662 (delete-process (get-process "gdb-inferior")))
2663 (error nil))) 2696 (error nil)))
2664 2697
2665(defun gud-reset () 2698(defun gud-reset ()
@@ -2682,8 +2715,8 @@ Obeying it means displaying in another window the specified file and line."
2682 2715
2683(declare-function global-hl-line-highlight "hl-line" ()) 2716(declare-function global-hl-line-highlight "hl-line" ())
2684(declare-function hl-line-highlight "hl-line" ()) 2717(declare-function hl-line-highlight "hl-line" ())
2685(declare-function gdb-display-source-buffer "gdb-mi" (buffer)) 2718(declare-function gdb-display-source-buffer "gdb-ui" (buffer))
2686(declare-function gdb-display-buffer "gdb-mi" (buf dedicated &optional size)) 2719(declare-function gdb-display-buffer "gdb-ui" (buf dedicated &optional size))
2687 2720
2688;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen 2721;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
2689;; and that its line LINE is visible. 2722;; and that its line LINE is visible.
@@ -2699,7 +2732,7 @@ Obeying it means displaying in another window the specified file and line."
2699 (gud-find-file true-file))) 2732 (gud-find-file true-file)))
2700 (window (and buffer 2733 (window (and buffer
2701 (or (get-buffer-window buffer) 2734 (or (get-buffer-window buffer)
2702 (if (eq gud-minor-mode 'gdbmi) 2735 (if (memq gud-minor-mode '(gdbmi gdba))
2703 (or (if (get-buffer-window buffer 'visible) 2736 (or (if (get-buffer-window buffer 'visible)
2704 (display-buffer buffer nil 'visible)) 2737 (display-buffer buffer nil 'visible))
2705 (unless (gdb-display-source-buffer buffer) 2738 (unless (gdb-display-source-buffer buffer)
@@ -2736,7 +2769,7 @@ Obeying it means displaying in another window the specified file and line."
2736 (goto-char pos)))) 2769 (goto-char pos))))
2737 (when window 2770 (when window
2738 (set-window-point window gud-overlay-arrow-position) 2771 (set-window-point window gud-overlay-arrow-position)
2739 (if (eq gud-minor-mode 'gdbmi) 2772 (if (memq gud-minor-mode '(gdbmi gdba))
2740 (setq gdb-source-window window))))))) 2773 (setq gdb-source-window window)))))))
2741 2774
2742;; The gud-call function must do the right thing whether its invoking 2775;; The gud-call function must do the right thing whether its invoking
@@ -2842,7 +2875,7 @@ Obeying it means displaying in another window the specified file and line."
2842 (forward-line 0)) 2875 (forward-line 0))
2843 (if (looking-at comint-prompt-regexp) 2876 (if (looking-at comint-prompt-regexp)
2844 (set-marker gud-delete-prompt-marker (point))) 2877 (set-marker gud-delete-prompt-marker (point)))
2845 (if (eq gud-minor-mode 'gdbmi) 2878 (if (memq gud-minor-mode '(gdbmi gdba))
2846 (apply comint-input-sender (list proc command)) 2879 (apply comint-input-sender (list proc command))
2847 (process-send-string proc (concat command "\n")))))))) 2880 (process-send-string proc (concat command "\n"))))))))
2848 2881
@@ -3268,14 +3301,14 @@ Treats actions as defuns."
3268 (gud-tooltip-activate-mouse-motions-if-enabled) 3301 (gud-tooltip-activate-mouse-motions-if-enabled)
3269 (if (and gud-comint-buffer 3302 (if (and gud-comint-buffer
3270 (buffer-name gud-comint-buffer); gud-comint-buffer might be killed 3303 (buffer-name gud-comint-buffer); gud-comint-buffer might be killed
3271 (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 3304 (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
3272 'gdbmi)) 3305 '(gdbmi gdba)))
3273 (if gud-tooltip-mode 3306 (if gud-tooltip-mode
3274 (progn 3307 (progn
3275 (dolist (buffer (buffer-list)) 3308 (dolist (buffer (buffer-list))
3276 (unless (eq buffer gud-comint-buffer) 3309 (unless (eq buffer gud-comint-buffer)
3277 (with-current-buffer buffer 3310 (with-current-buffer buffer
3278 (when (and (eq gud-minor-mode 'gdbmi) 3311 (when (and (memq gud-minor-mode '(gdbmi gdba))
3279 (not (string-match "\\`\\*.+\\*\\'" 3312 (not (string-match "\\`\\*.+\\*\\'"
3280 (buffer-name)))) 3313 (buffer-name))))
3281 (make-local-variable 'gdb-define-alist) 3314 (make-local-variable 'gdb-define-alist)
@@ -3400,8 +3433,8 @@ With arg, dereference expr if ARG is positive, otherwise do not derereference."
3400; Larger arrays (say 400 elements) are displayed in 3433; Larger arrays (say 400 elements) are displayed in
3401; the tooltip incompletely and spill over into the gud buffer. 3434; the tooltip incompletely and spill over into the gud buffer.
3402; Switching the process-filter creates timing problems and 3435; Switching the process-filter creates timing problems and
3403; it may be difficult to do better. Using GDB/MI as in 3436; it may be difficult to do better. Using annotations as in
3404; gdb-mi.el gets round this problem. 3437; gdb-ui.el gets round this problem.
3405(defun gud-tooltip-process-output (process output) 3438(defun gud-tooltip-process-output (process output)
3406 "Process debugger output and show it in a tooltip window." 3439 "Process debugger output and show it in a tooltip window."
3407 (set-process-filter process gud-tooltip-original-filter) 3440 (set-process-filter process gud-tooltip-original-filter)
@@ -3411,12 +3444,12 @@ With arg, dereference expr if ARG is positive, otherwise do not derereference."
3411(defun gud-tooltip-print-command (expr) 3444(defun gud-tooltip-print-command (expr)
3412 "Return a suitable command to print the expression EXPR." 3445 "Return a suitable command to print the expression EXPR."
3413 (case gud-minor-mode 3446 (case gud-minor-mode
3414 (gdbmi (concat "-data-evaluate-expression " expr)) 3447 (gdba (concat "server print " expr))
3415 (dbx (concat "print " expr)) 3448 ((dbx gdbmi) (concat "print " expr))
3416 ((xdb pdb) (concat "p " expr)) 3449 ((xdb pdb) (concat "p " expr))
3417 (sdb (concat expr "/")))) 3450 (sdb (concat expr "/"))))
3418 3451
3419(declare-function gdb-input "gdb-mi" (item)) 3452(declare-function gdb-enqueue-input "gdb-ui" (item))
3420(declare-function tooltip-expr-to-print "tooltip" (event)) 3453(declare-function tooltip-expr-to-print "tooltip" (event))
3421(declare-function tooltip-event-buffer "tooltip" (event)) 3454(declare-function tooltip-event-buffer "tooltip" (event))
3422 3455
@@ -3436,12 +3469,12 @@ This function must return nil if it doesn't handle EVENT."
3436 (buffer-name gud-comint-buffer); might be killed 3469 (buffer-name gud-comint-buffer); might be killed
3437 (setq process (get-buffer-process gud-comint-buffer)) 3470 (setq process (get-buffer-process gud-comint-buffer))
3438 (posn-point (event-end event)) 3471 (posn-point (event-end event))
3439 (or (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process)) 3472 (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process))
3440 (progn (setq gud-tooltip-event event) 3473 (progn (setq gud-tooltip-event event)
3441 (eval (cons 'and gud-tooltip-display))))) 3474 (eval (cons 'and gud-tooltip-display)))))
3442 (let ((expr (tooltip-expr-to-print event))) 3475 (let ((expr (tooltip-expr-to-print event)))
3443 (when expr 3476 (when expr
3444 (if (and (eq gud-minor-mode 'gdbmi) 3477 (if (and (eq gud-minor-mode 'gdba)
3445 (not gdb-active-process)) 3478 (not gdb-active-process))
3446 (progn 3479 (progn
3447 (with-current-buffer (tooltip-event-buffer event) 3480 (with-current-buffer (tooltip-event-buffer event)
@@ -3459,13 +3492,13 @@ This function must return nil if it doesn't handle EVENT."
3459 (message-box "Using GUD tooltips in this mode is unsafe\n\ 3492 (message-box "Using GUD tooltips in this mode is unsafe\n\
3460so they have been disabled.")) 3493so they have been disabled."))
3461 (unless (null cmd) ; CMD can be nil if unknown debugger 3494 (unless (null cmd) ; CMD can be nil if unknown debugger
3462 (if (eq gud-minor-mode 'gdbmi) 3495 (if (memq gud-minor-mode '(gdba gdbmi))
3463 (if gdb-macro-info 3496 (if gdb-macro-info
3464 (gdb-input 3497 (gdb-enqueue-input
3465 (list (concat 3498 (list (concat
3466 "server macro expand " expr "\n") 3499 gdb-server-prefix "macro expand " expr "\n")
3467 `(lambda () (gdb-tooltip-print-1 ,expr)))) 3500 `(lambda () (gdb-tooltip-print-1 ,expr))))
3468 (gdb-input 3501 (gdb-enqueue-input
3469 (list (concat cmd "\n") 3502 (list (concat cmd "\n")
3470 `(lambda () (gdb-tooltip-print ,expr))))) 3503 `(lambda () (gdb-tooltip-print ,expr)))))
3471 (setq gud-tooltip-original-filter (process-filter process)) 3504 (setq gud-tooltip-original-filter (process-filter process))