|
0
|
1 ;;; gdbsrc.el -- Source-based (as opposed to comint-based) debugger
|
|
|
2 ;; interaction mode eventually, this will be unified with GUD
|
|
|
3 ;; (after gud works reliably w/ XEmacs...)
|
|
|
4 ;; Keywords: c, unix, tools, debugging
|
|
|
5
|
|
|
6 ;; Copyright (C) 1990 Debby Ayers <ayers@austin.ibm.com>, and
|
|
|
7 ;; Rich Schaefer <schaefer@asc.slb.com>
|
|
|
8 ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
|
|
|
9 ;;
|
|
|
10 ;; This file is part of XEmacs.
|
|
|
11 ;;
|
|
|
12 ;; XEmacs 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 2 of the License, or
|
|
|
15 ;; (at your option) any later version.
|
|
|
16 ;;
|
|
|
17 ;; XEmacs 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 XEmacs; if not, write to the Free Software
|
|
|
24 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
25
|
|
|
26 ;; Based upon code for version18 by Debra Ayers <ayers@austin.ibm.com>
|
|
|
27
|
|
|
28 ;;; GDBSRC::
|
|
|
29 ;;; Gdbsrc extends the emacs GDB interface to accept gdb commands issued
|
|
|
30 ;;; from the source code buffer. Gdbsrc behaves similar to gdb except
|
|
|
31 ;;; now most debugging may be done from the source code using the *gdb*
|
|
|
32 ;;; buffer to view output. Supports a point and click model under X to
|
|
|
33 ;;; evaluate source code expressions (no more typing long variable names).
|
|
|
34 ;;;
|
|
|
35 ;;; Supports C source at the moment but C++ support will be added if there
|
|
|
36 ;;; is sufficient interest.
|
|
|
37 ;;;
|
|
|
38
|
|
|
39 ;; GDBSRC::Gdb Source Mode Interface description.
|
|
|
40 ;; Gdbsrc extends the emacs GDB interface to accept gdb commands issued
|
|
|
41 ;; from the source code buffer. Gdbsrc behaves similar to gdb except now all
|
|
|
42 ;; debugging may be done from the currently focused source buffer using
|
|
|
43 ;; the *gdb* buffer to view output.
|
|
|
44
|
|
|
45 ;; When source files are displayed through gdbsrc, buffers are put in
|
|
|
46 ;; gdbsrc-mode minor mode. This mode puts the buffer in read-only state
|
|
|
47 ;; and sets up a special key and mouse map to invoke communication with
|
|
|
48 ;; the current gdb process. The minor mode may be toggled on/off as needed.
|
|
|
49 ;; (ESC-T)
|
|
|
50
|
|
|
51 ;; C-expressions may be evaluated by gdbsrc by simply pointing at text in the
|
|
|
52 ;; current source buffer with the mouse or by centering the cursor over text
|
|
|
53 ;; and typing a single key command. ('p' for print, '*' for print *).
|
|
|
54
|
|
|
55 ;; As code is debugged and new buffers are displayed, the focus of gdbsrc
|
|
|
56 ;; follows to each new source buffer. Makes debugging fun. (sound like a
|
|
|
57 ;; commercial or what!)
|
|
|
58 ;;
|
|
|
59
|
|
|
60 ;; Current Listing ::
|
|
|
61 ;;key binding Comment
|
|
|
62 ;;--- ------- -------
|
|
|
63 ;;
|
|
|
64 ;; r gdb-return-from-src GDB return command
|
|
|
65 ;; n gdb-next-from-src GDB next command
|
|
|
66 ;; b gdb-back-from-src GDB back command
|
|
|
67 ;; w gdb-where-from-src GDB where command
|
|
|
68 ;; f gdb-finish-from-src GDB finish command
|
|
|
69 ;; u gdb-up-from-src GDB up command
|
|
|
70 ;; d gdb-down-from-src GDB down command
|
|
|
71 ;; c gdb-cont-from-src GDB continue command
|
|
|
72 ;; i gdb-stepi-from-src GDB step instruction command
|
|
|
73 ;; s gdb-step-from-src GDB step command
|
|
|
74 ;; ? gdb-whatis-c-sexp GDB whatis command for data at
|
|
|
75 ;; buffer point
|
|
|
76 ;; x gdbsrc-delete GDB Delete all breakpoints if no arg
|
|
|
77 ;; given or delete arg (C-u arg x)
|
|
|
78 ;; m gdbsrc-frame GDB Display current frame if no arg,
|
|
|
79 ;; given or display frame arg
|
|
|
80 ;; * gdb-*print-c-sexp GDB print * command for data at
|
|
|
81 ;; buffer point
|
|
|
82 ;; ! gdbsrc-goto-gdb Goto the GDB output buffer
|
|
|
83 ;; p gdb-print-c-sexp GDB print * command for data at
|
|
|
84 ;; buffer point
|
|
|
85 ;; g gdbsrc-goto-gdb Goto the GDB output buffer
|
|
|
86 ;; t gdbsrc-mode Toggles Gdbsrc mode (turns it off)
|
|
|
87 ;;
|
|
|
88 ;; C-c C-f gdb-finish-from-src GDB finish command
|
|
|
89 ;;
|
|
|
90 ;; C-x SPC gdb-break Set break for line with point
|
|
|
91 ;; ESC t gdbsrc-mode Toggle Gdbsrc mode
|
|
|
92 ;;
|
|
|
93 ;; Local Bindings for buffer when you exit Gdbsrc minor mode
|
|
|
94 ;;
|
|
|
95 ;; C-x SPC gdb-break Set break for line with point
|
|
|
96 ;; ESC t gdbsrc-mode Toggle Gdbsrc mode
|
|
|
97 ;;
|
|
|
98
|
|
|
99 ;;; (eval-when-compile
|
|
|
100 ;;; (or noninteractive
|
|
|
101 ;;; (progn
|
|
|
102 ;;; (message "ONLY compile gdbsrc except with -batch because of advice")
|
|
|
103 ;;; (ding)
|
|
|
104 ;;; )))
|
|
|
105
|
|
|
106 (require 'gdb "gdb") ; NOT gud! (yet...)
|
|
|
107
|
|
|
108 (defvar gdbsrc-active-p t
|
|
|
109 "*Set to nil if you do not want source files put in gdbsrc-mode")
|
|
|
110
|
|
|
111 (defvar gdbsrc-call-p nil
|
|
|
112 "True if gdb command issued from a source buffer")
|
|
|
113
|
|
|
114 (defvar gdbsrc-associated-buffer nil
|
|
|
115 "Buffer name of attached gdb process")
|
|
|
116
|
|
|
117 (defvar gdbsrc-mode nil
|
|
|
118 "Indicates whether buffer is in gdbsrc-mode or not")
|
|
|
119 (make-variable-buffer-local 'gdbsrc-mode)
|
|
|
120
|
|
|
121 (defvar gdbsrc-global-mode nil
|
|
|
122 "Indicates whether global gdbsrc bindings are in effect or not")
|
|
|
123
|
|
|
124 (defvar gdb-prompt-pattern "^[^)#$%>\n]*[)#$%>] *"
|
|
|
125 "A regexp for matching the end of the gdb prompt")
|
|
|
126
|
|
|
127 ;;; bindings
|
|
|
128
|
|
|
129 (defvar gdbsrc-global-map
|
|
|
130 (let ((map (make-sparse-keymap)))
|
|
|
131 (set-keymap-name map 'gdbsrc-global-map)
|
|
|
132 (define-key map "\C-x " 'gdb-break)
|
|
|
133 (define-key map "\M-\C-t" 'gdbsrc-mode)
|
|
|
134 (define-key map "\M-\C-g" 'gdbsrc-goto-gdb)
|
|
|
135
|
|
|
136 ;; middle button to select and print expressions...
|
|
|
137 (define-key map '(meta button2) 'gdbsrc-print-csexp)
|
|
|
138 (define-key map '(meta shift button2) 'gdbsrc-*print-csexp)
|
|
|
139 ;; left button to position breakpoints
|
|
|
140 (define-key map '(meta button1) 'gdbsrc-set-break)
|
|
|
141 (define-key map '(meta shift button1) 'gdbsrc-set-tbreak-continue)
|
|
|
142 map)
|
|
|
143 "Global minor keymap that is active whenever gdbsrc is running.")
|
|
|
144
|
|
|
145 (add-minor-mode 'gdbsrc-global-mode " GdbGlobal" gdbsrc-global-map)
|
|
|
146
|
|
|
147 (defvar gdbsrc-mode-map
|
|
|
148 (let ((map (make-sparse-keymap)))
|
|
|
149 (suppress-keymap map)
|
|
|
150 (set-keymap-name map 'gdbsrc-mode-map)
|
|
|
151 ;; inherit keys from global gdbsrc map just in case that somehow gets turned off.
|
|
|
152 (set-keymap-parents map (list gdbsrc-global-map))
|
|
|
153 (define-key map "\C-x\C-q" 'gdbsrc-mode) ; toggle read-only
|
|
|
154 (define-key map "\C-c\C-c" 'gdbsrc-mode)
|
|
|
155 (define-key map "b" 'gdb-break)
|
|
|
156 (define-key map "g" 'gdbsrc-goto-gdb)
|
|
|
157 (define-key map "!" 'gdbsrc-goto-gdb)
|
|
|
158 (define-key map "p" 'gdb-print-c-sexp)
|
|
|
159 (define-key map "*" 'gdb-*print-c-sexp)
|
|
|
160 (define-key map "?" 'gdb-whatis-c-sexp)
|
|
|
161 (define-key map "R" 'gdbsrc-reset)
|
|
|
162 map)
|
|
|
163 "Minor keymap for buffers in gdbsrc-mode")
|
|
|
164
|
|
|
165 (add-minor-mode 'gdbsrc-mode " GdbSrc" gdbsrc-mode-map)
|
|
|
166
|
|
|
167 (defvar gdbsrc-toolbar
|
|
|
168 '([eos::toolbar-stop-at-icon
|
|
|
169 gdb-break
|
|
|
170 t
|
|
|
171 "Stop at selected position"]
|
|
|
172 [eos::toolbar-stop-in-icon
|
|
|
173 gdb-break
|
|
|
174 t
|
|
|
175 "Stop in function whose name is selected"]
|
|
|
176 [eos::toolbar-clear-at-icon
|
|
|
177 gdbsrc-delete
|
|
|
178 t
|
|
|
179 "Clear at selected position"]
|
|
|
180 [eos::toolbar-evaluate-icon
|
|
|
181 gdb-print-c-sexp
|
|
|
182 t
|
|
|
183 "Evaluate selected expression; shows in separate XEmacs frame"]
|
|
|
184 [eos::toolbar-evaluate-star-icon
|
|
|
185 gdb-*print-c-sexp
|
|
|
186 t
|
|
|
187 "Evaluate selected expression as a pointer; shows in separate XEmacs frame"]
|
|
|
188 [eos::toolbar-run-icon
|
|
|
189 gdbsrc-run
|
|
|
190 t
|
|
|
191 "Run current program"]
|
|
|
192 [eos::toolbar-cont-icon
|
|
|
193 gdbsrc-cont
|
|
|
194 t
|
|
|
195 "Continue current program"]
|
|
|
196 [eos::toolbar-step-into-icon
|
|
|
197 gdbsrc-step
|
|
|
198 t
|
|
|
199 "Step into (aka step)"]
|
|
|
200 [eos::toolbar-step-over-icon
|
|
|
201 gdbsrc-next
|
|
|
202 t
|
|
|
203 "Step over (aka next)"]
|
|
|
204 [eos::toolbar-up-icon
|
|
|
205 gdbsrc-up
|
|
|
206 t
|
|
|
207 "Stack Up (towards \"cooler\" - less recently visited - frames)"]
|
|
|
208 [eos::toolbar-down-icon
|
|
|
209 gdbsrc-down
|
|
|
210 t
|
|
|
211 "Stack Down (towards \"warmer\" - more recently visited - frames)"]
|
|
|
212 [eos::toolbar-fix-icon
|
|
|
213 nil
|
|
|
214 nil
|
|
|
215 "Fix (not available with gdb)"]
|
|
|
216 [eos::toolbar-build-icon
|
|
|
217 toolbar-compile
|
|
|
218 t
|
|
|
219 "Build (aka make -NYI)"]
|
|
|
220 ))
|
|
|
221
|
|
|
222 (defmacro def-gdb-from-src (gdb-command key &optional doc &rest forms)
|
|
|
223 "Create a function that will call GDB-COMMAND with KEY."
|
|
|
224 (let* ((fname (format "gdbsrc-%s" gdb-command))
|
|
|
225 (cstr (list 'if 'arg
|
|
|
226 (list 'format "%s %s" gdb-command '(prefix-numeric-value arg))
|
|
|
227 gdb-command))
|
|
|
228 fun)
|
|
|
229 (while (string-match " " fname)
|
|
|
230 (aset fname (match-beginning 0) ?-))
|
|
|
231 (setq fun (intern fname))
|
|
|
232
|
|
|
233 (list 'progn
|
|
|
234 (nconc (list 'defun fun '(arg)
|
|
|
235 (or doc "")
|
|
|
236 '(interactive "P")
|
|
|
237 (list 'gdb-call-from-src cstr))
|
|
|
238 forms)
|
|
|
239 (list 'define-key 'gdbsrc-mode-map key (list 'quote fun)))))
|
|
|
240
|
|
|
241 (def-gdb-from-src "step" "s" "Step one instruction in src"
|
|
|
242 (gdb-delete-arrow-extent))
|
|
|
243 (def-gdb-from-src "stepi" "i" "Step one source line (skip functions)"
|
|
|
244 (gdb-delete-arrow-extent))
|
|
|
245 (def-gdb-from-src "cont" "c" "Continue with display"
|
|
|
246 (gdb-delete-arrow-extent))
|
|
|
247 (def-gdb-from-src "down" "d" "Go down N stack frames (numeric arg) ")
|
|
|
248 (def-gdb-from-src "up" "u" "Go up N stack frames (numeric arg)")
|
|
|
249 (def-gdb-from-src "finish" "f" "Finish frame")
|
|
|
250 (def-gdb-from-src "where" "w" "Display (N frames of) backtrace")
|
|
|
251 (def-gdb-from-src "next" "n" "Step one line with display"
|
|
|
252 (gdb-delete-arrow-extent))
|
|
|
253 (def-gdb-from-src "run" "r" "Run program from start"
|
|
|
254 (gdb-delete-arrow-extent))
|
|
|
255 (def-gdb-from-src "return" "R" "Return from selected stack frame")
|
|
|
256 (def-gdb-from-src "disable" "x" "Disable all breakpoints")
|
|
|
257 (def-gdb-from-src "delete" "X" "Delete all breakpoints")
|
|
|
258 (def-gdb-from-src "quit" "Q" "Quit gdb."
|
|
|
259 (gdb-delete-arrow-extent))
|
|
|
260 (def-gdb-from-src "info locals" "l" "Show local variables")
|
|
|
261 (def-gdb-from-src "info break" "B" "Show breakpoints")
|
|
|
262 (def-gdb-from-src "" "\r" "Repeat last command")
|
|
|
263 (def-gdb-from-src "frame" "m" "Show frame if no arg, with arg go to frame")
|
|
|
264
|
|
|
265 ;;; code
|
|
|
266
|
|
|
267 ;;;###autoload
|
|
|
268 (defun gdbsrc (path &optional core-or-pid)
|
|
|
269 "Activates a gdb session with gdbsrc-mode turned on. A numeric prefix
|
|
|
270 argument can be used to specify a running process to attach, and a non-numeric
|
|
|
271 prefix argument will cause you to be prompted for a core file to debug."
|
|
|
272 (interactive (let ((file (read-file-name "Program to debug: " nil nil t)))
|
|
|
273 (cond ((numberp current-prefix-arg)
|
|
|
274 (list file (int-to-string current-prefix-arg)))
|
|
|
275 (current-prefix-arg
|
|
|
276 (list file (read-file-name "Core file: " nil nil t)))
|
|
|
277 (t (list file)))
|
|
|
278 ))
|
|
|
279 ;; FIXME - this is perhaps an uncool thing to do --Stig
|
|
|
280 (delete-other-windows)
|
|
|
281 (split-window-vertically)
|
|
|
282 (other-window 0)
|
|
|
283
|
|
|
284 (gdb path core-or-pid)
|
|
|
285 (local-set-key 'button2 'gdbsrc-select-or-yank)
|
|
|
286 (setq mode-motion-hook 'gdbsrc-mode-motion)
|
|
|
287 ;; XEmacs change:
|
|
|
288 (make-local-hook 'kill-buffer-hook)
|
|
|
289 (add-hook 'kill-buffer-hook 'gdbsrc-reset nil t))
|
|
|
290
|
|
|
291 (defun gdbsrc-global-mode ()
|
|
|
292 ;; this can be used as a hook for gdb-mode....
|
|
|
293 (or current-gdb-buffer
|
|
|
294 (and (eq major-mode 'gdb-mode) ; doesn't work w/ energize yet
|
|
|
295 (setq current-gdb-buffer (current-buffer))
|
|
|
296 ;; XEmacs change:
|
|
4
|
297 (progn
|
|
|
298 (make-local-hook 'kill-buffer-hook)
|
|
|
299 (add-hook 'kill-buffer-hook 'gdbsrc-reset nil t)))
|
|
0
|
300 (error "Cannot determine current-gdb-buffer"))
|
|
|
301 ;;; (set-process-filter
|
|
|
302 ;;; (get-buffer-process current-gdb-buffer) 'gdbsrc-mode-filter)
|
|
|
303 ;;; (set-process-sentinel
|
|
|
304 ;;; (get-buffer-process current-gdb-buffer) 'gdbsrc-mode-sentinel)
|
|
|
305 ;; gdbsrc-global-mode was set to t here but that tended to piss
|
|
|
306 ;; people off
|
|
|
307 (setq gdbsrc-global-mode nil
|
|
|
308 gdbsrc-active-p t
|
|
|
309 gdbsrc-call-p nil
|
|
|
310 gdbsrc-mode nil)
|
|
|
311 (message "Gbd source mode active"))
|
|
|
312
|
|
|
313 (add-hook 'gdb-mode-hook 'gdbsrc-global-mode)
|
|
|
314
|
|
|
315 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
316 ;;; Gdb Source minor mode.
|
|
|
317 ;;;
|
|
|
318
|
|
|
319 (defvar gdbsrc-associated-buffer nil
|
|
|
320 "The gdb buffer to send commands to.")
|
|
|
321 (defvar gdbsrc-initial-readonly 'undefined
|
|
|
322 "read-only status of buffer when not in gdbsrc-mode")
|
|
|
323 (defvar gdbsrc-old-toolbar nil
|
|
|
324 "saved toolbar for buffer")
|
|
|
325
|
|
|
326 (defun gdbsrc-mode (arg &optional quiet)
|
|
|
327 "Minor mode for interacting with gdb from a c source file.
|
|
|
328 With arg, turn gdbsrc-mode on iff arg is positive. In gdbsrc-mode,
|
|
|
329 you may send an associated gdb buffer commands from the current buffer
|
|
|
330 containing c source code."
|
|
|
331 (interactive "P")
|
|
|
332 (setq gdbsrc-mode
|
|
|
333 (if (null arg)
|
|
|
334 (not gdbsrc-mode)
|
|
|
335 (> (prefix-numeric-value arg) 0)))
|
|
|
336
|
|
|
337 (cond (gdbsrc-mode
|
|
|
338 (cond ((not (local-variable-p 'gdbsrc-initial-readonly (current-buffer)))
|
|
|
339 (set (make-local-variable 'gdbsrc-initial-readonly)
|
|
|
340 buffer-read-only)
|
|
|
341 (set (make-local-variable 'gdbsrc-associated-buffer)
|
|
|
342 current-gdb-buffer)
|
|
|
343 (if (featurep 'toolbar)
|
|
|
344 (set (make-local-variable 'gdbsrc-old-toolbar)
|
|
|
345 (specifier-specs default-toolbar (current-buffer))))
|
|
|
346 )
|
|
|
347 )
|
|
|
348 (if (featurep 'toolbar)
|
|
|
349 (set-specifier default-toolbar (cons (current-buffer)
|
|
|
350 gdbsrc-toolbar)))
|
|
|
351 (setq buffer-read-only t)
|
|
|
352 (or quiet (message "Entering gdbsrc-mode...")))
|
|
|
353 (t
|
|
|
354 (and (local-variable-p 'gdbsrc-initial-readonly (current-buffer))
|
|
|
355 (progn
|
|
|
356 (if (featurep 'toolbar)
|
|
|
357 (if gdbsrc-old-toolbar
|
|
|
358 (set-specifier default-toolbar
|
|
|
359 (cons (current-buffer)
|
|
|
360 gdbsrc-old-toolbar))
|
|
|
361 (remove-specifier default-toolbar (current-buffer))))
|
|
|
362 (kill-local-variable 'gdbsrc-old-toolbar)
|
|
|
363 (setq buffer-read-only gdbsrc-initial-readonly)
|
|
|
364 (kill-local-variable 'gdbsrc-initial-readonly)
|
|
|
365 (kill-local-variable 'gdbsrc-associated-buffer)
|
|
|
366 ))
|
|
|
367 (or quiet (message "Exiting gdbsrc-mode..."))))
|
|
|
368 (redraw-modeline t))
|
|
|
369
|
|
|
370 ;;
|
|
|
371 ;; Sends commands to gdb process.
|
|
|
372
|
|
|
373 (defun gdb-call-from-src (command)
|
|
|
374 "Send associated gdb process COMMAND displaying source in this window."
|
|
|
375 (setq gdbsrc-call-p t)
|
|
26
|
376 (let ((src-win (selected-window))
|
|
|
377 (buf (or gdbsrc-associated-buffer current-gdb-buffer)))
|
|
|
378 (or (buffer-name buf)
|
|
|
379 (error "GDB buffer deleted"))
|
|
|
380 (pop-to-buffer buf)
|
|
|
381 (goto-char (point-max))
|
|
|
382 (beginning-of-line)
|
|
|
383 ;; Go past gdb prompt
|
|
|
384 (re-search-forward
|
|
|
385 gdb-prompt-pattern (save-excursion (end-of-line) (point)) t)
|
|
|
386 ;; Delete any not-supposed-to-be-there text
|
|
|
387 (delete-region (point) (point-max))
|
|
|
388 (insert command)
|
|
|
389 (comint-send-input)
|
|
|
390 (select-window src-win)
|
|
|
391 ))
|
|
0
|
392
|
|
|
393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
394 ;;;
|
|
|
395 ;;; Define Commands for GDB SRC Mode Buffer
|
|
|
396 ;;;
|
|
|
397
|
|
|
398 ;;; ;; #### - move elsewhere
|
|
|
399 (or (fboundp 'event-buffer)
|
|
|
400 (defun event-buffer (event)
|
|
|
401 "Return buffer assocaited with EVENT, or nil."
|
|
|
402 (let ((win (event-window event)))
|
|
|
403 (and win (window-buffer win)))))
|
|
|
404
|
|
|
405 (defun set-gdbsrc-mode-motion-extent (st en action)
|
|
|
406 ;; by Stig@hackvan.com
|
|
|
407 (let ((ex (make-extent st en)))
|
|
|
408 (set-extent-face ex 'highlight)
|
|
|
409 (set-extent-property ex 'gdbsrc t)
|
|
|
410 (set-extent-property ex 'action action)
|
|
|
411 (setq mode-motion-extent ex)))
|
|
|
412
|
|
|
413 (defun nuke-mode-motion-extent ()
|
|
|
414 ;; by Stig@hackvan.com
|
|
|
415 (cond (mode-motion-extent
|
|
|
416 (delete-extent mode-motion-extent)
|
|
|
417 (setq mode-motion-extent nil))))
|
|
|
418
|
|
|
419 (defun looking-at-any (regex-list)
|
|
|
420 ;; by Stig@hackvan.com
|
|
|
421 (catch 'found
|
|
|
422 (while regex-list
|
|
|
423 (and (looking-at (car regex-list))
|
|
|
424 (throw 'found t))
|
|
|
425 (setq regex-list (cdr regex-list)))))
|
|
|
426
|
|
|
427 (defconst gdb-breakpoint-patterns
|
|
|
428 '(
|
|
|
429 ;; when execution stops...
|
|
|
430 ;;Breakpoint 1, XlwMenuRedisplay (w=0x4d2e00, ev=0xefffe3f8, region=0x580e60)
|
|
|
431 ;; at /net/stig/src/xemacs/lwlib/xlwmenu.c:2518
|
|
|
432 "^[BW][ra][et][ac][kh]point [0-9]+, .*\\(\n\\s .*\\)*"
|
|
|
433 ;; output of the breakpoint command:
|
|
|
434 ;;Breakpoint 1 at 0x19f5c8: file /net/stig/src/xemacs/lwlib/xlwmenu.c, line 2715.
|
|
|
435 "^[BW][ra][et][ac][kh]point [0-9]+ at .*: file \\([^ ,\n]+\\), line \\([0-9]+\\)."
|
|
|
436 ;;Num Type Disp Enb Address What
|
|
|
437 ;;1 breakpoint keep y 0x0019ee60 in XlwMenuRedisplay
|
|
|
438 ;; at /net/stig/src/xemacs/lwlib/xlwmenu.c:2518
|
|
|
439 "^[0-9]+\\s +[bw][ra][et][ac][kh]point.* in .*\\(\n\\s +\\)?at [^ :\n]+:[0-9]+\\(\n\\s .*\\)*"
|
|
|
440 )
|
|
|
441 "list of patterns to match gdb's various ways of displaying a breakpoint")
|
|
|
442
|
|
|
443 (defun gdbsrc-make-breakpoint-action (string)
|
|
|
444 ;; by Stig@hackvan.com
|
|
|
445 (if (or (string-match "file \\([^ ,\n]+\\), line \\([0-9]+\\)" string)
|
|
|
446 (string-match "at \\([^ :\n]+\\):\\([0-9]+\\)" string))
|
|
|
447 (list 'gdbsrc-display
|
|
|
448 (match-string 1 string)
|
|
|
449 (string-to-int (match-string 2 string)))))
|
|
|
450
|
|
|
451 (defconst gdb-stack-frame-pattern
|
|
|
452 ;;#9 0x62f08 in emacs_Xt_next_event (emacs_event=0x4cf804)
|
|
|
453 ;; at /net/stig/src/xemacs/src/event-Xt.c:1778
|
|
|
454 "^#\\([0-9]+\\)\\s +\\(0x[0-9a-f]+ in .*\\|.*\\sw+.* (.*) at .*\\)\\(\n\\s .*\\)*"
|
|
|
455 "matches the first line of a gdb stack frame and all continuation lines.
|
|
|
456 subex 1 is frame number.")
|
|
|
457
|
|
|
458 (defun gdbsrc-mode-motion (ee)
|
|
|
459 ;; by Stig@hackvan.com
|
|
|
460 (save-excursion
|
|
|
461 (set-buffer (event-buffer ee))
|
|
|
462 (save-excursion
|
|
|
463 (if (not (event-point ee))
|
|
|
464 (nuke-mode-motion-extent)
|
|
|
465 (goto-char (event-point ee))
|
|
|
466 (beginning-of-line)
|
|
|
467 (while (and (not (bobp)) (eq ? (char-syntax (following-char))))
|
|
|
468 (forward-line -1))
|
|
|
469 (if (extent-at (point) (current-buffer) 'gdbsrc)
|
|
|
470 nil
|
|
|
471 (nuke-mode-motion-extent)
|
|
|
472 (cond ((looking-at-any gdb-breakpoint-patterns)
|
|
|
473 (set-gdbsrc-mode-motion-extent
|
|
|
474 (match-beginning 0)
|
|
|
475 (match-end 0)
|
|
|
476 (gdbsrc-make-breakpoint-action (match-string 0))))
|
|
|
477 ((looking-at gdb-stack-frame-pattern)
|
|
|
478 (set-gdbsrc-mode-motion-extent
|
|
|
479 (match-beginning 0)
|
|
|
480 (match-end 0)
|
|
|
481 (list 'gdbsrc-frame
|
|
|
482 (string-to-int (match-string 1)))))
|
|
|
483 )))
|
|
|
484 )))
|
|
|
485
|
|
|
486 (defun gdbsrc-display (file line)
|
|
|
487 ;; by Stig@hackvan.com
|
|
|
488 (select-window (display-buffer (find-file-noselect file)))
|
|
|
489 (goto-line line))
|
|
|
490
|
|
|
491 (defun click-inside-selection-p (click)
|
|
|
492 (or (click-inside-extent-p click primary-selection-extent)
|
|
|
493 (click-inside-extent-p click zmacs-region-extent)
|
|
|
494 ))
|
|
|
495
|
|
|
496 (defun click-inside-extent-p (click extent)
|
|
|
497 "Returns non-nil if the button event is within the bounds of the primary
|
|
|
498 selection-extent, nil otherwise."
|
|
|
499 ;; stig@hackvan.com
|
|
|
500 (let ((ewin (event-window click))
|
|
|
501 (epnt (event-point click)))
|
|
|
502 (and ewin
|
|
|
503 epnt
|
|
|
504 extent
|
|
|
505 (eq (window-buffer ewin)
|
|
4
|
506 (extent-object extent))
|
|
0
|
507 (extent-start-position extent)
|
|
|
508 (> epnt (extent-start-position extent))
|
|
|
509 (> (extent-end-position extent) epnt))))
|
|
|
510
|
|
|
511 (defun point-inside-extent-p (extent)
|
|
|
512 "Returns non-nil if the point is within or just after the bounds of the
|
|
|
513 primary selection-extent, nil otherwise."
|
|
|
514 ;; stig@hackvan.com
|
|
|
515 (and extent ; FIXME - I'm such a sinner...
|
|
|
516 (eq (current-buffer)
|
|
4
|
517 (extent-object extent))
|
|
0
|
518 (> (point) (extent-start-position extent))
|
|
|
519 (>= (extent-end-position extent) (point))))
|
|
|
520
|
|
|
521 (defun gdbsrc-select-or-yank (ee)
|
|
|
522 ;; by Stig@hackvan.com
|
|
|
523 (interactive "e")
|
|
|
524 (let ((action (save-excursion
|
|
|
525 (set-buffer (event-buffer ee))
|
|
|
526 (and mode-motion-extent
|
|
|
527 (click-inside-extent-p ee mode-motion-extent)
|
|
|
528 (extent-property mode-motion-extent 'action)))
|
|
|
529 ))
|
|
|
530 (if action
|
|
|
531 (eval action)
|
|
|
532 (mouse-yank ee))))
|
|
|
533
|
|
|
534 (defvar gdb-print-format ""
|
|
|
535 "Set this variable to a valid format string to print c-sexps in a
|
|
|
536 different way (hex,octal, etc).")
|
|
|
537
|
|
|
538 (defun gdb-print-c-sexp ()
|
|
|
539 "Find the nearest c-mode sexp. Send it to gdb with print command."
|
|
|
540 (interactive)
|
|
|
541 (let* ((tag (find-c-sexp))
|
|
|
542 (command (concat "print " gdb-print-format tag)))
|
|
|
543 (gdb-call-from-src command)))
|
|
|
544
|
|
|
545 (defun gdb-*print-c-sexp ()
|
|
|
546 "Find the nearest c-mode sexp. Send it to gdb with the print * command."
|
|
|
547 (interactive)
|
|
|
548 (let* ((tag (find-c-sexp))
|
|
|
549 (command (concat "print " gdb-print-format "*" tag)))
|
|
|
550 (gdb-call-from-src command)))
|
|
|
551
|
|
|
552 (defun gdb-whatis-c-sexp ()
|
|
|
553 "Find the nearest c-mode sexp. Send it to gdb with the whatis command. "
|
|
|
554 (interactive)
|
|
|
555 (let* ((tag (gdbsrc-selection-or-sexp))
|
|
|
556 (command (concat "whatis " tag)))
|
|
|
557 (gdb-call-from-src command)))
|
|
|
558
|
|
|
559 (defun gdbsrc-goto-gdb ()
|
|
|
560 "Hop back and forth between the gdb interaction buffer and the gdb source
|
|
|
561 buffer. "
|
|
|
562 ;; by Stig@hackvan.com
|
|
|
563 (interactive)
|
|
|
564 (let ((gbuf (or gdbsrc-associated-buffer current-gdb-buffer)))
|
|
|
565 (cond ((eq (current-buffer) gbuf)
|
|
|
566 (and gdb-arrow-extent
|
|
4
|
567 (extent-object gdb-arrow-extent)
|
|
|
568 (progn (pop-to-buffer (extent-object gdb-arrow-extent))
|
|
0
|
569 (goto-char (extent-start-position gdb-arrow-extent)))))
|
|
|
570 ((buffer-name gbuf) (pop-to-buffer gbuf))
|
|
|
571 ((y-or-n-p "No debugger. Start a new one? ")
|
|
|
572 (call-interactively 'gdbsrc))
|
|
|
573 (t (error "No gdb buffer."))
|
|
|
574 )))
|
|
|
575
|
|
|
576 (defvar gdbsrc-last-src-buffer nil)
|
|
|
577
|
|
|
578 (defun gdbsrc-goto-src ()
|
|
|
579 (interactive)
|
|
|
580 (let* ((valid (and gdbsrc-last-src-buffer
|
|
|
581 (memq gdbsrc-last-src-buffer (buffer-list))))
|
|
|
582 (win (and valid
|
|
|
583 (get-buffer-window gdbsrc-last-src-buffer))))
|
|
|
584 (cond (win (select-window win))
|
|
|
585 (valid (pop-to-buffer gdbsrc-last-src-buffer)))))
|
|
|
586
|
|
|
587 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
588 ;;;
|
|
|
589 ;;; The following functions are used to extract the closest surrounding
|
|
|
590 ;;; c expression from point
|
|
|
591 ;;;
|
|
|
592 (defun back-sexp ()
|
|
|
593 "Version of backward-sexp that catches errors"
|
|
|
594 (condition-case nil
|
|
|
595 (backward-sexp)
|
|
|
596 (error t)))
|
|
|
597
|
|
|
598 (defun forw-sexp ()
|
|
|
599 "Version of forward-sexp that catches errors"
|
|
|
600 (condition-case nil
|
|
|
601 (forward-sexp)
|
|
|
602 (error t)))
|
|
|
603
|
|
|
604 (defun sexp-compound-sep (span-start span-end)
|
|
|
605 "Returns '.' for '->' & '.', returns ' ' for white space,
|
|
|
606 returns '?' for other puctuation"
|
|
|
607 (let ((result ? )
|
|
|
608 (syntax))
|
|
|
609 (while (< span-start span-end)
|
|
|
610 (setq syntax (char-syntax (char-after span-start)))
|
|
|
611 (cond
|
|
|
612 ((= syntax ? ) t)
|
|
|
613 ((= syntax ?.) (setq syntax (char-after span-start))
|
|
|
614 (cond
|
|
|
615 ((= syntax ?.) (setq result ?.))
|
|
|
616 ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
|
|
|
617 (setq result ?.)
|
|
|
618 (setq span-start (+ span-start 1)))
|
|
|
619 (t (setq span-start span-end)
|
|
|
620 (setq result ??)))))
|
|
|
621 (setq span-start (+ span-start 1)))
|
|
|
622 result
|
|
|
623 )
|
|
|
624 )
|
|
|
625
|
|
|
626 (defun sexp-compound (first second)
|
|
|
627 "Returns non-nil if the concatenation of two S-EXPs result in a Single C
|
|
|
628 token. The two S-EXPs are represented as a cons cells, where the car
|
|
|
629 specifies the point in the current buffer that marks the begging of the
|
|
|
630 S-EXP and the cdr specifies the character after the end of the S-EXP
|
|
|
631 Link S-Exps of the form:
|
|
|
632 Sexp -> SexpC
|
|
|
633 Sexp . Sexp
|
|
|
634 Sexp (Sexp) Maybe exclude if first Sexp is: if, while, do, for, switch
|
|
|
635 Sexp [Sexp]
|
|
|
636 (Sexp) Sexp
|
|
|
637 [Sexp] Sexp"
|
|
|
638 (let ((span-start (cdr first))
|
|
|
639 (span-end (car second))
|
|
|
640 (syntax))
|
|
|
641 (setq syntax (sexp-compound-sep span-start span-end))
|
|
|
642 (cond
|
|
|
643 ((= (car first) (car second)) nil)
|
|
|
644 ((= (cdr first) (cdr second)) nil)
|
|
|
645 ((= syntax ?.) t)
|
|
|
646 ((= syntax ? )
|
|
|
647 (setq span-start (char-after (- span-start 1)))
|
|
|
648 (setq span-end (char-after span-end))
|
|
|
649 (cond
|
|
|
650 ((= span-start ?) ) t )
|
|
|
651 ((= span-start ?] ) t )
|
|
|
652 ((= span-end ?( ) t )
|
|
|
653 ((= span-end ?[ ) t )
|
|
|
654 (t nil))
|
|
|
655 )
|
|
|
656 (t nil))
|
|
|
657 )
|
|
|
658 )
|
|
|
659
|
|
|
660 (defun sexp-cur ()
|
|
|
661 "Returns the S-EXP that Point is a member, Point is set to begging of S-EXP.
|
|
|
662 The S-EXPs is represented as a cons cell, where the car specifies the point in
|
|
|
663 the current buffer that marks the begging of the S-EXP and the cdr specifies
|
|
|
664 the character after the end of the S-EXP"
|
|
|
665 (let ((p (point)) (begin) (end))
|
|
|
666 (back-sexp)
|
|
|
667 (setq begin (point))
|
|
|
668 (forw-sexp)
|
|
|
669 (setq end (point))
|
|
|
670 (if (>= p end)
|
|
|
671 (progn
|
|
|
672 (setq begin p)
|
|
|
673 (goto-char p)
|
|
|
674 (forw-sexp)
|
|
|
675 (setq end (point))
|
|
|
676 )
|
|
|
677 )
|
|
|
678 (goto-char begin)
|
|
|
679 (cons begin end)
|
|
|
680 )
|
|
|
681 )
|
|
|
682
|
|
|
683 (defun sexp-prev ()
|
|
|
684 "Returns the previous S-EXP, Point is set to begging of that S-EXP.
|
|
|
685 The S-EXPs is represented as a cons cell, where the car specifies the point in
|
|
|
686 the current buffer that marks the begging of the S-EXP and the cdr specifies
|
|
|
687 the character after the end of the S-EXP"
|
|
|
688 (let ((begin) (end))
|
|
|
689 (back-sexp)
|
|
|
690 (setq begin (point))
|
|
|
691 (forw-sexp)
|
|
|
692 (setq end (point))
|
|
|
693 (goto-char begin)
|
|
|
694 (cons begin end))
|
|
|
695 )
|
|
|
696
|
|
|
697 (defun sexp-next ()
|
|
|
698 "Returns the following S-EXP, Point is set to begging of that S-EXP.
|
|
|
699 The S-EXPs is represented as a cons cell, where the car specifies the point in
|
|
|
700 the current buffer that marks the begging of the S-EXP and the cdr specifies
|
|
|
701 the character after the end of the S-EXP"
|
|
|
702 (let ((begin) (end))
|
|
|
703 (forw-sexp)
|
|
|
704 (forw-sexp)
|
|
|
705 (setq end (point))
|
|
|
706 (back-sexp)
|
|
|
707 (setq begin (point))
|
|
|
708 (cons begin end)
|
|
|
709 )
|
|
|
710 )
|
|
|
711
|
|
|
712 (defun find-c-sexp ()
|
|
|
713 "Returns the Complex S-EXP that surrounds Point"
|
|
|
714 (interactive)
|
|
|
715 (save-excursion
|
|
|
716 (let ((p) (sexp) (test-sexp))
|
|
|
717 (setq p (point))
|
|
|
718 (setq sexp (sexp-cur))
|
|
|
719 (setq test-sexp (sexp-prev))
|
|
|
720 (while (sexp-compound test-sexp sexp)
|
|
|
721 (setq sexp (cons (car test-sexp) (cdr sexp)))
|
|
|
722 (goto-char (car sexp))
|
|
|
723 (setq test-sexp (sexp-prev))
|
|
|
724 )
|
|
|
725 (goto-char p)
|
|
|
726 (setq test-sexp (sexp-next))
|
|
|
727 (while (sexp-compound sexp test-sexp)
|
|
|
728 (setq sexp (cons (car sexp) (cdr test-sexp)))
|
|
|
729 (setq test-sexp (sexp-next))
|
|
|
730 )
|
|
|
731 (buffer-substring (car sexp) (cdr sexp))
|
|
|
732 )
|
|
|
733 )
|
|
|
734 )
|
|
|
735
|
|
|
736 (defun gdbsrc-selection-or-sexp (&optional ee)
|
|
|
737 ;; FIXME - fix this docstring
|
|
|
738 "If the EVENT is within the primary selection, then return the selected
|
|
|
739 text, otherwise parse the expression at the point of the mouse click and
|
|
|
740 return that. If EVENT is nil, then return the C sexp at point."
|
|
|
741 ;; stig@hackvan.com
|
|
|
742 (cond ((or (and ee (click-inside-selection-p ee))
|
|
|
743 (and (not ee) (point-inside-selection-p)))
|
|
|
744 (replace-in-string (extent-string primary-selection-extent) "\n\\s *" " "))
|
|
|
745 (ee
|
|
|
746 (gdbsrc-get-csexp-at-click ee))
|
|
|
747 (t
|
|
|
748 (find-c-sexp))
|
|
|
749 ))
|
|
|
750
|
|
|
751 (defun gdbsrc-get-csexp-at-click (ee)
|
|
|
752 "Returns the containing s-expression located at the mouse cursor to point."
|
|
|
753 ;; "
|
|
|
754 ;; by Stig@hackvan.com
|
|
|
755 (let ((ewin (event-window ee))
|
|
|
756 (epnt (event-point ee)))
|
|
|
757 (or (and ewin epnt)
|
|
|
758 (error "Must click within a window"))
|
|
|
759 (save-excursion
|
|
|
760 (set-buffer (window-buffer ewin))
|
|
|
761 (save-excursion
|
|
|
762 (goto-char epnt)
|
|
|
763 (find-c-sexp)))))
|
|
|
764
|
|
|
765 (defun gdbsrc-print-csexp (&optional ee)
|
|
|
766 (interactive)
|
|
|
767 (or ee (setq ee current-mouse-event))
|
|
|
768 (gdb-call-from-src
|
|
|
769 (concat "print " gdb-print-format (gdbsrc-selection-or-sexp ee))))
|
|
|
770
|
|
|
771 (defun gdbsrc-*print-csexp (&optional ee)
|
|
|
772 (interactive)
|
|
|
773 (or ee (setq ee current-mouse-event))
|
|
|
774 (gdb-call-from-src
|
|
|
775 (concat "print *" gdb-print-format (gdbsrc-selection-or-sexp ee))))
|
|
|
776
|
|
|
777 ;; (defun gdbsrc-print-region (arg)
|
|
|
778 ;; (let (( command (concat "print " gdb-print-format (x-get-cut-buffer))))
|
|
|
779 ;; (gdb-call-from-src command)))
|
|
|
780 ;;
|
|
|
781 ;; (defun gdbsrc-*print-region (arg)
|
|
|
782 ;; (let (( command (concat "print *" gdb-print-format (x-get-cut-buffer))))
|
|
|
783 ;; (gdb-call-from-src command)))
|
|
|
784
|
|
|
785 (defun gdbsrc-file:lno ()
|
|
|
786 "returns \"file:lno\" specification for location of point. "
|
|
|
787 ;; by Stig@hackvan.com
|
|
|
788 (format "%s:%d"
|
|
|
789 (file-name-nondirectory buffer-file-name)
|
|
|
790 (save-restriction
|
|
|
791 (widen)
|
|
|
792 (1+ (count-lines (point-min)
|
|
|
793 (save-excursion (beginning-of-line) (point)))))
|
|
|
794 ))
|
|
|
795
|
|
|
796 (defun gdbsrc-set-break (ee)
|
|
|
797 "Sets a breakpoint. Click on the selection and it will set a breakpoint
|
|
|
798 using the selected text. Click anywhere in a source file, and it will set
|
|
|
799 a breakpoint at that line number of that file."
|
|
|
800 ;; by Stig@hackvan.com
|
|
|
801 ;; there is already gdb-break, so this only needs to work with mouse clicks.
|
|
|
802 (interactive "e")
|
|
|
803 (gdb-call-from-src
|
|
|
804 (concat "break "
|
|
|
805 (if (click-inside-selection-p ee)
|
|
|
806 (extent-string primary-selection-extent)
|
|
|
807 (mouse-set-point ee)
|
|
|
808 (or buffer-file-name (error "No file in window"))
|
|
|
809 (gdbsrc-file:lno)
|
|
|
810 ))))
|
|
|
811
|
|
|
812 (defun gdbsrc-set-tbreak-continue (&optional ee)
|
|
|
813 "Set a temporary breakpoint at the position of the mouse click and then
|
|
|
814 continues. This can be bound to either a key or a mouse button."
|
|
|
815 ;; by Stig@hackvan.com
|
|
|
816 (interactive)
|
|
|
817 (or ee (setq ee current-mouse-event))
|
|
|
818 (and ee (mouse-set-point ee))
|
|
|
819 (gdb-call-from-src (concat "tbreak " (gdbsrc-file:lno)))
|
|
|
820 (gdb-call-from-src "c"))
|
|
|
821
|
|
|
822 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
823 ;; Functions extended from gdb.el for gdbsrc.
|
|
|
824 ;;
|
|
|
825 ;; gdbsrc-set-buffer - added a check to set buffer to gdbsrc-associated-buffer
|
|
|
826 ;; to handle multiple gdb sessions being driven from src
|
|
|
827 ;; files.
|
|
|
828
|
|
|
829 (require 'advice)
|
|
|
830
|
|
|
831 (defadvice gdb-set-buffer (after gdbsrc activate) ; ()
|
|
|
832 "Advised to work from a source buffer instead of just the gdb buffer."
|
|
|
833 ;; by Stig@hackvan.com
|
|
|
834 ;; the operations below have tests which are disjoint from the tests in
|
|
|
835 ;; the original `gdb-set-buffer'. Current-gdb-buffer cannot be set twice.
|
|
|
836 (and gdbsrc-call-p
|
|
|
837 gdbsrc-associated-buffer
|
|
|
838 (setq current-gdb-buffer gdbsrc-associated-buffer)))
|
|
|
839
|
|
|
840 (defadvice gdb-display-line (around gdbsrc activate)
|
|
|
841 ;; (true-file line &optional select-method)
|
|
|
842 "Advised to select the source buffer instead of the gdb-buffer"
|
|
|
843 ;; by Stig@hackvan.com
|
|
|
844 (ad-set-arg 2 'source) ; tell it not to select the gdb window
|
|
|
845 ad-do-it
|
|
|
846 (save-excursion
|
|
4
|
847 (let* ((buf (extent-object gdb-arrow-extent))
|
|
0
|
848 (win (get-buffer-window buf)))
|
|
|
849 (setq gdbsrc-last-src-buffer buf)
|
|
|
850 (select-window win)
|
|
|
851 (set-window-point win (extent-start-position gdb-arrow-extent))
|
|
|
852 (set-buffer buf))
|
|
|
853 (and gdbsrc-active-p
|
|
|
854 (not gdbsrc-mode)
|
|
|
855 (not (eq (current-buffer) current-gdb-buffer))
|
|
|
856 (gdbsrc-mode 1))))
|
|
|
857
|
|
|
858 (defadvice gdb-filter (after gdbsrc activate) ; (proc string)
|
|
|
859 ;; by Stig@hackvan.com
|
|
|
860 ;; if we got a gdb prompt and it wasn't a gdbsrc command, then it's gdb
|
|
|
861 ;; hitting a breakpoint or having a core dump, so bounce back to the gdb
|
|
|
862 ;; window.
|
|
|
863 (let* ((selbuf (window-buffer (selected-window)))
|
|
|
864 win)
|
|
|
865 ;; if we're at a gdb prompt, then display the buffer
|
|
|
866 (and (save-match-data (string-match gdb-prompt-pattern (ad-get-arg 1)))
|
|
|
867 (prog1
|
|
|
868 (not gdbsrc-call-p)
|
|
|
869 (setq gdbsrc-call-p nil))
|
|
|
870 (setq win (display-buffer current-gdb-buffer))
|
|
|
871 ;; if we're not in either the source buffer or the gdb buffer,
|
|
|
872 ;; then select the window too...
|
|
|
873 (not (eq selbuf current-gdb-buffer))
|
|
|
874 (not (eq selbuf gdbsrc-last-src-buffer))
|
|
|
875 (progn
|
|
|
876 (ding nil 'warp)
|
|
|
877 (select-window win)))
|
|
|
878 ))
|
|
|
879
|
|
|
880 (defun gdbsrc-reset ()
|
|
|
881 ;; tidy house and turn off gdbsrc-mode in all buffers
|
|
|
882 ;; by Stig@hackvan.com
|
|
|
883 (gdb-delete-arrow-extent)
|
|
|
884 (setq gdbsrc-global-mode nil)
|
|
|
885 (mapcar #'(lambda (buffer)
|
|
|
886 (set-buffer buffer)
|
|
|
887 (cond ((eq gdbsrc-associated-buffer current-gdb-buffer)
|
|
|
888 (gdbsrc-mode -1))))
|
|
|
889 (buffer-list)))
|
|
|
890
|
|
|
891 (defadvice gdb-sentinel (after gdbsrc freeze) ; (proc msg)
|
|
|
892 ;; by Stig@hackvan.com
|
|
|
893 (gdbsrc-reset)
|
|
|
894 (message "Gdbsrc finished"))
|
|
|
895
|
|
|
896 (provide 'gdbsrc)
|
