|
155
|
1 ;;; gdb-highlight.el --- make gdb buffers be mouse-sensitive.
|
|
|
2
|
|
|
3 ;;; Copyright (C) 1997 Jamie Zawinski <jwz@netscape.com>
|
|
|
4
|
|
|
5 ;; Author: Jamie Zawinski <jwz@netscape.com>
|
|
|
6 ;; Created: 16-Apr-1997
|
|
|
7 ;; Version: 1.2 (17-May-97)
|
|
|
8 ;; Keywords: extensions, c, unix, tools, debugging
|
|
|
9
|
|
|
10 ;; This file is part of XEmacs.
|
|
|
11
|
|
|
12 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
13 ;; under the terms of the GNU General Public License as published by
|
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;; any later version.
|
|
|
16
|
|
|
17 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
20 ;; General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
25 ;; 02111-1307, USA.
|
|
|
26
|
|
|
27 ;;; Synched up with: Not synched.
|
|
|
28
|
|
|
29 ;;; Commentary:
|
|
|
30 ;;
|
|
|
31 ;; This package makes most objects printed in a *gdb* buffer be
|
|
|
32 ;; mouse-sensitive: as text shows up in the buffer, it is parsed,
|
|
|
33 ;; and objects which are recognized have context-sensitive commands
|
|
|
34 ;; attached to them. Generally, the types that are noticed are:
|
|
|
35 ;;
|
|
|
36 ;; = function and method names;
|
|
|
37 ;; = variable and parameter names;
|
|
|
38 ;; = structure and object slots;
|
|
|
39 ;; = source file names;
|
|
|
40 ;; = type names;
|
|
|
41 ;; = breakpoint numbers;
|
|
|
42 ;; = stack frame numbers.
|
|
|
43 ;;
|
|
|
44 ;; Any time one of those objects is presented in the *gdb* buffer,
|
|
|
45 ;; it will be mousable. Clicking middle mouse button (button2) on
|
|
|
46 ;; it will take some default action -- edit the function, select
|
|
|
47 ;; the stack frame, disable the breakpoint, etc. Clicking the right
|
|
|
48 ;; mouse button (button3) will bring up a menu of commands, including
|
|
|
49 ;; commands specific to the object under the mouse, or other objects
|
|
|
50 ;; on the same line.
|
|
|
51 ;;
|
|
|
52 ;; In addition to these context-sensitive commands are more general
|
|
|
53 ;; gdb commands which were previously inaccessible via the mouse
|
|
|
54 ;; (listing breakpoints, returning values, etc); and the general
|
|
|
55 ;; comint/shell-buffer commands which had been present before.
|
|
|
56 ;;
|
|
|
57 ;; If you notice an object being presented which could (usefully)
|
|
|
58 ;; be made mouse sensitive, but which currently is not, please let
|
|
|
59 ;; me know.
|
|
|
60
|
|
|
61 ;;; Installation:
|
|
|
62 ;;
|
|
|
63 ;; To install, add this to your .emacs file:
|
|
|
64 ;; (add-hook 'gdb-mode-hook '(lambda () (require 'gdb-highlight)))
|
|
|
65
|
|
|
66 ;;; TODO:
|
|
|
67 ;;
|
|
|
68 ;; = It doesn't really work very well unless you've done `set width 0'
|
|
|
69 ;; in your .gdbinit. It would be nice if this were fixed.
|
|
|
70 ;; (And with `set width 0', `set print pretty on' is the way to go.)
|
|
|
71 ;;
|
|
|
72 ;; = In some contexts, the toggle-breakpoint command doesn't work,
|
|
|
73 ;; because this code doesn't know whether it's enabled. It should
|
|
|
74 ;; remember, or figure it out, or something.
|
|
|
75 ;;
|
|
|
76 ;; = Make it possible to edit the `keep' state of breakpoints.
|
|
|
77 ;;
|
|
|
78 ;; = Is it useful to make addresses clickable? If an address is
|
|
|
79 ;; always acompanied by a variable, then no.
|
|
|
80 ;;
|
|
|
81 ;; = There has got to be a better way to implement `gdb-guess-file-name'.
|
|
|
82 ;;
|
|
|
83 ;; = Make some new toolbar icons and put the most common commands on it.
|
|
|
84 ;;
|
|
|
85 ;; = Maybe make gdb-toolbar-clear work more reliably by consulting a
|
|
|
86 ;; breakpoint-number extent?
|
|
|
87 ;;
|
|
|
88 ;; = I want breakpoint icons in my source files, just like in Energize.
|
|
|
89 ;;
|
|
|
90 ;; = Add a command to quit-and-restart the debugger, with the same
|
|
|
91 ;; breakpoints and program-arguments. (This wouldn't be interesting
|
|
|
92 ;; if gdb didn't leak like a sieve...)
|
|
|
93 ;;
|
|
|
94 ;; = Figure out some way to realize when extents are no longer interesting
|
|
|
95 ;; (stack frames and local variables that are no longer on the stack)
|
|
|
96 ;; and make them no longer be mousable. This is tricky... Nuke them
|
|
|
97 ;; whenever a "run" command is seen?
|
|
|
98 ;;
|
|
|
99 ;; = Make C-x SPC in a source buffer use gdb-menu-command so that it will
|
|
|
100 ;; interrupt-and-continue the debugged program as necessary.
|
|
|
101 ;;
|
|
|
102 ;; = Do stuff for watchpoints (but I never use them, myself.)
|
|
|
103
|
|
|
104 ;;; WISHLIST:
|
|
|
105 ;;
|
|
|
106 ;; (extracted from my 13-May-1997 message to comp.emacs and
|
|
|
107 ;; comp.emacs.xemacs, news:33785828.5A524730@netscape.com)
|
|
|
108 ;;
|
|
|
109 ;; 6.1. Make gdbsrc-mode not suck.
|
|
|
110 ;;
|
|
|
111 ;; The idea behind gdbsrc-mode is on the side of the angels: one
|
|
|
112 ;; should be able to focus on the source code and not on the
|
|
|
113 ;; debugger buffer, absolutely. But the implementation is just
|
|
|
114 ;; awful.
|
|
|
115 ;;
|
|
|
116 ;; First and foremost, it should not change "modes" (in the more
|
|
|
117 ;; general sense). Any commands that it defines should be on
|
|
|
118 ;; keys which are exclusively used for that purpose, not keys
|
|
|
119 ;; which are normally self-inserting. I can't be the only person
|
|
|
120 ;; who usually has occasion to actually *edit* the sources which
|
|
|
121 ;; the debugger has chosen to display! Switching into and out of
|
|
|
122 ;; gdbsrc-mode is prohibitive.
|
|
|
123 ;;
|
|
|
124 ;; I want to be looking at my sources at all times, yet I don't
|
|
|
125 ;; want to have to give up my source-editing gestures. I think
|
|
|
126 ;; the right way to accomplish this is to put the gdbsrc commands
|
|
|
127 ;; on the toolbar and on popup menus; or to let the user define
|
|
|
128 ;; their own keys (I could see devoting my kp_enter key to
|
|
|
129 ;; "step", or something common like that.)
|
|
|
130 ;;
|
|
|
131 ;; Also it's extremely frustrating that one can't turn off gdbsrc
|
|
|
132 ;; mode once it has been loaded, without exiting and restarting
|
|
|
133 ;; emacs; that alone means that I'd probably never take the time
|
|
|
134 ;; to learn how to use it, without first having taken the time to
|
|
|
135 ;; repair it...
|
|
|
136 ;;
|
|
|
137 ;; 6.2. Make it easier access to variable values.
|
|
|
138 ;;
|
|
|
139 ;; I want to be able to double-click on a variable name to
|
|
|
140 ;; highlight it, and then drag it to the debugger window to have
|
|
|
141 ;; its value printed.
|
|
|
142 ;;
|
|
|
143 ;; I want gestures that let me write as well as read: for
|
|
|
144 ;; example, to store value A into slot B.
|
|
|
145 ;;
|
|
|
146 ;; 6.3. Make all breakpoints visible.
|
|
|
147 ;;
|
|
|
148 ;; Any time there is a running gdb which has breakpoints, the
|
|
|
149 ;; buffers holding the lines on which those breakpoints are set
|
|
|
150 ;; should have icons in them. These icons should be context-
|
|
|
151 ;; sensitive: I should be able to pop up a menu to enable or
|
|
|
152 ;; disable them, to delete them, to change their commands or
|
|
|
153 ;; conditions.
|
|
|
154 ;;
|
|
|
155 ;; I should also be able to MOVE them. It's annoying when you
|
|
|
156 ;; have a breakpoint with a complex condition or command on it,
|
|
|
157 ;; and then you realize that you really want it to be at a
|
|
|
158 ;; different location. I want to be able to drag-and-drop the
|
|
|
159 ;; icon to its new home.
|
|
|
160 ;;
|
|
|
161 ;; 6.4. Make a debugger status display window.
|
|
|
162 ;;
|
|
|
163 ;; o I want a window off to the side that shows persistent
|
|
|
164 ;; information -- it should have a pane which is a
|
|
|
165 ;; drag-editable, drag-reorderable representation of the
|
|
|
166 ;; elements on gdb's "display" list; they should be displayed
|
|
|
167 ;; here instead of being just dumped in with the rest of the
|
|
|
168 ;; output in the *gdb* buffer.
|
|
|
169 ;;
|
|
|
170 ;; o I want a pane that displays the current call-stack and
|
|
|
171 ;; nothing else. I want a pane that displays the arguments
|
|
|
172 ;; and locals of the currently-selected frame and nothing
|
|
|
173 ;; else. I want these both to update as I move around on the
|
|
|
174 ;; stack.
|
|
|
175 ;;
|
|
|
176 ;; Since the unfortunate reality is that excavating this
|
|
|
177 ;; information from gdb can be slow, it would be a good idea
|
|
|
178 ;; for these panes to have a toggle button on them which meant
|
|
|
179 ;; "stop updating", so that when I want to move fast, I can,
|
|
|
180 ;; but I can easily get the display back when I need it again.
|
|
|
181 ;;
|
|
|
182 ;; The reason for all of this is that I spend entirely too much
|
|
|
183 ;; time scrolling around in the *gdb* buffer; with gdb-highlight,
|
|
|
184 ;; I can just click on a line in the backtrace output to go to
|
|
|
185 ;; that frame, but I find that I spend a lot of time *looking*
|
|
|
186 ;; for that backtrace: since it's mixed in with all the other
|
|
|
187 ;; random output, I waste time looking around for things (and
|
|
|
188 ;; usually just give up and type "bt" again, then thrash around
|
|
|
189 ;; as the buffer scrolls, and I try to find the lower frames that
|
|
|
190 ;; I'm interested in, as they have invariably scrolled off the
|
|
|
191 ;; window already...
|
|
|
192 ;;
|
|
|
193 ;; 6.5. Save and restore breakpoints across emacs/debugger sessions.
|
|
|
194 ;;
|
|
|
195 ;; This would be especially handy given that gdb leaks like a
|
|
|
196 ;; sieve, and with a big program, I only get a few dozen
|
|
|
197 ;; relink-and-rerun attempts before gdb has blown my swap space.
|
|
|
198 ;;
|
|
|
199 ;; 6.6. Keep breakpoints in sync with source lines.
|
|
|
200 ;;
|
|
|
201 ;; When a program is recompiled and then reloaded into gdb, the
|
|
|
202 ;; breakpoints often end up in less-than-useful places. For
|
|
|
203 ;; example, when I edit text which occurs in a file anywhere
|
|
|
204 ;; before a breakpoint, emacs is aware that the line of the bp
|
|
|
205 ;; hasn't changed, but just that it is in a different place
|
|
|
206 ;; relative to the top of the file. Gdb doesn't know this, so
|
|
|
207 ;; your breakpoints end up getting set in the wrong places
|
|
|
208 ;; (usually the maximally inconvenient places, like *after* a
|
|
|
209 ;; loop instead of *inside* it). But emacs knows, so emacs
|
|
|
210 ;; should inform the debugger, and move the breakpoints back to
|
|
|
211 ;; the places they were intended to be.
|
|
|
212 ;;
|
|
|
213 ;; (Possibly the OOBR stuff does some of this, but can't tell,
|
|
|
214 ;; because I've never been able to get it to do anything but beep at
|
|
|
215 ;; me and mumble about environments. I find it pretty funny that the
|
|
|
216 ;; manual keeps explaining to me how intuitive it is, without
|
|
|
217 ;; actually giving me a clue how to launch it...)
|
|
|
218
|
|
|
219
|
|
|
220 ;;; Code:
|
|
|
221 ;;
|
|
|
222 ;; This code should be considered an example of how over-use of regular
|
|
|
223 ;; expressions leads to code that is an unreadable, unmaintainable mess,
|
|
|
224 ;; and why it's unfortunate that so much of emacs's speed depends on
|
|
|
225 ;; their use, rather than on the use of more traditional parsers.
|
|
|
226
|
|
|
227 (require 'gdb)
|
|
|
228
|
|
|
229 (define-key gdb-mode-map 'button3 'gdb-popup-menu)
|
|
|
230 (defvar gdb-popup-menu
|
|
|
231 '("GDB Commands"
|
|
|
232 ["Up Stack" (gdb-menu-command "up" t) t]
|
|
|
233 ["Down Stack" (gdb-menu-command "down" t) t]
|
|
|
234 ["Next Line" (gdb-menu-command "next" t) t]
|
|
|
235 ["Next Line (Step In)" (gdb-menu-command "step" t) t]
|
|
|
236 ["Continue" (gdb-menu-command "continue" t) t]
|
|
|
237 ["Continue Until Return" (gdb-menu-command "finish" t) t]
|
|
|
238 ("Return..."
|
|
|
239 ["Return" (gdb-menu-command "return" t) t]
|
|
|
240 ["Return 0" (gdb-menu-command "return 0" t) t]
|
|
|
241 ["Return 1" (gdb-menu-command "return 1" t) t]
|
|
|
242 ["Return -1" (gdb-menu-command "return -1" t) t]
|
|
|
243 ["Return $" (gdb-menu-command "return $" t) t]
|
|
|
244 )
|
|
|
245 "---"
|
|
|
246 ["Backtrace" (gdb-menu-command "backtrace" t) t]
|
|
|
247 ["List Breakpoints" (gdb-menu-command "info breakpoints" t) t]
|
|
|
248 ["List Local Variables" (gdb-menu-command "info locals" t) t]
|
|
|
249 )
|
|
|
250 "Commands for the popup menu in gdb-mode.
|
|
|
251 The comint-popup-menu is appended to this, and certain context-sensitive
|
|
|
252 commands may be prepended to it, depending on the location of the mouse
|
|
|
253 when the `gdb-popup-menu' command is invoked.")
|
|
|
254
|
|
|
255
|
|
|
256 ;;; Faces and keymaps used for mousable tokens in the *gdb* buffer.
|
|
|
257
|
|
|
258 (defvar gdb-highlight-face 'gdb-highlight-face) ; the base face
|
|
|
259 (defvar gdb-breakpoint-number-face 'gdb-breakpoint-number-face)
|
|
|
260 ;(defvar gdb-breakpoint-keep-face 'gdb-breakpoint-keep-face)
|
|
|
261 (defvar gdb-breakpoint-enabled-face 'gdb-breakpoint-enabled-face)
|
|
|
262 (defvar gdb-function-name-face 'gdb-function-name-face)
|
|
|
263 (defvar gdb-function-location-face 'gdb-function-location-face)
|
|
|
264 (defvar gdb-variable-name-face 'gdb-variable-name-face)
|
|
|
265 (defvar gdb-type-name-face 'gdb-type-name-face)
|
|
|
266
|
|
|
267 (make-face 'gdb-highlight-face)
|
|
|
268 (or (face-differs-from-default-p 'gdb-highlight-face)
|
|
|
269 (make-face-italic 'gdb-highlight-face))
|
|
|
270
|
|
|
271 (let ((faces '(gdb-breakpoint-number-face
|
|
|
272 gdb-breakpoint-enabled-face
|
|
|
273 ;gdb-breakpoint-keep-face
|
|
|
274 gdb-function-name-face
|
|
|
275 gdb-function-location-face
|
|
|
276 gdb-variable-name-face
|
|
|
277 gdb-type-name-face)))
|
|
|
278 (while faces
|
|
|
279 (make-face (car faces))
|
|
|
280 (or (face-differs-from-default-p (car faces))
|
|
|
281 (if (fboundp 'set-face-parent)
|
|
|
282 (set-face-parent (car faces) 'gdb-highlight-face)
|
|
|
283 (copy-face 'gdb-highlight-face (car faces))))
|
|
|
284 (setq faces (cdr faces))))
|
|
|
285
|
|
|
286
|
|
|
287 (defvar gdb-token-map ; the base map, inherited by all.
|
|
|
288 (let ((m (make-sparse-keymap)))
|
|
|
289 (set-keymap-name m 'gdb-token-map)
|
|
|
290 (define-key m 'button2 'undefined)
|
|
|
291 ;;(define-key m 'button3 'gdb-token-popup)
|
|
|
292 m))
|
|
|
293
|
|
|
294 (defvar gdb-breakpoint-number-map
|
|
|
295 (let ((m (make-sparse-keymap)))
|
|
|
296 (set-keymap-name m 'gdb-breakpoint-number-map)
|
|
|
297 (set-keymap-parent m gdb-token-map)
|
|
|
298 ;; not sure if this is the most useful binding... maybe "delete" is better?
|
|
|
299 (define-key m 'button2 'gdb-mouse-disable-breakpoint)
|
|
|
300 m))
|
|
|
301
|
|
|
302 (defvar gdb-info-breakpoint-number-map
|
|
|
303 (let ((m (make-sparse-keymap)))
|
|
|
304 (set-keymap-name m 'gdb-breakpoint-number-map)
|
|
|
305 (set-keymap-parent m gdb-token-map)
|
|
|
306 ;; not sure if this is the most useful binding... maybe "delete" is better?
|
|
|
307 (define-key m 'button2 'gdb-mouse-toggle-breakpoint-enabled)
|
|
|
308 m))
|
|
|
309
|
|
|
310 ;(defvar gdb-breakpoint-keep-map
|
|
|
311 ; (let ((m (make-sparse-keymap)))
|
|
|
312 ; (set-keymap-name m 'gdb-breakpoint-keep-map)
|
|
|
313 ; (set-keymap-parent m gdb-token-map)
|
|
|
314 ; (define-key m 'button2 'gdb-token-mouse-toggle-keep)
|
|
|
315 ; m))
|
|
|
316
|
|
|
317 (defvar gdb-breakpoint-enabled-map
|
|
|
318 (let ((m (make-sparse-keymap)))
|
|
|
319 (set-keymap-name m 'gdb-breakpoint-enabled-map)
|
|
|
320 (set-keymap-parent m gdb-token-map)
|
|
|
321 (define-key m 'button2 'gdb-mouse-toggle-breakpoint-enabled)
|
|
|
322 m))
|
|
|
323
|
|
|
324 (defvar gdb-function-name-map
|
|
|
325 (let ((m (make-sparse-keymap)))
|
|
|
326 (set-keymap-name m 'gdb-function-name-map)
|
|
|
327 (set-keymap-parent m gdb-token-map)
|
|
|
328 (define-key m 'button2 'gdb-mouse-edit-function)
|
|
|
329 m))
|
|
|
330
|
|
|
331 (defvar gdb-function-location-map
|
|
|
332 (let ((m (make-sparse-keymap)))
|
|
|
333 (set-keymap-name m 'gdb-function-location-map)
|
|
|
334 (set-keymap-parent m gdb-token-map)
|
|
|
335 (define-key m 'button2 'gdb-mouse-edit-function-location)
|
|
|
336 m))
|
|
|
337
|
|
|
338 (defvar gdb-frame-number-map
|
|
|
339 (let ((m (make-sparse-keymap)))
|
|
|
340 (set-keymap-name m 'gdb-frame-number-map)
|
|
|
341 (set-keymap-parent m gdb-token-map)
|
|
|
342 (define-key m 'button2 'gdb-mouse-goto-frame)
|
|
|
343 m))
|
|
|
344
|
|
|
345 (defvar gdb-variable-name-map
|
|
|
346 (let ((m (make-sparse-keymap)))
|
|
|
347 (set-keymap-name m 'gdb-variable-name-map)
|
|
|
348 (set-keymap-parent m gdb-token-map)
|
|
|
349 (define-key m 'button2 'gdb-mouse-print-variable)
|
|
|
350 m))
|
|
|
351
|
|
|
352 (defvar gdb-type-name-map
|
|
|
353 (let ((m (make-sparse-keymap)))
|
|
|
354 (set-keymap-name m 'gdb-type-name-map)
|
|
|
355 (set-keymap-parent m gdb-token-map)
|
|
|
356 (define-key m 'button2 'gdb-mouse-print-type)
|
|
|
357 m))
|
|
|
358
|
|
|
359
|
|
|
360 ;;; Token definitions.
|
|
|
361
|
|
|
362 ;; These properties enumerate the faces and keymaps that will be put over
|
|
|
363 ;; the tokens.
|
|
|
364
|
|
|
365 (put 'gdb-frame-number-token 'gdb-token-face gdb-breakpoint-number-face)
|
|
|
366 (put 'gdb-frame-number-token 'gdb-token-keymap gdb-frame-number-map)
|
|
|
367
|
|
|
368 ;(put 'gdb-breakpoint-keep-token 'gdb-token-face gdb-breakpoint-keep-face)
|
|
|
369 ;(put 'gdb-breakpoint-keep-token 'gdb-token-keymap gdb-breakpoint-keep-map)
|
|
|
370
|
|
|
371 (put 'gdb-enabled-token 'gdb-token-face gdb-breakpoint-enabled-face)
|
|
|
372 (put 'gdb-enabled-token 'gdb-token-keymap gdb-breakpoint-enabled-map)
|
|
|
373
|
|
|
374 (put 'gdb-function-name-token 'gdb-token-face gdb-function-name-face)
|
|
|
375 (put 'gdb-function-name-token 'gdb-token-keymap gdb-function-name-map)
|
|
|
376
|
|
|
377 (put 'gdb-function-location-token 'gdb-token-face gdb-function-location-face)
|
|
|
378 (put 'gdb-function-location-token 'gdb-token-keymap gdb-function-location-map)
|
|
|
379
|
|
|
380 (put 'gdb-breakpoint-number-token 'gdb-token-face gdb-breakpoint-number-face)
|
|
|
381 (put 'gdb-breakpoint-number-token 'gdb-token-keymap gdb-breakpoint-number-map)
|
|
|
382 (put 'gdb-info-breakpoint-number-token 'gdb-token-face
|
|
|
383 gdb-breakpoint-number-face)
|
|
|
384 (put 'gdb-info-breakpoint-number-token 'gdb-token-keymap
|
|
|
385 gdb-info-breakpoint-number-map)
|
|
|
386
|
|
|
387 (put 'gdb-frame-number-token 'gdb-token-face gdb-breakpoint-number-face)
|
|
|
388 (put 'gdb-frame-number-token 'gdb-token-keymap gdb-frame-number-map)
|
|
|
389
|
|
|
390 (put 'gdb-variable-name-token 'gdb-token-face gdb-variable-name-face)
|
|
|
391 (put 'gdb-variable-name-token 'gdb-token-keymap gdb-variable-name-map)
|
|
|
392
|
|
|
393 (put 'gdb-type-name-token 'gdb-token-face gdb-type-name-face)
|
|
|
394 (put 'gdb-type-name-token 'gdb-token-keymap gdb-type-name-map)
|
|
|
395
|
|
|
396
|
|
|
397 ;;; These regular expressions control what text corresponds to which tokens.
|
|
|
398
|
|
|
399 (defconst gdb-highlight-token-patterns
|
|
|
400 ;; "May god forgive me for what I have unleashed." -- Evil Dead II.
|
|
|
401 (purecopy
|
|
|
402 (list
|
|
|
403 ;; Breakpoints output:
|
|
|
404 ;;
|
|
|
405 ;; Breakpoint 5, XCreateWindow () at Window.c:136
|
|
|
406 ;; Breakpoint 6, foobar (x=0x7fff3000 "baz") at blorp.c:5382
|
|
|
407 ;;
|
|
|
408 (list (concat "\\(Breakpoint " ; 1
|
|
|
409 "\\([0-9]+\\)" ; .2
|
|
|
410 "\\), " ; 1
|
|
|
411 "\\(0x[0-9a-fA-F]+ in \\)?" ; 3
|
|
|
412 "\\(" ; 4
|
|
|
413 "\\([a-zA-Z0-9_]+\\):[a-zA-Z0-9_:~]+" ; .5
|
|
|
414 "\\|" ; .
|
|
|
415 "[a-zA-Z0-9_]+" ; .
|
|
|
416 "\\)" ; 4
|
|
|
417 "\\(" ; 6
|
|
|
418 " *\\((.*)\\)" ; .7
|
|
|
419 " at \\(" ; .8
|
|
|
420 "\\([^ \t\n:]+\\):" ; ..9
|
|
|
421 "\\([0-9]+\\)" ; ..10
|
|
|
422 "\\)" ; .8
|
|
|
423 "\\)?" ; 6
|
|
|
424 )
|
|
|
425 '(gdb-breakpoint-number-token ; 1
|
|
|
426 nil ; 2
|
|
|
427 nil ; 3
|
|
|
428 gdb-function-name-token ; 4 (+5)
|
|
|
429 gdb-type-name-token ; 5
|
|
|
430 nil ; 6
|
|
|
431 gdb-arglist-token ; 7
|
|
|
432 gdb-function-location-token ; 8 (9+10)
|
|
|
433 ))
|
|
|
434
|
|
|
435 ;; Output of the "Break" command:
|
|
|
436 ;;
|
|
|
437 ;; Breakpoint 1 at 0x4881d4
|
|
|
438 ;; Breakpoint 6 at 0xfa50f68: file cuexit.c, line 58.
|
|
|
439 ;;
|
|
|
440 (list (concat "\\(Breakpoint " ; 1
|
|
|
441 "\\([0-9]+\\)" ; .2
|
|
|
442 "\\) at " ; 1
|
|
|
443 "\\(0x[0-9A-Fa-f]+\\)" ; 3
|
|
|
444 "\\(: file " ; 4
|
|
|
445 "\\(" ; .5
|
|
|
446 "\\([^ \t\n:]+\\)" ; ..6
|
|
|
447 ", line \\([0-9]+\\)" ; ..7
|
|
|
448 "\\)" ; .5
|
|
|
449 "\\)?" ; 4
|
|
|
450 )
|
|
|
451 '(gdb-breakpoint-number-token ; 1
|
|
|
452 nil ; 2
|
|
|
453 nil ;gdb-address-token ; 3
|
|
|
454 nil ; 4
|
|
|
455 gdb-function-location-token ; 5 (6+7)
|
|
|
456 ))
|
|
|
457
|
|
|
458 ;; Note: breakpoint 5 (disabled) also set at pc 0x40b420.
|
|
|
459 ;; Note: breakpoint 5 also set at pc 0x40b420.
|
|
|
460 ;;
|
|
|
461 (list (concat "Note: " ;
|
|
|
462 "\\(breakpoint " ; 1
|
|
|
463 "\\([0-9]+\\)" ; .2
|
|
|
464 "\\)" ; 1
|
|
|
465 )
|
|
|
466 '(gdb-breakpoint-number-token ; 1
|
|
|
467 nil ; 2
|
|
|
468 ))
|
|
|
469
|
|
|
470 ;; Stack Frames:
|
|
|
471 ;;
|
|
|
472 ;; 0xe1b8e0 in _OS_SELECT () at os_IRIX.s:50
|
|
|
473 ;; XCreateWindow () at Window.c:136
|
|
|
474 ;; #0 0x8e0db0 in _OS_SELECT () at os_IRIX.s:50
|
|
|
475 ;; #0 XCreateWindow () at Window.c:136
|
|
|
476 ;; Run till exit from #0 __ll_mul () at llmul.s:51
|
|
|
477 ;;
|
|
|
478 (list (concat "\\(Run till exit from \\)?" ; 1
|
|
|
479 "\\(" ; 2
|
|
|
480 "#\\([0-9]+ *\\)" ; .3
|
|
|
481 "\\)?" ; 2
|
|
|
482 "\\(" ; 4
|
|
|
483 "\\(0x[0-9A-Fa-f]+\\)" ; .5
|
|
|
484 " in +\\)?" ; 4
|
|
|
485 "\\(" ; 6
|
|
|
486 "\\([a-zA-Z0-9_]+\\):[a-zA-Z0-9_:~]+" ; .7
|
|
|
487 "\\|" ; 6
|
|
|
488 "[a-zA-Z0-9_]+" ;
|
|
|
489 "\\) (" ; 6
|
|
|
490 "\\(" ; 8
|
|
|
491 "\\(.*\\)" ; .9
|
|
|
492 "\\bat \\(" ; .10
|
|
|
493 "\\([^ \t\n:]+\\):" ; ..11
|
|
|
494 "\\([0-9]+\\)" ; ..12
|
|
|
495 "\\)" ; .10
|
|
|
496 "\\)?" ; 8
|
|
|
497 )
|
|
|
498 '(nil ; 1
|
|
|
499 gdb-frame-number-token ; 2
|
|
|
500 nil ; 3
|
|
|
501 nil ; 4
|
|
|
502 nil ;gdb-address-token ; 5
|
|
|
503 gdb-function-name-token ; 6 (+7)
|
|
|
504 gdb-type-name-token ; 7
|
|
|
505 nil ; 8
|
|
|
506 gdb-arglist-token ; 9
|
|
|
507 gdb-function-location-token ; 10 (11+12)
|
|
|
508 ))
|
|
|
509
|
|
|
510 ;; Info Breakpoints output:
|
|
|
511 ;;
|
|
|
512 ;; 1 breakpoint keep y 0x0fa50f68 in exit at exit.c:58
|
|
|
513 ;; 1 breakpoint keep y 0x000a1b00 <exit+4>
|
|
|
514 ;; 1 breakpoint keep y 0x0fa429ac <_write>
|
|
|
515 ;; 6 breakpoint keep y 0x00789490 in foo::bar(bad *) at x.cpp:99
|
|
|
516 ;; 7 breakpoint keep y 0x00789490 <foo::bar(bad *)+128>
|
|
|
517 ;;
|
|
|
518 (list (concat "\\([0-9]+ *\\) " ; 1
|
|
|
519 "\\(breakpoint *\\|watchpoint *\\) " ; 2
|
|
|
520 "\\(keep *\\|del *\\|dis *\\) " ; 3
|
|
|
521 "\\([yn] *\\) " ; 4
|
|
|
522 "\\(0x[0-9A-Fa-f]+\\) *" ; 5
|
|
|
523 "\\(in " ; 6
|
|
|
524 "\\(" ; .7
|
|
|
525 "[a-zA-Z0-9_]+" ; ..
|
|
|
526 "\\|" ; .7
|
|
|
527 "\\([a-zA-Z0-9_]+\\):[a-zA-Z0-9_:~]+" ; ..8
|
|
|
528 "\\)" ; .7
|
|
|
529 "\\((.*)\\)?" ; 9
|
|
|
530 " at " ; .
|
|
|
531 "\\(" ; .10
|
|
|
532 "\\([^ \t\n:]+\\):" ; ..11
|
|
|
533 "\\([0-9]+\\)" ; ..12
|
|
|
534 "\\)" ; .10
|
|
|
535 "\\|" ; 6
|
|
|
536 "<" ; .
|
|
|
537 "\\(" ; .13
|
|
|
538 "\\([a-zA-Z0-9_]+\\):[a-zA-Z0-9_:~]+" ; ..14
|
|
|
539 "\\|" ; .13
|
|
|
540 "[a-zA-Z0-9_]+" ; ..
|
|
|
541 "\\)" ; .13
|
|
|
542 "\\((.*)\\)?" ; .15
|
|
|
543 "[^>\n]*>" ; .
|
|
|
544 "\\)?" ; 6
|
|
|
545 )
|
|
|
546 '(gdb-info-breakpoint-number-token ; 1
|
|
|
547 nil ; 2
|
|
|
548 nil ;gdb-breakpoint-keep-token ; 3
|
|
|
549 gdb-enabled-token ; 4
|
|
|
550 nil ;gdb-address-token ; 5
|
|
|
551 nil ; 6
|
|
|
552 gdb-function-name-token ; 7 (+8)
|
|
|
553 gdb-type-name-token ; 8
|
|
|
554 gdb-arglist-types-token ; 9
|
|
|
555 gdb-function-location-token ; 10 (11+12)
|
|
|
556 nil ; 11
|
|
|
557 nil ; 12
|
|
|
558 gdb-function-name-token ; 13
|
|
|
559 gdb-type-name-token ; 14
|
|
|
560 gdb-arglist-types-token ; 15
|
|
|
561 ))
|
|
|
562
|
|
|
563 ;; Whatis and Ptype output:
|
|
|
564 ;; type = struct _WidgetRec *
|
|
|
565 ;; type = struct _WidgetRec {
|
|
|
566 ;; type = int ()
|
|
|
567 ;; type = struct <undefined> *(struct <undefined> *, void *, void (*)())
|
|
|
568 ;; type = struct foo *(struct foo *, unsigned char, int)
|
|
|
569 ;; type = unsigned int [4]
|
|
|
570 ;;
|
|
|
571 (list (concat "type = "
|
|
|
572 "\\(" ; 1
|
|
|
573 "\\(signed \\|unsigned \\)?" ; .2
|
|
|
574 "\\(struct \\|class \\|union \\|enum \\)?" ; .3
|
|
|
575 "\\(<?[a-zA-Z_][a-zA-Z0-9_:]*>?\\)" ; .4
|
|
|
576 "\\)" ; 1
|
|
|
577 "[ *]*" ;
|
|
|
578 "\\(" ; 5
|
|
|
579 "{?$\\|" ; .
|
|
|
580 "\\[[0-9]*\\]$\\|" ; .
|
|
|
581 "\\((.*)\\)" ; .6
|
|
|
582 "\\)" ; 5
|
|
|
583 )
|
|
|
584 '(gdb-type-name-token ; 1 (2+3+4)
|
|
|
585 nil ; 2
|
|
|
586 nil ; 3
|
|
|
587 nil ; 4
|
|
|
588 nil ; 5
|
|
|
589 gdb-arglist-types-token ; 6
|
|
|
590 ))
|
|
|
591
|
|
|
592 ;; Ptype output:
|
|
|
593 ;; CorePart core;
|
|
|
594 ;; void *constraints;
|
|
|
595 ;; short x;
|
|
|
596 ;; unsigned short width;
|
|
|
597 ;; struct <undefined> *event_table;
|
|
|
598 ;; XtTMRec tm;
|
|
|
599 ;; void (*class_initialize)();
|
|
|
600 ;; unsigned char (*set_values)();
|
|
|
601 ;; unsigned char st_fstype[16];
|
|
|
602 ;; type = enum {XtGeometryYes, XtGeometryNo, XtGeometryAlmost}
|
|
|
603 ;;
|
|
|
604 (list (concat " *"
|
|
|
605 "\\(" ; 1
|
|
|
606 "\\(signed \\|unsigned \\)?" ; .2
|
|
|
607 "\\(struct \\|class \\|union \\|enum \\)?" ; .3
|
|
|
608 "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; .4
|
|
|
609 "\\)" ; 1
|
|
|
610 "[ *]*"
|
|
|
611 "\\((\\**\\)?" ; 5
|
|
|
612 "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; 6
|
|
|
613 "\\()()\\)?" ; 7
|
|
|
614 "\\( *\\[[0-9]*\\]\\)?" ; 8
|
|
|
615 "; *$"
|
|
|
616 )
|
|
|
617 '(gdb-type-name-token ; 1 (2+3+4)
|
|
|
618 ))
|
|
|
619
|
|
|
620 ;; Ptype output on C++ classes:
|
|
|
621 ;;
|
|
|
622 ;; virtual foo (int);
|
|
|
623 ;; unsigned int foo(void);
|
|
|
624 ;; static long unsigned int * foo(bar *, baz *, unsigned int);
|
|
|
625 ;;
|
|
|
626 ;; not handled:
|
|
|
627 ;; foo(bar *, _WidgetRec *, char const *, int);
|
|
|
628 ;; foo (foo &);
|
|
|
629 ;; foo & operator=(foo const &);
|
|
|
630 ;;
|
|
|
631 (list (concat " *"
|
|
|
632 "\\(static \\)?" ; 1
|
|
|
633 "\\(" ; 2
|
|
|
634 "\\(signed \\|unsigned " ; .3
|
|
|
635 ;; #### not so sure about this:
|
|
|
636 "\\|long unsigned \\|short unsigned " ; .3
|
|
|
637 "\\)?" ; .3
|
|
|
638 "\\(struct \\|class \\|union \\|enum \\)?" ; .4
|
|
|
639 "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; .5
|
|
|
640 "\\)" ; 1
|
|
|
641 "[ *&]+" ;
|
|
|
642 " *\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; 6
|
|
|
643 " *\\((.*)\\)" ; 7
|
|
|
644 "; *$" ;
|
|
|
645 )
|
|
|
646 '(nil ; 1
|
|
|
647 gdb-type-name-token ; 2 (3+4+5)
|
|
|
648 nil ; 3
|
|
|
649 nil ; 4
|
|
|
650 nil ; 5
|
|
|
651 gdb-function-name-token ; 6
|
|
|
652 gdb-arglist-types-token ; 7
|
|
|
653 ))
|
|
|
654
|
|
|
655 ;; Pointers to functions:
|
|
|
656 ;;
|
|
|
657 ;; $1 = {void ()} 0x4a1334 <fe_pulldown_cb>
|
|
|
658 ;; $2 = (void (*)()) 0x4a1334 <fe_pulldown_cb>
|
|
|
659 ;;
|
|
|
660 (list (concat ".* = "
|
|
|
661 "[({]"
|
|
|
662 "\\(" ; 1
|
|
|
663 "\\(signed \\|unsigned \\)?" ; .2
|
|
|
664 "\\(struct \\|class \\|union \\|enum \\)?" ; .3
|
|
|
665 "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; .4
|
|
|
666 "\\)" ; 1
|
|
|
667 " \\((\\*) ?\\)?" ; 5
|
|
|
668 "\\((.*)\\)" ; 6
|
|
|
669 "[)}] +" ;
|
|
|
670 "\\(0x[0-9A-Fa-f]+\\) +" ; 7
|
|
|
671 "<\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)" ; 8
|
|
|
672 "\\+?[0-9]+?>" ;
|
|
|
673 )
|
|
|
674 '(gdb-type-name-token ; 1 (2+3+4)
|
|
|
675 nil ; 2
|
|
|
676 nil ; 3
|
|
|
677 nil ; 4
|
|
|
678 nil ; 5
|
|
|
679 gdb-arglist-types-token ; 6
|
|
|
680 nil ;gdb-address-token ; 7
|
|
|
681 gdb-function-name-token ; 8
|
|
|
682 ))
|
|
|
683
|
|
|
684 ;; Local variables and structures:
|
|
|
685 ;;
|
|
|
686 ;; shell = (struct _WidgetRec *) 0x10267350
|
|
|
687 ;; delete_response = 270955344
|
|
|
688 ;; allow_resize = 200 'È'
|
|
|
689 ;; is_modal = 47 '/'
|
|
|
690 ;; class_name = 0xf661d40 "TopLevelShell",
|
|
|
691 ;; static foo = 0x10791ec0,
|
|
|
692 ;; initialize = 0xf684770 <TopLevelInitialize>,
|
|
|
693 ;; av = {{
|
|
|
694 ;; name = "foo",
|
|
|
695 ;; value = 270349836
|
|
|
696 ;; }, {
|
|
|
697 ;; name = 0x12 <Address 0x12 out of bounds>,
|
|
|
698 ;; value = 0
|
|
|
699 ;; }, {
|
|
|
700 ;; name = 0x0,
|
|
|
701 ;; value = 0
|
|
|
702 ;; }}
|
|
|
703 ;;
|
|
|
704 (list (concat " *"
|
|
|
705 "\\(static \\)?" ; 1
|
|
|
706 "\\([$a-zA-Z_][a-zA-Z0-9_:]*\\) = " ; 2
|
|
|
707 "\\((" ; 3
|
|
|
708 "\\(" ; .4
|
|
|
709 "\\(signed \\|unsigned \\)?" ; ..5
|
|
|
710 "\\(struct \\|class \\|union \\|enum \\)?"; ..6
|
|
|
711 "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; ..7
|
|
|
712 "\\)" ; .4
|
|
|
713 "[ *]*)" ;
|
|
|
714 "\\)?" ; 3
|
|
|
715 "\\(" ; 8
|
|
|
716 ".*"
|
|
|
717 " <\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)" ; .9
|
|
|
718 "\\+?[0-9]+?>" ; .
|
|
|
719 "\\)?" ; 8
|
|
|
720 )
|
|
|
721 '(nil ; 1
|
|
|
722 gdb-variable-name-token ; 2
|
|
|
723 nil ; 3
|
|
|
724 gdb-type-name-token ; 4
|
|
|
725 nil ; 5
|
|
|
726 nil ; 6
|
|
|
727 nil ; 7
|
|
|
728 nil ; 8
|
|
|
729 gdb-function-name-token ; 9
|
|
|
730 ))
|
|
|
731
|
|
|
732 ;; Purify output:
|
|
|
733 ;; UMR: Uninitialized memory read:
|
|
|
734 ;; * This is occurring while in:
|
|
|
735 ;; SHA1_Update [algsha.c:137]
|
|
|
736 ;; * Reading 1 byte from 0xefffdb34 on the stack.
|
|
|
737 (list (concat "[ \t]+"
|
|
|
738 "\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)[ \t]*" ; 1
|
|
|
739 "\\[\\(" ; 2
|
|
|
740 "\\([^ \t\n:]+\\):" ; .3
|
|
|
741 "\\([0-9]+\\)" ; .4
|
|
|
742 "\\)\\]" ; 2
|
|
|
743 )
|
|
|
744 '(gdb-function-name-token ; 1
|
|
|
745 gdb-function-location-token ; 2 (3+4)
|
|
|
746 ))
|
|
|
747
|
|
|
748 ;; Purify output:
|
|
|
749 ;; * Address 0xefffdb34 is 36 bytes past start of local variable \
|
|
|
750 ;; "data" in function fe_EventForRNG.
|
|
|
751 (list (concat ".*\\bAddress "
|
|
|
752 "\\(0x[0-9A-Fa-f]+\\) +" ; 1
|
|
|
753 ".*\\bvariable \"" ;
|
|
|
754 "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)\"" ; 2
|
|
|
755 "\\(" ; 3
|
|
|
756 ".*\\bfunction " ; .
|
|
|
757 "\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)" ; .4
|
|
|
758 "\\)?" ; 3
|
|
|
759 )
|
|
|
760 '(nil ;gdb-address-token ; 1
|
|
|
761 gdb-variable-name-token ; 2
|
|
|
762 nil ; 3
|
|
|
763 gdb-function-name-token ; 4
|
|
|
764 ))
|
|
|
765 ))
|
|
|
766 "Patterns to highlight in gdb buffers.
|
|
|
767 Each element of this list takes the form
|
|
|
768 ( \"regexp\" ( token-1 token-2 ... ))
|
|
|
769 where token-N is the token to place on the text matched
|
|
|
770 by sub-pattern N in the match data.
|
|
|
771
|
|
|
772 The patterns should not begin with \"^\".")
|
|
|
773
|
|
|
774
|
|
|
775 (defun gdb-highlight-line ()
|
|
|
776 "Highlight any tokens on the line which match gdb-highlight-token-patterns."
|
|
|
777 (map-extents #'(lambda (e ignore) (delete-extent e))
|
|
|
778 nil
|
|
|
779 (point) (save-excursion (forward-line 1) (point))
|
|
|
780 nil nil 'gdb-token)
|
|
|
781 (while (looking-at comint-prompt-regexp)
|
|
|
782 (goto-char (match-end 0)))
|
|
|
783 (if (eobp)
|
|
|
784 nil
|
|
|
785 (let ((tokens gdb-highlight-token-patterns)
|
|
|
786 (do-magic-variable-hack nil))
|
|
|
787 (while tokens
|
|
|
788 (if (not (looking-at (car (car tokens))))
|
|
|
789 (setq tokens (cdr tokens))
|
|
|
790 (let ((i 1)
|
|
|
791 (types (nth 1 (car tokens))))
|
|
|
792 (if (eq (car types) 'gdb-variable-name-token)
|
|
|
793 (setq do-magic-variable-hack t))
|
|
|
794 (while types
|
|
|
795 (cond ((not (and (car types)
|
|
|
796 (match-beginning i)))
|
|
|
797 nil)
|
|
|
798 ((memq (car types) '(gdb-arglist-token
|
|
|
799 gdb-arglist-types-token))
|
|
|
800 (gdb-highlight-arglist (car types)
|
|
|
801 (match-beginning i)
|
|
|
802 (match-end i)))
|
|
|
803 ((/= ?$ (char-after (match-beginning i)))
|
|
|
804 (gdb-highlight-token (car types)
|
|
|
805 (match-beginning i)
|
|
|
806 (match-end i))))
|
|
|
807 (setq i (1+ i)
|
|
|
808 types (cdr types)))
|
|
|
809
|
|
|
810 (if (not do-magic-variable-hack)
|
|
|
811 ;; we're done.
|
|
|
812 (setq tokens nil)
|
|
|
813 ;; else, do a grody hack to cope with multiple variables
|
|
|
814 ;; on the same line.
|
|
|
815 (save-restriction
|
|
|
816 (let ((p (point))
|
|
|
817 (ok nil))
|
|
|
818 (end-of-line)
|
|
|
819 (narrow-to-region p (point))
|
|
|
820 (goto-char (match-end 0))
|
|
|
821 (if (= (following-char) ?\{)
|
|
|
822 (progn
|
|
|
823 (forward-char 1)
|
|
|
824 (setq ok t))
|
|
|
825 (setq p (scan-sexps (point) 1 nil t))
|
|
|
826 (setq ok (if (null p)
|
|
|
827 nil
|
|
|
828 (goto-char p)
|
|
|
829 (if (or (= (following-char) ?\,)
|
|
|
830 (= (following-char) ?\}))
|
|
|
831 t
|
|
|
832 (setq p (scan-sexps (point) 1 nil t))
|
|
|
833 (if (null p)
|
|
|
834 nil
|
|
|
835 (goto-char p)
|
|
|
836 t)))))
|
|
|
837 (if ok
|
|
|
838 ;; skip over the comma and go around again.
|
|
|
839 (and (looking-at "}?[ \t]*,[ \t]*")
|
|
|
840 (goto-char (match-end 0)))
|
|
|
841 ;; saw something unexpected; give up on this line.
|
|
|
842 (setq tokens nil)))))
|
|
|
843 )))))
|
|
|
844 nil)
|
|
|
845
|
|
|
846 (defun gdb-highlight-token (type start end)
|
|
|
847 "Helper for gdb-highlight-line -- makes an extent for one matched token."
|
|
|
848 (let ((e (make-extent start end)))
|
|
|
849 (set-extent-property e 'gdb-token type)
|
|
|
850 (set-extent-property e 'highlight 't)
|
|
|
851 (set-extent-property e 'help-echo 'gdb-token-help-echo)
|
|
|
852 (set-extent-property e 'face (get type 'gdb-token-face))
|
|
|
853 (set-extent-property e 'keymap (get type 'gdb-token-keymap))
|
|
|
854 e))
|
|
|
855
|
|
|
856 (defun gdb-highlight-arglist (type start end)
|
|
|
857 "Helper for gdb-highlight-line.
|
|
|
858 Makes extents for variables or types in an arglist."
|
|
|
859 (save-match-data
|
|
|
860 (save-excursion
|
|
|
861 (goto-char end)
|
|
|
862 (if (eq (preceding-char) ?\))
|
|
|
863 (setq end (1- end)))
|
|
|
864 (goto-char start)
|
|
|
865 (if (eq (following-char) ?\()
|
|
|
866 (forward-char 1))
|
|
|
867 (set-extent-property (make-extent start end) 'gdb-token type)
|
|
|
868
|
|
|
869 (cond
|
|
|
870 ((eq type 'gdb-arglist-token)
|
|
|
871 (let* ((pat1 "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)=")
|
|
|
872 (pat2 ", \\([a-zA-Z_][a-zA-Z0-9_:]*\\)=")
|
|
|
873 (pat pat1))
|
|
|
874 (while(re-search-forward pat end t)
|
|
|
875 (gdb-highlight-token 'gdb-variable-name-token
|
|
|
876 (match-beginning 1) (match-end 1))
|
|
|
877 (cond ((looking-at
|
|
|
878 "0?x?[0-9A-Fa-f]+ <\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)>")
|
|
|
879 (goto-char (match-end 0))
|
|
|
880 (gdb-highlight-token 'gdb-function-name-token
|
|
|
881 (match-beginning 1) (match-end 1))))
|
|
|
882 (setq pat pat2))))
|
|
|
883
|
|
|
884 ((eq type 'gdb-arglist-types-token)
|
|
|
885 (let ((pat (eval-when-compile
|
|
|
886 (concat
|
|
|
887 "\\(" ; 1
|
|
|
888 "\\(signed \\|unsigned \\)?" ; .2
|
|
|
889 "\\(struct \\|class \\|union \\|enum \\)?" ; .3
|
|
|
890 "\\(<?[a-zA-Z_~][a-zA-Z0-9_:]*>?\\)" ; .4
|
|
|
891 "\\)" ; 1
|
|
|
892 "[ *]*"
|
|
|
893 "\\((\\*) *(.*)\\)?" ; 5
|
|
|
894 ))))
|
|
|
895 (while (< (point) end)
|
|
|
896 (cond ((looking-at pat)
|
|
|
897 (goto-char (match-end 0))
|
|
|
898 (gdb-highlight-token 'gdb-type-name-token
|
|
|
899 (match-beginning 1) (match-end 1))
|
|
|
900 (if (looking-at " *, *")
|
|
|
901 (goto-char (match-end 0))))
|
|
|
902 (t
|
|
|
903 ;; error -- try to cope...
|
|
|
904 (search-forward "," (1+ end) t))))))
|
|
|
905 (t
|
|
|
906 (error "unknown arglist type %s" type)))))
|
|
|
907 nil)
|
|
|
908
|
|
|
909 (defun gdb-token-help-echo (extent)
|
|
|
910 "Used as the 'mouse-help property of gdb-token extents,
|
|
|
911 to describe the binding on button2."
|
|
|
912 (let* ((map (extent-property extent 'keymap))
|
|
|
913 (key 'button2)
|
|
|
914 (fn (and map (lookup-key map key)))
|
|
|
915 (doc (and fn (symbolp fn)
|
|
|
916 (if (fboundp fn)
|
|
|
917 (format "%s: %s" key (documentation fn))
|
|
|
918 (format "Error: %s is undefined" fn)))))
|
|
|
919 (if doc
|
|
|
920 (save-match-data
|
|
|
921 (if (string-match "\n" doc)
|
|
|
922 (setq doc (substring doc 0 (match-beginning 0))))))
|
|
|
923 (or doc
|
|
|
924 (concat "Error: no doc for "
|
|
|
925 (symbol-name (extent-property extent 'gdb-token))))))
|
|
|
926
|
|
|
927 (defun gdb-get-line-token-extents (tokens)
|
|
|
928 "Given a list of gdb-tokens, returns this line's extents of those types.
|
|
|
929 The returned value is a list of the same length as the `tokens' list, with
|
|
|
930 the corresponding extents in the corresponding positions. If an extent
|
|
|
931 isn't found, nil is placed in the result-list instead."
|
|
|
932 (setq tokens (append tokens nil))
|
|
|
933 (let* ((result (make-list (length tokens) nil)))
|
|
|
934 (save-excursion
|
|
|
935 (beginning-of-line)
|
|
|
936 (map-extents #'(lambda (e ignore)
|
|
|
937 (let ((type (extent-property e 'gdb-token))
|
|
|
938 (r1 tokens)
|
|
|
939 (r2 result))
|
|
|
940 (while r1
|
|
|
941 (cond ((and (car r1) (eq type (car r1)))
|
|
|
942 (setcar r1 nil)
|
|
|
943 (setcar r2 e)
|
|
|
944 (setq r1 nil)))
|
|
|
945 (setq r1 (cdr r1)
|
|
|
946 r2 (cdr r2))))
|
|
|
947 nil)
|
|
|
948 nil
|
|
|
949 (point)
|
|
|
950 (progn (forward-line 1) (point))
|
|
|
951 nil nil
|
|
|
952 'gdb-token)
|
|
|
953 result)))
|
|
|
954
|
|
|
955
|
|
|
956 ;;; Remembering directory names.
|
|
|
957 ;;; gdb and gdb-mode conspire to hide from us the full file names of things
|
|
|
958 ;;; that are presented into the buffer; this is an attempt to circumvent that.
|
|
|
959
|
|
|
960 (defvar gdb-highlight-last-directory nil)
|
|
|
961 (defvar gdb-highlight-last-directory-table nil)
|
|
|
962
|
|
|
963 (defun gdb-highlight-remember-directory ()
|
|
|
964 ;; When gdb deigns to give us a full pathname, and it's in a different
|
|
|
965 ;; directory than last time, cache it away on one of the nearby gdb-token
|
|
|
966 ;; extents. (We intern it to avoid hanging on to a lot of strings.)
|
|
|
967 (cond ((and (boundp 'gdb-last-frame)
|
|
|
968 (car gdb-last-frame))
|
|
|
969 (cond ((not gdb-highlight-last-directory-table)
|
|
|
970 (set (make-local-variable 'gdb-highlight-last-directory) nil)
|
|
|
971 (set (make-local-variable 'gdb-highlight-last-directory-table)
|
|
|
972 (make-vector 211 0))))
|
|
|
973 (let ((dir (file-name-directory (car gdb-last-frame))))
|
|
|
974 (setq dir (intern dir gdb-highlight-last-directory-table))
|
|
|
975 (cond ((not (eq dir gdb-highlight-last-directory))
|
|
|
976 (let ((extent (previous-extent (current-buffer))))
|
|
|
977 (setq gdb-highlight-last-directory dir)
|
|
|
978 (while extent
|
|
|
979 (cond ((extent-property extent 'gdb-token)
|
|
|
980 (set-extent-property extent 'gdb-directory dir)
|
|
|
981 (setq extent nil))
|
|
|
982 (t
|
|
|
983 (setq extent (previous-extent extent))))))))))))
|
|
|
984
|
|
|
985 (defun gdb-guess-directory ()
|
|
|
986 "Guess what directory gdb was talking about when it wrote the current line."
|
|
|
987 (let ((extent (or (map-extents #'(lambda (e ignore) e)
|
|
|
988 (current-buffer) (point) (point-max))
|
|
|
989 (previous-extent (current-buffer))
|
|
|
990 (error "no extents")))
|
|
|
991 (dir nil))
|
|
|
992 (while extent
|
|
|
993 (setq dir (extent-property extent 'gdb-directory))
|
|
|
994 (if dir
|
|
|
995 (setq extent nil)
|
|
|
996 (setq extent (previous-extent extent))))
|
|
|
997 (if dir
|
|
|
998 (symbol-name dir)
|
|
|
999 default-directory)))
|
|
|
1000
|
|
|
1001 (defun gdb-guess-file-name (file)
|
|
|
1002 "Given a directoryless file name printed by gdb, find the file.
|
|
|
1003 First it tries to expand the file relative to `gdb-guess-directory',
|
|
|
1004 and if the resultant file doesn't exist, it tries every other directory
|
|
|
1005 gdb has ever told us about, in no particular order."
|
|
|
1006 (abbreviate-file-name
|
|
|
1007 (if (file-name-absolute-p file)
|
|
|
1008 file
|
|
|
1009 (let ((file2 (expand-file-name file (gdb-guess-directory))))
|
|
|
1010 (if (file-exists-p file2)
|
|
|
1011 file2
|
|
|
1012 ;; Oh boy, gdb didn't tell us what directory it's in.
|
|
|
1013 ;; A-hunting we will go.
|
|
|
1014 (if (catch 'done
|
|
|
1015 (mapatoms #'(lambda (dir)
|
|
|
1016 (setq file2 (expand-file-name file
|
|
|
1017 (symbol-name dir)))
|
|
|
1018 (if (file-exists-p file2)
|
|
|
1019 (throw 'done t)))
|
|
|
1020 gdb-highlight-last-directory-table)
|
|
|
1021 nil)
|
|
|
1022 file2
|
|
|
1023 (expand-file-name file)))))))
|
|
|
1024
|
|
|
1025
|
|
|
1026 ;;; Commands which are invoked from bindings in the keymaps of the tokens.
|
|
|
1027
|
|
|
1028 (defun gdb-mouse-toggle-breakpoint-enabled (event &optional what)
|
|
|
1029 "Toggle whether the breakpoint is enabled.
|
|
|
1030 Looks for a gdb-breakpoint extent on the line under the mouse,
|
|
|
1031 and executes an `enable' or `disable' command as appropriate.
|
|
|
1032 Optional arg `what' may be 'enable, 'disable, or 'toggle (default.)"
|
|
|
1033 (interactive "@*e")
|
|
|
1034 (let (number target enabled-p)
|
|
|
1035 (save-excursion
|
|
|
1036 (mouse-set-point event)
|
|
|
1037 (let* ((extents (gdb-get-line-token-extents
|
|
|
1038 '(gdb-breakpoint-number-token
|
|
|
1039 gdb-info-breakpoint-number-token
|
|
|
1040 gdb-enabled-token)))
|
|
|
1041 (be (or (nth 0 extents) (nth 1 extents)))
|
|
|
1042 (ee (nth 2 extents)))
|
|
|
1043
|
|
|
1044 (or be
|
|
|
1045 (error "no breakpoint-number extent on this line"))
|
|
|
1046 (setq number
|
|
|
1047 (buffer-substring (extent-start-position be)
|
|
|
1048 (extent-end-position be)))
|
|
|
1049 (if (string-match " [0-9]+\\'" number)
|
|
|
1050 (setq number (substring number (1+ (match-beginning 0)))))
|
|
|
1051 (setq number (string-to-int number))
|
|
|
1052 (or (> number 0)
|
|
|
1053 (error "couldn't find breakpoint number"))
|
|
|
1054 (if (null ee)
|
|
|
1055 (setq enabled-p 'unknown)
|
|
|
1056 (setq target (extent-start-position ee))
|
|
|
1057 (goto-char target)
|
|
|
1058 (setq enabled-p
|
|
|
1059 (cond ((looking-at "[yY]\\b") t)
|
|
|
1060 ((looking-at "[nN]\\b") nil)
|
|
|
1061 (t (error "enabled is not y or n?")))))
|
|
|
1062
|
|
|
1063 (cond ((eq what 'enable)
|
|
|
1064 (setq enabled-p nil))
|
|
|
1065 ((eq what 'disable)
|
|
|
1066 (setq enabled-p t))
|
|
|
1067 ((or (eq what 'toggle) (null what))
|
|
|
1068 (if (eq enabled-p 'unknown)
|
|
|
1069 (error
|
|
|
1070 "can't toggle breakpoint: don't know current state")))
|
|
|
1071 (t
|
|
|
1072 (error "what must be enable, disable, toggle, or nil.")))
|
|
|
1073 ))
|
|
|
1074
|
|
|
1075 (gdb-menu-command (format "%s %d"
|
|
|
1076 (if enabled-p "disable" "enable")
|
|
|
1077 number)
|
|
|
1078 nil)
|
|
|
1079 (message "%s breakpoint %d."
|
|
|
1080 (if enabled-p "Disabled" "Enabled")
|
|
|
1081 number)
|
|
|
1082 (cond (target
|
|
|
1083 (save-excursion
|
|
|
1084 (goto-char target)
|
|
|
1085 (insert (if enabled-p "n" "y"))
|
|
|
1086 (delete-char 1)
|
|
|
1087 ;; don't let shell-fonts or font-lock second-guess us.
|
|
|
1088 (remove-text-properties (1- (point)) (point) '(face))))))
|
|
|
1089 nil)
|
|
|
1090
|
|
|
1091 (defun gdb-mouse-enable-breakpoint (event)
|
|
|
1092 "Enable the breakpoint.
|
|
|
1093 Looks for a gdb-breakpoint extent on the line under the mouse,
|
|
|
1094 and executes an `enable' command"
|
|
|
1095 (interactive "@*e")
|
|
|
1096 (gdb-mouse-toggle-breakpoint-enabled event 'enable))
|
|
|
1097
|
|
|
1098 (defun gdb-mouse-disable-breakpoint (event)
|
|
|
1099 "Disable the breakpoint.
|
|
|
1100 Looks for a gdb-breakpoint extent on the line under the mouse,
|
|
|
1101 and executes a `disable' command"
|
|
|
1102 (interactive "@*e")
|
|
|
1103 (gdb-mouse-toggle-breakpoint-enabled event 'disable))
|
|
|
1104
|
|
|
1105
|
|
|
1106 ;; compatibility hack...
|
|
|
1107 (or (fboundp 'extent-object) (fset 'extent-object 'extent-buffer))
|
|
|
1108
|
|
|
1109 (defun gdb-mouse-edit-function (event)
|
|
|
1110 "Edit the definition of this function (as with \\[find-tag])
|
|
|
1111 Looks for a gdb-function-name extent on the line under the mouse,
|
|
|
1112 and runs find-tag on the text under that extent."
|
|
|
1113 (interactive "@*e")
|
|
|
1114 (let (extent)
|
|
|
1115 (save-excursion
|
|
|
1116 (mouse-set-point event)
|
|
|
1117 (setq extent (or (car (gdb-get-line-token-extents
|
|
|
1118 '(gdb-function-name-token)))
|
|
|
1119 (error "no function-name extent on this line"))))
|
|
|
1120 (find-tag
|
|
|
1121 (buffer-substring (extent-start-position extent)
|
|
|
1122 (extent-end-position extent)
|
|
|
1123 (extent-object extent)))))
|
|
|
1124
|
|
|
1125
|
|
|
1126 (defun gdb-mouse-edit-function-location (event)
|
|
|
1127 "Edit the source file of this function.
|
|
|
1128 Looks for a gdb-function-location extent on line of the mouse,
|
|
|
1129 and parses the text under it."
|
|
|
1130 (interactive "@*e")
|
|
|
1131 (let (file line)
|
|
|
1132 (save-excursion
|
|
|
1133 (mouse-set-point event)
|
|
|
1134 (let ((extent (or (car (gdb-get-line-token-extents
|
|
|
1135 '(gdb-function-location-token)))
|
|
|
1136 (error "no function-location extent on this line"))))
|
|
|
1137 (goto-char (extent-start-position extent))
|
|
|
1138 (or (looking-at "\\([^ \t\n:,]+\\):\\([0-9]+\\)")
|
|
|
1139 (looking-at "\\([^ \t\n:,]+\\),? line \\([0-9]+\\)")
|
|
|
1140 (error "no file position on this line"))
|
|
|
1141 (setq file (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
1142 line (buffer-substring (match-beginning 2) (match-end 2)))
|
|
|
1143 (setq file (gdb-guess-file-name file)
|
|
|
1144 line (string-to-int line))
|
|
|
1145 ))
|
|
|
1146 (if (file-exists-p file)
|
|
|
1147 (find-file-other-window file)
|
|
|
1148 (signal 'file-error (list "File not found" file)))
|
|
|
1149 (goto-line line)))
|
|
|
1150
|
|
|
1151
|
|
|
1152 (defun gdb-mouse-goto-frame (event)
|
|
|
1153 "Select this stack frame.
|
|
|
1154 Looks for a gdb-frame-number extent on the line of the mouse,
|
|
|
1155 and executes a `frame' command to select that frame."
|
|
|
1156 (interactive "@*e")
|
|
|
1157 (let (number)
|
|
|
1158 (save-excursion
|
|
|
1159 (mouse-set-point event)
|
|
|
1160 (let ((extent (or (car (gdb-get-line-token-extents
|
|
|
1161 '(gdb-frame-number-token)))
|
|
|
1162 (error "no frame-number extent on this line"))))
|
|
|
1163 (goto-char (extent-start-position extent))
|
|
|
1164 (if (eq (following-char) ?#)
|
|
|
1165 (forward-char 1))
|
|
|
1166 (setq number (string-to-int
|
|
|
1167 (buffer-substring (point)
|
|
|
1168 (extent-end-position extent))))))
|
|
|
1169 (gdb-menu-command (format "frame %d" number) t))
|
|
|
1170 nil)
|
|
|
1171
|
|
|
1172
|
|
|
1173 (defun gdb-mouse-get-variable-reference (event)
|
|
|
1174 "Returns a string which references the variable under the mouse.
|
|
|
1175 This works even if the variable is deep inside nested arrays or structures.
|
|
|
1176 If the variable seems to hold a pointer, then a \"*\" will be prepended."
|
|
|
1177 (save-excursion
|
|
|
1178 (let* ((extent (if (extentp event)
|
|
|
1179 event
|
|
|
1180 (progn
|
|
|
1181 (mouse-set-point event)
|
|
|
1182 (extent-at (point) nil 'gdb-token))))
|
|
|
1183 dereference-p
|
|
|
1184 name)
|
|
|
1185 (or (and extent
|
|
|
1186 (eq (extent-property extent 'gdb-token)
|
|
|
1187 'gdb-variable-name-token))
|
|
|
1188 (error "not over a variable name"))
|
|
|
1189 (setq name (buffer-substring (extent-start-position extent)
|
|
|
1190 (extent-end-position extent)))
|
|
|
1191 (save-excursion
|
|
|
1192 (goto-char (extent-end-position extent))
|
|
|
1193 (if (and (looking-at " *= *\\(([^)]+)\\)? *0x[0-9a-fA-F]+") ; pointer
|
|
|
1194 (progn
|
|
|
1195 (goto-char (match-end 0))
|
|
|
1196 (not (looking-at " +\"")))) ; but not string
|
|
|
1197 (setq dereference-p t))
|
|
|
1198
|
|
|
1199 ;; Now, if this variable is buried in a structure, compose a complete
|
|
|
1200 ;; reference-chain to it.
|
|
|
1201 (goto-char (extent-start-position extent))
|
|
|
1202
|
|
|
1203 (let ((done nil))
|
|
|
1204 (while (not done)
|
|
|
1205 (skip-chars-backward " \t")
|
|
|
1206 (if (or (and (/= (preceding-char) ?\n)
|
|
|
1207 (/= (preceding-char) ?\,)
|
|
|
1208 (/= (preceding-char) ?\{))
|
|
|
1209 (<= (buffer-syntactic-context-depth) 0))
|
|
|
1210 (setq done t)
|
|
|
1211 (let ((p (scan-lists (point) -1 1)))
|
|
|
1212 (if (null p)
|
|
|
1213 (setq done t)
|
|
|
1214 (goto-char (setq p (- p 3)))
|
|
|
1215 (cond
|
|
|
1216 ((looking-at " = {")
|
|
|
1217 (skip-chars-backward "a-zA-Z0-9_")
|
|
|
1218 (if (= (preceding-char) ?\$)
|
|
|
1219 (forward-char -1))
|
|
|
1220 (setq name (concat (buffer-substring (point) p) "." name)))
|
|
|
1221
|
|
|
1222 ((looking-at "}, +{")
|
|
|
1223 (forward-char 1)
|
|
|
1224 (let ((parse-sexp-ignore-comments nil)
|
|
|
1225 (count 0))
|
|
|
1226 (while (setq p (scan-sexps (point) -1 nil t))
|
|
|
1227 (goto-char p)
|
|
|
1228 (setq count (1+ count)))
|
|
|
1229
|
|
|
1230 (setq name (format "[%d].%s" count name))
|
|
|
1231
|
|
|
1232 ;; up out of the list
|
|
|
1233 (skip-chars-backward " \t\n")
|
|
|
1234 (if (= (preceding-char) ?\{)
|
|
|
1235 (forward-char -1))
|
|
|
1236
|
|
|
1237 ;; we might be tightly nested in slot 0...
|
|
|
1238 (while (= (preceding-char) ?\{)
|
|
|
1239 (forward-char -1)
|
|
|
1240 (setq name (concat "[0]" name)))
|
|
|
1241
|
|
|
1242 (skip-chars-backward " \t")
|
|
|
1243 (if (= (preceding-char) ?=) (forward-char -1))
|
|
|
1244 (skip-chars-backward " \t")
|
|
|
1245 (setq p (point))
|
|
|
1246 (skip-chars-backward "a-zA-Z0-9_")
|
|
|
1247 (if (= (preceding-char) ?\$)
|
|
|
1248 (forward-char -1))
|
|
|
1249
|
|
|
1250 (setq name (concat (buffer-substring (point) p) name))
|
|
|
1251 ))
|
|
|
1252 (t
|
|
|
1253 (setq done t)))))))))
|
|
|
1254
|
|
|
1255 (if dereference-p
|
|
|
1256 (setq name (concat "*" name)))
|
|
|
1257 name)))
|
|
|
1258
|
|
|
1259 (defun gdb-mouse-print-variable (event)
|
|
|
1260 "Print the value of this variable.
|
|
|
1261 Finds a variable under the mouse, and figures out whether it is inside of
|
|
|
1262 a structure, and composes and executes a `print' command. If the variable
|
|
|
1263 seems to hold a pointer, prints the object pointed to."
|
|
|
1264 (interactive "@*e")
|
|
|
1265 (gdb-menu-command (concat "print "
|
|
|
1266 (gdb-mouse-get-variable-reference event))
|
|
|
1267 t))
|
|
|
1268
|
|
|
1269 (defun gdb-mouse-print-variable-type (event)
|
|
|
1270 "Describe the type of this variable.
|
|
|
1271 Finds a variable under the mouse, and figures out whether it is inside of
|
|
|
1272 a structure, and composes and executes a `whatis' command. If the variable
|
|
|
1273 seems to hold a pointer, describes the type of the object pointed to."
|
|
|
1274 (interactive "@*e")
|
|
|
1275 (gdb-menu-command (concat "whatis "
|
|
|
1276 (gdb-mouse-get-variable-reference event))
|
|
|
1277 t))
|
|
|
1278
|
|
|
1279 (defun gdb-mouse-print-type (event)
|
|
|
1280 "Describe this type.
|
|
|
1281 Finds a type description under the mouse, and executes a `ptype' command."
|
|
|
1282 (interactive "@*e")
|
|
|
1283 (let* ((extent (save-excursion
|
|
|
1284 (mouse-set-point event)
|
|
|
1285 (extent-at (point) nil 'gdb-token)))
|
|
|
1286 name)
|
|
|
1287 (or (and extent
|
|
|
1288 (eq (extent-property extent 'gdb-token) 'gdb-type-name-token))
|
|
|
1289 (error "not over a type name"))
|
|
|
1290 (setq name (buffer-substring (extent-start-position extent)
|
|
|
1291 (extent-end-position extent)))
|
|
|
1292 (gdb-menu-command (format "ptype %s" name)
|
|
|
1293 t))
|
|
|
1294 nil)
|
|
|
1295
|
|
|
1296
|
|
|
1297 ;;; Popup menus
|
|
|
1298
|
|
|
1299 (defun gdb-menu-command (command &optional scroll-to-bottom)
|
|
|
1300 "Sends the command to gdb.
|
|
|
1301 If gdb is not sitting at a prompt, interrupts it first
|
|
|
1302 \(as if with \\[gdb-control-c-subjob]), executes the command, and then lets
|
|
|
1303 the debugged program continue.
|
|
|
1304
|
|
|
1305 If scroll-to-bottom is true, then point will be moved to after the new
|
|
|
1306 output. Otherwise, an effort is made to avoid scrolling the window and
|
|
|
1307 to keep point where it was."
|
|
|
1308
|
|
|
1309 ;; this is kinda like gdb-call except for the interrupt-first behavior,
|
|
|
1310 ;; but also it leaves the commands in the buffer instead of trying to
|
|
|
1311 ;; hide them.
|
|
|
1312
|
|
|
1313 (let* ((proc (or (get-buffer-process (current-buffer))
|
|
|
1314 (error "no process in %s" (buffer-name (current-buffer)))))
|
|
|
1315 (window (selected-window))
|
|
|
1316 wstart
|
|
|
1317 (opoint (point))
|
|
|
1318 was-at-bottom
|
|
|
1319 running-p)
|
|
|
1320
|
|
|
1321 (if (not (eq (current-buffer) (window-buffer window)))
|
|
|
1322 (setq window (get-buffer-window (current-buffer))))
|
|
|
1323 (setq wstart (window-start window))
|
|
|
1324
|
|
|
1325 (let ((pmark (process-mark proc)))
|
|
|
1326 (setq was-at-bottom (>= (point) pmark))
|
|
|
1327 (goto-char pmark)
|
|
|
1328 (delete-region (point) (point-max)))
|
|
|
1329
|
|
|
1330 (setq running-p (bolp)) ; maybe not the best way to tell...
|
|
|
1331
|
|
|
1332 (cond (running-p
|
|
|
1333 (message "Program is running -- interrupting first...")
|
|
|
1334 (gdb-control-c-subjob)
|
|
|
1335 (while (accept-process-output proc 1)
|
|
|
1336 ;; continue accepting output as long as it's arriving
|
|
|
1337 )))
|
|
|
1338
|
|
|
1339 (message "%s" command)
|
|
|
1340 (goto-char (process-mark proc))
|
|
|
1341 (insert command)
|
|
|
1342 (comint-send-input)
|
|
|
1343
|
|
|
1344 ;; wait for the command to be accepted
|
|
|
1345 (accept-process-output proc)
|
|
|
1346 (goto-char (process-mark proc))
|
|
|
1347
|
|
|
1348 ;; continue, if we had interrupted
|
|
|
1349 (cond (running-p
|
|
|
1350 (insert "continue")
|
|
|
1351 (comint-send-input)))
|
|
|
1352
|
|
|
1353 (if scroll-to-bottom
|
|
|
1354 (goto-char (process-mark proc))
|
|
|
1355
|
|
|
1356 (set-window-start window wstart)
|
|
|
1357 (goto-char opoint)
|
|
|
1358 (if was-at-bottom
|
|
|
1359 (if (pos-visible-in-window-p (process-mark proc) window)
|
|
|
1360 (goto-char (process-mark proc))
|
|
|
1361 (goto-char (window-end window))
|
|
|
1362 (forward-line -2))))
|
|
|
1363 )
|
|
|
1364 nil)
|
|
|
1365
|
|
|
1366
|
|
|
1367 (defun gdb-make-context-menu (event)
|
|
|
1368 "Returns a menu-desc corresponding to the stack-frame line under the mouse.
|
|
|
1369 Returns nil if not over a stack-frame."
|
|
|
1370 (save-excursion
|
|
|
1371 (mouse-set-point event)
|
|
|
1372 (let* ((extents (gdb-get-line-token-extents
|
|
|
1373 '(gdb-breakpoint-number-token
|
|
|
1374 gdb-info-breakpoint-number-token
|
|
|
1375 gdb-enabled-token
|
|
|
1376 gdb-frame-number-token
|
|
|
1377 gdb-function-name-token
|
|
|
1378 gdb-function-location-token
|
|
|
1379 gdb-arglist-token
|
|
|
1380 gdb-arglist-types-token
|
|
|
1381 gdb-variable-name-token
|
|
|
1382 gdb-type-name-token
|
|
|
1383 )))
|
|
|
1384 (bnumber (or (nth 0 extents)
|
|
|
1385 (nth 1 extents)))
|
|
|
1386 (enabled-p (nth 2 extents))
|
|
|
1387 (fnumber (nth 3 extents))
|
|
|
1388 (name (nth 4 extents))
|
|
|
1389 (loc (nth 5 extents))
|
|
|
1390 (al (nth 6 extents))
|
|
|
1391 (alt (nth 7 extents))
|
|
|
1392 (var (nth 8 extents))
|
|
|
1393 (type (nth 9 extents))
|
|
|
1394 (var-e var))
|
|
|
1395
|
|
|
1396 ;; If this line has an arglist, only document variables and types
|
|
|
1397 ;; if the mouse is directly over them.
|
|
|
1398 (if (or al alt)
|
|
|
1399 (setq var nil
|
|
|
1400 type nil))
|
|
|
1401
|
|
|
1402 ;; Always prefer the object under the mouse to one elsewhere on the line.
|
|
|
1403 (let* ((e (extent-at (point) nil 'gdb-token))
|
|
|
1404 (p (and e (extent-property e 'gdb-token))))
|
|
|
1405 (cond ((eq p 'gdb-function-name-token) (setq name e))
|
|
|
1406 ((eq p 'gdb-variable-name-token) (setq var e var-e e))
|
|
|
1407 ((eq p 'gdb-type-name-token) (setq type e))
|
|
|
1408 ))
|
|
|
1409
|
|
|
1410 ;; Extract the frame number (it may begin with "#".)
|
|
|
1411 (cond (fnumber
|
|
|
1412 (goto-char (extent-start-position fnumber))
|
|
|
1413 (if (eq (following-char) ?#)
|
|
|
1414 (forward-char 1))
|
|
|
1415 (setq fnumber
|
|
|
1416 (string-to-int
|
|
|
1417 (buffer-substring (point)
|
|
|
1418 (extent-end-position fnumber))))))
|
|
|
1419
|
|
|
1420 ;; Extract the breakpoint number (it may begin with "Breakpoint ".)
|
|
|
1421 (cond (bnumber
|
|
|
1422 (setq bnumber
|
|
|
1423 (buffer-substring (extent-start-position bnumber)
|
|
|
1424 (extent-end-position bnumber)))
|
|
|
1425 (if (string-match " [0-9]+\\'" bnumber)
|
|
|
1426 (setq bnumber (substring bnumber (1+ (match-beginning 0)))))
|
|
|
1427 (setq bnumber (string-to-int bnumber))
|
|
|
1428 (or (> bnumber 0)
|
|
|
1429 (error "couldn't parse breakpoint number"))))
|
|
|
1430
|
|
|
1431 (cond ((null enabled-p)
|
|
|
1432 (setq enabled-p 'unknown))
|
|
|
1433 ((memq (char-after (extent-start-position enabled-p)) '(?y ?Y))
|
|
|
1434 (setq enabled-p 't))
|
|
|
1435 ((memq (char-after (extent-start-position enabled-p)) '(?n ?N))
|
|
|
1436 (setq enabled-p 'nil))
|
|
|
1437 (t
|
|
|
1438 (setq enabled-p 'unknown)))
|
|
|
1439
|
|
|
1440 ;; Convert the extents to strings.
|
|
|
1441 ;;
|
|
|
1442 (if name
|
|
|
1443 (setq name (buffer-substring (extent-start-position name)
|
|
|
1444 (extent-end-position name))))
|
|
|
1445 (if loc
|
|
|
1446 (setq loc (buffer-substring (extent-start-position loc)
|
|
|
1447 (extent-end-position loc))))
|
|
|
1448 (if var
|
|
|
1449 (setq var (buffer-substring (extent-start-position var)
|
|
|
1450 (extent-end-position var))))
|
|
|
1451 (if type
|
|
|
1452 (setq type (buffer-substring (extent-start-position type)
|
|
|
1453 (extent-end-position type))))
|
|
|
1454
|
|
|
1455 ;; Return a menu description list.
|
|
|
1456 ;;
|
|
|
1457 (nconc
|
|
|
1458 (if (and bnumber (not (eq enabled-p 'nil)))
|
|
|
1459 (list (vector (format "Disable Breakpoint %d"
|
|
|
1460 bnumber)
|
|
|
1461 (list 'gdb-mouse-disable-breakpoint event)
|
|
|
1462 t)))
|
|
|
1463 (if (and bnumber (not (eq enabled-p 't)))
|
|
|
1464 (list (vector (format "Enable Breakpoint %d"
|
|
|
1465 bnumber)
|
|
|
1466 (list 'gdb-mouse-enable-breakpoint event)
|
|
|
1467 t)))
|
|
|
1468 (if bnumber
|
|
|
1469 (list (vector (format "Delete Breakpoint %d" bnumber)
|
|
|
1470 (list 'gdb-menu-command (format "delete %d" bnumber)
|
|
|
1471 nil)
|
|
|
1472 t)))
|
|
|
1473 (if var
|
|
|
1474 (list (vector (format "Print Value of `%s'" var)
|
|
|
1475 (list 'gdb-mouse-print-variable var-e)
|
|
|
1476 t)
|
|
|
1477 (vector (format "Print Type of `%s'" var)
|
|
|
1478 (list 'gdb-mouse-print-variable-type var-e)
|
|
|
1479 t)))
|
|
|
1480 (if name
|
|
|
1481 (list (vector (format "Edit Definition of `%s'" name)
|
|
|
1482 (list 'gdb-mouse-edit-function event)
|
|
|
1483 t)
|
|
|
1484 (vector (format "Set Breakpoint on `%s'" name)
|
|
|
1485 (list 'gdb-menu-command (format "break %s" name) nil)
|
|
|
1486 t)))
|
|
|
1487 (if loc
|
|
|
1488 (list (vector (format "Visit Source Line (%s)" loc)
|
|
|
1489 (list 'gdb-mouse-edit-function-location event)
|
|
|
1490 t)))
|
|
|
1491 (if type
|
|
|
1492 (list (vector (format "Describe Type `%s'" type)
|
|
|
1493 (list 'gdb-menu-command (format "ptype %s" type) t)
|
|
|
1494 t)))
|
|
|
1495 (if fnumber
|
|
|
1496 (list (vector (format "Select Stack Frame %d" fnumber)
|
|
|
1497 (list 'gdb-menu-command (format "frame %d" fnumber) t)
|
|
|
1498 t)))
|
|
|
1499 ))))
|
|
|
1500
|
|
|
1501
|
|
|
1502 (defun gdb-popup-menu (event)
|
|
|
1503 "Pop up a context-sensitive menu of gdb-mode commands."
|
|
|
1504 (interactive "_@e")
|
|
|
1505 (select-window (event-window event))
|
|
|
1506 (let (menu)
|
|
|
1507 (save-excursion
|
|
|
1508 (setq menu (append (if (boundp 'gdb-popup-menu)
|
|
|
1509 (append (cdr gdb-popup-menu)
|
|
|
1510 '("---")))
|
|
|
1511 (if (boundp 'comint-popup-menu)
|
|
|
1512 (cdr comint-popup-menu))))
|
|
|
1513 (let ((history (if (fboundp 'comint-make-history-menu)
|
|
|
1514 (comint-make-history-menu)))
|
|
|
1515 (context (gdb-make-context-menu event)))
|
|
|
1516 (if history
|
|
|
1517 (setq menu
|
|
|
1518 (append menu (list "---" (cons "Command History" history)))))
|
|
|
1519 (if context
|
|
|
1520 (setq menu (append context (cons "---" menu))))
|
|
|
1521 )
|
|
|
1522 (setq menu (cons (if (boundp 'gdb-popup-menu)
|
|
|
1523 (car gdb-popup-menu)
|
|
|
1524 "GDB Commands")
|
|
|
1525 menu)))
|
|
|
1526 (popup-menu menu event)))
|
|
|
1527
|
|
|
1528
|
|
|
1529 ;;; Patch it in...
|
|
|
1530
|
|
|
1531 (or (fboundp 'gdb-highlight-orig-filter)
|
|
|
1532 (fset 'gdb-highlight-orig-filter (symbol-function 'gdb-filter)))
|
|
|
1533
|
|
|
1534 (defun gdb-highlight-filter (proc string)
|
|
|
1535 (let ((p (marker-position (process-mark proc))))
|
|
|
1536 (prog1
|
|
|
1537 (gdb-highlight-orig-filter proc string)
|
|
|
1538
|
|
|
1539 (save-match-data
|
|
|
1540 ;;
|
|
|
1541 ;; If there are no newlines in this string at all, then don't
|
|
|
1542 ;; bother processing it -- we will pick up these characters on
|
|
|
1543 ;; the next time around, when the line's newline gets inserted.
|
|
|
1544 ;;
|
|
|
1545 (cond
|
|
|
1546 ((string-match "\n" string)
|
|
|
1547 (save-excursion
|
|
|
1548 (set-buffer (process-buffer proc))
|
|
|
1549 (goto-char p)
|
|
|
1550 (let ((p2 (marker-position (process-mark proc)))
|
|
|
1551 p3)
|
|
|
1552 ;;
|
|
|
1553 ;; If gdb has given us a full pathname, remember it. (Do this
|
|
|
1554 ;; before emitting any gdb-token extents, so that we attach it
|
|
|
1555 ;; to the buffer *before* any of the extents to which it is
|
|
|
1556 ;; known to correspond.
|
|
|
1557 ;;
|
|
|
1558 (gdb-highlight-remember-directory)
|
|
|
1559 ;;
|
|
|
1560 ;; Now highlight each line that has been written. If we wrote
|
|
|
1561 ;; the last half of a line, re-highlight that whole line. (We
|
|
|
1562 ;; need to do that so that the regexps will match properly;
|
|
|
1563 ;; the "\n" test above also depends on this behavior.)
|
|
|
1564 ;;
|
|
|
1565 ;; But don't highlight lines longer than 5000 characters -- that
|
|
|
1566 ;; probably means something is spewing, and we'll just get stuck
|
|
|
1567 ;; hard in the regexp matcher.
|
|
|
1568 ;;
|
|
|
1569 (beginning-of-line)
|
|
|
1570 (while (< (point) p2)
|
|
|
1571 (goto-char (prog1
|
|
|
1572 (point)
|
|
|
1573 (forward-line 1)
|
|
|
1574 (setq p3 (point))))
|
|
|
1575 (if (< (- p3 (point)) 5000)
|
|
|
1576 (gdb-highlight-line))
|
|
|
1577 (goto-char p3))))))))))
|
|
|
1578
|
|
|
1579 (fset 'gdb-filter 'gdb-highlight-filter)
|
|
|
1580
|
|
|
1581
|
|
|
1582 (provide 'gdb-highlight)
|
|
|
1583
|
|
|
1584 ;;; gdb-highlight.el ends here
|
|
|
1585
|
|
|
1586 --------------4273DDB4BB90CEC3B645B5AC--
|
|
|
1587
|
|
|
1588
|
