aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNick Roberts2010-03-28 02:27:43 +1300
committerNick Roberts2010-03-28 02:27:43 +1300
commit691cf4a0a2e4805dbfad20644a9748bf3597024a (patch)
tree3d98fd36bd4d24a03b216900676410cdd7b15df8
parent31f191b3a2d314c41a1e48b51615fdfe3fe20260 (diff)
downloademacs-691cf4a0a2e4805dbfad20644a9748bf3597024a.tar.gz
emacs-691cf4a0a2e4805dbfad20644a9748bf3597024a.zip
Restore GDB/MI fuctionality removed by 2009-12-29T07:15:34Z!nickrob@snap.net.nz:
added: lisp/progmodes/gdb-mi.el removed: lisp/progmodes/gdb-ui.el modified: doc/emacs/building.texi doc/emacs/emacs.texi etc/NEWS lisp/Makefile.in lisp/progmodes/gud.el
-rw-r--r--ChangeLog4
-rw-r--r--doc/emacs/building.texi226
-rw-r--r--doc/emacs/emacs.texi18
-rw-r--r--etc/NEWS6
-rw-r--r--lisp/progmodes/gdb-mi.el4192
-rw-r--r--lisp/progmodes/gdb-ui.el4143
-rw-r--r--lisp/progmodes/gud.el204
7 files changed, 4480 insertions, 4313 deletions
diff --git a/ChangeLog b/ChangeLog
index 26a38fedcfa..aab2a0d9755 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
12010-03-27 Nick Roberts <nickrob@snap.net.nz>
2
3 * Restore GDB/MI fuctionality removed by 2009-12-29T07:15:34Z!nickrob@snap.net.nz.
4
12010-03-27 Eli Zaretskii <eliz@gnu.org> 52010-03-27 Eli Zaretskii <eliz@gnu.org>
2 6
3 * config.bat <lib-src>: Edit out lines that begin with several # 7 * config.bat <lib-src>: Edit out lines that begin with several #
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 6dbd5abf026..8637641f9e1 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -853,18 +853,19 @@ use @kbd{M-x gud-gdb}. You need to use text command mode to debug
853multiple programs within one Emacs session. 853multiple programs within one Emacs session.
854 854
855@menu 855@menu
856* GDB-UI Layout:: Control the number of displayed buffers. 856* GDB User Interface Layout:: Control the number of displayed buffers.
857* Source Buffers:: Use the mouse in the fringe/margin to 857* Source Buffers:: Use the mouse in the fringe/margin to
858 control your program. 858 control your program.
859* Breakpoints Buffer:: A breakpoint control panel. 859* Breakpoints Buffer:: A breakpoint control panel.
860* Threads Buffer:: Displays your threads.
860* Stack Buffer:: Select a frame from the call stack. 861* Stack Buffer:: Select a frame from the call stack.
861* Other GDB-UI Buffers:: Input/output, locals, registers, 862* Other GDB Buffers:: Input/output, locals, registers,
862 assembler, threads and memory buffers. 863 assembler, threads and memory buffers.
863* Watch Expressions:: Monitor variable values in the speedbar. 864* Watch Expressions:: Monitor variable values in the speedbar.
864* Reverse Debugging:: Execute and reverse debug your program. 865* Multithreaded Debugging:: Debugging programs with several threads.
865@end menu 866@end menu
866 867
867@node GDB-UI Layout 868@node GDB User Interface Layout
868@subsubsection GDB User Interface Layout 869@subsubsection GDB User Interface Layout
869@cindex GDB User Interface layout 870@cindex GDB User Interface layout
870 871
@@ -1014,10 +1015,92 @@ Visit the source line for the current breakpoint
1014Visit the source line for the breakpoint you click on. 1015Visit the source line for the breakpoint you click on.
1015@end table 1016@end table
1016 1017
1018@vindex gdb-show-threads-by-default
1017When @code{gdb-many-windows} is non-@code{nil}, the breakpoints buffer 1019When @code{gdb-many-windows} is non-@code{nil}, the breakpoints buffer
1018shares its window with the threads buffer. To switch from one to the 1020shares its window with the threads buffer. To switch from one to the
1019other click with @kbd{Mouse-1} on the relevant button in the header 1021other click with @kbd{Mouse-1} on the relevant button in the header
1020line. 1022line. If @code{gdb-show-threads-by-default} is non-@code{nil}, the
1023threads buffer, rather than the breakpoints buffer, is shown at start
1024up.
1025
1026@node Threads Buffer
1027@subsubsection Threads Buffer
1028
1029@findex gdb-select-thread
1030The threads buffer displays a summary of all threads currently in your
1031program (@pxref{Threads, Threads, Debugging programs with multiple
1032threads, gdb, The GNU debugger}). Move point to any thread in the list
1033and press @key{RET} to select it (@code{gdb-select-thread}) and
1034display the associated source in the primary source buffer.
1035Alternatively, click @kbd{Mouse-2} on a thread to select it. Contents
1036of all GDB buffers are updated whenever you select a thread.
1037
1038 You can customize variables under @code{gdb-buffers} group to select
1039fields included in threads buffer.
1040
1041@table @code
1042@item gdb-thread-buffer-verbose-names
1043@vindex gdb-thread-buffer-verbose-names
1044Show long thread names like @samp{Thread 0x4e2ab70 (LWP 1983)} in
1045threads buffer.
1046
1047@item gdb-thread-buffer-arguments
1048@vindex gdb-thread-buffer-arguments
1049Show arguments of thread top frames in threads buffer.
1050
1051@item gdb-thread-buffer-locations
1052@vindex gdb-thread-buffer-locations
1053Show file information or library names in threads buffer.
1054
1055@item gdb-thread-buffer-addresses
1056@vindex gdb-thread-buffer-addresses
1057Show addresses for thread frames in threads buffer.
1058@end table
1059
1060 It’s possible to observe information for several threads
1061simultaneously (in addition to buffers which show information for
1062currently selected thread) using the following keys from the threads
1063buffer.
1064
1065@table @kbd
1066@item d
1067@kindex d @r{(GDB threads buffer)}
1068@findex gdb-display-disassembly-for-thread
1069Display disassembly buffer for the thread at current line.
1070(@code{gdb-display-disassembly-for-thread})
1071
1072@item f
1073@kindex f @r{(GDB threads buffer)}
1074@findex gdb-display-stack-for-thread
1075Display stack buffer for the thread at current line.
1076(@code{gdb-display-stack-for-thread}).
1077
1078@item l
1079@kindex l @r{(GDB threads buffer)}
1080@findex gdb-display-locals-for-thread
1081Display locals buffer for the thread at current line.
1082(@code{gdb-display-locals-for-thread}).
1083
1084@item r
1085@kindex r @r{(GDB threads buffer)}
1086@findex gdb-display-registers-for-thread
1087Display registers buffer for the thread at current line.
1088(@code{gdb-display-registers-for-thread}).
1089@end table
1090
1091Pressing their upper-case counterparts, @kbd{D}, @kbd{F} ,@kbd{L} and
1092@kbd{R} displays the corresponding buffer in a new frame.
1093
1094 When you create a buffer showing information about some specific
1095thread, it becomes bound to that thread and keeps showing actual
1096information while you debug your program. Every GDB buffer contains a
1097number of thread it shows information for in its mode name. Thread
1098number is also included in the buffer name of bound buffers to prevent
1099buffer names clashing.
1100
1101Further commands are available in the threads buffer which depend on the
1102mode of GDB that is used for controlling execution of your program.
1103(@pxref{Multithreaded Debugging, Stopping and Starting Multi-threaded Programs}).
1021 1104
1022@node Stack Buffer 1105@node Stack Buffer
1023@subsubsection Stack Buffer 1106@subsubsection Stack Buffer
@@ -1035,7 +1118,7 @@ that stack frame and type @key{RET} (@code{gdb-frames-select}), or click
1035selecting a stack frame updates it to display the local variables of the 1118selecting a stack frame updates it to display the local variables of the
1036new frame. 1119new frame.
1037 1120
1038@node Other GDB-UI Buffers 1121@node Other GDB Buffers
1039@subsubsection Other Buffers 1122@subsubsection Other Buffers
1040 1123
1041@table @asis 1124@table @asis
@@ -1079,21 +1162,6 @@ arrow points to the current instruction, and you can set and remove
1079breakpoints as in a source buffer. Breakpoint icons also appear in 1162breakpoints as in a source buffer. Breakpoint icons also appear in
1080the fringe or margin. 1163the fringe or margin.
1081 1164
1082@item Threads Buffer
1083@findex gdb-threads-select
1084The threads buffer displays a summary of all threads currently in your
1085program (@pxref{Threads, Threads, Debugging programs with multiple
1086threads, gdb, The GNU debugger}). Move point to any thread in the
1087list and press @key{RET} to select it (@code{gdb-threads-select}) and
1088display the associated source in the primary source buffer.
1089Alternatively, click @kbd{Mouse-2} on a thread to select it. If the
1090locals buffer is visible, its contents update to display the variables
1091that are local in the new thread.
1092
1093When there is more than one main thread and the threads buffer is
1094present, Emacs displays the selected thread number in the mode line of
1095many of the GDB-UI Buffers.
1096
1097@item Memory Buffer 1165@item Memory Buffer
1098The memory buffer lets you examine sections of program memory 1166The memory buffer lets you examine sections of program memory
1099(@pxref{Memory, Memory, Examining memory, gdb, The GNU debugger}). 1167(@pxref{Memory, Memory, Examining memory, gdb, The GNU debugger}).
@@ -1104,9 +1172,9 @@ displays. Alternatively, use @kbd{S} or @kbd{N} respectively. Click
1104size for these data items. 1172size for these data items.
1105@end table 1173@end table
1106 1174
1107When @code{gdb-many-windows} is non-@code{nil}, the threads buffer 1175When @code{gdb-many-windows} is non-@code{nil}, the locals buffer
1108shares its window with the breakpoints buffer, and the locals buffer 1176shares its window with the registers buffer, just like breakpoints
1109with the registers buffer. To switch from one to the other click with 1177and threads buffers. To switch from one to the other click with
1110@kbd{Mouse-1} on the relevant button in the header line. 1178@kbd{Mouse-1} on the relevant button in the header line.
1111 1179
1112@node Watch Expressions 1180@node Watch Expressions
@@ -1175,26 +1243,96 @@ expressions updates, set @code{gdb-speedbar-auto-raise} to
1175non-@code{nil}. This can be useful if you are debugging with a full 1243non-@code{nil}. This can be useful if you are debugging with a full
1176screen Emacs frame. 1244screen Emacs frame.
1177 1245
1178@node Reverse Debugging 1246@node Multithreaded Debugging
1179@subsubsection Reverse Debugging 1247@subsubsection Stopping and Starting Multi-threaded Programs
1180 1248@cindex Multithreaded debugging in GDB
1181 The GDB tool bar shares many buttons with the other GUD debuggers 1249
1182for tasks like stepping and printing expressions. It also has a 1250@subsubheading All-stop Debugging
1183further set of buttons that allow reverse debugging (@pxref{Process 1251
1184Record and Replay, , ,gdb, The GNU debugger}). This is useful when it 1252In all-stop mode, whenever your program stops, @emph{all} threads of
1185takes a long time to reproduce the conditions where your program fails 1253execution stop. Likewise, whenever you restart the program, all
1186or for transient problems, like race conditions in multi-threaded 1254threads start executing. @xref{All-Stop Mode, , All-Stop Mode, gdb,
1187programs, where a failure might otherwise be hard to reproduce. 1255The GNU debugger}. You can enable this behaviour in Emacs by setting
1188 1256@code{gdb-non-stop-setting} to @code{nil} before starting a debugging
1189To use reverse debugging, set a breakpoint slightly before the 1257session.
1190location of interest and run your program to that point. Enable 1258
1191process recording by clicking on the record button. At this point, a 1259@subsubheading Non-stop Debugging
1192new set of buttons appear. These buttons allow program execution in 1260@cindex Non-stop debugging in GDB
1193the reverse direction. Run your program over the code where the 1261
1194problem occurs, and then use the new set of buttons to retrace your 1262For some multi-threaded targets, GDB supports a further mode of
1195steps, examine values, and analyze the problem. When analysis is 1263operation in which you can examine stopped program threads in the
1196complete, turn off process recording by clicking on the record button 1264debugger while other threads continue to execute freely.
1197again. 1265@xref{Non-Stop Mode, , Non-Stop Mode, gdb, The GNU debugger}.
1266This is referred to as @dfn{non-stop} mode.
1267
1268Versions of GDB prior to 7.0 do not support non-stop mode and it does
1269not work on all targets. In such cases, Emacs uses all-stop mode
1270regardless of the value of @code{gdb-non-stop-setting}.
1271
1272@vindex gdb-non-stop-setting
1273If the variable @code{gdb-non-stop-setting} is non-@code{nil} (the
1274default value), Emacs tries to start GDB in non-stop mode. Note that
1275GDB debugging session needs to be restarted for change of this setting
1276to take effect.
1277
1278@vindex gdb-switch-when-another-stopped
1279When a thread stops in non-stop mode, Emacs automatically switches to
1280that thread. It may be undesirable to allow switching of current
1281thread when some other stopped thread is already selected. Set
1282@code{gdb-switch-when-another-stopped} to @code{nil} to prevent this.
1283
1284@vindex gdb-switch-reasons
1285Emacs can decide whether or not to switch to the stopped thread
1286depending on the reason which caused the stop. Customize
1287@code{gdb-switch-reasons} to select stop reasons which make Emacs
1288switch thread.
1289
1290@vindex gdb-stopped-hooks
1291The variable @code{gdb-stopped-hooks} allows you to execute your
1292functions whenever some thread stops.
1293
1294 In non-stop mode, you can switch between different modes for GUD
1295execution control commands.
1296
1297@vindex gdb-gud-control-all-threads
1298@table @dfn
1299@item Non-stop/A
1300
1301When @code{gdb-gud-control-all-threads} is @code{t} (the default
1302value), interruption and continuation commands apply to all threads,
1303so you can halt or continue all your threads with one command using
1304@code{gud-stop-subjob} and @code{gud-cont}, respectively. The
1305@samp{Go} button is shown on the toolbar when at least one thread is
1306stopped, whereas @samp{Stop} button is shown when at least one thread
1307is running.
1308
1309@item Non-stop/T
1310
1311When @code{gdb-gud-control-all-threads} is @code{nil}, only the
1312current thread is stopped/continued. @samp{Go} and @samp{Stop}
1313buttons on the GUD toolbar are shown depending on the state of current
1314thread.
1315@end table
1316
1317You can change the current value of @code{gdb-gud-control-all-threads}
1318from the tool bar or from @samp{GUD->GDB-MI} menu.
1319
1320 Stepping commands always apply to the current thread.
1321
1322@subsubheading Fine Thread Control
1323
1324 In non-stop mode, you can interrupt/continue your threads without
1325selecting them. Hitting @kbd{i} in threads buffer interrupts thread
1326under point, @kbd{c} continues it, @kbd{s} steps through. More such
1327commands may be added in the future.
1328
1329Combined with creating bound buffers for any thread, this allows you
1330to change and track state of many threads in the same time.
1331
1332 Note that when you interrupt a thread, it stops with @samp{signal
1333received} reason. If that reason is included in your
1334@code{gdb-switch-reasons} (it is by default), Emacs will switch to
1335that thread.
1198 1336
1199@node Executing Lisp 1337@node Executing Lisp
1200@section Executing Lisp Expressions 1338@section Executing Lisp Expressions
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 7e8c2052d94..b77863e366b 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -746,14 +746,16 @@ Running Debuggers Under Emacs
746 746
747GDB Graphical Interface 747GDB Graphical Interface
748 748
749* GDB-UI Layout:: Control the number of displayed buffers. 749* GDB-UI Layout:: Control the number of displayed buffers.
750* Source Buffers:: Use the mouse in the fringe/margin to 750* Source Buffers:: Use the mouse in the fringe/margin to
751 control your program. 751 control your program.
752* Breakpoints Buffer:: A breakpoint control panel. 752* Breakpoints Buffer:: A breakpoint control panel.
753* Stack Buffer:: Select a frame from the call stack. 753* Threads Buffer:: Displays your threads.
754* Other GDB-UI Buffers::Input/output, locals, registers, 754* Stack Buffer:: Select a frame from the call stack.
755 assembler, threads and memory buffers. 755* Other GDB-UI Buffers:: Input/output, locals, registers,
756* Watch Expressions:: Monitor variable values in the speedbar. 756 assembler, threads and memory buffers.
757* Watch Expressions:: Monitor variable values in the speedbar.
758* Multithreaded Debugging:: Debugging programs with several threads.
757 759
758Maintaining Large Programs 760Maintaining Large Programs
759 761
diff --git a/etc/NEWS b/etc/NEWS
index 5bc053a69c7..1518f9ffc0c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -82,6 +82,12 @@ buffers.
82** s-region.el is now declared obsolete, superceded by shift-select-mode 82** s-region.el is now declared obsolete, superceded by shift-select-mode
83enabled by default in 23.1. 83enabled by default in 23.1.
84 84
85** gdb-mi
86
87*** GDB User Interface migrated to GDB Machine Interface and now
88supports multithread non-stop debugging and debugging of several
89threads simultaneously.
90
85 91
86* New Modes and Packages in Emacs 24.1 92* New Modes and Packages in Emacs 24.1
87 93
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
new file mode 100644
index 00000000000..0f9532dcb3e
--- /dev/null
+++ b/lisp/progmodes/gdb-mi.el
@@ -0,0 +1,4192 @@
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
deleted file mode 100644
index 9c4f8b4dd58..00000000000
--- a/lisp/progmodes/gdb-ui.el
+++ /dev/null
@@ -1,4143 +0,0 @@
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, 2010
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.
144Only used for files that Emacs 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(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default))
856
857(defun gdb-var-create-handler (expr)
858 (let* ((result (gdb-json-partial-output)))
859 (if (not (bindat-get-field result 'msg))
860 (let ((var
861 (list (bindat-get-field result 'name)
862 (if (and (string-equal gdb-current-language "c")
863 gdb-use-colon-colon-notation gdb-selected-frame)
864 (setq expr (concat gdb-selected-frame "::" expr))
865 expr)
866 (bindat-get-field result 'numchild)
867 (bindat-get-field result 'type)
868 (bindat-get-field result 'value)
869 nil
870 (bindat-get-field result 'has_more)
871 gdb-frame-address)))
872 (push var gdb-var-list)
873 (speedbar 1)
874 (unless (string-equal
875 speedbar-initial-expansion-list-name "GUD")
876 (speedbar-change-initial-expansion-list "GUD")))
877 (message-box "No symbol \"%s\" in current context." expr))))
878
879(declare-function speedbar-timer-fn "speedbar" ())
880
881(defun gdb-speedbar-update ()
882 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
883 (not (member 'gdb-speedbar-timer gdb-pending-triggers)))
884 ;; Dummy command to update speedbar even when idle.
885 (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))
886 ;; Keep gdb-pending-triggers non-nil till end.
887 (push 'gdb-speedbar-timer gdb-pending-triggers)))
888
889(defun gdb-speedbar-timer-fn ()
890 (if gdb-speedbar-auto-raise
891 (raise-frame speedbar-frame))
892 (setq gdb-pending-triggers
893 (delq 'gdb-speedbar-timer gdb-pending-triggers))
894 (speedbar-timer-fn))
895
896(defun gdb-var-evaluate-expression-handler (varnum changed)
897 (goto-char (point-min))
898 (re-search-forward "\\(.+\\)\\^done,value=\\(\".*\"\\)" nil t)
899 (setq gdb-pending-triggers
900 (delq (string-to-number (match-string 1)) gdb-pending-triggers))
901 (let ((var (assoc varnum gdb-var-list)))
902 (when var
903 (if changed (setcar (nthcdr 5 var) 'changed))
904 (setcar (nthcdr 4 var) (read (match-string 2)))))
905 (gdb-speedbar-update))
906
907(defun gdb-var-list-children (varnum)
908 (gdb-enqueue-input
909 (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n")
910 `(lambda () (gdb-var-list-children-handler ,varnum)))))
911
912(defconst gdb-var-list-children-regexp
913 "child={.*?name=\"\\(.*?\\)\".*?,exp=\"\\(.*?\\)\".*?,\
914numchild=\"\\(.*?\\)\"\\(}\\|.*?,\\(type=\"\\(.*?\\)\"\\)?.*?}\\)")
915
916(defun gdb-var-list-children-handler (varnum)
917 (goto-char (point-min))
918 (let ((var-list nil))
919 (catch 'child-already-watched
920 (dolist (var gdb-var-list)
921 (if (string-equal varnum (car var))
922 (progn
923 (push var var-list)
924 (while (re-search-forward gdb-var-list-children-regexp nil t)
925 (let ((varchild (list (match-string 1)
926 (match-string 2)
927 (match-string 3)
928 (match-string 6)
929 nil nil)))
930 (if (assoc (car varchild) gdb-var-list)
931 (throw 'child-already-watched nil))
932 (push varchild var-list)
933 (gdb-enqueue-input
934 (list
935 (concat
936 "server interpreter mi \"0-var-evaluate-expression "
937 (car varchild) "\"\n")
938 `(lambda () (gdb-var-evaluate-expression-handler
939 ,(car varchild) nil)))))))
940 (push var var-list)))
941 (setq gdb-var-list (nreverse var-list)))))
942
943(defun gdb-var-update ()
944 (when (not (member 'gdb-var-update gdb-pending-triggers))
945 (gdb-enqueue-input
946 (list "server interpreter mi \"-var-update *\"\n"
947 'gdb-var-update-handler))
948 (push 'gdb-var-update gdb-pending-triggers)))
949
950(defconst gdb-var-update-regexp
951 "{.*?name=\"\\(.*?\\)\".*?,in_scope=\"\\(.*?\\)\".*?,\
952type_changed=\".*?\".*?}")
953
954(defun gdb-var-update-handler ()
955 (dolist (var gdb-var-list)
956 (setcar (nthcdr 5 var) nil))
957 (goto-char (point-min))
958 (let ((n 0))
959 (while (re-search-forward gdb-var-update-regexp nil t)
960 (let ((varnum (match-string 1)))
961 (if (string-equal (match-string 2) "false")
962 (let ((var (assoc varnum gdb-var-list)))
963 (if var (setcar (nthcdr 5 var) 'out-of-scope)))
964 (setq n (1+ n))
965 (push n gdb-pending-triggers)
966 (gdb-enqueue-input
967 (list
968 (concat "server interpreter mi \"" (number-to-string n)
969 "-var-evaluate-expression " varnum "\"\n")
970 `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))))))
971 (setq gdb-pending-triggers
972 (delq 'gdb-var-update gdb-pending-triggers)))
973
974(defun gdb-var-set-format (format)
975 "Set the output format for a variable displayed in the speedbar."
976 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
977 (varnum (car var)))
978 (gdb-enqueue-input
979 (list
980 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
981 (concat "server interpreter mi \"-var-set-format "
982 varnum " " format "\"\n")
983 (concat "-var-set-format " varnum " " format "\n"))
984 `(lambda () (gdb-var-set-format-handler ,varnum))))))
985
986(defconst gdb-var-set-format-regexp
987 "format=\"\\(.*?\\)\",.*value=\"\\(.*?\\)\"")
988
989(defun gdb-var-set-format-handler (varnum)
990 (goto-char (point-min))
991 (if (re-search-forward gdb-var-set-format-regexp nil t)
992 (let ((var (assoc varnum gdb-var-list)))
993 (setcar (nthcdr 4 var) (match-string 2))
994 (gdb-var-update-1))))
995
996(defun gdb-var-delete-1 (var varnum)
997 (gdb-enqueue-input
998 (list
999 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1000 (concat "server interpreter mi \"-var-delete " varnum "\"\n")
1001 (concat "-var-delete " varnum "\n"))
1002 'ignore))
1003 (setq gdb-var-list (delq var gdb-var-list))
1004 (dolist (varchild gdb-var-list)
1005 (if (string-match (concat (car var) "\\.") (car varchild))
1006 (setq gdb-var-list (delq varchild gdb-var-list)))))
1007
1008(defun gdb-var-delete ()
1009 "Delete watch expression at point from the speedbar."
1010 (interactive)
1011 (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
1012 '(gdbmi gdba))
1013 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1014 (varnum (car var)))
1015 (if (string-match "\\." (car var))
1016 (message-box "Can only delete a root expression")
1017 (gdb-var-delete-1 var varnum)))))
1018
1019(defun gdb-var-delete-children (varnum)
1020 "Delete children of variable object at point from the speedbar."
1021 (gdb-enqueue-input
1022 (list
1023 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1024 (concat "server interpreter mi \"-var-delete -c " varnum "\"\n")
1025 (concat "-var-delete -c " varnum "\n")) 'ignore)))
1026
1027(defun gdb-edit-value (text token indent)
1028 "Assign a value to a variable displayed in the speedbar."
1029 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1030 (varnum (car var)) (value))
1031 (setq value (read-string "New value: "))
1032 (gdb-enqueue-input
1033 (list
1034 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1035 (concat "server interpreter mi \"-var-assign "
1036 varnum " " value "\"\n")
1037 (concat "-var-assign " varnum " " value "\n"))
1038 `(lambda () (gdb-edit-value-handler ,value))))))
1039
1040(defun gdb-edit-value-handler (value)
1041 (goto-char (point-min))
1042 (if (re-search-forward gdb-error-regexp nil t)
1043 (message-box "Invalid number or expression (%s)" value)))
1044
1045(defcustom gdb-show-changed-values t
1046 "If non-nil change the face of out of scope variables and changed values.
1047Out of scope variables are suppressed with `shadow' face.
1048Changed values are highlighted with the face `font-lock-warning-face'."
1049 :type 'boolean
1050 :group 'gdb
1051 :version "22.1")
1052
1053(defcustom gdb-max-children 40
1054 "Maximum number of children before expansion requires confirmation."
1055 :type 'integer
1056 :group 'gdb
1057 :version "22.1")
1058
1059(defcustom gdb-delete-out-of-scope t
1060 "If non-nil delete watch expressions automatically when they go out of scope."
1061 :type 'boolean
1062 :group 'gdb
1063 :version "22.2")
1064
1065(declare-function speedbar-change-expand-button-char "speedbar" (char))
1066(declare-function speedbar-delete-subblock "speedbar" (indent))
1067(declare-function speedbar-center-buffer-smartly "speedbar" ())
1068
1069(defun gdb-speedbar-expand-node (text token indent)
1070 "Expand the node the user clicked on.
1071TEXT is the text of the button we clicked on, a + or - item.
1072TOKEN is data related to this node.
1073INDENT is the current indentation depth."
1074 (if (and gud-comint-buffer (buffer-name gud-comint-buffer))
1075 (progn
1076 (cond ((string-match "+" text) ;expand this node
1077 (let* ((var (assoc token gdb-var-list))
1078 (expr (nth 1 var)) (children (nth 2 var)))
1079 (if (or (<= (string-to-number children) gdb-max-children)
1080 (y-or-n-p
1081 (format
1082 "%s has %s children. Continue? " expr children)))
1083 (if (and (eq (buffer-local-value
1084 'gud-minor-mode gud-comint-buffer) 'gdba)
1085 (string-equal gdb-version "pre-6.4"))
1086 (gdb-var-list-children token)
1087 (gdb-var-list-children-1 token)))))
1088 ((string-match "-" text) ;contract this node
1089 (dolist (var gdb-var-list)
1090 (if (string-match (concat token "\\.") (car var))
1091 (setq gdb-var-list (delq var gdb-var-list))))
1092 (gdb-var-delete-children token)
1093 (speedbar-change-expand-button-char ?+)
1094 (speedbar-delete-subblock indent))
1095 (t (error "Ooops... not sure what to do")))
1096 (speedbar-center-buffer-smartly))
1097 (message-box "GUD session has been killed")))
1098
1099(defun gdb-get-target-string ()
1100 (with-current-buffer gud-comint-buffer
1101 gud-target-name))
1102
1103
1104;;
1105;; gdb buffers.
1106;;
1107;; Each buffer has a TYPE -- a symbol that identifies the function
1108;; of that particular buffer.
1109;;
1110;; The usual gdb interaction buffer is given the type `gdba' and
1111;; is constructed specially.
1112;;
1113;; Others are constructed by gdb-get-buffer-create and
1114;; named according to the rules set forth in the gdb-buffer-rules-assoc
1115
1116(defvar gdb-buffer-rules-assoc '())
1117
1118(defun gdb-get-buffer (key)
1119 "Return the gdb buffer tagged with type KEY.
1120The key should be one of the cars in `gdb-buffer-rules-assoc'."
1121 (save-excursion
1122 (gdb-look-for-tagged-buffer key (buffer-list))))
1123
1124(defun gdb-get-buffer-create (key)
1125 "Create a new gdb buffer of the type specified by KEY.
1126The key should be one of the cars in `gdb-buffer-rules-assoc'."
1127 (or (gdb-get-buffer key)
1128 (let* ((rules (assoc key gdb-buffer-rules-assoc))
1129 (name (funcall (gdb-rules-name-maker rules)))
1130 (new (get-buffer-create name)))
1131 (with-current-buffer new
1132 (let ((trigger))
1133 (if (cdr (cdr rules))
1134 (setq trigger (funcall (car (cdr (cdr rules))))))
1135 (setq gdb-buffer-type key)
1136 (set (make-local-variable 'gud-minor-mode)
1137 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
1138 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1139 (if trigger (funcall trigger)))
1140 new))))
1141
1142(defun gdb-rules-name-maker (rules) (car (cdr rules)))
1143
1144(defun gdb-look-for-tagged-buffer (key bufs)
1145 (let ((retval nil))
1146 (while (and (not retval) bufs)
1147 (set-buffer (car bufs))
1148 (if (eq gdb-buffer-type key)
1149 (setq retval (car bufs)))
1150 (setq bufs (cdr bufs)))
1151 retval))
1152
1153;;
1154;; This assoc maps buffer type symbols to rules. Each rule is a list of
1155;; at least one and possible more functions. The functions have these
1156;; roles in defining a buffer type:
1157;;
1158;; NAME - Return a name for this buffer type.
1159;;
1160;; The remaining function(s) are optional:
1161;;
1162;; MODE - called in a new buffer with no arguments, should establish
1163;; the proper mode for the buffer.
1164;;
1165
1166(defun gdb-set-buffer-rules (buffer-type &rest rules)
1167 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc)))
1168 (if binding
1169 (setcdr binding rules)
1170 (push (cons buffer-type rules)
1171 gdb-buffer-rules-assoc))))
1172
1173;; GUD buffers are an exception to the rules
1174(gdb-set-buffer-rules 'gdba 'error)
1175
1176;; Partial-output buffer : This accumulates output from a command executed on
1177;; behalf of emacs (rather than the user).
1178;;
1179(gdb-set-buffer-rules 'gdb-partial-output-buffer
1180 'gdb-partial-output-name)
1181
1182(defun gdb-partial-output-name ()
1183 (concat " *partial-output-"
1184 (gdb-get-target-string)
1185 "*"))
1186
1187
1188(gdb-set-buffer-rules 'gdb-inferior-io
1189 'gdb-inferior-io-name
1190 'gdb-inferior-io-mode)
1191
1192(defun gdb-inferior-io-name ()
1193 (concat "*input/output of "
1194 (gdb-get-target-string)
1195 "*"))
1196
1197(defun gdb-display-separate-io-buffer ()
1198 "Display IO of debugged program in a separate window."
1199 (interactive)
1200 (if gdb-use-separate-io-buffer
1201 (gdb-display-buffer
1202 (gdb-get-buffer-create 'gdb-inferior-io) t)))
1203
1204(defconst gdb-frame-parameters
1205 '((height . 14) (width . 80)
1206 (unsplittable . t)
1207 (tool-bar-lines . nil)
1208 (menu-bar-lines . nil)
1209 (minibuffer . nil)))
1210
1211(defun gdb-frame-separate-io-buffer ()
1212 "Display IO of debugged program in a new frame."
1213 (interactive)
1214 (if gdb-use-separate-io-buffer
1215 (let ((special-display-regexps (append special-display-regexps '(".*")))
1216 (special-display-frame-alist gdb-frame-parameters))
1217 (display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))))
1218
1219(defvar gdb-inferior-io-mode-map
1220 (let ((map (make-sparse-keymap)))
1221 (define-key map "\C-c\C-c" 'gdb-separate-io-interrupt)
1222 (define-key map "\C-c\C-z" 'gdb-separate-io-stop)
1223 (define-key map "\C-c\C-\\" 'gdb-separate-io-quit)
1224 (define-key map "\C-c\C-d" 'gdb-separate-io-eof)
1225 (define-key map "\C-d" 'gdb-separate-io-eof)
1226 map))
1227
1228(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
1229 "Major mode for gdb inferior-io."
1230 :syntax-table nil :abbrev-table nil
1231 ;; We want to use comint because it has various nifty and familiar
1232 ;; features. We don't need a process, but comint wants one, so create
1233 ;; a dummy one.
1234 (make-comint-in-buffer
1235 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
1236 (current-buffer) "hexl")
1237 (setq comint-input-sender 'gdb-inferior-io-sender))
1238
1239(defun gdb-inferior-io-sender (proc string)
1240 ;; PROC is the pseudo-process created to satisfy comint.
1241 (with-current-buffer (process-buffer proc)
1242 (setq proc (get-buffer-process gud-comint-buffer))
1243 (process-send-string proc string)
1244 (process-send-string proc "\n")))
1245
1246(defun gdb-separate-io-interrupt ()
1247 "Interrupt the program being debugged."
1248 (interactive)
1249 (interrupt-process
1250 (get-buffer-process gud-comint-buffer) comint-ptyp))
1251
1252(defun gdb-separate-io-quit ()
1253 "Send quit signal to the program being debugged."
1254 (interactive)
1255 (quit-process
1256 (get-buffer-process gud-comint-buffer) comint-ptyp))
1257
1258(defun gdb-separate-io-stop ()
1259 "Stop the program being debugged."
1260 (interactive)
1261 (stop-process
1262 (get-buffer-process gud-comint-buffer) comint-ptyp))
1263
1264(defun gdb-separate-io-eof ()
1265 "Send end-of-file to the program being debugged."
1266 (interactive)
1267 (process-send-eof
1268 (get-buffer-process gud-comint-buffer)))
1269
1270
1271;; gdb communications
1272;;
1273
1274;; INPUT: things sent to gdb
1275;;
1276;; The queues are lists. Each element is either a string (indicating user or
1277;; user-like input) or a list of the form:
1278;;
1279;; (INPUT-STRING HANDLER-FN)
1280;;
1281;; The handler function will be called from the partial-output buffer when the
1282;; command completes. This is the way to write commands which invoke gdb
1283;; commands autonomously.
1284;;
1285;; These lists are consumed tail first.
1286;;
1287
1288(defun gdb-send (proc string)
1289 "A comint send filter for gdb.
1290This filter may simply queue input for a later time."
1291 (if gdb-ready
1292 (progn
1293 (with-current-buffer gud-comint-buffer
1294 (let ((inhibit-read-only t))
1295 (remove-text-properties (point-min) (point-max) '(face))))
1296 (if gud-running
1297 (progn
1298 (let ((item (concat string "\n")))
1299 (if gdb-enable-debug (push (cons 'send item) gdb-debug-log))
1300 (process-send-string proc item)))
1301 (if (string-match "\\\\\\'" string)
1302 (setq gdb-continuation (concat gdb-continuation string "\n"))
1303 (let ((item (concat
1304 gdb-continuation string
1305 (if (not comint-input-sender-no-newline) "\n"))))
1306 (gdb-enqueue-input item)
1307 (setq gdb-continuation nil)))))
1308 (push (concat string "\n") gdb-early-user-input)))
1309
1310;; Note: Stuff enqueued here will be sent to the next prompt, even if it
1311;; is a query, or other non-top-level prompt.
1312
1313(defun gdb-enqueue-input (item)
1314 (if (not gud-running)
1315 (if gdb-prompting
1316 (progn
1317 (gdb-send-item item)
1318 (setq gdb-prompting nil))
1319 (push item gdb-input-queue))))
1320
1321(defun gdb-dequeue-input ()
1322 (let ((queue gdb-input-queue))
1323 (if queue
1324 (let ((last (car (last queue))))
1325 (unless (nbutlast queue) (setq gdb-input-queue '()))
1326 last)
1327 ;; This should be nil here anyway but set it just to make sure.
1328 (setq gdb-pending-triggers nil))))
1329
1330(defun gdb-send-item (item)
1331 (setq gdb-flush-pending-output nil)
1332 (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log))
1333 (setq gdb-current-item item)
1334 (let ((process (get-buffer-process gud-comint-buffer)))
1335 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1336 (if (stringp item)
1337 (progn
1338 (setq gdb-output-sink 'user)
1339 (process-send-string process item))
1340 (progn
1341 (gdb-clear-partial-output)
1342 (setq gdb-output-sink 'pre-emacs)
1343 (process-send-string process
1344 (car item))))
1345 ;; case: eq gud-minor-mode 'gdbmi
1346 (gdb-clear-partial-output)
1347 (setq gdb-output-sink 'emacs)
1348 (process-send-string process (car item)))))
1349
1350;;
1351;; output -- things gdb prints to emacs
1352;;
1353;; GDB output is a stream interrupted by annotations.
1354;; Annotations can be recognized by their beginning
1355;; with \C-j\C-z\C-z<tag><opt>\C-j
1356;;
1357;; The tag is a string obeying symbol syntax.
1358;;
1359;; The optional part `<opt>' can be either the empty string
1360;; or a space followed by more data relating to the annotation.
1361;; For example, the SOURCE annotation is followed by a filename,
1362;; line number and various useless goo. This data must not include
1363;; any newlines.
1364;;
1365
1366(defcustom gud-gdb-command-name "gdb --annotate=3"
1367 "Default command to execute an executable under the GDB debugger.
1368The option \"--annotate=3\" must be included in this value if you
1369want the GDB Graphical Interface."
1370 :type 'string
1371 :group 'gud
1372 :version "22.1")
1373
1374(defvar gdb-annotation-rules
1375 '(("pre-prompt" gdb-pre-prompt)
1376 ("prompt" gdb-prompt)
1377 ("commands" gdb-subprompt)
1378 ("overload-choice" gdb-subprompt)
1379 ("query" gdb-subprompt)
1380 ;; Need this prompt for GDB 6.1
1381 ("nquery" gdb-subprompt)
1382 ("prompt-for-continue" gdb-subprompt)
1383 ("post-prompt" gdb-post-prompt)
1384 ("source" gdb-source)
1385 ("starting" gdb-starting)
1386 ("exited" gdb-exited)
1387 ("signalled" gdb-signalled)
1388 ("signal" gdb-signal)
1389 ("breakpoint" gdb-stopping)
1390 ("watchpoint" gdb-stopping)
1391 ("frame-begin" gdb-frame-begin)
1392 ("stopped" gdb-stopped)
1393 ("error-begin" gdb-error)
1394 ("error" gdb-error)
1395 ("new-thread" (lambda (ignored)
1396 (gdb-get-buffer-create 'gdb-threads-buffer)))
1397 ("thread-changed" gdb-thread-changed))
1398 "An assoc mapping annotation tags to functions which process them.")
1399
1400(defun gdb-resync()
1401 (setq gdb-flush-pending-output t)
1402 (setq gud-running nil)
1403 (gdb-force-mode-line-update
1404 (propertize "stopped" 'face font-lock-warning-face))
1405 (setq gdb-output-sink 'user)
1406 (setq gdb-input-queue nil)
1407 (setq gdb-pending-triggers nil)
1408 (setq gdb-prompting t))
1409
1410(defconst gdb-source-spec-regexp
1411 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x0*\\([a-f0-9]*\\)")
1412
1413;; Do not use this except as an annotation handler.
1414(defun gdb-source (args)
1415 (string-match gdb-source-spec-regexp args)
1416 ;; Extract the frame position from the marker.
1417 (setq gud-last-frame
1418 (cons
1419 (match-string 1 args)
1420 (string-to-number (match-string 2 args))))
1421 (setq gdb-pc-address (match-string 3 args))
1422 ;; cover for auto-display output which comes *before*
1423 ;; stopped annotation
1424 (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user)))
1425
1426(defun gdb-pre-prompt (ignored)
1427 "An annotation handler for `pre-prompt'.
1428This terminates the collection of output from a previous command if that
1429happens to be in effect."
1430 (setq gdb-error nil)
1431 (let ((sink gdb-output-sink))
1432 (cond
1433 ((eq sink 'user) t)
1434 ((eq sink 'emacs)
1435 (setq gdb-output-sink 'post-emacs))
1436 (t
1437 (gdb-resync)
1438 (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
1439
1440(defun gdb-prompt (ignored)
1441 "An annotation handler for `prompt'.
1442This sends the next command (if any) to gdb."
1443 (when gdb-first-prompt
1444 (gdb-force-mode-line-update
1445 (propertize "initializing..." 'face font-lock-variable-name-face))
1446 (gdb-init-1)
1447 (setq gdb-first-prompt nil))
1448 (let ((sink gdb-output-sink))
1449 (cond
1450 ((eq sink 'user) t)
1451 ((eq sink 'post-emacs)
1452 (setq gdb-output-sink 'user)
1453 (let ((handler
1454 (car (cdr gdb-current-item))))
1455 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1456 (funcall handler))))
1457 (t
1458 (gdb-resync)
1459 (error "Phase error in gdb-prompt (got %s)" sink))))
1460 (let ((input (gdb-dequeue-input)))
1461 (if input
1462 (gdb-send-item input)
1463 (progn
1464 (setq gdb-prompting t)
1465 (gud-display-frame)
1466 (setq gdb-early-user-input (nreverse gdb-early-user-input))
1467 (while gdb-early-user-input
1468 (gdb-enqueue-input (car gdb-early-user-input))
1469 (setq gdb-early-user-input (cdr gdb-early-user-input)))))))
1470
1471(defun gdb-subprompt (ignored)
1472 "An annotation handler for non-top-level prompts."
1473 (setq gdb-prompting t))
1474
1475(defun gdb-starting (ignored)
1476 "An annotation handler for `starting'.
1477This says that I/O for the subprocess is now the program being debugged,
1478not GDB."
1479 (setq gdb-active-process t)
1480 (setq gdb-printing t)
1481 (let ((sink gdb-output-sink))
1482 (cond
1483 ((eq sink 'user)
1484 (progn
1485 (setq gud-running t)
1486 (setq gdb-stack-update t)
1487 ;; Temporarily set gud-running to nil to force "info stack" onto queue.
1488 (let ((gud-running nil))
1489 (gdb-invalidate-frames)
1490 (unless (or gdb-register-names
1491 (string-equal gdb-version "pre-6.4"))
1492 (gdb-enqueue-input
1493 (list "server interpreter mi -data-list-register-names\n"
1494 'gdb-get-register-names))))
1495 (setq gdb-inferior-status "running")
1496 (setq gdb-signalled nil)
1497 (gdb-force-mode-line-update
1498 (propertize gdb-inferior-status 'face font-lock-type-face))
1499 (gdb-remove-text-properties)
1500 (setq gud-old-arrow gud-overlay-arrow-position)
1501 (setq gud-overlay-arrow-position nil)
1502 (setq gdb-overlay-arrow-position nil)
1503 (setq gdb-stack-position nil)
1504 (if gdb-use-separate-io-buffer
1505 (setq gdb-output-sink 'inferior))))
1506 (t
1507 (gdb-resync)
1508 (error "Unexpected `starting' annotation")))))
1509
1510(defun gdb-signal (ignored)
1511 (setq gdb-inferior-status "signal")
1512 (gdb-force-mode-line-update
1513 (propertize gdb-inferior-status 'face font-lock-warning-face))
1514 (gdb-stopping ignored))
1515
1516(defun gdb-stopping (ignored)
1517 "An annotation handler for `breakpoint' and other annotations.
1518They say that I/O for the subprocess is now GDB, not the program
1519being debugged."
1520 (if gdb-use-separate-io-buffer
1521 (let ((sink gdb-output-sink))
1522 (cond
1523 ((eq sink 'inferior)
1524 (setq gdb-output-sink 'user))
1525 (t
1526 (gdb-resync)
1527 (error "Unexpected stopping annotation"))))))
1528
1529(defun gdb-exited (ignored)
1530 "An annotation handler for `exited' and `signalled'.
1531They say that I/O for the subprocess is now GDB, not the program
1532being debugged and that the program is no longer running. This
1533function is used to change the focus of GUD tooltips to #define
1534directives."
1535 (setq gdb-active-process nil)
1536 (setq gud-overlay-arrow-position nil)
1537 (setq gdb-overlay-arrow-position nil)
1538 (setq gdb-stack-position nil)
1539 (setq gud-old-arrow nil)
1540 (setq gdb-inferior-status "exited")
1541 (gdb-force-mode-line-update
1542 (propertize gdb-inferior-status 'face font-lock-warning-face))
1543 (gdb-stopping ignored))
1544
1545(defun gdb-signalled (ignored)
1546 (setq gdb-signalled t))
1547
1548(defun gdb-frame-begin (ignored)
1549 (setq gdb-frame-begin t)
1550 (setq gdb-printing nil)
1551 (let ((sink gdb-output-sink))
1552 (cond
1553 ((eq sink 'inferior)
1554 (setq gdb-output-sink 'user))
1555 ((eq sink 'user) t)
1556 ((eq sink 'emacs) t)
1557 (t
1558 (gdb-resync)
1559 (error "Unexpected frame-begin annotation (%S)" sink)))))
1560
1561(defcustom gdb-same-frame (not focus-follows-mouse)
1562 "Non-nil means pop up GUD buffer in same frame."
1563 :group 'gdb
1564 :type 'boolean
1565 :version "22.1")
1566
1567(defcustom gdb-find-source-frame nil
1568 "Non-nil means try to find a source frame further up stack e.g after signal."
1569 :group 'gdb
1570 :type 'boolean
1571 :version "22.1")
1572
1573(defun gdb-find-source-frame (arg)
1574 "Toggle looking for a source frame further up call stack.
1575The code associated with current (innermost) frame may not have
1576been compiled with debug information, e.g., C library routine.
1577With prefix argument ARG, look for a source frame further up
1578stack to display in the source buffer if ARG is positive,
1579otherwise don't look further up."
1580 (interactive "P")
1581 (setq gdb-find-source-frame
1582 (if (null arg)
1583 (not gdb-find-source-frame)
1584 (> (prefix-numeric-value arg) 0)))
1585 (message (format "Looking for source frame %sabled"
1586 (if gdb-find-source-frame "en" "dis"))))
1587
1588(defun gdb-stopped (ignored)
1589 "An annotation handler for `stopped'.
1590It is just like `gdb-stopping', except that if we already set the output
1591sink to `user' in `gdb-stopping', that is fine."
1592 (setq gud-running nil)
1593 (unless (or gud-overlay-arrow-position gud-last-frame)
1594 (if (and gdb-frame-begin gdb-printing)
1595 (setq gud-overlay-arrow-position gud-old-arrow)
1596 ;;Pop up GUD buffer to display current frame when it doesn't have source
1597 ;;information i.e if not compiled with -g as with libc routines generally.
1598 (if gdb-same-frame
1599 (gdb-display-gdb-buffer)
1600 (gdb-frame-gdb-buffer))
1601 (if gdb-find-source-frame
1602 ;;Try to find source further up stack e.g after signal.
1603 (setq gdb-look-up-stack
1604 (if (gdb-get-buffer 'gdb-stack-buffer)
1605 'keep
1606 (progn
1607 (gdb-get-buffer-create 'gdb-stack-buffer)
1608 (gdb-invalidate-frames)
1609 'delete))))))
1610 (unless (member gdb-inferior-status '("exited" "signal"))
1611 (setq gdb-active-process t) ;Just for attaching case.
1612 (setq gdb-inferior-status "stopped")
1613 (gdb-force-mode-line-update
1614 (propertize gdb-inferior-status 'face font-lock-warning-face)))
1615 (let ((sink gdb-output-sink))
1616 (cond
1617 ((eq sink 'inferior)
1618 (setq gdb-output-sink 'user))
1619 ((eq sink 'user) t)
1620 (t
1621 (gdb-resync)
1622 (error "Unexpected stopped annotation"))))
1623 (if gdb-signalled (gdb-exited ignored)))
1624
1625(defun gdb-error (ignored)
1626 (setq gdb-error (not gdb-error)))
1627
1628(defun gdb-thread-changed (ignored)
1629 (gdb-frames-force-update))
1630
1631(defun gdb-post-prompt (ignored)
1632 "An annotation handler for `post-prompt'.
1633This begins the collection of output from the current command if that
1634happens to be appropriate."
1635 ;; Don't add to queue if there outstanding items or gdb-version is not known
1636 ;; yet.
1637 (unless (or gdb-pending-triggers gdb-first-post-prompt)
1638 (gdb-get-selected-frame)
1639 (gdb-invalidate-frames)
1640 ;; Regenerate breakpoints buffer in case it has been inadvertantly deleted.
1641 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
1642 (gdb-invalidate-breakpoints)
1643 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler
1644 ;; so gdb-pc-address is updated.
1645 ;; (gdb-invalidate-assembler)
1646
1647 (if (string-equal gdb-version "pre-6.4")
1648 (gdb-invalidate-registers)
1649 (gdb-get-changed-registers)
1650 (gdb-invalidate-registers-1))
1651
1652 (gdb-invalidate-memory)
1653 (if (string-equal gdb-version "pre-6.4")
1654 (gdb-invalidate-locals)
1655 (gdb-invalidate-locals-1))
1656
1657 (gdb-invalidate-threads)
1658 (unless (or (null gdb-var-list)
1659 (eq system-type 'darwin)) ;Breaks on Darwin's GDB-5.3.
1660 ;; FIXME: with GDB-6 on Darwin, this might very well work.
1661 ;; Only needed/used with speedbar/watch expressions.
1662 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
1663 (if (string-equal gdb-version "pre-6.4")
1664 (gdb-var-update)
1665 (gdb-var-update-1)))))
1666 (setq gdb-first-post-prompt nil)
1667 (let ((sink gdb-output-sink))
1668 (cond
1669 ((eq sink 'user) t)
1670 ((eq sink 'pre-emacs)
1671 (setq gdb-output-sink 'emacs))
1672 (t
1673 (gdb-resync)
1674 (error "Phase error in gdb-post-prompt (got %s)" sink)))))
1675
1676(defconst gdb-buffer-list
1677'(gdb-stack-buffer gdb-locals-buffer gdb-registers-buffer gdb-threads-buffer))
1678
1679(defun gdb-remove-text-properties ()
1680 (dolist (buffertype gdb-buffer-list)
1681 (let ((buffer (gdb-get-buffer buffertype)))
1682 (if buffer
1683 (with-current-buffer buffer
1684 (let ((inhibit-read-only t))
1685 (remove-text-properties
1686 (point-min) (point-max) '(mouse-face nil help-echo nil))))))))
1687
1688;; GUD displays the selected GDB frame. This might might not be the current
1689;; GDB frame (after up, down etc). If no GDB frame is visible but the last
1690;; visited breakpoint is, use that window.
1691(defun gdb-display-source-buffer (buffer)
1692 (let* ((last-window (if gud-last-last-frame
1693 (get-buffer-window
1694 (gud-find-file (car gud-last-last-frame)))))
1695 (source-window (or last-window
1696 (if (and gdb-source-window
1697 (window-live-p gdb-source-window))
1698 gdb-source-window))))
1699 (when source-window
1700 (setq gdb-source-window source-window)
1701 (set-window-buffer source-window buffer))
1702 source-window))
1703
1704;; Derived from gud-gdb-marker-regexp
1705(defvar gdb-fullname-regexp
1706 (concat "\\(.:?[^" ":" "\n]*\\)" ":" "\\([0-9]*\\)" ":" ".*"))
1707
1708(defun gud-gdba-marker-filter (string)
1709 "A gud marker filter for gdb. Handle a burst of output from GDB."
1710 (if gdb-flush-pending-output
1711 nil
1712 (when gdb-enable-debug
1713 (push (cons 'recv string) gdb-debug-log)
1714 (if (and gdb-debug-log-max
1715 (> (length gdb-debug-log) gdb-debug-log-max))
1716 (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil)))
1717 ;; Recall the left over gud-marker-acc from last time.
1718 (setq gud-marker-acc (concat gud-marker-acc string))
1719 ;; Start accumulating output for the GUD buffer.
1720 (let ((output ""))
1721 ;;
1722 ;; Process all the complete markers in this chunk.
1723 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
1724 (let ((annotation (match-string 1 gud-marker-acc))
1725 (before (substring gud-marker-acc 0 (match-beginning 0)))
1726 (after (substring gud-marker-acc (match-end 0))))
1727 ;;
1728 ;; Parse the tag from the annotation, and maybe its arguments.
1729 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
1730 (let* ((annotation-type (match-string 1 annotation))
1731 (annotation-arguments (match-string 2 annotation))
1732 (annotation-rule (assoc annotation-type
1733 gdb-annotation-rules)))
1734
1735 ;; Stuff prior to the match is just ordinary output.
1736 ;; It is either concatenated to OUTPUT or directed
1737 ;; elsewhere.
1738 (setq output (gdb-concat-output output before))
1739
1740 ;; Take that stuff off the gud-marker-acc.
1741 (setq gud-marker-acc after)
1742
1743 ;; Call the handler for this annotation.
1744 (if annotation-rule
1745 (funcall (car (cdr annotation-rule))
1746 annotation-arguments))
1747
1748 ;; Else the annotation is not recognized. Ignore it silently,
1749 ;; so that GDB can add new annotations without causing
1750 ;; us to blow up.
1751 )))
1752
1753 ;; Does the remaining text end in a partial line?
1754 ;; If it does, then keep part of the gud-marker-acc until we get more.
1755 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1756 gud-marker-acc)
1757 (progn
1758 ;; Everything before the potential marker start can be output.
1759 (setq output
1760 (gdb-concat-output output
1761 (substring gud-marker-acc 0
1762 (match-beginning 0))))
1763 ;;
1764 ;; Everything after, we save, to combine with later input.
1765 (setq gud-marker-acc (substring gud-marker-acc
1766 (match-beginning 0))))
1767 ;;
1768 ;; In case we know the gud-marker-acc contains no partial annotations:
1769 (progn
1770 (setq output (gdb-concat-output output gud-marker-acc))
1771 (setq gud-marker-acc "")))
1772 output)))
1773
1774(defun gdb-concat-output (so-far new)
1775 (if gdb-error
1776 (put-text-property 0 (length new) 'face font-lock-warning-face new))
1777 (let ((sink gdb-output-sink))
1778 (cond
1779 ((eq sink 'user) (concat so-far new))
1780 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
1781 ((eq sink 'emacs)
1782 (gdb-append-to-partial-output new)
1783 so-far)
1784 ((eq sink 'inferior)
1785 (gdb-append-to-inferior-io new)
1786 so-far)
1787 (t
1788 (gdb-resync)
1789 (error "Bogon output sink %S" sink)))))
1790
1791(defun gdb-append-to-partial-output (string)
1792 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1793 (goto-char (point-max))
1794 (insert string)))
1795
1796(defun gdb-clear-partial-output ()
1797 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1798 (erase-buffer)))
1799
1800(defun gdb-append-to-inferior-io (string)
1801 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
1802 (goto-char (point-max))
1803 (insert-before-markers string))
1804 (if (not (string-equal string ""))
1805 (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t)))
1806
1807(defun gdb-clear-inferior-io ()
1808 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
1809 (erase-buffer)))
1810
1811(defun gdb-jsonify-buffer (&optional fix-key fix-list)
1812 "Prepare GDB/MI output in current buffer for parsing with `json-read'.
1813
1814Field names are wrapped in double quotes and equal signs are
1815replaced with semicolons.
1816
1817If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from
1818partial output. This is used to get rid of useless keys in lists
1819in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
1820-break-info are examples of MI commands which issue such
1821responses.
1822
1823If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with
1824\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken
1825-break-info output when it contains breakpoint script field
1826incompatible with GDB/MI output syntax."
1827 (save-excursion
1828 (goto-char (point-min))
1829 ;; Sometimes missing symbol information precedes "^done" record.
1830 (re-search-forward "[[:ascii:]]*?\\^done," nil t)
1831 (replace-match "")
1832 (re-search-forward "(gdb) \n" nil t)
1833 (replace-match "")
1834 (goto-char (point-min))
1835 (when fix-key
1836 (save-excursion
1837 (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t)
1838 (replace-match "" nil nil nil 1))))
1839 (when fix-list
1840 (save-excursion
1841 ;; Find positions of braces which enclose broken list
1842 (while (re-search-forward (concat fix-list "={\"") nil t)
1843 (let ((p1 (goto-char (- (point) 2)))
1844 (p2 (progn (forward-sexp)
1845 (1- (point)))))
1846 ;; Replace braces with brackets
1847 (save-excursion
1848 (goto-char p1)
1849 (delete-char 1)
1850 (insert "[")
1851 (goto-char p2)
1852 (delete-char 1)
1853 (insert "]"))))))
1854 (goto-char (point-min))
1855 (insert "{")
1856 (while (re-search-forward
1857 "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t)
1858 (replace-match "\"\\1\":\\2" nil nil))
1859 (goto-char (point-max))
1860 (insert "}")))
1861
1862(defun gdb-json-read-buffer (&optional fix-key fix-list)
1863 "Prepare and parse GDB/MI output in current buffer with `json-read'.
1864
1865FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
1866 (gdb-jsonify-buffer fix-key fix-list)
1867 (save-excursion
1868 (goto-char (point-min))
1869 (let ((json-array-type 'list))
1870 (json-read))))
1871
1872(defun gdb-json-partial-output (&optional fix-key fix-list)
1873 "Prepare and parse gdb-partial-output-buffer with `json-read'.
1874
1875FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'."
1876 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1877 (gdb-json-read-buffer fix-key fix-list)))
1878
1879
1880;; One trick is to have a command who's output is always available in a buffer
1881;; of it's own, and is always up to date. We build several buffers of this
1882;; type.
1883;;
1884;; There are two aspects to this: gdb has to tell us when the output for that
1885;; command might have changed, and we have to be able to run the command
1886;; behind the user's back.
1887;;
1888;; The output phasing associated with the variable gdb-output-sink
1889;; help us to run commands behind the user's back.
1890;;
1891;; Below is the code for specificly managing buffers of output from one
1892;; command.
1893;;
1894
1895;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1896;; It adds an input for the command we are tracking. It should be the
1897;; annotation rule binding of whatever gdb sends to tell us this command
1898;; might have changed it's output.
1899;;
1900;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1901;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1902;; input in the input queue (see comment about ``gdb communications'' above).
1903
1904(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command
1905 output-handler)
1906 `(defun ,name (&optional ignored)
1907 (if (and ,demand-predicate
1908 (not (member ',name
1909 gdb-pending-triggers)))
1910 (progn
1911 (gdb-enqueue-input
1912 (list ,gdb-command ',output-handler))
1913 (push ',name gdb-pending-triggers)))))
1914
1915(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
1916 `(defun ,name ()
1917 (setq gdb-pending-triggers
1918 (delq ',trigger
1919 gdb-pending-triggers))
1920 (let ((buf (gdb-get-buffer ',buf-key)))
1921 (and buf
1922 (with-current-buffer buf
1923 (let* ((window (get-buffer-window buf 0))
1924 (start (window-start window))
1925 (p (if window (window-point window) (point)))
1926 (buffer-read-only nil))
1927 (erase-buffer)
1928 (insert-buffer-substring (gdb-get-buffer-create
1929 'gdb-partial-output-buffer))
1930 (if window
1931 (progn
1932 (set-window-start window start)
1933 (set-window-point window p))
1934 (goto-char p))))))
1935 ;; put customisation here
1936 (,custom-defun)))
1937
1938(defmacro def-gdb-auto-updated-buffer (buffer-key
1939 trigger-name gdb-command
1940 output-handler-name custom-defun)
1941 `(progn
1942 (def-gdb-auto-update-trigger ,trigger-name
1943 ;; The demand predicate:
1944 (gdb-get-buffer ',buffer-key)
1945 ,gdb-command
1946 ,output-handler-name)
1947 (def-gdb-auto-update-handler ,output-handler-name
1948 ,trigger-name ,buffer-key ,custom-defun)))
1949
1950
1951;;
1952;; Breakpoint buffer : This displays the output of `info breakpoints'.
1953;;
1954(gdb-set-buffer-rules 'gdb-breakpoints-buffer
1955 'gdb-breakpoints-buffer-name
1956 'gdb-breakpoints-mode)
1957
1958(def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1959 ;; This defines the auto update rule for buffers of type
1960 ;; `gdb-breakpoints-buffer'.
1961 ;;
1962 ;; It defines a function to serve as the annotation handler that
1963 ;; handles the `foo-invalidated' message. That function is called:
1964 gdb-invalidate-breakpoints
1965 ;;
1966 ;; To update the buffer, this command is sent to gdb.
1967 "server info breakpoints\n"
1968 ;;
1969 ;; This also defines a function to be the handler for the output
1970 ;; from the command above. That function will copy the output into
1971 ;; the appropriately typed buffer. That function will be called:
1972 gdb-info-breakpoints-handler
1973 ;; buffer specific functions
1974 gdb-info-breakpoints-custom)
1975
1976(defconst breakpoint-xpm-data
1977 "/* XPM */
1978static char *magick[] = {
1979/* columns rows colors chars-per-pixel */
1980\"10 10 2 1\",
1981\" c red\",
1982\"+ c None\",
1983/* pixels */
1984\"+++ +++\",
1985\"++ ++\",
1986\"+ +\",
1987\" \",
1988\" \",
1989\" \",
1990\" \",
1991\"+ +\",
1992\"++ ++\",
1993\"+++ +++\",
1994};"
1995 "XPM data used for breakpoint icon.")
1996
1997(defconst breakpoint-enabled-pbm-data
1998 "P1
199910 10\",
20000 0 0 0 1 1 1 1 0 0 0 0
20010 0 0 1 1 1 1 1 1 0 0 0
20020 0 1 1 1 1 1 1 1 1 0 0
20030 1 1 1 1 1 1 1 1 1 1 0
20040 1 1 1 1 1 1 1 1 1 1 0
20050 1 1 1 1 1 1 1 1 1 1 0
20060 1 1 1 1 1 1 1 1 1 1 0
20070 0 1 1 1 1 1 1 1 1 0 0
20080 0 0 1 1 1 1 1 1 0 0 0
20090 0 0 0 1 1 1 1 0 0 0 0"
2010 "PBM data used for enabled breakpoint icon.")
2011
2012(defconst breakpoint-disabled-pbm-data
2013 "P1
201410 10\",
20150 0 1 0 1 0 1 0 0 0
20160 1 0 1 0 1 0 1 0 0
20171 0 1 0 1 0 1 0 1 0
20180 1 0 1 0 1 0 1 0 1
20191 0 1 0 1 0 1 0 1 0
20200 1 0 1 0 1 0 1 0 1
20211 0 1 0 1 0 1 0 1 0
20220 1 0 1 0 1 0 1 0 1
20230 0 1 0 1 0 1 0 1 0
20240 0 0 1 0 1 0 1 0 0"
2025 "PBM data used for disabled breakpoint icon.")
2026
2027(defvar breakpoint-enabled-icon nil
2028 "Icon for enabled breakpoint in display margin.")
2029
2030(defvar breakpoint-disabled-icon nil
2031 "Icon for disabled breakpoint in display margin.")
2032
2033(declare-function define-fringe-bitmap "fringe.c"
2034 (bitmap bits &optional height width align))
2035
2036(and (display-images-p)
2037 ;; Bitmap for breakpoint in fringe
2038 (define-fringe-bitmap 'breakpoint
2039 "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
2040 ;; Bitmap for gud-overlay-arrow in fringe
2041 (define-fringe-bitmap 'hollow-right-triangle
2042 "\xe0\x90\x88\x84\x84\x88\x90\xe0"))
2043
2044(defface breakpoint-enabled
2045 '((t
2046 :foreground "red1"
2047 :weight bold))
2048 "Face for enabled breakpoint icon in fringe."
2049 :group 'gdb)
2050
2051(defface breakpoint-disabled
2052 '((((class color) (min-colors 88)) :foreground "grey70")
2053 ;; Ensure that on low-color displays that we end up something visible.
2054 (((class color) (min-colors 8) (background light))
2055 :foreground "black")
2056 (((class color) (min-colors 8) (background dark))
2057 :foreground "white")
2058 (((type tty) (class mono))
2059 :inverse-video t)
2060 (t :background "gray"))
2061 "Face for disabled breakpoint icon in fringe."
2062 :group 'gdb)
2063
2064(defconst gdb-breakpoint-regexp
2065 "\\(?:\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\|\\([0-9]+\\.[0-9]+\\)\\)\\s-+\\(.\\)\\s-+")
2066
2067;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
2068(defun gdb-info-breakpoints-custom ()
2069 (let ((flag) (bptno))
2070 ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
2071 (dolist (buffer (buffer-list))
2072 (with-current-buffer buffer
2073 (if (and (memq gud-minor-mode '(gdba gdbmi))
2074 (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name))))
2075 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
2076 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
2077 (save-excursion
2078 (let ((buffer-read-only nil))
2079 (goto-char (point-min))
2080 (while (< (point) (- (point-max) 1))
2081 (forward-line 1)
2082 (if (looking-at gdb-breakpoint-regexp)
2083 (progn
2084 (setq bptno (or (match-string 1) (match-string 2)))
2085 (setq flag (char-after (match-beginning 3)))
2086 (if (match-string 1)
2087 (setq gdb-parent-bptno-enabled (eq flag ?y)))
2088 (add-text-properties
2089 (match-beginning 3) (match-end 3)
2090 (if (eq flag ?y)
2091 '(face font-lock-warning-face)
2092 '(face font-lock-type-face)))
2093 (let ((bl (point))
2094 (el (line-end-position)))
2095 (when (re-search-forward " in \\(.*\\) at" el t)
2096 (add-text-properties
2097 (match-beginning 1) (match-end 1)
2098 '(face font-lock-function-name-face)))
2099 (if (re-search-forward
2100 ".*\\s-+\\(\\S-+\\):\\([0-9]+\\)$" el t)
2101 (let ((line (match-string 2))
2102 (file (match-string 1)))
2103 (add-text-properties bl el
2104 '(mouse-face highlight
2105 help-echo "mouse-2, RET: visit breakpoint"))
2106 (unless (file-exists-p file)
2107 (setq file (cdr (assoc bptno gdb-location-alist))))
2108 (if (and file
2109 (not (string-equal file "File not found")))
2110 (with-current-buffer
2111 (find-file-noselect file 'nowarn)
2112 (gdb-init-buffer)
2113 ;; Only want one breakpoint icon at each
2114 ;; location.
2115 (save-excursion
2116 (goto-char (point-min))
2117 (forward-line (1- (string-to-number line)))
2118 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
2119 (gdb-enqueue-input
2120 (list
2121 (concat gdb-server-prefix "list "
2122 (match-string-no-properties 1) ":1\n")
2123 'ignore))
2124 (gdb-enqueue-input
2125 (list (concat gdb-server-prefix "info source\n")
2126 `(lambda () (gdb-get-location
2127 ,bptno ,line ,flag))))))
2128 (if (re-search-forward
2129 "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
2130 el t)
2131 (add-text-properties
2132 (match-beginning 1) (match-end 1)
2133 '(face font-lock-function-name-face))
2134 (end-of-line)
2135 (re-search-backward "\\s-\\(\\S-*\\)"
2136 bl t)
2137 (add-text-properties
2138 (match-beginning 1) (match-end 1)
2139 '(face font-lock-variable-name-face)))))))
2140 (end-of-line))))))
2141 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))
2142
2143 ;; Breakpoints buffer is always present. Hack to just update
2144 ;; current frame if there's been no execution.
2145 (if gdb-stack-update
2146 (setq gdb-stack-update nil)
2147 (if (gdb-get-buffer 'gdb-stack-buffer) (gdb-info-stack-custom))))
2148
2149(declare-function gud-remove "gdb-ui" t t) ; gud-def
2150(declare-function gud-break "gdb-ui" t t) ; gud-def
2151(declare-function fringe-bitmaps-at-pos "fringe.c" (&optional pos window))
2152
2153(defun gdb-mouse-set-clear-breakpoint (event)
2154 "Set/clear breakpoint in left fringe/margin at mouse click.
2155If not in a source or disassembly buffer just set point."
2156 (interactive "e")
2157 (mouse-minibuffer-check event)
2158 (let ((posn (event-end event)))
2159 (with-selected-window (posn-window posn)
2160 (if (or (buffer-file-name) (eq major-mode 'gdb-assembler-mode))
2161 (if (numberp (posn-point posn))
2162 (save-excursion
2163 (goto-char (posn-point posn))
2164 (if (or (posn-object posn)
2165 (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
2166 'breakpoint))
2167 (gud-remove nil)
2168 (gud-break nil)))))
2169 (posn-set-point posn))))
2170
2171(defun gdb-mouse-toggle-breakpoint-margin (event)
2172 "Enable/disable breakpoint in left margin with mouse click."
2173 (interactive "e")
2174 (mouse-minibuffer-check event)
2175 (let ((posn (event-end event)))
2176 (if (numberp (posn-point posn))
2177 (with-selected-window (posn-window posn)
2178 (save-excursion
2179 (goto-char (posn-point posn))
2180 (if (posn-object posn)
2181 (let* ((bptno (get-text-property
2182 0 'gdb-bptno (car (posn-string posn)))))
2183 (string-match "\\([0-9+]\\)*" bptno)
2184 (gdb-enqueue-input
2185 (list
2186 (concat gdb-server-prefix
2187 (if (get-text-property
2188 0 'gdb-enabled (car (posn-string posn)))
2189 "disable "
2190 "enable ")
2191 (match-string 1 bptno) "\n")
2192 'ignore)))))))))
2193
2194(defun gdb-mouse-toggle-breakpoint-fringe (event)
2195 "Enable/disable breakpoint in left fringe with mouse click."
2196 (interactive "e")
2197 (mouse-minibuffer-check event)
2198 (let* ((posn (event-end event))
2199 (pos (posn-point posn))
2200 obj)
2201 (when (numberp pos)
2202 (with-selected-window (posn-window posn)
2203 (with-current-buffer (window-buffer (selected-window))
2204 (goto-char pos)
2205 (dolist (overlay (overlays-in pos pos))
2206 (when (overlay-get overlay 'put-break)
2207 (setq obj (overlay-get overlay 'before-string))))
2208 (when (stringp obj)
2209 (let* ((bptno (get-text-property 0 'gdb-bptno obj)))
2210 (string-match "\\([0-9+]\\)*" bptno)
2211 (gdb-enqueue-input
2212 (list
2213 (concat gdb-server-prefix
2214 (if (get-text-property 0 'gdb-enabled obj)
2215 "disable "
2216 "enable ")
2217 (match-string 1 bptno) "\n")
2218 'ignore)))))))))
2219
2220(defun gdb-breakpoints-buffer-name ()
2221 (with-current-buffer gud-comint-buffer
2222 (concat "*breakpoints of " (gdb-get-target-string) "*")))
2223
2224(defun gdb-display-breakpoints-buffer ()
2225 "Display status of user-settable breakpoints."
2226 (interactive)
2227 (gdb-display-buffer
2228 (gdb-get-buffer-create 'gdb-breakpoints-buffer) t))
2229
2230(defun gdb-frame-breakpoints-buffer ()
2231 "Display status of user-settable breakpoints in a new frame."
2232 (interactive)
2233 (let ((special-display-regexps (append special-display-regexps '(".*")))
2234 (special-display-frame-alist gdb-frame-parameters))
2235 (display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer))))
2236
2237(defvar gdb-breakpoints-mode-map
2238 (let ((map (make-sparse-keymap))
2239 (menu (make-sparse-keymap "Breakpoints")))
2240 (define-key menu [quit] '("Quit" . gdb-delete-frame-or-window))
2241 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
2242 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
2243 (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
2244 (suppress-keymap map)
2245 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
2246 (define-key map " " 'gdb-toggle-breakpoint)
2247 (define-key map "D" 'gdb-delete-breakpoint)
2248 ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons.
2249 (define-key map "q" 'gdb-delete-frame-or-window)
2250 (define-key map "\r" 'gdb-goto-breakpoint)
2251 (define-key map [mouse-2] 'gdb-goto-breakpoint)
2252 (define-key map [follow-link] 'mouse-face)
2253 map))
2254
2255(defun gdb-delete-frame-or-window ()
2256 "Delete frame if there is only one window. Otherwise delete the window."
2257 (interactive)
2258 (if (one-window-p) (delete-frame)
2259 (delete-window)))
2260
2261;;from make-mode-line-mouse-map
2262(defun gdb-make-header-line-mouse-map (mouse function) "\
2263Return a keymap with single entry for mouse key MOUSE on the header line.
2264MOUSE is defined to run function FUNCTION with no args in the buffer
2265corresponding to the mode line clicked."
2266 (let ((map (make-sparse-keymap)))
2267 (define-key map (vector 'header-line mouse) function)
2268 (define-key map (vector 'header-line 'down-mouse-1) 'ignore)
2269 map))
2270
2271(defmacro gdb-propertize-header (name buffer help-echo mouse-face face)
2272 `(propertize ,name
2273 'help-echo ,help-echo
2274 'mouse-face ',mouse-face
2275 'face ',face
2276 'local-map
2277 (gdb-make-header-line-mouse-map
2278 'mouse-1
2279 (lambda (event) (interactive "e")
2280 (save-selected-window
2281 (select-window (posn-window (event-start event)))
2282 (set-window-dedicated-p (selected-window) nil)
2283 (switch-to-buffer
2284 (gdb-get-buffer-create ',buffer))
2285 (setq header-line-format(gdb-set-header ',buffer))
2286 (set-window-dedicated-p (selected-window) t))))))
2287
2288(defun gdb-set-header (buffer)
2289 (cond ((eq buffer 'gdb-locals-buffer)
2290 (list
2291 (gdb-propertize-header "Locals" gdb-locals-buffer
2292 nil nil mode-line)
2293 " "
2294 (gdb-propertize-header "Registers" gdb-registers-buffer
2295 "mouse-1: select" mode-line-highlight mode-line-inactive)))
2296 ((eq buffer 'gdb-registers-buffer)
2297 (list
2298 (gdb-propertize-header "Locals" gdb-locals-buffer
2299 "mouse-1: select" mode-line-highlight mode-line-inactive)
2300 " "
2301 (gdb-propertize-header "Registers" gdb-registers-buffer
2302 nil nil mode-line)))
2303 ((eq buffer 'gdb-breakpoints-buffer)
2304 (list
2305 (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
2306 nil nil mode-line)
2307 " "
2308 (gdb-propertize-header "Threads" gdb-threads-buffer
2309 "mouse-1: select" mode-line-highlight mode-line-inactive)))
2310 ((eq buffer 'gdb-threads-buffer)
2311 (list
2312 (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
2313 "mouse-1: select" mode-line-highlight mode-line-inactive)
2314 " "
2315 (gdb-propertize-header "Threads" gdb-threads-buffer
2316 nil nil mode-line)))))
2317
2318(defvar gdb-breakpoints-header
2319 (list
2320 (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
2321 nil nil mode-line)
2322 " "
2323 (gdb-propertize-header "Threads" gdb-threads-buffer
2324 "mouse-1: select" mode-line-highlight mode-line-inactive)))
2325
2326(defun gdb-breakpoints-mode ()
2327 "Major mode for gdb breakpoints.
2328
2329\\{gdb-breakpoints-mode-map}"
2330 (kill-all-local-variables)
2331 (setq major-mode 'gdb-breakpoints-mode)
2332 (setq mode-name "Breakpoints")
2333 (use-local-map gdb-breakpoints-mode-map)
2334 (setq buffer-read-only t)
2335 (buffer-disable-undo)
2336 (setq header-line-format gdb-breakpoints-header)
2337 (run-mode-hooks 'gdb-breakpoints-mode-hook)
2338 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2339 'gdb-invalidate-breakpoints
2340 'gdbmi-invalidate-breakpoints))
2341
2342(defun gdb-toggle-breakpoint ()
2343 "Enable/disable breakpoint at current line."
2344 (interactive)
2345 (save-excursion
2346 (beginning-of-line 1)
2347 (if (looking-at gdb-breakpoint-regexp)
2348 (gdb-enqueue-input
2349 (list
2350 (concat gdb-server-prefix
2351 (if (eq ?y (char-after (match-beginning 3)))
2352 "disable "
2353 "enable ")
2354 (or (match-string 1) (match-string 2)) "\n") 'ignore))
2355 (error "Not recognized as break/watchpoint line"))))
2356
2357(defun gdb-delete-breakpoint ()
2358 "Delete the breakpoint at current line."
2359 (interactive)
2360 (save-excursion
2361 (beginning-of-line 1)
2362 (if (looking-at gdb-breakpoint-regexp)
2363 (if (match-string 1)
2364 (gdb-enqueue-input
2365 (list
2366 (concat gdb-server-prefix "delete " (match-string 1) "\n")
2367 'ignore))
2368 (message-box "This breakpoint cannot be deleted on its own."))
2369 (error "Not recognized as break/watchpoint line"))))
2370
2371(defun gdb-goto-breakpoint (&optional event)
2372 "Display the breakpoint location specified at current line."
2373 (interactive (list last-input-event))
2374 (if event (posn-set-point (event-end event)))
2375 (save-excursion
2376 (beginning-of-line 1)
2377 (if (looking-at "\\([0-9]+\\.?[0-9]*\\) .*\\s-+\\(\\S-+\\):\\([0-9]+\\)$")
2378 (let ((bptno (match-string 1))
2379 (file (match-string 2))
2380 (line (match-string 3)))
2381 (save-selected-window
2382 (let* ((buffer (find-file-noselect
2383 (if (file-exists-p file) file
2384 (cdr (assoc bptno gdb-location-alist)))))
2385 (window (or (gdb-display-source-buffer buffer)
2386 (display-buffer buffer))))
2387 (setq gdb-source-window window)
2388 (with-current-buffer buffer
2389 (goto-char (point-min))
2390 (forward-line (1- (string-to-number line)))
2391 (set-window-point window (point))))))
2392 (error "No location specified"))))
2393
2394
2395;; Frames buffer. This displays a perpetually correct backtrace
2396;; (from the command `where').
2397;;
2398;; Alas, if your stack is deep, it is costly.
2399;;
2400(defcustom gdb-max-frames 40
2401 "Maximum number of frames displayed in call stack."
2402 :type 'integer
2403 :group 'gdb
2404 :version "22.1")
2405
2406(gdb-set-buffer-rules 'gdb-stack-buffer
2407 'gdb-stack-buffer-name
2408 'gdb-frames-mode)
2409
2410(def-gdb-auto-updated-buffer gdb-stack-buffer
2411 gdb-invalidate-frames
2412 (concat "server info stack " (number-to-string gdb-max-frames) "\n")
2413 gdb-info-stack-handler
2414 gdb-info-stack-custom)
2415
2416;; This may be more important for embedded targets where unwinding the
2417;; stack may take a long time.
2418(defadvice gdb-invalidate-frames (around gdb-invalidate-frames-advice
2419 (&optional ignored) activate compile)
2420 "Only queue \"info stack\" if execution has occurred."
2421 (if gdb-stack-update ad-do-it))
2422
2423(defun gdb-info-stack-custom ()
2424 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
2425 (let (move-to)
2426 (save-excursion
2427 (unless (eq gdb-look-up-stack 'delete)
2428 (let ((buffer-read-only nil)
2429 bl el)
2430 (goto-char (point-min))
2431 (while (< (point) (point-max))
2432 (setq bl (line-beginning-position)
2433 el (line-end-position))
2434 (when (looking-at "#")
2435 (add-text-properties bl el
2436 '(mouse-face highlight
2437 help-echo "mouse-2, RET: Select frame")))
2438 (goto-char bl)
2439 (when (looking-at "^#\\([0-9]+\\)")
2440 (when (string-equal (match-string 1) gdb-frame-number)
2441 (if (gud-tool-bar-item-visible-no-fringe)
2442 (progn
2443 (put-text-property bl (+ bl 4)
2444 'face '(:inverse-video t))
2445 (setq move-to bl))
2446 (or gdb-stack-position
2447 (setq gdb-stack-position (make-marker)))
2448 (set-marker gdb-stack-position (point))
2449 (setq move-to gdb-stack-position)))
2450 (when (re-search-forward "\\([^ ]+\\) (" el t)
2451 (put-text-property (match-beginning 1) (match-end 1)
2452 'face font-lock-function-name-face)
2453 (setq bl (match-end 0))
2454 (while (re-search-forward "<\\([^>]+\\)>" el t)
2455 (put-text-property (match-beginning 1) (match-end 1)
2456 'face font-lock-function-name-face))
2457 (goto-char bl)
2458 (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t)
2459 (put-text-property (match-beginning 1) (match-end 1)
2460 'face font-lock-variable-name-face))))
2461 (forward-line 1))
2462 (forward-line -1)
2463 (when (looking-at "(More stack frames follow...)")
2464 (add-text-properties
2465 (match-beginning 0) (match-end 0)
2466 '(mouse-face highlight
2467 gdb-max-frames t
2468 help-echo
2469 "mouse-2, RET: customize gdb-max-frames to see more frames"
2470 )))))
2471 (when gdb-look-up-stack
2472 (goto-char (point-min))
2473 (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t)
2474 (let ((start (line-beginning-position))
2475 (file (match-string 1))
2476 (line (match-string 2)))
2477 (re-search-backward "^#*\\([0-9]+\\)" start t)
2478 (gdb-enqueue-input
2479 (list (concat gdb-server-prefix "frame "
2480 (match-string 1) "\n") 'gdb-set-hollow))
2481 (gdb-enqueue-input
2482 (list (concat gdb-server-prefix "frame 0\n") 'ignore))))))
2483 (when move-to
2484 (let ((window (get-buffer-window (current-buffer) 0)))
2485 (when window
2486 (with-selected-window window
2487 (goto-char move-to)
2488 (unless (pos-visible-in-window-p)
2489 (recenter '(center)))))))))
2490 (if (eq gdb-look-up-stack 'delete)
2491 (kill-buffer (gdb-get-buffer 'gdb-stack-buffer)))
2492 (setq gdb-look-up-stack nil))
2493
2494(defun gdb-set-hollow ()
2495 (if gud-last-last-frame
2496 (with-current-buffer (gud-find-file (car gud-last-last-frame))
2497 (setq fringe-indicator-alist
2498 '((overlay-arrow . hollow-right-triangle))))))
2499
2500(defun gdb-stack-buffer-name ()
2501 (with-current-buffer gud-comint-buffer
2502 (concat "*stack frames of " (gdb-get-target-string) "*")))
2503
2504(defun gdb-display-stack-buffer ()
2505 "Display backtrace of current stack."
2506 (interactive)
2507 (gdb-display-buffer
2508 (gdb-get-buffer-create 'gdb-stack-buffer) t))
2509
2510(defun gdb-frame-stack-buffer ()
2511 "Display backtrace of current stack in a new frame."
2512 (interactive)
2513 (let ((special-display-regexps (append special-display-regexps '(".*")))
2514 (special-display-frame-alist gdb-frame-parameters))
2515 (display-buffer (gdb-get-buffer-create 'gdb-stack-buffer))))
2516
2517(defvar gdb-frames-mode-map
2518 (let ((map (make-sparse-keymap)))
2519 (suppress-keymap map)
2520 (define-key map "q" 'kill-this-buffer)
2521 (define-key map "\r" 'gdb-frames-select)
2522 (define-key map "F" 'gdb-frames-force-update)
2523 (define-key map [mouse-2] 'gdb-frames-select)
2524 (define-key map [follow-link] 'mouse-face)
2525 map))
2526
2527(declare-function gdbmi-invalidate-frames "ext:gdb-mi" nil t)
2528
2529(defun gdb-frames-force-update ()
2530 "Force update of call stack.
2531Use when the displayed call stack gets out of sync with the
2532actual one, e.g after using the Gdb command \"return\" or setting
2533$pc directly from the GUD buffer. This command isn't normally needed."
2534 (interactive)
2535 (setq gdb-stack-update t)
2536 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2537 (gdb-invalidate-frames)
2538 (gdbmi-invalidate-frames)))
2539
2540(defun gdb-frames-mode ()
2541 "Major mode for gdb call stack.
2542
2543\\{gdb-frames-mode-map}"
2544 (kill-all-local-variables)
2545 (setq major-mode 'gdb-frames-mode)
2546 (setq mode-name "Frames")
2547 (setq gdb-stack-position nil)
2548 (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
2549 (setq truncate-lines t) ;; Make it easier to see overlay arrow.
2550 (setq buffer-read-only t)
2551 (buffer-disable-undo)
2552 (gdb-thread-identification)
2553 (use-local-map gdb-frames-mode-map)
2554 (run-mode-hooks 'gdb-frames-mode-hook)
2555 (setq gdb-stack-update t)
2556 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2557 'gdb-invalidate-frames
2558 'gdbmi-invalidate-frames))
2559
2560(defun gdb-get-frame-number ()
2561 (save-excursion
2562 (end-of-line)
2563 (let* ((start (line-beginning-position))
2564 (pos (re-search-backward "^#*\\([0-9]+\\)" start t))
2565 (n (or (and pos (match-string 1)) "0")))
2566 n)))
2567
2568(defun gdb-frames-select (&optional event)
2569 "Select the frame and display the relevant source."
2570 (interactive (list last-input-event))
2571 (if event (posn-set-point (event-end event)))
2572 (if (get-text-property (point) 'gdb-max-frames)
2573 (progn
2574 (message-box "After setting gdb-max-frames, you need to enter\n\
2575another GDB command e.g pwd, to see new frames")
2576 (customize-variable-other-window 'gdb-max-frames))
2577 (gdb-enqueue-input
2578 (list (concat gdb-server-prefix "frame "
2579 (gdb-get-frame-number) "\n") 'ignore))))
2580
2581
2582;; Threads buffer. This displays a selectable thread list.
2583;;
2584(gdb-set-buffer-rules 'gdb-threads-buffer
2585 'gdb-threads-buffer-name
2586 'gdb-threads-mode)
2587
2588(def-gdb-auto-updated-buffer gdb-threads-buffer
2589 gdb-invalidate-threads
2590 (concat gdb-server-prefix "info threads\n")
2591 gdb-info-threads-handler
2592 gdb-info-threads-custom)
2593
2594(defun gdb-info-threads-custom ()
2595 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
2596 (let ((buffer-read-only nil))
2597 (save-excursion
2598 (goto-char (point-min))
2599 (if (re-search-forward "\\* \\([0-9]+\\)" nil t)
2600 (setq gdb-thread-indicator
2601 (propertize (concat " [" (match-string 1) "]")
2602 ; FIXME: this help-echo doesn't work
2603 'help-echo "thread id")))
2604 (goto-char (point-min))
2605 (while (< (point) (point-max))
2606 (unless (looking-at "No ")
2607 (add-text-properties (line-beginning-position) (line-end-position)
2608 '(mouse-face highlight
2609 help-echo "mouse-2, RET: select thread")))
2610 (forward-line 1))))))
2611
2612(defun gdb-threads-buffer-name ()
2613 (with-current-buffer gud-comint-buffer
2614 (concat "*threads of " (gdb-get-target-string) "*")))
2615
2616(defun gdb-display-threads-buffer ()
2617 "Display IDs of currently known threads."
2618 (interactive)
2619 (gdb-display-buffer
2620 (gdb-get-buffer-create 'gdb-threads-buffer) t))
2621
2622(defun gdb-frame-threads-buffer ()
2623 "Display IDs of currently known threads in a new frame."
2624 (interactive)
2625 (let ((special-display-regexps (append special-display-regexps '(".*")))
2626 (special-display-frame-alist gdb-frame-parameters))
2627 (display-buffer (gdb-get-buffer-create 'gdb-threads-buffer))))
2628
2629(defvar gdb-threads-mode-map
2630 (let ((map (make-sparse-keymap)))
2631 (suppress-keymap map)
2632 (define-key map "q" 'kill-this-buffer)
2633 (define-key map "\r" 'gdb-threads-select)
2634 (define-key map [mouse-2] 'gdb-threads-select)
2635 (define-key map [follow-link] 'mouse-face)
2636 map))
2637
2638(defvar gdb-threads-font-lock-keywords
2639 '((") +\\([^ ]+\\) (" (1 font-lock-function-name-face))
2640 ("in \\([^ ]+\\) (" (1 font-lock-function-name-face))
2641 ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face)))
2642 "Font lock keywords used in `gdb-threads-mode'.")
2643
2644(defun gdb-threads-mode ()
2645 "Major mode for gdb threads.
2646
2647\\{gdb-threads-mode-map}"
2648 (kill-all-local-variables)
2649 (setq major-mode 'gdb-threads-mode)
2650 (setq mode-name "Threads")
2651 (setq buffer-read-only t)
2652 (buffer-disable-undo)
2653 (setq header-line-format gdb-breakpoints-header)
2654 (use-local-map gdb-threads-mode-map)
2655 (set (make-local-variable 'font-lock-defaults)
2656 '(gdb-threads-font-lock-keywords))
2657 (run-mode-hooks 'gdb-threads-mode-hook)
2658 ;; Force "info threads" onto queue.
2659 (lambda () (let ((gud-running nil)) (gdb-invalidate-threads))))
2660
2661(defun gdb-get-thread-number ()
2662 (save-excursion
2663 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
2664 (match-string-no-properties 1)))
2665
2666(defun gdb-threads-select (&optional event)
2667 "Select the thread and display the relevant source."
2668 (interactive (list last-input-event))
2669 (if event (posn-set-point (event-end event)))
2670 (setq gdb-stack-update t)
2671 (gdb-enqueue-input
2672 (list (concat gdb-server-prefix "thread "
2673 (gdb-get-thread-number) "\n") 'ignore))
2674 (gud-display-frame))
2675
2676(defun gdb-thread-identification ()
2677 (setq mode-line-buffer-identification
2678 (list (car mode-line-buffer-identification)
2679 '(gdb-thread-indicator gdb-thread-indicator))))
2680
2681;; Registers buffer.
2682;;
2683(defcustom gdb-all-registers nil
2684 "Non-nil means include floating-point registers."
2685 :type 'boolean
2686 :group 'gdb
2687 :version "22.1")
2688
2689(gdb-set-buffer-rules 'gdb-registers-buffer
2690 'gdb-registers-buffer-name
2691 'gdb-registers-mode)
2692
2693(def-gdb-auto-updated-buffer gdb-registers-buffer
2694 gdb-invalidate-registers
2695 (concat
2696 gdb-server-prefix "info " (if gdb-all-registers "all-") "registers\n")
2697 gdb-info-registers-handler
2698 gdb-info-registers-custom)
2699
2700(defun gdb-info-registers-custom ()
2701 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
2702 (save-excursion
2703 (let ((buffer-read-only nil)
2704 start end)
2705 (goto-char (point-min))
2706 (while (< (point) (point-max))
2707 (setq start (line-beginning-position))
2708 (setq end (line-end-position))
2709 (when (looking-at "^[^ ]+")
2710 (unless (string-equal (match-string 0) "The")
2711 (put-text-property start (match-end 0)
2712 'face font-lock-variable-name-face)
2713 (add-text-properties start end
2714 '(help-echo "mouse-2: edit value"
2715 mouse-face highlight))))
2716 (forward-line 1))))))
2717
2718(defun gdb-edit-register-value (&optional event)
2719 (interactive (list last-input-event))
2720 (save-excursion
2721 (if event (posn-set-point (event-end event)))
2722 (beginning-of-line)
2723 (let* ((register (current-word))
2724 (value (read-string (format "New value (%s): " register))))
2725 (gdb-enqueue-input
2726 (list (concat gdb-server-prefix "set $" register "=" value "\n")
2727 'ignore)))))
2728
2729(defvar gdb-registers-mode-map
2730 (let ((map (make-sparse-keymap)))
2731 (suppress-keymap map)
2732 (define-key map "\r" 'gdb-edit-register-value)
2733 (define-key map [mouse-2] 'gdb-edit-register-value)
2734 (define-key map " " 'gdb-all-registers)
2735 (define-key map "q" 'kill-this-buffer)
2736 map))
2737
2738(defvar gdb-locals-header
2739 (list
2740 (gdb-propertize-header "Locals" gdb-locals-buffer
2741 nil nil mode-line)
2742 " "
2743 (gdb-propertize-header "Registers" gdb-registers-buffer
2744 "mouse-1: select" mode-line-highlight mode-line-inactive)))
2745
2746
2747(defun gdb-registers-mode ()
2748 "Major mode for gdb registers.
2749
2750\\{gdb-registers-mode-map}"
2751 (kill-all-local-variables)
2752 (setq major-mode 'gdb-registers-mode)
2753 (setq mode-name "Registers")
2754 (setq header-line-format gdb-locals-header)
2755 (setq buffer-read-only t)
2756 (buffer-disable-undo)
2757 (gdb-thread-identification)
2758 (use-local-map gdb-registers-mode-map)
2759 (run-mode-hooks 'gdb-registers-mode-hook)
2760 (if (string-equal gdb-version "pre-6.4")
2761 (progn
2762 (if gdb-all-registers (setq mode-name "Registers:All"))
2763 'gdb-invalidate-registers)
2764 'gdb-invalidate-registers-1))
2765
2766(defun gdb-registers-buffer-name ()
2767 (with-current-buffer gud-comint-buffer
2768 (concat "*registers of " (gdb-get-target-string) "*")))
2769
2770(defun gdb-display-registers-buffer ()
2771 "Display integer register contents."
2772 (interactive)
2773 (gdb-display-buffer
2774 (gdb-get-buffer-create 'gdb-registers-buffer) t))
2775
2776(defun gdb-frame-registers-buffer ()
2777 "Display integer register contents in a new frame."
2778 (interactive)
2779 (let ((special-display-regexps (append special-display-regexps '(".*")))
2780 (special-display-frame-alist gdb-frame-parameters))
2781 (display-buffer (gdb-get-buffer-create 'gdb-registers-buffer))))
2782
2783(defun gdb-all-registers ()
2784 "Toggle the display of floating-point registers (pre GDB 6.4 only)."
2785 (interactive)
2786 (when (string-equal gdb-version "pre-6.4")
2787 (if gdb-all-registers
2788 (progn
2789 (setq gdb-all-registers nil)
2790 (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer)
2791 (setq mode-name "Registers")))
2792 (setq gdb-all-registers t)
2793 (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer)
2794 (setq mode-name "Registers:All")))
2795 (message (format "Display of floating-point registers %sabled"
2796 (if gdb-all-registers "en" "dis")))
2797 (gdb-invalidate-registers)))
2798
2799
2800;; Memory buffer.
2801;;
2802(defcustom gdb-memory-repeat-count 32
2803 "Number of data items in memory window."
2804 :type 'integer
2805 :group 'gdb
2806 :version "22.1")
2807
2808(defcustom gdb-memory-format "x"
2809 "Display format of data items in memory window."
2810 :type '(choice (const :tag "Hexadecimal" "x")
2811 (const :tag "Signed decimal" "d")
2812 (const :tag "Unsigned decimal" "u")
2813 (const :tag "Octal" "o")
2814 (const :tag "Binary" "t"))
2815 :group 'gdb
2816 :version "22.1")
2817
2818(defcustom gdb-memory-unit "w"
2819 "Unit size of data items in memory window."
2820 :type '(choice (const :tag "Byte" "b")
2821 (const :tag "Halfword" "h")
2822 (const :tag "Word" "w")
2823 (const :tag "Giant word" "g"))
2824 :group 'gdb
2825 :version "22.1")
2826
2827(gdb-set-buffer-rules 'gdb-memory-buffer
2828 'gdb-memory-buffer-name
2829 'gdb-memory-mode)
2830
2831(def-gdb-auto-updated-buffer gdb-memory-buffer
2832 gdb-invalidate-memory
2833 (concat gdb-server-prefix "x/" (number-to-string gdb-memory-repeat-count)
2834 gdb-memory-format gdb-memory-unit " " gdb-memory-address "\n")
2835 gdb-read-memory-handler
2836 gdb-read-memory-custom)
2837
2838(defun gdb-read-memory-custom ()
2839 (save-excursion
2840 (goto-char (point-min))
2841 (if (looking-at "0x[[:xdigit:]]+")
2842 (setq gdb-memory-address (match-string 0)))))
2843
2844(defvar gdb-memory-mode-map
2845 (let ((map (make-sparse-keymap)))
2846 (suppress-keymap map)
2847 (define-key map "S" 'gdb-memory-set-address)
2848 (define-key map "N" 'gdb-memory-set-repeat-count)
2849 (define-key map "q" 'kill-this-buffer)
2850 map))
2851
2852(defun gdb-memory-set-address (&optional event)
2853 "Set the start memory address."
2854 (interactive)
2855 (let ((arg (read-from-minibuffer "Start address: ")))
2856 (setq gdb-memory-address arg))
2857 (gdb-invalidate-memory))
2858
2859(defun gdb-memory-set-repeat-count (&optional event)
2860 "Set the number of data items in memory window."
2861 (interactive)
2862 (let* ((arg (read-from-minibuffer "Repeat count: "))
2863 (count (string-to-number arg)))
2864 (if (<= count 0)
2865 (error "Positive numbers only")
2866 (customize-set-variable 'gdb-memory-repeat-count count)
2867 (gdb-invalidate-memory))))
2868
2869(defun gdb-memory-format-binary ()
2870 "Set the display format to binary."
2871 (interactive)
2872 (customize-set-variable 'gdb-memory-format "t")
2873 (gdb-invalidate-memory))
2874
2875(defun gdb-memory-format-octal ()
2876 "Set the display format to octal."
2877 (interactive)
2878 (customize-set-variable 'gdb-memory-format "o")
2879 (gdb-invalidate-memory))
2880
2881(defun gdb-memory-format-unsigned ()
2882 "Set the display format to unsigned decimal."
2883 (interactive)
2884 (customize-set-variable 'gdb-memory-format "u")
2885 (gdb-invalidate-memory))
2886
2887(defun gdb-memory-format-signed ()
2888 "Set the display format to decimal."
2889 (interactive)
2890 (customize-set-variable 'gdb-memory-format "d")
2891 (gdb-invalidate-memory))
2892
2893(defun gdb-memory-format-hexadecimal ()
2894 "Set the display format to hexadecimal."
2895 (interactive)
2896 (customize-set-variable 'gdb-memory-format "x")
2897 (gdb-invalidate-memory))
2898
2899(defvar gdb-memory-format-map
2900 (let ((map (make-sparse-keymap)))
2901 (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)
2902 map)
2903 "Keymap to select format in the header line.")
2904
2905(defvar gdb-memory-format-menu (make-sparse-keymap "Format")
2906 "Menu of display formats in the header line.")
2907
2908(define-key gdb-memory-format-menu [binary]
2909 '(menu-item "Binary" gdb-memory-format-binary
2910 :button (:radio . (equal gdb-memory-format "t"))))
2911(define-key gdb-memory-format-menu [octal]
2912 '(menu-item "Octal" gdb-memory-format-octal
2913 :button (:radio . (equal gdb-memory-format "o"))))
2914(define-key gdb-memory-format-menu [unsigned]
2915 '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
2916 :button (:radio . (equal gdb-memory-format "u"))))
2917(define-key gdb-memory-format-menu [signed]
2918 '(menu-item "Signed Decimal" gdb-memory-format-signed
2919 :button (:radio . (equal gdb-memory-format "d"))))
2920(define-key gdb-memory-format-menu [hexadecimal]
2921 '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
2922 :button (:radio . (equal gdb-memory-format "x"))))
2923
2924(defun gdb-memory-format-menu (event)
2925 (interactive "@e")
2926 (x-popup-menu event gdb-memory-format-menu))
2927
2928(defun gdb-memory-format-menu-1 (event)
2929 (interactive "e")
2930 (save-selected-window
2931 (select-window (posn-window (event-start event)))
2932 (let* ((selection (gdb-memory-format-menu event))
2933 (binding (and selection (lookup-key gdb-memory-format-menu
2934 (vector (car selection))))))
2935 (if binding (call-interactively binding)))))
2936
2937(defun gdb-memory-unit-giant ()
2938 "Set the unit size to giant words (eight bytes)."
2939 (interactive)
2940 (customize-set-variable 'gdb-memory-unit "g")
2941 (gdb-invalidate-memory))
2942
2943(defun gdb-memory-unit-word ()
2944 "Set the unit size to words (four bytes)."
2945 (interactive)
2946 (customize-set-variable 'gdb-memory-unit "w")
2947 (gdb-invalidate-memory))
2948
2949(defun gdb-memory-unit-halfword ()
2950 "Set the unit size to halfwords (two bytes)."
2951 (interactive)
2952 (customize-set-variable 'gdb-memory-unit "h")
2953 (gdb-invalidate-memory))
2954
2955(defun gdb-memory-unit-byte ()
2956 "Set the unit size to bytes."
2957 (interactive)
2958 (customize-set-variable 'gdb-memory-unit "b")
2959 (gdb-invalidate-memory))
2960
2961(defvar gdb-memory-unit-map
2962 (let ((map (make-sparse-keymap)))
2963 (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)
2964 map)
2965 "Keymap to select units in the header line.")
2966
2967(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit")
2968 "Menu of units in the header line.")
2969
2970(define-key gdb-memory-unit-menu [giantwords]
2971 '(menu-item "Giant words" gdb-memory-unit-giant
2972 :button (:radio . (equal gdb-memory-unit "g"))))
2973(define-key gdb-memory-unit-menu [words]
2974 '(menu-item "Words" gdb-memory-unit-word
2975 :button (:radio . (equal gdb-memory-unit "w"))))
2976(define-key gdb-memory-unit-menu [halfwords]
2977 '(menu-item "Halfwords" gdb-memory-unit-halfword
2978 :button (:radio . (equal gdb-memory-unit "h"))))
2979(define-key gdb-memory-unit-menu [bytes]
2980 '(menu-item "Bytes" gdb-memory-unit-byte
2981 :button (:radio . (equal gdb-memory-unit "b"))))
2982
2983(defun gdb-memory-unit-menu (event)
2984 (interactive "@e")
2985 (x-popup-menu event gdb-memory-unit-menu))
2986
2987(defun gdb-memory-unit-menu-1 (event)
2988 (interactive "e")
2989 (save-selected-window
2990 (select-window (posn-window (event-start event)))
2991 (let* ((selection (gdb-memory-unit-menu event))
2992 (binding (and selection (lookup-key gdb-memory-unit-menu
2993 (vector (car selection))))))
2994 (if binding (call-interactively binding)))))
2995
2996(defvar gdb-memory-font-lock-keywords
2997 '(;; <__function.name+n>
2998 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face))
2999 )
3000 "Font lock keywords used in `gdb-memory-mode'.")
3001
3002(defun gdb-memory-mode ()
3003 "Major mode for examining memory.
3004
3005\\{gdb-memory-mode-map}"
3006 (kill-all-local-variables)
3007 (setq major-mode 'gdb-memory-mode)
3008 (setq mode-name "Memory")
3009 (setq buffer-read-only t)
3010 (buffer-disable-undo)
3011 (use-local-map gdb-memory-mode-map)
3012 (setq header-line-format
3013 '(:eval
3014 (concat
3015 "Start address["
3016 (propertize
3017 "-"
3018 'face font-lock-warning-face
3019 'help-echo "mouse-1: decrement address"
3020 'mouse-face 'mode-line-highlight
3021 'local-map
3022 (gdb-make-header-line-mouse-map
3023 'mouse-1
3024 (lambda () (interactive)
3025 (let ((gdb-memory-address
3026 ;; Let GDB do the arithmetic.
3027 (concat
3028 gdb-memory-address " - "
3029 (number-to-string
3030 (* gdb-memory-repeat-count
3031 (cond ((string= gdb-memory-unit "b") 1)
3032 ((string= gdb-memory-unit "h") 2)
3033 ((string= gdb-memory-unit "w") 4)
3034 ((string= gdb-memory-unit "g") 8)))))))
3035 (gdb-invalidate-memory)))))
3036 "|"
3037 (propertize "+"
3038 'face font-lock-warning-face
3039 'help-echo "mouse-1: increment address"
3040 'mouse-face 'mode-line-highlight
3041 'local-map (gdb-make-header-line-mouse-map
3042 'mouse-1
3043 (lambda () (interactive)
3044 (let ((gdb-memory-address nil))
3045 (gdb-invalidate-memory)))))
3046 "]: "
3047 (propertize gdb-memory-address
3048 'face font-lock-warning-face
3049 'help-echo "mouse-1: set start address"
3050 'mouse-face 'mode-line-highlight
3051 'local-map (gdb-make-header-line-mouse-map
3052 'mouse-1
3053 #'gdb-memory-set-address))
3054 " Repeat Count: "
3055 (propertize (number-to-string gdb-memory-repeat-count)
3056 'face font-lock-warning-face
3057 'help-echo "mouse-1: set repeat count"
3058 'mouse-face 'mode-line-highlight
3059 'local-map (gdb-make-header-line-mouse-map
3060 'mouse-1
3061 #'gdb-memory-set-repeat-count))
3062 " Display Format: "
3063 (propertize gdb-memory-format
3064 'face font-lock-warning-face
3065 'help-echo "mouse-3: select display format"
3066 'mouse-face 'mode-line-highlight
3067 'local-map gdb-memory-format-map)
3068 " Unit Size: "
3069 (propertize gdb-memory-unit
3070 'face font-lock-warning-face
3071 'help-echo "mouse-3: select unit size"
3072 'mouse-face 'mode-line-highlight
3073 'local-map gdb-memory-unit-map))))
3074 (set (make-local-variable 'font-lock-defaults)
3075 '(gdb-memory-font-lock-keywords))
3076 (run-mode-hooks 'gdb-memory-mode-hook)
3077 'gdb-invalidate-memory)
3078
3079(defun gdb-memory-buffer-name ()
3080 (with-current-buffer gud-comint-buffer
3081 (concat "*memory of " (gdb-get-target-string) "*")))
3082
3083(defun gdb-display-memory-buffer ()
3084 "Display memory contents."
3085 (interactive)
3086 (gdb-display-buffer
3087 (gdb-get-buffer-create 'gdb-memory-buffer) t))
3088
3089(defun gdb-frame-memory-buffer ()
3090 "Display memory contents in a new frame."
3091 (interactive)
3092 (let* ((special-display-regexps (append special-display-regexps '(".*")))
3093 (special-display-frame-alist
3094 (cons '(left-fringe . 0)
3095 (cons '(right-fringe . 0)
3096 (cons '(width . 83) gdb-frame-parameters)))))
3097 (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
3098
3099
3100;; Locals buffer.
3101;;
3102(gdb-set-buffer-rules 'gdb-locals-buffer
3103 'gdb-locals-buffer-name
3104 'gdb-locals-mode)
3105
3106(def-gdb-auto-update-trigger gdb-invalidate-locals
3107 (gdb-get-buffer 'gdb-locals-buffer)
3108 "server info locals\n"
3109 gdb-info-locals-handler)
3110
3111(defvar gdb-locals-watch-map
3112 (let ((map (make-sparse-keymap)))
3113 (suppress-keymap map)
3114 (define-key map "\r" (lambda () (interactive)
3115 (beginning-of-line)
3116 (gud-watch)))
3117 (define-key map [mouse-2] (lambda (event) (interactive "e")
3118 (mouse-set-point event)
3119 (beginning-of-line)
3120 (gud-watch)))
3121 map)
3122 "Keymap to create watch expression of a complex data type local variable.")
3123
3124(defconst gdb-struct-string
3125 (concat (propertize "[struct/union]"
3126 'mouse-face 'highlight
3127 'help-echo "mouse-2: create watch expression"
3128 'local-map gdb-locals-watch-map) "\n"))
3129
3130(defconst gdb-array-string
3131 (concat " " (propertize "[array]"
3132 'mouse-face 'highlight
3133 'help-echo "mouse-2: create watch expression"
3134 'local-map gdb-locals-watch-map) "\n"))
3135
3136;; Abbreviate for arrays and structures.
3137;; These can be expanded using gud-display.
3138(defun gdb-info-locals-handler ()
3139 (setq gdb-pending-triggers (delq 'gdb-invalidate-locals
3140 gdb-pending-triggers))
3141 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
3142 (with-current-buffer buf
3143 (goto-char (point-min))
3144 ;; Need this in case "set print pretty" is on.
3145 (while (re-search-forward "^[ }].*\n" nil t)
3146 (replace-match "" nil nil))
3147 (goto-char (point-min))
3148 (while (re-search-forward "{\\(.*=.*\n\\|\n\\)" nil t)
3149 (replace-match gdb-struct-string nil nil))
3150 (goto-char (point-min))
3151 (while (re-search-forward "\\s-*{[^.].*\n" nil t)
3152 (replace-match gdb-array-string nil nil))))
3153 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
3154 (and buf
3155 (with-current-buffer buf
3156 (let* ((window (get-buffer-window buf 0))
3157 (start (window-start window))
3158 (p (window-point window))
3159 (buffer-read-only nil))
3160 (erase-buffer)
3161 (insert-buffer-substring (gdb-get-buffer-create
3162 'gdb-partial-output-buffer))
3163 (set-window-start window start)
3164 (set-window-point window p)))))
3165 (run-hooks 'gdb-info-locals-hook))
3166
3167(defvar gdb-locals-mode-map
3168 (let ((map (make-sparse-keymap)))
3169 (suppress-keymap map)
3170 (define-key map "q" 'kill-this-buffer)
3171 map))
3172
3173(defun gdb-locals-mode ()
3174 "Major mode for gdb locals.
3175
3176\\{gdb-locals-mode-map}"
3177 (kill-all-local-variables)
3178 (setq major-mode 'gdb-locals-mode)
3179 (setq mode-name (concat "Locals:" gdb-selected-frame))
3180 (use-local-map gdb-locals-mode-map)
3181 (setq buffer-read-only t)
3182 (buffer-disable-undo)
3183 (setq header-line-format gdb-locals-header)
3184 (gdb-thread-identification)
3185 (set (make-local-variable 'font-lock-defaults)
3186 '(gdb-locals-font-lock-keywords))
3187 (run-mode-hooks 'gdb-locals-mode-hook)
3188 (if (and (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3189 (string-equal gdb-version "pre-6.4"))
3190 'gdb-invalidate-locals
3191 'gdb-invalidate-locals-1))
3192
3193(defun gdb-locals-buffer-name ()
3194 (with-current-buffer gud-comint-buffer
3195 (concat "*locals of " (gdb-get-target-string) "*")))
3196
3197(defun gdb-display-locals-buffer ()
3198 "Display local variables of current stack and their values."
3199 (interactive)
3200 (gdb-display-buffer
3201 (gdb-get-buffer-create 'gdb-locals-buffer) t))
3202
3203(defun gdb-frame-locals-buffer ()
3204 "Display local variables of current stack and their values in a new frame."
3205 (interactive)
3206 (let ((special-display-regexps (append special-display-regexps '(".*")))
3207 (special-display-frame-alist gdb-frame-parameters))
3208 (display-buffer (gdb-get-buffer-create 'gdb-locals-buffer))))
3209
3210
3211;;;; Window management
3212(defun gdb-display-buffer (buf dedicated &optional frame)
3213 (let ((answer (get-buffer-window buf (or frame 0))))
3214 (if answer
3215 (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary.
3216 (let ((window (get-lru-window)))
3217 (if (memq (buffer-local-value 'gud-minor-mode (window-buffer window))
3218 '(gdba gdbmi))
3219 (let* ((largest (get-largest-window))
3220 (cur-size (window-height largest)))
3221 (setq answer (split-window largest))
3222 (set-window-buffer answer buf)
3223 (set-window-dedicated-p answer dedicated)
3224 answer)
3225 (set-window-buffer window buf)
3226 window)))))
3227
3228
3229;;; Shared keymap initialization:
3230
3231(let ((menu (make-sparse-keymap "GDB-Windows")))
3232 (define-key gud-menu-map [displays]
3233 `(menu-item "GDB-Windows" ,menu
3234 :help "Open a GDB-UI buffer in a new window."
3235 :visible (memq gud-minor-mode '(gdbmi gdba))))
3236 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
3237 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
3238 (define-key menu [inferior]
3239 '(menu-item "Separate IO" gdb-display-separate-io-buffer
3240 :enable gdb-use-separate-io-buffer))
3241 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
3242 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
3243 (define-key menu [disassembly]
3244 '("Disassembly" . gdb-display-assembler-buffer))
3245 (define-key menu [breakpoints]
3246 '("Breakpoints" . gdb-display-breakpoints-buffer))
3247 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
3248 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)))
3249
3250(let ((menu (make-sparse-keymap "GDB-Frames")))
3251 (define-key gud-menu-map [frames]
3252 `(menu-item "GDB-Frames" ,menu
3253 :help "Open a GDB-UI buffer in a new frame."
3254 :visible (memq gud-minor-mode '(gdbmi gdba))))
3255 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
3256 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
3257 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
3258 (define-key menu [inferior]
3259 '(menu-item "Separate IO" gdb-frame-separate-io-buffer
3260 :enable gdb-use-separate-io-buffer))
3261 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
3262 (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer))
3263 (define-key menu [breakpoints]
3264 '("Breakpoints" . gdb-frame-breakpoints-buffer))
3265 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
3266 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)))
3267
3268(let ((menu (make-sparse-keymap "GDB-UI/MI")))
3269 (define-key gud-menu-map [ui]
3270 `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI")
3271 ,menu :visible (memq gud-minor-mode '(gdbmi gdba))))
3272 (define-key menu [gdb-customize]
3273 '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
3274 :help "Customize Gdb Graphical Mode options."))
3275 (define-key menu [gdb-find-source-frame]
3276 '(menu-item "Look For Source Frame" gdb-find-source-frame
3277 :visible (eq gud-minor-mode 'gdba)
3278 :help "Toggle looking for source frame further up call stack."
3279 :button (:toggle . gdb-find-source-frame)))
3280 (define-key menu [gdb-use-separate-io]
3281 '(menu-item "Separate IO" gdb-use-separate-io-buffer
3282 :visible (eq gud-minor-mode 'gdba)
3283 :help "Toggle separate IO for debugged program."
3284 :button (:toggle . gdb-use-separate-io-buffer)))
3285 (define-key menu [gdb-many-windows]
3286 '(menu-item "Display Other Windows" gdb-many-windows
3287 :help "Toggle display of locals, stack and breakpoint information."
3288 :button (:toggle . gdb-many-windows)))
3289 (define-key menu [gdb-restore-windows]
3290 '(menu-item "Restore Window Layout" gdb-restore-windows
3291 :help "Restore standard layout for debug session.")))
3292
3293(defun gdb-frame-gdb-buffer ()
3294 "Display GUD buffer in a new frame."
3295 (interactive)
3296 (let ((special-display-regexps (append special-display-regexps '(".*")))
3297 (special-display-frame-alist
3298 (remove '(menu-bar-lines) (remove '(tool-bar-lines)
3299 gdb-frame-parameters)))
3300 (same-window-regexps nil))
3301 (display-buffer gud-comint-buffer)))
3302
3303(defun gdb-display-gdb-buffer ()
3304 "Display GUD buffer."
3305 (interactive)
3306 (let ((same-window-regexps nil))
3307 (select-window (display-buffer gud-comint-buffer nil 0))))
3308
3309(defun gdb-set-window-buffer (name)
3310 (set-window-buffer (selected-window) (get-buffer name))
3311 (set-window-dedicated-p (selected-window) t))
3312
3313(defun gdb-setup-windows ()
3314 "Layout the window pattern for `gdb-many-windows'."
3315 (gdb-display-locals-buffer)
3316 (gdb-display-stack-buffer)
3317 (delete-other-windows)
3318 (gdb-display-breakpoints-buffer)
3319 (delete-other-windows)
3320 ; Don't dedicate.
3321 (pop-to-buffer gud-comint-buffer)
3322 (split-window nil ( / ( * (window-height) 3) 4))
3323 (split-window nil ( / (window-height) 3))
3324 (split-window-horizontally)
3325 (other-window 1)
3326 (gdb-set-window-buffer (gdb-locals-buffer-name))
3327 (other-window 1)
3328 (switch-to-buffer
3329 (if gud-last-last-frame
3330 (gud-find-file (car gud-last-last-frame))
3331 (if gdb-main-file
3332 (gud-find-file gdb-main-file)
3333 ;; Put buffer list in window if we
3334 ;; can't find a source file.
3335 (list-buffers-noselect))))
3336 (setq gdb-source-window (selected-window))
3337 (when gdb-use-separate-io-buffer
3338 (split-window-horizontally)
3339 (other-window 1)
3340 (gdb-set-window-buffer
3341 (gdb-get-buffer-create 'gdb-inferior-io)))
3342 (other-window 1)
3343 (gdb-set-window-buffer (gdb-stack-buffer-name))
3344 (split-window-horizontally)
3345 (other-window 1)
3346 (gdb-set-window-buffer (gdb-breakpoints-buffer-name))
3347 (other-window 1))
3348
3349(defun gdb-restore-windows ()
3350 "Restore the basic arrangement of windows used by gdba.
3351This arrangement depends on the value of `gdb-many-windows'."
3352 (interactive)
3353 (pop-to-buffer gud-comint-buffer) ;Select the right window and frame.
3354 (delete-other-windows)
3355 (if gdb-many-windows
3356 (gdb-setup-windows)
3357 (when (or gud-last-last-frame gdb-show-main)
3358 (split-window)
3359 (other-window 1)
3360 (switch-to-buffer
3361 (if gud-last-last-frame
3362 (gud-find-file (car gud-last-last-frame))
3363 (gud-find-file gdb-main-file)))
3364 (setq gdb-source-window (selected-window))
3365 (other-window 1))))
3366
3367(defun gdb-reset ()
3368 "Exit a debugging session cleanly.
3369Kills the gdb buffers, and resets variables and the source buffers."
3370 (dolist (buffer (buffer-list))
3371 (unless (eq buffer gud-comint-buffer)
3372 (with-current-buffer buffer
3373 (if (memq gud-minor-mode '(gdbmi gdba))
3374 (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name))
3375 (kill-buffer nil)
3376 (gdb-remove-breakpoint-icons (point-min) (point-max) t)
3377 (setq gud-minor-mode nil)
3378 (kill-local-variable 'tool-bar-map)
3379 (kill-local-variable 'gdb-define-alist))))))
3380 (setq gdb-overlay-arrow-position nil)
3381 (setq overlay-arrow-variable-list
3382 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
3383 (setq fringe-indicator-alist '((overlay-arrow . right-triangle)))
3384 (setq gdb-stack-position nil)
3385 (setq overlay-arrow-variable-list
3386 (delq 'gdb-stack-position overlay-arrow-variable-list))
3387 (if (boundp 'speedbar-frame) (speedbar-timer-fn))
3388 (setq gud-running nil)
3389 (setq gdb-active-process nil)
3390 (setq gdb-var-list nil)
3391 (remove-hook 'after-save-hook 'gdb-create-define-alist t))
3392
3393(defun gdb-source-info ()
3394 "Find the source file where the program starts and display it with related
3395buffers."
3396 (goto-char (point-min))
3397 (if (and (search-forward "Located in " nil t)
3398 (looking-at "\\S-+"))
3399 (setq gdb-main-file (match-string 0)))
3400 (goto-char (point-min))
3401 (if (search-forward "Includes preprocessor macro info." nil t)
3402 (setq gdb-macro-info t))
3403 (if gdb-many-windows
3404 (gdb-setup-windows)
3405 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
3406 (if (and gdb-show-main gdb-main-file)
3407 (let ((pop-up-windows t))
3408 (display-buffer (gud-find-file gdb-main-file)))))
3409 (setq gdb-ready t))
3410
3411(defun gdb-get-location (bptno line flag)
3412 "Find the directory containing the relevant source file.
3413Put in buffer and place breakpoint icon."
3414 (goto-char (point-min))
3415 (catch 'file-not-found
3416 (if (search-forward "Located in " nil t)
3417 (when (looking-at "\\S-+")
3418 (delete (cons bptno "File not found") gdb-location-alist)
3419 (push (cons bptno (match-string 0)) gdb-location-alist))
3420 (gdb-resync)
3421 (unless (assoc bptno gdb-location-alist)
3422 (push (cons bptno "File not found") gdb-location-alist)
3423 (message-box "Cannot find source file for breakpoint location.\n\
3424Add directory to search path for source files using the GDB command, dir."))
3425 (throw 'file-not-found nil))
3426 (with-current-buffer
3427 (find-file-noselect (match-string 0))
3428 (gdb-init-buffer)
3429 ;; only want one breakpoint icon at each location
3430 (save-excursion
3431 (goto-char (point-min))
3432 (forward-line (1- (string-to-number line)))
3433 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))
3434
3435(add-hook 'find-file-hook 'gdb-find-file-hook)
3436
3437(defun gdb-find-file-hook ()
3438 "Set up buffer for debugging if file is part of the source code
3439of the current session."
3440 (if (and (buffer-name gud-comint-buffer)
3441 ;; in case gud or gdb-ui is just loaded
3442 gud-comint-buffer
3443 (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
3444 '(gdba gdbmi)))
3445 ;;Pre GDB 6.3 "info sources" doesn't give absolute file name.
3446 (if (member (if (string-equal gdb-version "pre-6.4")
3447 (file-name-nondirectory buffer-file-name)
3448 buffer-file-name)
3449 gdb-source-file-list)
3450 (with-current-buffer (find-buffer-visiting buffer-file-name)
3451 (gdb-init-buffer)))))
3452
3453;;from put-image
3454(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
3455 "Put string PUTSTRING in front of POS in the current buffer.
3456PUTSTRING is displayed by putting an overlay into the current buffer with a
3457`before-string' string that has a `display' property whose value is
3458PUTSTRING."
3459 (let ((string (make-string 1 ?x))
3460 (buffer (current-buffer)))
3461 (setq putstring (copy-sequence putstring))
3462 (let ((overlay (make-overlay pos pos buffer))
3463 (prop (or dprop
3464 (list (list 'margin 'left-margin) putstring))))
3465 (put-text-property 0 1 'display prop string)
3466 (if sprops
3467 (add-text-properties 0 1 sprops string))
3468 (overlay-put overlay 'put-break t)
3469 (overlay-put overlay 'before-string string))))
3470
3471;;from remove-images
3472(defun gdb-remove-strings (start end &optional buffer)
3473 "Remove strings between START and END in BUFFER.
3474Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
3475BUFFER nil or omitted means use the current buffer."
3476 (unless buffer
3477 (setq buffer (current-buffer)))
3478 (dolist (overlay (overlays-in start end))
3479 (when (overlay-get overlay 'put-break)
3480 (delete-overlay overlay))))
3481
3482(defun gdb-put-breakpoint-icon (enabled bptno)
3483 (if (string-match "[0-9+]+\\." bptno)
3484 (setq enabled gdb-parent-bptno-enabled))
3485 (let ((start (- (line-beginning-position) 1))
3486 (end (+ (line-end-position) 1))
3487 (putstring (if enabled "B" "b"))
3488 (source-window (get-buffer-window (current-buffer) 0)))
3489 (add-text-properties
3490 0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt")
3491 putstring)
3492 (if enabled
3493 (add-text-properties
3494 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
3495 (add-text-properties
3496 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring))
3497 (gdb-remove-breakpoint-icons start end)
3498 (if (display-images-p)
3499 (if (>= (or left-fringe-width
3500 (if source-window (car (window-fringes source-window)))
3501 gdb-buffer-fringe-width) 8)
3502 (gdb-put-string
3503 nil (1+ start)
3504 `(left-fringe breakpoint
3505 ,(if enabled
3506 'breakpoint-enabled
3507 'breakpoint-disabled))
3508 'gdb-bptno bptno
3509 'gdb-enabled enabled)
3510 (when (< left-margin-width 2)
3511 (save-current-buffer
3512 (setq left-margin-width 2)
3513 (if source-window
3514 (set-window-margins
3515 source-window
3516 left-margin-width right-margin-width))))
3517 (put-image
3518 (if enabled
3519 (or breakpoint-enabled-icon
3520 (setq breakpoint-enabled-icon
3521 (find-image `((:type xpm :data
3522 ,breakpoint-xpm-data
3523 :ascent 100 :pointer hand)
3524 (:type pbm :data
3525 ,breakpoint-enabled-pbm-data
3526 :ascent 100 :pointer hand)))))
3527 (or breakpoint-disabled-icon
3528 (setq breakpoint-disabled-icon
3529 (find-image `((:type xpm :data
3530 ,breakpoint-xpm-data
3531 :conversion disabled
3532 :ascent 100 :pointer hand)
3533 (:type pbm :data
3534 ,breakpoint-disabled-pbm-data
3535 :ascent 100 :pointer hand))))))
3536 (+ start 1)
3537 putstring
3538 'left-margin))
3539 (when (< left-margin-width 2)
3540 (save-current-buffer
3541 (setq left-margin-width 2)
3542 (let ((window (get-buffer-window (current-buffer) 0)))
3543 (if window
3544 (set-window-margins
3545 window left-margin-width right-margin-width)))))
3546 (gdb-put-string
3547 (propertize putstring
3548 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled))
3549 (1+ start)))))
3550
3551(defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
3552 (gdb-remove-strings start end)
3553 (if (display-images-p)
3554 (remove-images start end))
3555 (when remove-margin
3556 (setq left-margin-width 0)
3557 (let ((window (get-buffer-window (current-buffer) 0)))
3558 (if window
3559 (set-window-margins
3560 window left-margin-width right-margin-width)))))
3561
3562
3563;;
3564;; Assembler buffer.
3565;;
3566(gdb-set-buffer-rules 'gdb-assembler-buffer
3567 'gdb-assembler-buffer-name
3568 'gdb-assembler-mode)
3569
3570;; We can't use def-gdb-auto-update-handler because we don't want to use
3571;; window-start but keep the overlay arrow/current line visible.
3572(defun gdb-assembler-handler ()
3573 (setq gdb-pending-triggers
3574 (delq 'gdb-invalidate-assembler
3575 gdb-pending-triggers))
3576 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
3577 (with-current-buffer buf
3578 (goto-char (point-min))
3579 ;; The disassemble command in GDB 7.1 onwards displays an overlay arrow.
3580 (while (re-search-forward "\\(^ 0x\\|=> 0x\\)" nil t)
3581 (replace-match "0x" nil nil))))
3582 (let ((buf (gdb-get-buffer 'gdb-assembler-buffer)))
3583 (and buf
3584 (with-current-buffer buf
3585 (let* ((window (get-buffer-window buf 0))
3586 (p (window-point window))
3587 (buffer-read-only nil))
3588 (erase-buffer)
3589 (insert-buffer-substring (gdb-get-buffer-create
3590 'gdb-partial-output-buffer))
3591 (set-window-point window p)))))
3592 ;; put customisation here
3593 (gdb-assembler-custom))
3594
3595(defun gdb-assembler-custom ()
3596 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
3597 (pos 1) (address) (flag) (bptno))
3598 (with-current-buffer buffer
3599 (save-excursion
3600 (if (not (equal gdb-pc-address "main"))
3601 (progn
3602 (goto-char (point-min))
3603 (if (and gdb-pc-address
3604 (search-forward gdb-pc-address nil t))
3605 (progn
3606 (setq pos (point))
3607 (beginning-of-line)
3608 (setq fringe-indicator-alist
3609 (if (string-equal gdb-frame-number "0")
3610 nil
3611 '((overlay-arrow . hollow-right-triangle))))
3612 (or gdb-overlay-arrow-position
3613 (setq gdb-overlay-arrow-position (make-marker)))
3614 (set-marker gdb-overlay-arrow-position (point))))))
3615 ;; remove all breakpoint-icons in assembler buffer before updating.
3616 (gdb-remove-breakpoint-icons (point-min) (point-max))))
3617 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
3618 (goto-char (point-min))
3619 (while (< (point) (- (point-max) 1))
3620 (forward-line 1)
3621 (when (looking-at
3622 "\\([0-9]+\\.?[0-9]*\\).*?\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)")
3623 (setq bptno (match-string 1))
3624 (setq flag (char-after (match-beginning 2)))
3625 (setq address (match-string 3))
3626 (with-current-buffer buffer
3627 (save-excursion
3628 (goto-char (point-min))
3629 (if (re-search-forward (concat "^0x0*" address) nil t)
3630 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))
3631 (if (not (equal gdb-pc-address "main"))
3632 (with-current-buffer buffer
3633 (set-window-point (get-buffer-window buffer 0) pos)))))
3634
3635(defvar gdb-assembler-mode-map
3636 (let ((map (make-sparse-keymap)))
3637 (suppress-keymap map)
3638 (define-key map "q" 'kill-this-buffer)
3639 map))
3640
3641(defvar gdb-assembler-font-lock-keywords
3642 '(;; <__function.name+n>
3643 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
3644 (1 font-lock-function-name-face))
3645 ;; 0xNNNNNNNN <__function.name+n>: opcode
3646 ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)"
3647 (4 font-lock-keyword-face))
3648 ;; %register(at least i386)
3649 ("%\\sw+" . font-lock-variable-name-face)
3650 ("^\\(Dump of assembler code for function\\) \\(.+\\):"
3651 (1 font-lock-comment-face)
3652 (2 font-lock-function-name-face))
3653 ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face))
3654 "Font lock keywords used in `gdb-assembler-mode'.")
3655
3656(defun gdb-assembler-mode ()
3657 "Major mode for viewing code assembler.
3658
3659\\{gdb-assembler-mode-map}"
3660 (kill-all-local-variables)
3661 (setq major-mode 'gdb-assembler-mode)
3662 (setq mode-name (concat "Machine:" gdb-selected-frame))
3663 (setq gdb-overlay-arrow-position nil)
3664 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
3665 (setq fringes-outside-margins t)
3666 (setq buffer-read-only t)
3667 (buffer-disable-undo)
3668 (gdb-thread-identification)
3669 (use-local-map gdb-assembler-mode-map)
3670 (gdb-invalidate-assembler)
3671 (set (make-local-variable 'font-lock-defaults)
3672 '(gdb-assembler-font-lock-keywords))
3673 (run-mode-hooks 'gdb-assembler-mode-hook)
3674 'gdb-invalidate-assembler)
3675
3676(defun gdb-assembler-buffer-name ()
3677 (with-current-buffer gud-comint-buffer
3678 (concat "*disassembly of " (gdb-get-target-string) "*")))
3679
3680(defun gdb-display-assembler-buffer ()
3681 "Display disassembly view."
3682 (interactive)
3683 (setq gdb-previous-frame nil)
3684 (gdb-display-buffer
3685 (gdb-get-buffer-create 'gdb-assembler-buffer) t))
3686
3687(defun gdb-frame-assembler-buffer ()
3688 "Display disassembly view in a new frame."
3689 (interactive)
3690 (setq gdb-previous-frame nil)
3691 (let ((special-display-regexps (append special-display-regexps '(".*")))
3692 (special-display-frame-alist gdb-frame-parameters))
3693 (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer))))
3694
3695;; modified because if gdb-pc-address has changed value a new command
3696;; must be enqueued to update the buffer with the new output
3697(defun gdb-invalidate-assembler (&optional ignored)
3698 (if (gdb-get-buffer 'gdb-assembler-buffer)
3699 (progn
3700 (unless (and gdb-selected-frame
3701 (string-equal gdb-selected-frame gdb-previous-frame))
3702 (if (or (not (member 'gdb-invalidate-assembler
3703 gdb-pending-triggers))
3704 (not (equal (string-to-number gdb-pc-address)
3705 (string-to-number
3706 gdb-previous-frame-pc-address))))
3707 (progn
3708 ;; take previous disassemble command, if any, off the queue
3709 (with-current-buffer gud-comint-buffer
3710 (let ((queue gdb-input-queue))
3711 (dolist (item queue)
3712 (if (equal (cdr item) '(gdb-assembler-handler))
3713 (setq gdb-input-queue
3714 (delete item gdb-input-queue))))))
3715 (gdb-enqueue-input
3716 (list
3717 (concat gdb-server-prefix "disassemble " gdb-pc-address "\n")
3718 'gdb-assembler-handler))
3719 (push 'gdb-invalidate-assembler gdb-pending-triggers)
3720 (setq gdb-previous-frame-pc-address gdb-pc-address)
3721 (setq gdb-previous-frame gdb-selected-frame)))))))
3722
3723(defun gdb-get-selected-frame ()
3724 (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
3725 (progn
3726 (if (string-equal gdb-version "pre-6.4")
3727 (gdb-enqueue-input
3728 (list (concat gdb-server-prefix "info frame\n")
3729 'gdb-frame-handler))
3730 (gdb-enqueue-input
3731 (list "server interpreter mi -stack-info-frame\n"
3732 'gdb-frame-handler-1)))
3733 (push 'gdb-get-selected-frame gdb-pending-triggers))))
3734
3735(defun gdb-frame-handler ()
3736 (setq gdb-pending-triggers
3737 (delq 'gdb-get-selected-frame gdb-pending-triggers))
3738 (goto-char (point-min))
3739 (when (re-search-forward
3740 "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t)
3741 (setq gdb-frame-number (match-string 1))
3742 (setq gdb-frame-address (match-string 2)))
3743 (goto-char (point-min))
3744 (when (re-search-forward ".*=\\s-+\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\
3745\\(?: (\\(\\S-+?\\):[0-9]+?)\\)*; "
3746 nil t)
3747 (setq gdb-selected-frame (match-string 2))
3748 (if (gdb-get-buffer 'gdb-locals-buffer)
3749 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
3750 (setq mode-name (concat "Locals:" gdb-selected-frame))))
3751 (if (gdb-get-buffer 'gdb-assembler-buffer)
3752 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
3753 (setq mode-name (concat "Machine:" gdb-selected-frame))))
3754 (setq gdb-pc-address (match-string 1))
3755 (if (and (match-string 3) gud-overlay-arrow-position)
3756 (let ((buffer (marker-buffer gud-overlay-arrow-position))
3757 (position (marker-position gud-overlay-arrow-position)))
3758 (when (and buffer
3759 (string-equal (file-name-nondirectory
3760 (buffer-file-name buffer))
3761 (file-name-nondirectory (match-string 3))))
3762 (with-current-buffer buffer
3763 (setq fringe-indicator-alist
3764 (if (string-equal gdb-frame-number "0")
3765 nil
3766 '((overlay-arrow . hollow-right-triangle))))
3767 (set-marker gud-overlay-arrow-position position))))))
3768 (goto-char (point-min))
3769 (if (re-search-forward " source language \\(\\S-+\\)\." nil t)
3770 (setq gdb-current-language (match-string 1)))
3771 (gdb-invalidate-assembler))
3772
3773
3774;; Code specific to GDB 6.4
3775(defconst gdb-source-file-regexp-1 "fullname=\"\\(.*?\\)\"")
3776
3777(defun gdb-set-gud-minor-mode-existing-buffers-1 ()
3778 "Create list of source files for current GDB session.
3779If buffers already exist for any of these files, `gud-minor-mode'
3780is set in them."
3781 (goto-char (point-min))
3782 (while (re-search-forward gdb-source-file-regexp-1 nil t)
3783 (push (match-string 1) gdb-source-file-list))
3784 (dolist (buffer (buffer-list))
3785 (with-current-buffer buffer
3786 (when (member buffer-file-name gdb-source-file-list)
3787 (gdb-init-buffer))))
3788 (gdb-force-mode-line-update
3789 (propertize "ready" 'face font-lock-variable-name-face)))
3790
3791;; Used for -stack-info-frame but could be used for -stack-list-frames too.
3792(defconst gdb-stack-list-frames-regexp
3793".*?level=\"\\(.*?\\)\".*?,addr=\"\\(.*?\\)\".*?,func=\"\\(.*?\\)\",\
3794\\(?:.*?file=\".*?\".*?,fullname=\"\\(.*?\\)\".*?,line=\"\\(.*?\\)\".*?}\\|\
3795from=\"\\(.*?\\)\"\\)")
3796
3797(defun gdb-frame-handler-1 ()
3798 (setq gdb-pending-triggers
3799 (delq 'gdb-get-selected-frame gdb-pending-triggers))
3800 (goto-char (point-min))
3801 (when (re-search-forward gdb-stack-list-frames-regexp nil t)
3802 (setq gdb-frame-number (match-string 1))
3803 (setq gdb-pc-address (match-string 2))
3804 (setq gdb-selected-frame (match-string 3))
3805 (if (gdb-get-buffer 'gdb-locals-buffer)
3806 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
3807 (setq mode-name (concat "Locals:" gdb-selected-frame))))
3808 (if (gdb-get-buffer 'gdb-assembler-buffer)
3809 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
3810 (setq mode-name (concat "Machine:" gdb-selected-frame)))))
3811 (if (and (match-string 4) (match-string 5) gud-overlay-arrow-position)
3812 (let ((buffer (marker-buffer gud-overlay-arrow-position))
3813 (position (marker-position gud-overlay-arrow-position)))
3814 (when (and buffer
3815 (string-equal (file-name-nondirectory
3816 (buffer-file-name buffer))
3817 (file-name-nondirectory (match-string 4))))
3818 (with-current-buffer buffer
3819 (setq fringe-indicator-alist
3820 (if (string-equal gdb-frame-number "0")
3821 nil
3822 '((overlay-arrow . hollow-right-triangle))))
3823 (set-marker gud-overlay-arrow-position position)))))
3824 (gdb-invalidate-assembler))
3825
3826; Uses "-var-list-children --all-values". Needs GDB 6.4 onwards.
3827(defun gdb-var-list-children-1 (varnum)
3828 (gdb-enqueue-input
3829 (list
3830 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3831 (concat "server interpreter mi \"-var-list-children --all-values \\\""
3832 varnum "\\\"\"\n")
3833 (concat "-var-list-children --all-values \"" varnum "\"\n"))
3834 `(lambda () (gdb-var-list-children-handler-1 ,varnum)))))
3835
3836(defun gdb-var-list-children-handler-1 (varnum)
3837 (let* ((var-list nil)
3838 (output (bindat-get-field (gdb-json-partial-output "child")))
3839 (children (bindat-get-field output 'children)))
3840 (catch 'child-already-watched
3841 (dolist (var gdb-var-list)
3842 (if (string-equal varnum (car var))
3843 (progn
3844 ;; With dynamic varobjs numchild may have increased.
3845 (setcar (nthcdr 2 var) (bindat-get-field output 'numchild))
3846 (push var var-list)
3847 (dolist (child children)
3848 (let ((varchild (list (bindat-get-field child 'name)
3849 (bindat-get-field child 'exp)
3850 (bindat-get-field child 'numchild)
3851 (bindat-get-field child 'type)
3852 (bindat-get-field child 'value)
3853 nil
3854 (bindat-get-field child 'has_more))))
3855 (if (assoc (car varchild) gdb-var-list)
3856 (throw 'child-already-watched nil))
3857 (push varchild var-list))))
3858 (push var var-list)))
3859 (setq gdb-var-list (nreverse var-list))))
3860 (gdb-speedbar-update))
3861
3862; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
3863(defun gdb-var-update-1 ()
3864 (if (not (member 'gdb-var-update gdb-pending-triggers))
3865 (progn
3866 (gdb-enqueue-input
3867 (list
3868 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3869 "server interpreter mi \"-var-update --all-values *\"\n"
3870 "-var-update --all-values *\n")
3871 'gdb-var-update-handler-1))
3872 (push 'gdb-var-update gdb-pending-triggers))))
3873
3874(defun gdb-var-update-handler-1 ()
3875 (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist)))
3876 (dolist (var gdb-var-list)
3877 (setcar (nthcdr 5 var) nil))
3878 (let ((temp-var-list gdb-var-list))
3879 (dolist (change changelist)
3880 (let* ((varnum (bindat-get-field change 'name))
3881 (var (assoc varnum gdb-var-list))
3882 (new-num (bindat-get-field change 'new_num_children)))
3883 (when var
3884 (let ((scope (bindat-get-field change 'in_scope))
3885 (has-more (bindat-get-field change 'has_more)))
3886 (cond ((string-equal scope "false")
3887 (if gdb-delete-out-of-scope
3888 (gdb-var-delete-1 var varnum)
3889 (setcar (nthcdr 5 var) 'out-of-scope)))
3890 ((string-equal scope "true")
3891 (setcar (nthcdr 6 var) has-more)
3892 (when (and (or (not has-more)
3893 (string-equal has-more "0"))
3894 (not new-num)
3895 (string-equal (nth 2 var) "0"))
3896 (setcar (nthcdr 4 var)
3897 (bindat-get-field change 'value))
3898 (setcar (nthcdr 5 var) 'changed)))
3899 ((string-equal scope "invalid")
3900 (gdb-var-delete-1 var varnum)))))
3901 (let ((var-list nil) var1
3902 (children (bindat-get-field change 'new_children)))
3903 (if new-num
3904 (progn
3905 (setq var1 (pop temp-var-list))
3906 (while var1
3907 (if (string-equal varnum (car var1))
3908 (let ((new (string-to-number new-num))
3909 (previous (string-to-number (nth 2 var1))))
3910 (setcar (nthcdr 2 var1) new-num)
3911 (push var1 var-list)
3912 (cond ((> new previous)
3913 ;; Add new children to list.
3914 (dotimes (dummy previous)
3915 (push (pop temp-var-list) var-list))
3916 (dolist (child children)
3917 (let ((varchild
3918 (list (bindat-get-field child 'name)
3919 (bindat-get-field child 'exp)
3920 (bindat-get-field child 'numchild)
3921 (bindat-get-field child 'type)
3922 (bindat-get-field child 'value)
3923 'changed
3924 (bindat-get-field child 'has_more))))
3925 (push varchild var-list))))
3926 ;; Remove deleted children from list.
3927 ((< new previous)
3928 (dotimes (dummy new)
3929 (push (pop temp-var-list) var-list))
3930 (dotimes (dummy (- previous new))
3931 (pop temp-var-list)))))
3932 (push var1 var-list))
3933 (setq var1 (pop temp-var-list)))
3934 (setq gdb-var-list (nreverse var-list)))))))))
3935 (setq gdb-pending-triggers
3936 (delq 'gdb-var-update gdb-pending-triggers))
3937 (gdb-speedbar-update))
3938
3939;; Registers buffer.
3940;;
3941(gdb-set-buffer-rules 'gdb-registers-buffer
3942 'gdb-registers-buffer-name
3943 'gdb-registers-mode)
3944
3945(def-gdb-auto-update-trigger gdb-invalidate-registers-1
3946 (gdb-get-buffer 'gdb-registers-buffer)
3947 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3948 "server interpreter mi \"-data-list-register-values x\"\n"
3949 "-data-list-register-values x\n")
3950 gdb-data-list-register-values-handler)
3951
3952(defconst gdb-data-list-register-values-regexp
3953 "{.*?number=\"\\(.*?\\)\".*?,value=\"\\(.*?\\)\".*?}")
3954
3955(defun gdb-data-list-register-values-handler ()
3956 (setq gdb-pending-triggers (delq 'gdb-invalidate-registers-1
3957 gdb-pending-triggers))
3958 (goto-char (point-min))
3959 (if (re-search-forward gdb-error-regexp nil t)
3960 (let ((err (match-string 1)))
3961 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
3962 (let ((buffer-read-only nil))
3963 (erase-buffer)
3964 (put-text-property 0 (length err) 'face font-lock-warning-face err)
3965 (insert err)
3966 (goto-char (point-min)))))
3967 (let ((register-list (reverse gdb-register-names))
3968 (register nil) (register-string nil) (register-values nil))
3969 (goto-char (point-min))
3970 (while (re-search-forward gdb-data-list-register-values-regexp nil t)
3971 (setq register (pop register-list))
3972 (setq register-string (concat register "\t" (match-string 2) "\n"))
3973 (if (member (match-string 1) gdb-changed-registers)
3974 (put-text-property 0 (length register-string)
3975 'face 'font-lock-warning-face
3976 register-string))
3977 (setq register-values
3978 (concat register-values register-string)))
3979 (let ((buf (gdb-get-buffer 'gdb-registers-buffer)))
3980 (with-current-buffer buf
3981 (let* ((window (get-buffer-window buf 0))
3982 (start (window-start window))
3983 (p (if window (window-point window) (point)))
3984 (buffer-read-only nil))
3985 (erase-buffer)
3986 (insert register-values)
3987 (if window
3988 (progn
3989 (set-window-start window start)
3990 (set-window-point window p))
3991 (goto-char p)))))))
3992 (gdb-data-list-register-values-custom))
3993
3994(defun gdb-data-list-register-values-custom ()
3995 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
3996 (save-excursion
3997 (let ((buffer-read-only nil)
3998 start end)
3999 (goto-char (point-min))
4000 (while (< (point) (point-max))
4001 (setq start (line-beginning-position))
4002 (setq end (line-end-position))
4003 (when (looking-at "^[^\t]+")
4004 (unless (string-equal (match-string 0) "No registers.")
4005 (put-text-property start (match-end 0)
4006 'face font-lock-variable-name-face)
4007 (add-text-properties start end
4008 '(help-echo "mouse-2: edit value"
4009 mouse-face highlight))))
4010 (forward-line 1))))))
4011
4012;; Needs GDB 6.4 onwards (used to fail with no stack).
4013(defun gdb-get-changed-registers ()
4014 (if (and (gdb-get-buffer 'gdb-registers-buffer)
4015 (not (member 'gdb-get-changed-registers gdb-pending-triggers)))
4016 (progn
4017 (gdb-enqueue-input
4018 (list
4019 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
4020 "server interpreter mi -data-list-changed-registers\n"
4021 "-data-list-changed-registers\n")
4022 'gdb-get-changed-registers-handler))
4023 (push 'gdb-get-changed-registers gdb-pending-triggers))))
4024
4025(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"")
4026
4027(defun gdb-get-changed-registers-handler ()
4028 (setq gdb-pending-triggers
4029 (delq 'gdb-get-changed-registers gdb-pending-triggers))
4030 (setq gdb-changed-registers nil)
4031 (goto-char (point-min))
4032 (while (re-search-forward gdb-data-list-register-names-regexp nil t)
4033 (push (match-string 1) gdb-changed-registers)))
4034
4035
4036;; Locals buffer.
4037;;
4038;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
4039(gdb-set-buffer-rules 'gdb-locals-buffer
4040 'gdb-locals-buffer-name
4041 'gdb-locals-mode)
4042
4043(def-gdb-auto-update-trigger gdb-invalidate-locals-1
4044 (gdb-get-buffer 'gdb-locals-buffer)
4045 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
4046 "server interpreter mi -\"stack-list-locals --simple-values\"\n"
4047 "-stack-list-locals --simple-values\n")
4048 gdb-stack-list-locals-handler)
4049
4050(defconst gdb-stack-list-locals-regexp
4051 "{.*?name=\"\\(.*?\\)\".*?,type=\"\\(.*?\\)\"")
4052
4053(defvar gdb-locals-watch-map-1
4054 (let ((map (make-sparse-keymap)))
4055 (suppress-keymap map)
4056 (define-key map "\r" 'gud-watch)
4057 (define-key map [mouse-2] 'gud-watch)
4058 map)
4059 "Keymap to create watch expression of a complex data type local variable.")
4060
4061(defvar gdb-edit-locals-map-1
4062 (let ((map (make-sparse-keymap)))
4063 (suppress-keymap map)
4064 (define-key map "\r" 'gdb-edit-locals-value)
4065 (define-key map [mouse-2] 'gdb-edit-locals-value)
4066 map)
4067 "Keymap to edit value of a simple data type local variable.")
4068
4069(defun gdb-edit-locals-value (&optional event)
4070 "Assign a value to a variable displayed in the locals buffer."
4071 (interactive (list last-input-event))
4072 (save-excursion
4073 (if event (posn-set-point (event-end event)))
4074 (beginning-of-line)
4075 (let* ((var (current-word))
4076 (value (read-string (format "New value (%s): " var))))
4077 (gdb-enqueue-input
4078 (list (concat gdb-server-prefix "set variable " var " = " value "\n")
4079 'ignore)))))
4080
4081;; Dont display values of arrays or structures.
4082;; These can be expanded using gud-watch.
4083(defun gdb-stack-list-locals-handler ()
4084 (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1
4085 gdb-pending-triggers))
4086 (goto-char (point-min))
4087 (if (re-search-forward gdb-error-regexp nil t)
4088 (let ((err (match-string 1)))
4089 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
4090 (let ((buffer-read-only nil))
4091 (erase-buffer)
4092 (insert err)
4093 (goto-char (point-min)))))
4094 (let (local locals-list)
4095 (goto-char (point-min))
4096 (while (re-search-forward gdb-stack-list-locals-regexp nil t)
4097 (let ((local (list (match-string 1)
4098 (match-string 2)
4099 nil)))
4100 (if (looking-at ",value=\\(\".*\"\\).*?}")
4101 (setcar (nthcdr 2 local) (read (match-string 1))))
4102 (push local locals-list)))
4103 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
4104 (and buf (with-current-buffer buf
4105 (let* ((window (get-buffer-window buf 0))
4106 (start (window-start window))
4107 (p (if window (window-point window) (point)))
4108 (buffer-read-only nil) (name) (value))
4109 (erase-buffer)
4110 (dolist (local locals-list)
4111 (setq name (car local))
4112 (setq value (nth 2 local))
4113 (if (or (not value)
4114 (string-match "^\\0x" value))
4115 (add-text-properties 0 (length name)
4116 `(mouse-face highlight
4117 help-echo "mouse-2: create watch expression"
4118 local-map ,gdb-locals-watch-map-1)
4119 name)
4120 (add-text-properties 0 (length value)
4121 `(mouse-face highlight
4122 help-echo "mouse-2: edit value"
4123 local-map ,gdb-edit-locals-map-1)
4124 value))
4125 (insert
4126 (concat name "\t" (nth 1 local)
4127 "\t" value "\n")))
4128 (if window
4129 (progn
4130 (set-window-start window start)
4131 (set-window-point window p))
4132 (goto-char p)))))))))
4133
4134(defun gdb-get-register-names ()
4135 "Create a list of register names."
4136 (goto-char (point-min))
4137 (while (re-search-forward gdb-data-list-register-names-regexp nil t)
4138 (push (match-string 1) gdb-register-names)))
4139
4140(provide 'gdb-ui)
4141
4142;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352
4143;;; gdb-ui.el ends here
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index bee7a062f64..da38a086782 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -43,10 +43,8 @@
43(require 'comint) 43(require 'comint)
44 44
45(defvar gdb-active-process) 45(defvar gdb-active-process)
46(defvar gdb-recording)
47(defvar gdb-define-alist) 46(defvar gdb-define-alist)
48(defvar gdb-macro-info) 47(defvar gdb-macro-info)
49(defvar gdb-server-prefix)
50(defvar gdb-show-changed-values) 48(defvar gdb-show-changed-values)
51(defvar gdb-source-window) 49(defvar gdb-source-window)
52(defvar gdb-var-list) 50(defvar gdb-var-list)
@@ -126,77 +124,52 @@ Used to grey out relevant toolbar icons.")
126 (throw 'info-found nil)))) 124 (throw 'info-found nil))))
127 nil 0) 125 nil 0)
128 (select-frame (make-frame))) 126 (select-frame (make-frame)))
129 (if (memq gud-minor-mode '(gdbmi gdba)) 127 (if (eq gud-minor-mode 'gdbmi)
130 (info "(emacs)GDB Graphical Interface") 128 (info "(emacs)GDB Graphical Interface")
131 (info "(emacs)Debuggers")))) 129 (info "(emacs)Debuggers"))))
132 130
133(defun gud-tool-bar-item-visible-no-fringe () 131(defun gud-tool-bar-item-visible-no-fringe ()
134 (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) 132 (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode)
135 (and (memq gud-minor-mode '(gdbmi gdba)) 133 (eq (buffer-local-value 'major-mode (window-buffer)) 'gdb-memory-mode)
134 (and (eq gud-minor-mode 'gdbmi)
136 (> (car (window-fringes)) 0))))) 135 (> (car (window-fringes)) 0)))))
137 136
137(declare-function gdb-gud-context-command "gdb-mi.el")
138
138(defun gud-stop-subjob () 139(defun gud-stop-subjob ()
139 (interactive) 140 (interactive)
140 (with-current-buffer gud-comint-buffer 141 (with-current-buffer gud-comint-buffer
141 (if (string-equal gud-target-name "emacs") 142 (cond ((string-equal gud-target-name "emacs")
142 (comint-stop-subjob) 143 (comint-stop-subjob))
143 (if (eq gud-minor-mode 'jdb) 144 ((eq gud-minor-mode 'jdb)
144 (gud-call "suspend") 145 (gud-call "suspend"))
145 (comint-interrupt-subjob))))) 146 ((eq gud-minor-mode 'gdbmi)
147 (gud-call (gdb-gud-context-command "-exec-interrupt")))
148 (t
149 (comint-interrupt-subjob)))))
146 150
147(easy-mmode-defmap gud-menu-map 151(easy-mmode-defmap gud-menu-map
148 '(([help] "Info (debugger)" . gud-goto-info) 152 '(([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)))
179 ([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode 153 ([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode
180 :enable (and (not emacs-basic-display) 154 :enable (and (not emacs-basic-display)
181 (display-graphic-p) 155 (display-graphic-p)
182 (fboundp 'x-show-tip)) 156 (fboundp 'x-show-tip))
183 :visible (memq gud-minor-mode 157 :visible (memq gud-minor-mode
184 '(gdbmi gdba dbx sdb xdb pdb)) 158 '(gdbmi dbx sdb xdb pdb))
185 :button (:toggle . gud-tooltip-mode)) 159 :button (:toggle . gud-tooltip-mode))
186 ([refresh] "Refresh" . gud-refresh) 160 ([refresh] "Refresh" . gud-refresh)
187 ([run] menu-item "Run" gud-run 161 ([run] menu-item "Run" gud-run
188 :enable (not gud-running) 162 :enable (not gud-running)
189 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) 163 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
190 ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go 164 ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go
191 :visible (and (not gud-running) 165 :visible (and (eq gud-minor-mode 'gdbmi)
192 (eq gud-minor-mode 'gdba))) 166 (gdb-show-run-p)))
193 ([stop] menu-item "Stop" gud-stop-subjob 167 ([stop] menu-item "Stop" gud-stop-subjob
194 :visible (or (not (memq gud-minor-mode '(gdba pdb))) 168 :visible (or (not (memq gud-minor-mode '(gdbmi pdb)))
195 (and gud-running 169 (gdb-show-stop-p)))
196 (eq gud-minor-mode 'gdba))))
197 ([until] menu-item "Continue to selection" gud-until 170 ([until] menu-item "Continue to selection" gud-until
198 :enable (not gud-running) 171 :enable (not gud-running)
199 :visible (and (memq gud-minor-mode '(gdbmi gdba gdb perldb)) 172 :visible (and (memq gud-minor-mode '(gdbmi gdb perldb))
200 (gud-tool-bar-item-visible-no-fringe))) 173 (gud-tool-bar-item-visible-no-fringe)))
201 ([remove] menu-item "Remove Breakpoint" gud-remove 174 ([remove] menu-item "Remove Breakpoint" gud-remove
202 :enable (not gud-running) 175 :enable (not gud-running)
@@ -204,50 +177,52 @@ Used to grey out relevant toolbar icons.")
204 ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak 177 ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
205 :enable (not gud-running) 178 :enable (not gud-running)
206 :visible (memq gud-minor-mode 179 :visible (memq gud-minor-mode
207 '(gdbmi gdba gdb sdb xdb))) 180 '(gdbmi gdb sdb xdb)))
208 ([break] menu-item "Set Breakpoint" gud-break 181 ([break] menu-item "Set Breakpoint" gud-break
209 :enable (not gud-running) 182 :enable (not gud-running)
210 :visible (gud-tool-bar-item-visible-no-fringe)) 183 :visible (gud-tool-bar-item-visible-no-fringe))
211 ([up] menu-item "Up Stack" gud-up 184 ([up] menu-item "Up Stack" gud-up
212 :enable (not gud-running) 185 :enable (not gud-running)
213 :visible (memq gud-minor-mode 186 :visible (memq gud-minor-mode
214 '(gdbmi gdba gdb dbx xdb jdb pdb))) 187 '(gdbmi gdb dbx xdb jdb pdb)))
215 ([down] menu-item "Down Stack" gud-down 188 ([down] menu-item "Down Stack" gud-down
216 :enable (not gud-running) 189 :enable (not gud-running)
217 :visible (memq gud-minor-mode 190 :visible (memq gud-minor-mode
218 '(gdbmi gdba gdb dbx xdb jdb pdb))) 191 '(gdbmi gdb dbx xdb jdb pdb)))
219 ([pp] menu-item "Print S-expression" gud-pp 192 ([pp] menu-item "Print S-expression" gud-pp
220 :enable (and (not gud-running) 193 :enable (and (not gud-running)
221 gdb-active-process) 194 gdb-active-process)
222 :visible (and (string-equal 195 :visible (and (string-equal
223 (buffer-local-value 196 (buffer-local-value
224 'gud-target-name gud-comint-buffer) "emacs") 197 'gud-target-name gud-comint-buffer) "emacs")
225 (eq gud-minor-mode 'gdba))) 198 (eq gud-minor-mode 'gdbmi)))
226 ([print*] menu-item "Print Dereference" gud-pstar 199 ([print*] menu-item (if (eq gud-minor-mode 'jdb)
200 "Dump object"
201 "Print Dereference") gud-pstar
227 :enable (not gud-running) 202 :enable (not gud-running)
228 :visible (memq gud-minor-mode '(gdbmi gdba gdb))) 203 :visible (memq gud-minor-mode '(gdbmi gdb jdb)))
229 ([print] menu-item "Print Expression" gud-print 204 ([print] menu-item "Print Expression" gud-print
230 :enable (not gud-running)) 205 :enable (not gud-running))
231 ([watch] menu-item "Watch Expression" gud-watch 206 ([watch] menu-item "Watch Expression" gud-watch
232 :enable (not gud-running) 207 :enable (not gud-running)
233 :visible (memq gud-minor-mode '(gdbmi gdba))) 208 :visible (eq gud-minor-mode 'gdbmi))
234 ([finish] menu-item "Finish Function" gud-finish 209 ([finish] menu-item "Finish Function" gud-finish
235 :enable (not gud-running) 210 :enable (not gud-running)
236 :visible (memq gud-minor-mode 211 :visible (memq gud-minor-mode
237 '(gdbmi gdba gdb xdb jdb pdb))) 212 '(gdbmi gdb xdb jdb pdb)))
238 ([stepi] menu-item "Step Instruction" gud-stepi 213 ([stepi] menu-item "Step Instruction" gud-stepi
239 :enable (not gud-running) 214 :enable (not gud-running)
240 :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx))) 215 :visible (memq gud-minor-mode '(gdbmi gdb dbx)))
241 ([nexti] menu-item "Next Instruction" gud-nexti 216 ([nexti] menu-item "Next Instruction" gud-nexti
242 :enable (not gud-running) 217 :enable (not gud-running)
243 :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx))) 218 :visible (memq gud-minor-mode '(gdbmi gdb dbx)))
244 ([step] menu-item "Step Line" gud-step 219 ([step] menu-item "Step Line" gud-step
245 :enable (not gud-running)) 220 :enable (not gud-running))
246 ([next] menu-item "Next Line" gud-next 221 ([next] menu-item "Next Line" gud-next
247 :enable (not gud-running)) 222 :enable (not gud-running))
248 ([cont] menu-item "Continue" gud-cont 223 ([cont] menu-item "Continue" gud-cont
249 :enable (not gud-running) 224 :enable (not gud-running)
250 :visible (not (eq gud-minor-mode 'gdba)))) 225 :visible (not (eq gud-minor-mode 'gdbmi))))
251 "Menu for `gud-mode'." 226 "Menu for `gud-mode'."
252 :name "Gud") 227 :name "Gud")
253 228
@@ -269,21 +244,22 @@ Used to grey out relevant toolbar icons.")
269 . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next)) 244 . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next))
270 ([menu-bar until] menu-item 245 ([menu-bar until] menu-item
271 ,(propertize "until" 'face 'font-lock-doc-face) gud-until 246 ,(propertize "until" 'face 'font-lock-doc-face) gud-until
272 :visible (memq gud-minor-mode '(gdbmi gdba gdb perldb))) 247 :visible (memq gud-minor-mode '(gdbmi gdb perldb)))
273 ([menu-bar cont] menu-item 248 ([menu-bar cont] menu-item
274 ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont 249 ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont
275 :visible (not (eq gud-minor-mode 'gdba))) 250 :visible (not (eq gud-minor-mode 'gdbmi)))
276 ([menu-bar run] menu-item 251 ([menu-bar run] menu-item
277 ,(propertize "run" 'face 'font-lock-doc-face) gud-run 252 ,(propertize "run" 'face 'font-lock-doc-face) gud-run
278 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) 253 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
279 ([menu-bar go] menu-item 254 ([menu-bar go] menu-item
280 ,(propertize " go " 'face 'font-lock-doc-face) gud-go 255 ,(propertize " go " 'face 'font-lock-doc-face) gud-go
281 :visible (and (not gud-running) 256 :visible (and (eq gud-minor-mode 'gdbmi)
282 (eq gud-minor-mode 'gdba))) 257 (gdb-show-run-p)))
283 ([menu-bar stop] menu-item 258 ([menu-bar stop] menu-item
284 ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob 259 ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob
285 :visible (and gud-running 260 :visible (or (and (eq gud-minor-mode 'gdbmi)
286 (eq gud-minor-mode 'gdba))) 261 (gdb-show-stop-p))
262 (not (eq gud-minor-mode 'gdbmi))))
287 ([menu-bar print] 263 ([menu-bar print]
288 . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) 264 . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print))
289 ([menu-bar tools] . undefined) 265 ([menu-bar tools] . undefined)
@@ -322,14 +298,6 @@ Used to grey out relevant toolbar icons.")
322 (gud-stepi . "gud/stepi") 298 (gud-stepi . "gud/stepi")
323 (gud-up . "gud/up") 299 (gud-up . "gud/up")
324 (gud-down . "gud/down") 300 (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")
333 (gud-goto-info . "info")) 301 (gud-goto-info . "info"))
334 map) 302 map)
335 (tool-bar-local-item-from-menu 303 (tool-bar-local-item-from-menu
@@ -354,7 +322,7 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
354 (setq directories (cdr directories))) 322 (setq directories (cdr directories)))
355 result))) 323 result)))
356 324
357(declare-function gdb-create-define-alist "gdb-ui" ()) 325(declare-function gdb-create-define-alist "gdb-mi" ())
358 326
359(defun gud-find-file (file) 327(defun gud-find-file (file)
360 ;; Don't get confused by double slashes in the name that comes from GDB. 328 ;; Don't get confused by double slashes in the name that comes from GDB.
@@ -370,7 +338,7 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
370 (set (make-local-variable 'gud-minor-mode) minor-mode) 338 (set (make-local-variable 'gud-minor-mode) minor-mode)
371 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) 339 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
372 (when (and gud-tooltip-mode 340 (when (and gud-tooltip-mode
373 (memq gud-minor-mode '(gdbmi gdba))) 341 (eq gud-minor-mode 'gdbmi))
374 (make-local-variable 'gdb-define-alist) 342 (make-local-variable 'gdb-define-alist)
375 (unless gdb-define-alist (gdb-create-define-alist)) 343 (unless gdb-define-alist (gdb-create-define-alist))
376 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)) 344 (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
@@ -499,21 +467,21 @@ The value t means that there is no stack, and we are in display-file mode.")
499 467
500(defvar gud-speedbar-menu-items 468(defvar gud-speedbar-menu-items
501 '(["Jump to stack frame" speedbar-edit-line 469 '(["Jump to stack frame" speedbar-edit-line
502 :visible (not (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 470 :visible (not (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
503 '(gdbmi gdba)))] 471 'gdbmi))]
504 ["Edit value" speedbar-edit-line 472 ["Edit value" speedbar-edit-line
505 :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 473 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
506 '(gdbmi gdba))] 474 'gdbmi)]
507 ["Delete expression" gdb-var-delete 475 ["Delete expression" gdb-var-delete
508 :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 476 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
509 '(gdbmi gdba))] 477 'gdbmi)]
510 ["Auto raise frame" gdb-speedbar-auto-raise 478 ["Auto raise frame" gdb-speedbar-auto-raise
511 :style toggle :selected gdb-speedbar-auto-raise 479 :style toggle :selected gdb-speedbar-auto-raise
512 :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 480 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
513 '(gdbmi gdba))] 481 'gdbmi)]
514 ("Output Format" 482 ("Output Format"
515 :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 483 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
516 '(gdbmi gdba)) 484 'gdbmi)
517 ["Binary" (gdb-var-set-format "binary") t] 485 ["Binary" (gdb-var-set-format "binary") t]
518 ["Natural" (gdb-var-set-format "natural") t] 486 ["Natural" (gdb-var-set-format "natural") t]
519 ["Hexadecimal" (gdb-var-set-format "hexadecimal") t])) 487 ["Hexadecimal" (gdb-var-set-format "hexadecimal") t]))
@@ -542,7 +510,7 @@ required by the caller."
542 (start (window-start window)) 510 (start (window-start window))
543 (p (window-point window))) 511 (p (window-point window)))
544 (cond 512 (cond
545 ((memq minor-mode '(gdbmi gdba)) 513 ((eq minor-mode 'gdbmi)
546 (erase-buffer) 514 (erase-buffer)
547 (insert "Watch Expressions:\n") 515 (insert "Watch Expressions:\n")
548 (let ((var-list gdb-var-list) parent) 516 (let ((var-list gdb-var-list) parent)
@@ -632,7 +600,7 @@ required by the caller."
632 (car frame) 600 (car frame)
633 'speedbar-file-face 601 'speedbar-file-face
634 'speedbar-highlight-face 602 'speedbar-highlight-face
635 (cond ((memq minor-mode '(gdbmi gdba gdb)) 603 (cond ((memq minor-mode '(gdbmi gdb))
636 'gud-gdb-goto-stackframe) 604 'gud-gdb-goto-stackframe)
637 (t (error "Should never be here"))) 605 (t (error "Should never be here")))
638 frame t)))) 606 frame t))))
@@ -689,8 +657,6 @@ The option \"--fullname\" must be included in this value."
689 ;; Set the accumulator to the remaining text. 657 ;; Set the accumulator to the remaining text.
690 gud-marker-acc (substring gud-marker-acc (match-end 0)))) 658 gud-marker-acc (substring gud-marker-acc (match-end 0))))
691 659
692 ;; Check for annotations and change gud-minor-mode to 'gdba if
693 ;; they are found.
694 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) 660 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
695 (let ((match (match-string 1 gud-marker-acc))) 661 (let ((match (match-string 1 gud-marker-acc)))
696 662
@@ -754,10 +720,10 @@ The option \"--fullname\" must be included in this value."
754(defvar gud-filter-pending-text nil 720(defvar gud-filter-pending-text nil
755 "Non-nil means this is text that has been saved for later in `gud-filter'.") 721 "Non-nil means this is text that has been saved for later in `gud-filter'.")
756 722
757;; If in gdba mode, gdb-ui is loaded. 723;; If in gdb mode, gdb-mi is loaded.
758(declare-function gdb-restore-windows "gdb-ui" ()) 724(declare-function gdb-restore-windows "gdb-mi" ())
759 725
760;; The old gdb command (text command mode). The new one is in gdb-ui.el. 726;; The old gdb command (text command mode). The new one is in gdb-mi.el.
761;;;###autoload 727;;;###autoload
762(defun gud-gdb (command-line) 728(defun gud-gdb (command-line)
763 "Run gdb on program FILE in buffer *gud-FILE*. 729 "Run gdb on program FILE in buffer *gud-FILE*.
@@ -768,10 +734,10 @@ directory and source-file directory for your debugger."
768 (when (and gud-comint-buffer 734 (when (and gud-comint-buffer
769 (buffer-name gud-comint-buffer) 735 (buffer-name gud-comint-buffer)
770 (get-buffer-process gud-comint-buffer) 736 (get-buffer-process gud-comint-buffer)
771 (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))) 737 (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdbmi)))
772 (gdb-restore-windows) 738 (gdb-restore-windows)
773 (error 739 (error
774 "Multiple debugging requires restarting in text command mode")) 740 "Multiple debugging requires restarting in text command mode"))
775 741
776 (gud-common-init command-line nil 'gud-gdb-marker-filter) 742 (gud-common-init command-line nil 'gud-gdb-marker-filter)
777 (set (make-local-variable 'gud-minor-mode) 'gdb) 743 (set (make-local-variable 'gud-minor-mode) 'gdb)
@@ -2642,7 +2608,7 @@ It is saved for when this flag is not set.")
2642(defvar gud-overlay-arrow-position nil) 2608(defvar gud-overlay-arrow-position nil)
2643(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) 2609(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position)
2644 2610
2645(declare-function gdb-reset "gdb-ui" ()) 2611(declare-function gdb-reset "gdb-mi" ())
2646 2612
2647(defun gud-sentinel (proc msg) 2613(defun gud-sentinel (proc msg)
2648 (cond ((null (buffer-name (process-buffer proc))) 2614 (cond ((null (buffer-name (process-buffer proc)))
@@ -2654,14 +2620,14 @@ It is saved for when this flag is not set.")
2654 (string-equal speedbar-initial-expansion-list-name "GUD")) 2620 (string-equal speedbar-initial-expansion-list-name "GUD"))
2655 (speedbar-change-initial-expansion-list 2621 (speedbar-change-initial-expansion-list
2656 speedbar-previously-used-expansion-list-name)) 2622 speedbar-previously-used-expansion-list-name))
2657 (if (memq gud-minor-mode-type '(gdbmi gdba)) 2623 (if (eq gud-minor-mode-type 'gdbmi)
2658 (gdb-reset) 2624 (gdb-reset)
2659 (gud-reset))) 2625 (gud-reset)))
2660 ((memq (process-status proc) '(signal exit)) 2626 ((memq (process-status proc) '(signal exit))
2661 ;; Stop displaying an arrow in a source file. 2627 ;; Stop displaying an arrow in a source file.
2662 (setq gud-overlay-arrow-position nil) 2628 (setq gud-overlay-arrow-position nil)
2663 (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 2629 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
2664 '(gdba gdbmi)) 2630 'gdbmi)
2665 (gdb-reset) 2631 (gdb-reset)
2666 (gud-reset)) 2632 (gud-reset))
2667 (let* ((obuf (current-buffer))) 2633 (let* ((obuf (current-buffer)))
@@ -2692,7 +2658,9 @@ It is saved for when this flag is not set.")
2692(defun gud-kill-buffer-hook () 2658(defun gud-kill-buffer-hook ()
2693 (setq gud-minor-mode-type gud-minor-mode) 2659 (setq gud-minor-mode-type gud-minor-mode)
2694 (condition-case nil 2660 (condition-case nil
2695 (kill-process (get-buffer-process (current-buffer))) 2661 (progn
2662 (kill-process (get-buffer-process (current-buffer)))
2663 (delete-process (get-process "gdb-inferior")))
2696 (error nil))) 2664 (error nil)))
2697 2665
2698(defun gud-reset () 2666(defun gud-reset ()
@@ -2715,8 +2683,8 @@ Obeying it means displaying in another window the specified file and line."
2715 2683
2716(declare-function global-hl-line-highlight "hl-line" ()) 2684(declare-function global-hl-line-highlight "hl-line" ())
2717(declare-function hl-line-highlight "hl-line" ()) 2685(declare-function hl-line-highlight "hl-line" ())
2718(declare-function gdb-display-source-buffer "gdb-ui" (buffer)) 2686(declare-function gdb-display-source-buffer "gdb-mi" (buffer))
2719(declare-function gdb-display-buffer "gdb-ui" (buf dedicated &optional size)) 2687(declare-function gdb-display-buffer "gdb-mi" (buf dedicated &optional size))
2720 2688
2721;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen 2689;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
2722;; and that its line LINE is visible. 2690;; and that its line LINE is visible.
@@ -2732,7 +2700,7 @@ Obeying it means displaying in another window the specified file and line."
2732 (gud-find-file true-file))) 2700 (gud-find-file true-file)))
2733 (window (and buffer 2701 (window (and buffer
2734 (or (get-buffer-window buffer) 2702 (or (get-buffer-window buffer)
2735 (if (memq gud-minor-mode '(gdbmi gdba)) 2703 (if (eq gud-minor-mode 'gdbmi)
2736 (or (if (get-buffer-window buffer 'visible) 2704 (or (if (get-buffer-window buffer 'visible)
2737 (display-buffer buffer nil 'visible)) 2705 (display-buffer buffer nil 'visible))
2738 (unless (gdb-display-source-buffer buffer) 2706 (unless (gdb-display-source-buffer buffer)
@@ -2769,7 +2737,7 @@ Obeying it means displaying in another window the specified file and line."
2769 (goto-char pos)))) 2737 (goto-char pos))))
2770 (when window 2738 (when window
2771 (set-window-point window gud-overlay-arrow-position) 2739 (set-window-point window gud-overlay-arrow-position)
2772 (if (memq gud-minor-mode '(gdbmi gdba)) 2740 (if (eq gud-minor-mode 'gdbmi)
2773 (setq gdb-source-window window))))))) 2741 (setq gdb-source-window window)))))))
2774 2742
2775;; The gud-call function must do the right thing whether its invoking 2743;; The gud-call function must do the right thing whether its invoking
@@ -2875,7 +2843,7 @@ Obeying it means displaying in another window the specified file and line."
2875 (forward-line 0)) 2843 (forward-line 0))
2876 (if (looking-at comint-prompt-regexp) 2844 (if (looking-at comint-prompt-regexp)
2877 (set-marker gud-delete-prompt-marker (point))) 2845 (set-marker gud-delete-prompt-marker (point)))
2878 (if (memq gud-minor-mode '(gdbmi gdba)) 2846 (if (eq gud-minor-mode 'gdbmi)
2879 (apply comint-input-sender (list proc command)) 2847 (apply comint-input-sender (list proc command))
2880 (process-send-string proc (concat command "\n")))))))) 2848 (process-send-string proc (concat command "\n"))))))))
2881 2849
@@ -3301,14 +3269,14 @@ Treats actions as defuns."
3301 (gud-tooltip-activate-mouse-motions-if-enabled) 3269 (gud-tooltip-activate-mouse-motions-if-enabled)
3302 (if (and gud-comint-buffer 3270 (if (and gud-comint-buffer
3303 (buffer-name gud-comint-buffer); gud-comint-buffer might be killed 3271 (buffer-name gud-comint-buffer); gud-comint-buffer might be killed
3304 (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 3272 (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
3305 '(gdbmi gdba))) 3273 'gdbmi))
3306 (if gud-tooltip-mode 3274 (if gud-tooltip-mode
3307 (progn 3275 (progn
3308 (dolist (buffer (buffer-list)) 3276 (dolist (buffer (buffer-list))
3309 (unless (eq buffer gud-comint-buffer) 3277 (unless (eq buffer gud-comint-buffer)
3310 (with-current-buffer buffer 3278 (with-current-buffer buffer
3311 (when (and (memq gud-minor-mode '(gdbmi gdba)) 3279 (when (and (eq gud-minor-mode 'gdbmi)
3312 (not (string-match "\\`\\*.+\\*\\'" 3280 (not (string-match "\\`\\*.+\\*\\'"
3313 (buffer-name)))) 3281 (buffer-name))))
3314 (make-local-variable 'gdb-define-alist) 3282 (make-local-variable 'gdb-define-alist)
@@ -3433,8 +3401,8 @@ With arg, dereference expr if ARG is positive, otherwise do not derereference."
3433; Larger arrays (say 400 elements) are displayed in 3401; Larger arrays (say 400 elements) are displayed in
3434; the tooltip incompletely and spill over into the gud buffer. 3402; the tooltip incompletely and spill over into the gud buffer.
3435; Switching the process-filter creates timing problems and 3403; Switching the process-filter creates timing problems and
3436; it may be difficult to do better. Using annotations as in 3404; it may be difficult to do better. Using GDB/MI as in
3437; gdb-ui.el gets round this problem. 3405; gdb-mi.el gets round this problem.
3438(defun gud-tooltip-process-output (process output) 3406(defun gud-tooltip-process-output (process output)
3439 "Process debugger output and show it in a tooltip window." 3407 "Process debugger output and show it in a tooltip window."
3440 (set-process-filter process gud-tooltip-original-filter) 3408 (set-process-filter process gud-tooltip-original-filter)
@@ -3444,12 +3412,12 @@ With arg, dereference expr if ARG is positive, otherwise do not derereference."
3444(defun gud-tooltip-print-command (expr) 3412(defun gud-tooltip-print-command (expr)
3445 "Return a suitable command to print the expression EXPR." 3413 "Return a suitable command to print the expression EXPR."
3446 (case gud-minor-mode 3414 (case gud-minor-mode
3447 (gdba (concat "server print " expr)) 3415 (gdbmi (concat "-data-evaluate-expression " expr))
3448 ((dbx gdbmi) (concat "print " expr)) 3416 (dbx (concat "print " expr))
3449 ((xdb pdb) (concat "p " expr)) 3417 ((xdb pdb) (concat "p " expr))
3450 (sdb (concat expr "/")))) 3418 (sdb (concat expr "/"))))
3451 3419
3452(declare-function gdb-enqueue-input "gdb-ui" (item)) 3420(declare-function gdb-input "gdb-mi" (item))
3453(declare-function tooltip-expr-to-print "tooltip" (event)) 3421(declare-function tooltip-expr-to-print "tooltip" (event))
3454(declare-function tooltip-event-buffer "tooltip" (event)) 3422(declare-function tooltip-event-buffer "tooltip" (event))
3455 3423
@@ -3469,12 +3437,12 @@ This function must return nil if it doesn't handle EVENT."
3469 (buffer-name gud-comint-buffer); might be killed 3437 (buffer-name gud-comint-buffer); might be killed
3470 (setq process (get-buffer-process gud-comint-buffer)) 3438 (setq process (get-buffer-process gud-comint-buffer))
3471 (posn-point (event-end event)) 3439 (posn-point (event-end event))
3472 (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process)) 3440 (or (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process))
3473 (progn (setq gud-tooltip-event event) 3441 (progn (setq gud-tooltip-event event)
3474 (eval (cons 'and gud-tooltip-display))))) 3442 (eval (cons 'and gud-tooltip-display)))))
3475 (let ((expr (tooltip-expr-to-print event))) 3443 (let ((expr (tooltip-expr-to-print event)))
3476 (when expr 3444 (when expr
3477 (if (and (eq gud-minor-mode 'gdba) 3445 (if (and (eq gud-minor-mode 'gdbmi)
3478 (not gdb-active-process)) 3446 (not gdb-active-process))
3479 (progn 3447 (progn
3480 (with-current-buffer (tooltip-event-buffer event) 3448 (with-current-buffer (tooltip-event-buffer event)
@@ -3492,13 +3460,13 @@ This function must return nil if it doesn't handle EVENT."
3492 (message-box "Using GUD tooltips in this mode is unsafe\n\ 3460 (message-box "Using GUD tooltips in this mode is unsafe\n\
3493so they have been disabled.")) 3461so they have been disabled."))
3494 (unless (null cmd) ; CMD can be nil if unknown debugger 3462 (unless (null cmd) ; CMD can be nil if unknown debugger
3495 (if (memq gud-minor-mode '(gdba gdbmi)) 3463 (if (eq gud-minor-mode 'gdbmi)
3496 (if gdb-macro-info 3464 (if gdb-macro-info
3497 (gdb-enqueue-input 3465 (gdb-input
3498 (list (concat 3466 (list (concat
3499 gdb-server-prefix "macro expand " expr "\n") 3467 "server macro expand " expr "\n")
3500 `(lambda () (gdb-tooltip-print-1 ,expr)))) 3468 `(lambda () (gdb-tooltip-print-1 ,expr))))
3501 (gdb-enqueue-input 3469 (gdb-input
3502 (list (concat cmd "\n") 3470 (list (concat cmd "\n")
3503 `(lambda () (gdb-tooltip-print ,expr))))) 3471 `(lambda () (gdb-tooltip-print ,expr)))))
3504 (setq gud-tooltip-original-filter (process-filter process)) 3472 (setq gud-tooltip-original-filter (process-filter process))