I'll start to use this for technical notes I have to store somewhere, so forgive my latin english and the all over laziness.
When you are programming in C++, XEmacs gdb mode cries for a "finish" command toolbar button. The finish command in gdb finish to execute the current stack frame and return from it. Fundamental to use with all the implicit constructors calls (e.g., string from char*).
There's probably a more elegant way to do it, editing just the necessary snippets in your .xemacs/init.el file, but I just copied the gdb.el and gdb-highlight.el from the installation files, modified, and put them in my .xemacs dir, that I use for all my modules and is in front of the load path. My modified versions are called instead of the installed ones.
Below are the modified code for gdb.el and gdb-highlight.el. It adds a (ugly) custom created finish button to gdb-highlight.el, insert it in the menu beside the step-into button,, and change the order of step-over so the button are logically organized: (run, goto till breakpoint, step over, step into, finish).
here it is:
;;; gdb-highlight.el --- make gdb buffers be mouse-sensitive.
;;; Copyright (C) 1997 Jamie Zawinski
;; Author: Jamie Zawinski
;; Created: 16-Apr-1997
;; Version: 1.2 (17-May-97)
;; Keywords: extensions, c, unix, tools, debugging
;;
;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;; Commentary:
;;
;; This package makes most objects printed in a *gdb* buffer be
;; mouse-sensitive: as text shows up in the buffer, it is parsed,
;; and objects which are recognized have context-sensitive commands
;; attached to them. Generally, the types that are noticed are:
;;
;; = function and method names;
;; = variable and parameter names;
;; = structure and object slots;
;; = source file names;
;; = type names;
;; = breakpoint numbers;
;; = stack frame numbers.
;;
;; Any time one of those objects is presented in the *gdb* buffer,
;; it will be mousable. Clicking middle mouse button (button2) on
;; it will take some default action -- edit the function, select
;; the stack frame, disable the breakpoint, etc. Clicking the right
;; mouse button (button3) will bring up a menu of commands, including
;; commands specific to the object under the mouse, or other objects
;; on the same line.
;;
;; In addition to these context-sensitive commands are more general
;; gdb commands which were previously inaccessible via the mouse
;; (listing breakpoints, returning values, etc); and the general
;; comint/shell-buffer commands which had been present before.
;;
;; If you notice an object being presented which could (usefully)
;; be made mouse sensitive, but which currently is not, please let
;; me know.
;;; Installation:
;;
;; To install, add this to your .emacs file:
;; (add-hook 'gdb-mode-hook '(lambda () (require 'gdb-highlight)))
;;; TODO:
;;
;; = It doesn't really work very well unless you've done `set width 0'
;; in your .gdbinit. It would be nice if this were fixed.
;; (And with `set width 0', `set print pretty on' is the way to go.)
;;
;; = In some contexts, the toggle-breakpoint command doesn't work,
;; because this code doesn't know whether it's enabled. It should
;; remember, or figure it out, or something.
;;
;; = Make it possible to edit the `keep' state of breakpoints.
;;
;; = Is it useful to make addresses clickable? If an address is
;; always acompanied by a variable, then no.
;;
;; = There has got to be a better way to implement `gdb-guess-file-name'.
;;
;; = Make some new toolbar icons and put the most common commands on it.
;;
;; = Maybe make gdb-toolbar-clear work more reliably by consulting a
;; breakpoint-number extent?
;;
;; = I want breakpoint icons in my source files, just like in Energize.
;;
;; = Add a command to quit-and-restart the debugger, with the same
;; breakpoints and program-arguments. (This wouldn't be interesting
;; if gdb didn't leak like a sieve...)
;;
;; = Figure out some way to realize when extents are no longer interesting
;; (stack frames and local variables that are no longer on the stack)
;; and make them no longer be mousable. This is tricky... Nuke them
;; whenever a "run" command is seen?
;;
;; = Make C-x SPC in a source buffer use gdb-menu-command so that it will
;; interrupt-and-continue the debugged program as necessary.
;;
;; = Do stuff for watchpoints (but I never use them, myself.)
;;; WISHLIST:
;;
;; (extracted from my 13-May-1997 message to comp.emacs and
;; comp.emacs.xemacs, news:33785828.5A524730@netscape.com)
;;
;; 6.1. Make gdbsrc-mode not suck.
;;
;; The idea behind gdbsrc-mode is on the side of the angels: one
;; should be able to focus on the source code and not on the
;; debugger buffer, absolutely. But the implementation is just
;; awful.
;;
;; First and foremost, it should not change "modes" (in the more
;; general sense). Any commands that it defines should be on
;; keys which are exclusively used for that purpose, not keys
;; which are normally self-inserting. I can't be the only person
;; who usually has occasion to actually *edit* the sources which
;; the debugger has chosen to display! Switching into and out of
;; gdbsrc-mode is prohibitive.
;;
;; I want to be looking at my sources at all times, yet I don't
;; want to have to give up my source-editing gestures. I think
;; the right way to accomplish this is to put the gdbsrc commands
;; on the toolbar and on popup menus; or to let the user define
;; their own keys (I could see devoting my kp_enter key to
;; "step", or something common like that.)
;;
;; Also it's extremely frustrating that one can't turn off gdbsrc
;; mode once it has been loaded, without exiting and restarting
;; emacs; that alone means that I'd probably never take the time
;; to learn how to use it, without first having taken the time to
;; repair it...
;;
;; 6.2. Make it easier access to variable values.
;;
;; I want to be able to double-click on a variable name to
;; highlight it, and then drag it to the debugger window to have
;; its value printed.
;;
;; I want gestures that let me write as well as read: for
;; example, to store value A into slot B.
;;
;; 6.3. Make all breakpoints visible.
;;
;; Any time there is a running gdb which has breakpoints, the
;; buffers holding the lines on which those breakpoints are set
;; should have icons in them. These icons should be context-
;; sensitive: I should be able to pop up a menu to enable or
;; disable them, to delete them, to change their commands or
;; conditions.
;;
;; I should also be able to MOVE them. It's annoying when you
;; have a breakpoint with a complex condition or command on it,
;; and then you realize that you really want it to be at a
;; different location. I want to be able to drag-and-drop the
;; icon to its new home.
;;
;; 6.4. Make a debugger status display window.
;;
;; o I want a window off to the side that shows persistent
;; information -- it should have a pane which is a
;; drag-editable, drag-reorderable representation of the
;; elements on gdb's "display" list; they should be displayed
;; here instead of being just dumped in with the rest of the
;; output in the *gdb* buffer.
;;
;; o I want a pane that displays the current call-stack and
;; nothing else. I want a pane that displays the arguments
;; and locals of the currently-selected frame and nothing
;; else. I want these both to update as I move around on the
;; stack.
;;
;; Since the unfortunate reality is that excavating this
;; information from gdb can be slow, it would be a good idea
;; for these panes to have a toggle button on them which meant
;; "stop updating", so that when I want to move fast, I can,
;; but I can easily get the display back when I need it again.
;;
;; The reason for all of this is that I spend entirely too much
;; time scrolling around in the *gdb* buffer; with gdb-highlight,
;; I can just click on a line in the backtrace output to go to
;; that frame, but I find that I spend a lot of time *looking*
;; for that backtrace: since it's mixed in with all the other
;; random output, I waste time looking around for things (and
;; usually just give up and type "bt" again, then thrash around
;; as the buffer scrolls, and I try to find the lower frames that
;; I'm interested in, as they have invariably scrolled off the
;; window already...
;;
;; 6.5. Save and restore breakpoints across emacs/debugger sessions.
;;
;; This would be especially handy given that gdb leaks like a
;; sieve, and with a big program, I only get a few dozen
;; relink-and-rerun attempts before gdb has blown my swap space.
;;
;; 6.6. Keep breakpoints in sync with source lines.
;;
;; When a program is recompiled and then reloaded into gdb, the
;; breakpoints often end up in less-than-useful places. For
;; example, when I edit text which occurs in a file anywhere
;; before a breakpoint, emacs is aware that the line of the bp
;; hasn't changed, but just that it is in a different place
;; relative to the top of the file. Gdb doesn't know this, so
;; your breakpoints end up getting set in the wrong places
;; (usually the maximally inconvenient places, like *after* a
;; loop instead of *inside* it). But emacs knows, so emacs
;; should inform the debugger, and move the breakpoints back to
;; the places they were intended to be.
;;
;; (Possibly the OOBR stuff does some of this, but can't tell,
;; because I've never been able to get it to do anything but beep at
;; me and mumble about environments. I find it pretty funny that the
;; manual keeps explaining to me how intuitive it is, without
;; actually giving me a clue how to launch it...)
;;; Code:
;;
;; This code should be considered an example of how over-use of regular
;; expressions leads to code that is an unreadable, unmaintainable mess,
;; and why it's unfortunate that so much of emacs's speed depends on
;; their use, rather than on the use of more traditional parsers.
(require 'gdb)
(define-key gdb-mode-map 'button3 'gdb-popup-menu)
(defvar gdb-popup-menu
'("GDB Commands"
["Up Stack" (gdb-menu-command "up" t) t]
["Down Stack" (gdb-menu-command "down" t) t]
["Next Line" (gdb-menu-command "next" t) t]
["Next Line (Step In)" (gdb-menu-command "step" t) t]
["Continue" (gdb-menu-command "continue" t) t]
["Continue Until Return" (gdb-menu-command "finish" t) t]
("Return..."
["Return" (gdb-menu-command "return" t) t]
["Return 0" (gdb-menu-command "return 0" t) t]
["Return 1" (gdb-menu-command "return 1" t) t]
["Return -1" (gdb-menu-command "return -1" t) t]
["Return $" (gdb-menu-command "return $" t) t]
)
"---"
["Backtrace" (gdb-menu-command "backtrace" t) t]
["List Breakpoints" (gdb-menu-command "info breakpoints" t) t]
["List Local Variables" (gdb-menu-command "info locals" t) t]
)
"Commands for the popup menu in gdb-mode.
The comint-popup-menu is appended to this, and certain context-sensitive
commands may be prepended to it, depending on the location of the mouse
when the `gdb-popup-menu' command is invoked.")
;;; Faces and keymaps used for mousable tokens in the *gdb* buffer.
(defvar gdb-highlight-face 'gdb-highlight-face) ; the base face
(defvar gdb-breakpoint-number-face 'gdb-breakpoint-number-face)
;(defvar gdb-breakpoint-keep-face 'gdb-breakpoint-keep-face)
(defvar gdb-breakpoint-enabled-face 'gdb-breakpoint-enabled-face)
(defvar gdb-function-name-face 'gdb-function-name-face)
(defvar gdb-function-location-face 'gdb-function-location-face)
(defvar gdb-variable-name-face 'gdb-variable-name-face)
(defvar gdb-type-name-face 'gdb-type-name-face)
(make-face 'gdb-highlight-face)
(or (face-differs-from-default-p 'gdb-highlight-face)
(make-face-italic 'gdb-highlight-face))
(let ((faces '(gdb-breakpoint-number-face
gdb-breakpoint-enabled-face
;gdb-breakpoint-keep-face
gdb-function-name-face
gdb-function-location-face
gdb-variable-name-face
gdb-type-name-face)))
(while faces
(make-face (car faces))
(or (face-differs-from-default-p (car faces))
(if (fboundp 'set-face-parent)
(set-face-parent (car faces) 'gdb-highlight-face)
(copy-face 'gdb-highlight-face (car faces))))
(setq faces (cdr faces))))
(defvar gdb-token-map ; the base map, inherited by all.
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-token-map)
(define-key m 'button2 'undefined)
;;(define-key m 'button3 'gdb-token-popup)
m))
(defvar gdb-breakpoint-number-map
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-breakpoint-number-map)
(set-keymap-parent m gdb-token-map)
;; not sure if this is the most useful binding... maybe "delete" is better?
(define-key m 'button2 'gdb-mouse-disable-breakpoint)
m))
(defvar gdb-info-breakpoint-number-map
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-breakpoint-number-map)
(set-keymap-parent m gdb-token-map)
;; not sure if this is the most useful binding... maybe "delete" is better?
(define-key m 'button2 'gdb-mouse-toggle-breakpoint-enabled)
m))
;(defvar gdb-breakpoint-keep-map
; (let ((m (make-sparse-keymap)))
; (set-keymap-name m 'gdb-breakpoint-keep-map)
; (set-keymap-parent m gdb-token-map)
; (define-key m 'button2 'gdb-token-mouse-toggle-keep)
; m))
(defvar gdb-breakpoint-enabled-map
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-breakpoint-enabled-map)
(set-keymap-parent m gdb-token-map)
(define-key m 'button2 'gdb-mouse-toggle-breakpoint-enabled)
m))
(defvar gdb-function-name-map
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-function-name-map)
(set-keymap-parent m gdb-token-map)
(define-key m 'button2 'gdb-mouse-edit-function)
m))
(defvar gdb-function-location-map
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-function-location-map)
(set-keymap-parent m gdb-token-map)
(define-key m 'button2 'gdb-mouse-edit-function-location)
m))
(defvar gdb-frame-number-map
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-frame-number-map)
(set-keymap-parent m gdb-token-map)
(define-key m 'button2 'gdb-mouse-goto-frame)
m))
(defvar gdb-variable-name-map
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-variable-name-map)
(set-keymap-parent m gdb-token-map)
(define-key m 'button2 'gdb-mouse-print-variable)
m))
(defvar gdb-type-name-map
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'gdb-type-name-map)
(set-keymap-parent m gdb-token-map)
(define-key m 'button2 'gdb-mouse-print-type)
m))
;;; Token definitions.
;; These properties enumerate the faces and keymaps that will be put over
;; the tokens.
(put 'gdb-frame-number-token 'gdb-token-face gdb-breakpoint-number-face)
(put 'gdb-frame-number-token 'gdb-token-keymap gdb-frame-number-map)
;(put 'gdb-breakpoint-keep-token 'gdb-token-face gdb-breakpoint-keep-face)
;(put 'gdb-breakpoint-keep-token 'gdb-token-keymap gdb-breakpoint-keep-map)
(put 'gdb-enabled-token 'gdb-token-face gdb-breakpoint-enabled-face)
(put 'gdb-enabled-token 'gdb-token-keymap gdb-breakpoint-enabled-map)
(put 'gdb-function-name-token 'gdb-token-face gdb-function-name-face)
(put 'gdb-function-name-token 'gdb-token-keymap gdb-function-name-map)
(put 'gdb-function-location-token 'gdb-token-face gdb-function-location-face)
(put 'gdb-function-location-token 'gdb-token-keymap gdb-function-location-map)
(put 'gdb-breakpoint-number-token 'gdb-token-face gdb-breakpoint-number-face)
(put 'gdb-breakpoint-number-token 'gdb-token-keymap gdb-breakpoint-number-map)
(put 'gdb-info-breakpoint-number-token 'gdb-token-face
gdb-breakpoint-number-face)
(put 'gdb-info-breakpoint-number-token 'gdb-token-keymap
gdb-info-breakpoint-number-map)
(put 'gdb-frame-number-token 'gdb-token-face gdb-breakpoint-number-face)
(put 'gdb-frame-number-token 'gdb-token-keymap gdb-frame-number-map)
(put 'gdb-variable-name-token 'gdb-token-face gdb-variable-name-face)
(put 'gdb-variable-name-token 'gdb-token-keymap gdb-variable-name-map)
(put 'gdb-type-name-token 'gdb-token-face gdb-type-name-face)
(put 'gdb-type-name-token 'gdb-token-keymap gdb-type-name-map)
;;; These regular expressions control what text corresponds to which tokens.
(defconst gdb-highlight-token-patterns
;; "May god forgive me for what I have unleashed." -- Evil Dead II.
(purecopy
(list
;; Breakpoints output:
;;
;; Breakpoint 5, XCreateWindow () at Window.c:136
;; Breakpoint 6, foobar (x=0x7fff3000 "baz") at blorp.c:5382
;;
(list (concat "\\(Breakpoint " ; 1
"\\([0-9]+\\)" ; .2
"\\), " ; 1
"\\(0x[0-9a-fA-F]+ in \\)?" ; 3
"\\(" ; 4
"\\([a-zA-Z0-9_]+\\):[a-zA-Z0-9_:~]+" ; .5
"\\|" ; .
"[a-zA-Z0-9_]+" ; .
"\\)" ; 4
"\\(" ; 6
" *\\((.*)\\)" ; .7
" at \\(" ; .8
"\\([^ \t\n:]+\\):" ; ..9
"\\([0-9]+\\)" ; ..10
"\\)" ; .8
"\\)?" ; 6
)
'(gdb-breakpoint-number-token ; 1
nil ; 2
nil ; 3
gdb-function-name-token ; 4 (+5)
gdb-type-name-token ; 5
nil ; 6
gdb-arglist-token ; 7
gdb-function-location-token ; 8 (9+10)
))
;; Output of the "Break" command:
;;
;; Breakpoint 1 at 0x4881d4
;; Breakpoint 6 at 0xfa50f68: file cuexit.c, line 58.
;;
(list (concat "\\(Breakpoint " ; 1
"\\([0-9]+\\)" ; .2
"\\) at " ; 1
"\\(0x[0-9A-Fa-f]+\\)" ; 3
"\\(: file " ; 4
"\\(" ; .5
"\\([^ \t\n:]+\\)" ; ..6
", line \\([0-9]+\\)" ; ..7
"\\)" ; .5
"\\)?" ; 4
)
'(gdb-breakpoint-number-token ; 1
nil ; 2
nil ;gdb-address-token ; 3
nil ; 4
gdb-function-location-token ; 5 (6+7)
))
;; Note: breakpoint 5 (disabled) also set at pc 0x40b420.
;; Note: breakpoint 5 also set at pc 0x40b420.
;;
(list (concat "Note: " ;
"\\(breakpoint " ; 1
"\\([0-9]+\\)" ; .2
"\\)" ; 1
)
'(gdb-breakpoint-number-token ; 1
nil ; 2
))
;; Stack Frames:
;;
;; 0xe1b8e0 in _OS_SELECT () at os_IRIX.s:50
;; XCreateWindow () at Window.c:136
;; #0 0x8e0db0 in _OS_SELECT () at os_IRIX.s:50
;; #0 XCreateWindow () at Window.c:136
;; Run till exit from #0 __ll_mul () at llmul.s:51
;;
(list (concat "\\(Run till exit from \\)?" ; 1
"\\(" ; 2
"#\\([0-9]+ *\\)" ; .3
"\\)?" ; 2
"\\(" ; 4
"\\(0x[0-9A-Fa-f]+\\)" ; .5
" in +\\)?" ; 4
"\\(" ; 6
"\\([a-zA-Z0-9_]+\\):[a-zA-Z0-9_:~]+" ; .7
"\\|" ; 6
"[a-zA-Z0-9_]+" ;
"\\) (" ; 6
"\\(" ; 8
"\\(.*\\)" ; .9
"\\bat \\(" ; .10
"\\([^ \t\n:]+\\):" ; ..11
"\\([0-9]+\\)" ; ..12
"\\)" ; .10
"\\)?" ; 8
)
'(nil ; 1
gdb-frame-number-token ; 2
nil ; 3
nil ; 4
nil ;gdb-address-token ; 5
gdb-function-name-token ; 6 (+7)
gdb-type-name-token ; 7
nil ; 8
gdb-arglist-token ; 9
gdb-function-location-token ; 10 (11+12)
))
;; Info Breakpoints output:
;;
;; 1 breakpoint keep y 0x0fa50f68 in exit at exit.c:58
;; 1 breakpoint keep y 0x000a1b00
;; 1 breakpoint keep y 0x0fa429ac <_write>
;; 6 breakpoint keep y 0x00789490 in foo::bar(bad *) at x.cpp:99
;; 7 breakpoint keep y 0x00789490
;;
(list (concat "\\([0-9]+ *\\) " ; 1
"\\(breakpoint *\\|watchpoint *\\) " ; 2
"\\(keep *\\|del *\\|dis *\\) " ; 3
"\\([yn] *\\) " ; 4
"\\(0x[0-9A-Fa-f]+\\) *" ; 5
"\\(in " ; 6
"\\(" ; .7
"[a-zA-Z0-9_]+" ; ..
"\\|" ; .7
"\\([a-zA-Z0-9_]+\\):[a-zA-Z0-9_:~]+" ; ..8
"\\)" ; .7
"\\((.*)\\)?" ; 9
" at " ; .
"\\(" ; .10
"\\([^ \t\n:]+\\):" ; ..11
"\\([0-9]+\\)" ; ..12
"\\)" ; .10
"\\|" ; 6
"<" ; .
"\\(" ; .13
"\\([a-zA-Z0-9_]+\\):[a-zA-Z0-9_:~]+" ; ..14
"\\|" ; .13
"[a-zA-Z0-9_]+" ; ..
"\\)" ; .13
"\\((.*)\\)?" ; .15
"[^>\n]*>" ; .
"\\)?" ; 6
)
'(gdb-info-breakpoint-number-token ; 1
nil ; 2
nil ;gdb-breakpoint-keep-token ; 3
gdb-enabled-token ; 4
nil ;gdb-address-token ; 5
nil ; 6
gdb-function-name-token ; 7 (+8)
gdb-type-name-token ; 8
gdb-arglist-types-token ; 9
gdb-function-location-token ; 10 (11+12)
nil ; 11
nil ; 12
gdb-function-name-token ; 13
gdb-type-name-token ; 14
gdb-arglist-types-token ; 15
))
;; Whatis and Ptype output:
;; type = struct _WidgetRec *
;; type = struct _WidgetRec {
;; type = int ()
;; type = struct *(struct *, void *, void (*)())
;; type = struct foo *(struct foo *, unsigned char, int)
;; type = unsigned int [4]
;;
(list (concat "type = "
"\\(" ; 1
"\\(signed \\|unsigned \\)?" ; .2
"\\(struct \\|class \\|union \\|enum \\)?" ; .3
"\\(?\\)" ; .4
"\\)" ; 1
"[ *]*" ;
"\\(" ; 5
"{?$\\|" ; .
"\\[[0-9]*\\]$\\|" ; .
"\\((.*)\\)" ; .6
"\\)" ; 5
)
'(gdb-type-name-token ; 1 (2+3+4)
nil ; 2
nil ; 3
nil ; 4
nil ; 5
gdb-arglist-types-token ; 6
))
;; Ptype output:
;; CorePart core;
;; void *constraints;
;; short x;
;; unsigned short width;
;; struct *event_table;
;; XtTMRec tm;
;; void (*class_initialize)();
;; unsigned char (*set_values)();
;; unsigned char st_fstype[16];
;; type = enum {XtGeometryYes, XtGeometryNo, XtGeometryAlmost}
;;
(list (concat " *"
"\\(" ; 1
"\\(signed \\|unsigned \\)?" ; .2
"\\(struct \\|class \\|union \\|enum \\)?" ; .3
"\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; .4
"\\)" ; 1
"[ *]*"
"\\((\\**\\)?" ; 5
"\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; 6
"\\()()\\)?" ; 7
"\\( *\\[[0-9]*\\]\\)?" ; 8
"; *$"
)
'(gdb-type-name-token ; 1 (2+3+4)
))
;; Ptype output on C++ classes:
;;
;; virtual foo (int);
;; unsigned int foo(void);
;; static long unsigned int * foo(bar *, baz *, unsigned int);
;;
;; not handled:
;; foo(bar *, _WidgetRec *, char const *, int);
;; foo (foo &);
;; foo & operator=(foo const &);
;;
(list (concat " *"
"\\(static \\)?" ; 1
"\\(" ; 2
"\\(signed \\|unsigned " ; .3
;; #### not so sure about this:
"\\|long unsigned \\|short unsigned " ; .3
"\\)?" ; .3
"\\(struct \\|class \\|union \\|enum \\)?" ; .4
"\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; .5
"\\)" ; 1
"[ *&]+" ;
" *\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; 6
" *\\((.*)\\)" ; 7
"; *$" ;
)
'(nil ; 1
gdb-type-name-token ; 2 (3+4+5)
nil ; 3
nil ; 4
nil ; 5
gdb-function-name-token ; 6
gdb-arglist-types-token ; 7
))
;; Pointers to functions:
;;
;; $1 = {void ()} 0x4a1334
;; $2 = (void (*)()) 0x4a1334
;;
(list (concat ".* = "
"[({]"
"\\(" ; 1
"\\(signed \\|unsigned \\)?" ; .2
"\\(struct \\|class \\|union \\|enum \\)?" ; .3
"\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; .4
"\\)" ; 1
" \\((\\*) ?\\)?" ; 5
"\\((.*)\\)" ; 6
"[)}] +" ;
"\\(0x[0-9A-Fa-f]+\\) +" ; 7
"<\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)" ; 8
"\\+?[0-9]+?>" ;
)
'(gdb-type-name-token ; 1 (2+3+4)
nil ; 2
nil ; 3
nil ; 4
nil ; 5
gdb-arglist-types-token ; 6
nil ;gdb-address-token ; 7
gdb-function-name-token ; 8
))
;; Local variables and structures:
;;
;; shell = (struct _WidgetRec *) 0x10267350
;; delete_response = 270955344
;; allow_resize = 200 '?'
;; is_modal = 47 '/'
;; class_name = 0xf661d40 "TopLevelShell",
;; static foo = 0x10791ec0,
;; initialize = 0xf684770 ,
;; av = {{
;; name = "foo",
;; value = 270349836
;; }, {
;; name = 0x12 ,
;; value = 0
;; }, {
;; name = 0x0,
;; value = 0
;; }}
;;
(list (concat " *"
"\\(static \\)?" ; 1
"\\([$a-zA-Z_][a-zA-Z0-9_:]*\\) = " ; 2
"\\((" ; 3
"\\(" ; .4
"\\(signed \\|unsigned \\)?" ; ..5
"\\(struct \\|class \\|union \\|enum \\)?"; ..6
"\\([a-zA-Z_][a-zA-Z0-9_:]*\\)" ; ..7
"\\)" ; .4
"[ *]*)" ;
"\\)?" ; 3
"\\(" ; 8
".*"
" <\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)" ; .9
"\\+?[0-9]+?>" ; .
"\\)?" ; 8
)
'(nil ; 1
gdb-variable-name-token ; 2
nil ; 3
gdb-type-name-token ; 4
nil ; 5
nil ; 6
nil ; 7
nil ; 8
gdb-function-name-token ; 9
))
;; Purify output:
;; UMR: Uninitialized memory read:
;; * This is occurring while in:
;; SHA1_Update [algsha.c:137]
;; * Reading 1 byte from 0xefffdb34 on the stack.
(list (concat "[ \t]+"
"\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)[ \t]*" ; 1
"\\[\\(" ; 2
"\\([^ \t\n:]+\\):" ; .3
"\\([0-9]+\\)" ; .4
"\\)\\]" ; 2
)
'(gdb-function-name-token ; 1
gdb-function-location-token ; 2 (3+4)
))
;; Purify output:
;; * Address 0xefffdb34 is 36 bytes past start of local variable ;; "data" in function fe_EventForRNG.
(list (concat ".*\\bAddress "
"\\(0x[0-9A-Fa-f]+\\) +" ; 1
".*\\bvariable \"" ;
"\\([a-zA-Z_][a-zA-Z0-9_:]*\\)\"" ; 2
"\\(" ; 3
".*\\bfunction " ; .
"\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)" ; .4
"\\)?" ; 3
)
'(nil ;gdb-address-token ; 1
gdb-variable-name-token ; 2
nil ; 3
gdb-function-name-token ; 4
))
))
"Patterns to highlight in gdb buffers.
Each element of this list takes the form
( \"regexp\" ( token-1 token-2 ... ))
where token-N is the token to place on the text matched
by sub-pattern N in the match data.
The patterns should not begin with \"^\".")
(defun gdb-highlight-line ()
"Highlight any tokens on the line which match gdb-highlight-token-patterns."
(map-extents #'(lambda (e ignore) (delete-extent e))
nil
(point) (save-excursion (forward-line 1) (point))
nil nil 'gdb-token)
(while (looking-at comint-prompt-regexp)
(goto-char (match-end 0)))
(if (eobp)
nil
(let ((tokens gdb-highlight-token-patterns)
(do-magic-variable-hack nil))
(while tokens
(if (not (looking-at (car (car tokens))))
(setq tokens (cdr tokens))
(let ((i 1)
(types (nth 1 (car tokens))))
(if (eq (car types) 'gdb-variable-name-token)
(setq do-magic-variable-hack t))
(while types
(cond ((not (and (car types)
(match-beginning i)))
nil)
((memq (car types) '(gdb-arglist-token
gdb-arglist-types-token))
(gdb-highlight-arglist (car types)
(match-beginning i)
(match-end i)))
((/= ?$ (char-after (match-beginning i)))
(gdb-highlight-token (car types)
(match-beginning i)
(match-end i))))
(setq i (1+ i)
types (cdr types)))
(if (not do-magic-variable-hack)
;; we're done.
(setq tokens nil)
;; else, do a grody hack to cope with multiple variables
;; on the same line.
(save-restriction
(let ((p (point))
(ok nil))
(end-of-line)
(narrow-to-region p (point))
(goto-char (match-end 0))
(if (= (following-char) ?\{)
(progn
(forward-char 1)
(setq ok t))
(setq p (scan-sexps (point) 1 nil t))
(setq ok (if (null p)
nil
(goto-char p)
(if (or (= (following-char) ?\,)
(= (following-char) ?\}))
t
(setq p (scan-sexps (point) 1 nil t))
(if (null p)
nil
(goto-char p)
t)))))
(if ok
;; skip over the comma and go around again.
(and (looking-at "}?[ \t]*,[ \t]*")
(goto-char (match-end 0)))
;; saw something unexpected; give up on this line.
(setq tokens nil)))))
)))))
nil)
(defun gdb-highlight-token (type start end)
"Helper for gdb-highlight-line -- makes an extent for one matched token."
(let ((e (make-extent start end)))
(set-extent-property e 'gdb-token type)
(set-extent-property e 'highlight 't)
(set-extent-property e 'help-echo 'gdb-token-help-echo)
(set-extent-property e 'face (get type 'gdb-token-face))
(set-extent-property e 'keymap (get type 'gdb-token-keymap))
e))
(defun gdb-highlight-arglist (type start end)
"Helper for gdb-highlight-line.
Makes extents for variables or types in an arglist."
(save-match-data
(save-excursion
(goto-char end)
(if (eq (preceding-char) ?\))
(setq end (1- end)))
(goto-char start)
(if (eq (following-char) ?\()
(forward-char 1))
(set-extent-property (make-extent start end) 'gdb-token type)
(cond
((eq type 'gdb-arglist-token)
(let* ((pat1 "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)=")
(pat2 ", \\([a-zA-Z_][a-zA-Z0-9_:]*\\)=")
(pat pat1))
(while(re-search-forward pat end t)
(gdb-highlight-token 'gdb-variable-name-token
(match-beginning 1) (match-end 1))
(cond ((looking-at
"0?x?[0-9A-Fa-f]+ <\\([a-zA-Z_~][a-zA-Z0-9_:]*\\)>")
(goto-char (match-end 0))
(gdb-highlight-token 'gdb-function-name-token
(match-beginning 1) (match-end 1))))
(setq pat pat2))))
((eq type 'gdb-arglist-types-token)
(let ((pat (eval-when-compile
(concat
"\\(" ; 1
"\\(signed \\|unsigned \\)?" ; .2
"\\(struct \\|class \\|union \\|enum \\)?" ; .3
"\\(?\\)" ; .4
"\\)" ; 1
"[ *]*"
"\\((\\*) *(.*)\\)?" ; 5
))))
(while (< (point) end)
(cond ((looking-at pat)
(goto-char (match-end 0))
(gdb-highlight-token 'gdb-type-name-token
(match-beginning 1) (match-end 1))
(if (looking-at " *, *")
(goto-char (match-end 0))))
(t
;; error -- try to cope...
(search-forward "," (1+ end) t))))))
(t
(error "unknown arglist type %s" type)))))
nil)
(defun gdb-token-help-echo (extent)
"Used as the 'mouse-help property of gdb-token extents,
to describe the binding on button2."
(let* ((map (extent-property extent 'keymap))
(key 'button2)
(fn (and map (lookup-key map key)))
(doc (and fn (symbolp fn)
(if (fboundp fn)
(format "%s: %s" key (documentation fn))
(format "Error: %s is undefined" fn)))))
(if doc
(save-match-data
(if (string-match "\n" doc)
(setq doc (substring doc 0 (match-beginning 0))))))
(or doc
(concat "Error: no doc for "
(symbol-name (extent-property extent 'gdb-token))))))
(defun gdb-get-line-token-extents (tokens)
"Given a list of gdb-tokens, returns this line's extents of those types.
The returned value is a list of the same length as the `tokens' list, with
the corresponding extents in the corresponding positions. If an extent
isn't found, nil is placed in the result-list instead."
(setq tokens (append tokens nil))
(let* ((result (make-list (length tokens) nil)))
(save-excursion
(beginning-of-line)
(map-extents #'(lambda (e ignore)
(let ((type (extent-property e 'gdb-token))
(r1 tokens)
(r2 result))
(while r1
(cond ((and (car r1) (eq type (car r1)))
(setcar r1 nil)
(setcar r2 e)
(setq r1 nil)))
(setq r1 (cdr r1)
r2 (cdr r2))))
nil)
nil
(point)
(progn (forward-line 1) (point))
nil nil
'gdb-token)
result)))
;;; Remembering directory names.
;;; gdb and gdb-mode conspire to hide from us the full file names of things
;;; that are presented into the buffer; this is an attempt to circumvent that.
(defvar gdb-highlight-last-directory nil)
(defvar gdb-highlight-last-directory-table nil)
(defun gdb-highlight-remember-directory ()
;; When gdb deigns to give us a full pathname, and it's in a different
;; directory than last time, cache it away on one of the nearby gdb-token
;; extents. (We intern it to avoid hanging on to a lot of strings.)
(cond ((and (boundp 'gdb-last-frame)
(car gdb-last-frame))
(cond ((not gdb-highlight-last-directory-table)
(set (make-local-variable 'gdb-highlight-last-directory) nil)
(set (make-local-variable 'gdb-highlight-last-directory-table)
(make-vector 211 0))))
(let ((dir (file-name-directory (car gdb-last-frame))))
(setq dir (intern dir gdb-highlight-last-directory-table))
(cond ((not (eq dir gdb-highlight-last-directory))
(let ((extent (previous-extent (current-buffer))))
(setq gdb-highlight-last-directory dir)
(while extent
(cond ((extent-property extent 'gdb-token)
(set-extent-property extent 'gdb-directory dir)
(setq extent nil))
(t
(setq extent (previous-extent extent))))))))))))
(defun gdb-guess-directory ()
"Guess what directory gdb was talking about when it wrote the current line."
(let ((extent (or (map-extents #'(lambda (e ignore) e)
(current-buffer) (point) (point-max))
(previous-extent (current-buffer))
(error "no extents")))
(dir nil))
(while extent
(setq dir (extent-property extent 'gdb-directory))
(if dir
(setq extent nil)
(setq extent (previous-extent extent))))
(if dir
(symbol-name dir)
default-directory)))
(defun gdb-guess-file-name (file)
"Given a directoryless file name printed by gdb, find the file.
First it tries to expand the file relative to `gdb-guess-directory',
and if the resultant file doesn't exist, it tries every other directory
gdb has ever told us about, in no particular order."
(abbreviate-file-name
(if (file-name-absolute-p file)
file
(let ((file2 (expand-file-name file (gdb-guess-directory))))
(if (file-exists-p file2)
file2
;; Oh boy, gdb didn't tell us what directory it's in.
;; A-hunting we will go.
(if (catch 'done
(mapatoms #'(lambda (dir)
(setq file2 (expand-file-name file
(symbol-name dir)))
(if (file-exists-p file2)
(throw 'done t)))
gdb-highlight-last-directory-table)
nil)
file2
(expand-file-name file)))))))
;;; Commands which are invoked from bindings in the keymaps of the tokens.
(defun gdb-mouse-toggle-breakpoint-enabled (event &optional what)
"Toggle whether the breakpoint is enabled.
Looks for a gdb-breakpoint extent on the line under the mouse,
and executes an `enable' or `disable' command as appropriate.
Optional arg `what' may be 'enable, 'disable, or 'toggle (default.)"
(interactive "@*e")
(let (number target enabled-p)
(save-excursion
(mouse-set-point event)
(let* ((extents (gdb-get-line-token-extents
'(gdb-breakpoint-number-token
gdb-info-breakpoint-number-token
gdb-enabled-token)))
(be (or (nth 0 extents) (nth 1 extents)))
(ee (nth 2 extents)))
(or be
(error "no breakpoint-number extent on this line"))
(setq number
(buffer-substring (extent-start-position be)
(extent-end-position be)))
(if (string-match " [0-9]+\\'" number)
(setq number (substring number (1+ (match-beginning 0)))))
(setq number (string-to-int number))
(or (> number 0)
(error "couldn't find breakpoint number"))
(if (null ee)
(setq enabled-p 'unknown)
(setq target (extent-start-position ee))
(goto-char target)
(setq enabled-p
(cond ((looking-at "[yY]\\b") t)
((looking-at "[nN]\\b") nil)
(t (error "enabled is not y or n?")))))
(cond ((eq what 'enable)
(setq enabled-p nil))
((eq what 'disable)
(setq enabled-p t))
((or (eq what 'toggle) (null what))
(if (eq enabled-p 'unknown)
(error
"can't toggle breakpoint: don't know current state")))
(t
(error "what must be enable, disable, toggle, or nil.")))
))
(gdb-menu-command (format "%s %d"
(if enabled-p "disable" "enable")
number)
nil)
(message "%s breakpoint %d."
(if enabled-p "Disabled" "Enabled")
number)
(cond (target
(save-excursion
(goto-char target)
(insert (if enabled-p "n" "y"))
(delete-char 1)
;; don't let shell-fonts or font-lock second-guess us.
(remove-text-properties (1- (point)) (point) '(face))))))
nil)
(defun gdb-mouse-enable-breakpoint (event)
"Enable the breakpoint.
Looks for a gdb-breakpoint extent on the line under the mouse,
and executes an `enable' command"
(interactive "@*e")
(gdb-mouse-toggle-breakpoint-enabled event 'enable))
(defun gdb-mouse-disable-breakpoint (event)
"Disable the breakpoint.
Looks for a gdb-breakpoint extent on the line under the mouse,
and executes a `disable' command"
(interactive "@*e")
(gdb-mouse-toggle-breakpoint-enabled event 'disable))
;; compatibility hack...
(or (fboundp 'extent-object) (fset 'extent-object 'extent-buffer))
(defun gdb-mouse-edit-function (event)
"Edit the definition of this function (as with \\[find-tag])
Looks for a gdb-function-name extent on the line under the mouse,
and runs find-tag on the text under that extent."
(interactive "@*e")
(let (extent)
(save-excursion
(mouse-set-point event)
(setq extent (or (car (gdb-get-line-token-extents
'(gdb-function-name-token)))
(error "no function-name extent on this line"))))
(find-tag
(buffer-substring (extent-start-position extent)
(extent-end-position extent)
(extent-object extent)))))
(defun gdb-mouse-edit-function-location (event)
"Edit the source file of this function.
Looks for a gdb-function-location extent on line of the mouse,
and parses the text under it."
(interactive "@*e")
(let (file line)
(save-excursion
(mouse-set-point event)
(let ((extent (or (car (gdb-get-line-token-extents
'(gdb-function-location-token)))
(error "no function-location extent on this line"))))
(goto-char (extent-start-position extent))
(or (looking-at "\\([^ \t\n:,]+\\):\\([0-9]+\\)")
(looking-at "\\([^ \t\n:,]+\\),? line \\([0-9]+\\)")
(error "no file position on this line"))
(setq file (buffer-substring (match-beginning 1) (match-end 1))
line (buffer-substring (match-beginning 2) (match-end 2)))
(setq file (gdb-guess-file-name file)
line (string-to-int line))
))
(if (file-exists-p file)
(find-file-other-window file)
(signal 'file-error (list "File not found" file)))
(goto-line line)))
(defun gdb-mouse-goto-frame (event)
"Select this stack frame.
Looks for a gdb-frame-number extent on the line of the mouse,
and executes a `frame' command to select that frame."
(interactive "@*e")
(let (number)
(save-excursion
(mouse-set-point event)
(let ((extent (or (car (gdb-get-line-token-extents
'(gdb-frame-number-token)))
(error "no frame-number extent on this line"))))
(goto-char (extent-start-position extent))
(if (eq (following-char) ?#)
(forward-char 1))
(setq number (string-to-int
(buffer-substring (point)
(extent-end-position extent))))))
(gdb-menu-command (format "frame %d" number) t))
nil)
(defun gdb-mouse-get-variable-reference (event)
"Returns a string which references the variable under the mouse.
This works even if the variable is deep inside nested arrays or structures.
If the variable seems to hold a pointer, then a \"*\" will be prepended."
(save-excursion
(let* ((extent (if (extentp event)
event
(progn
(mouse-set-point event)
(extent-at (point) nil 'gdb-token))))
dereference-p
name)
(or (and extent
(eq (extent-property extent 'gdb-token)
'gdb-variable-name-token))
(error "not over a variable name"))
(setq name (buffer-substring (extent-start-position extent)
(extent-end-position extent)))
(save-excursion
(goto-char (extent-end-position extent))
(if (and (looking-at " *= *\\(([^)]+)\\)? *0x[0-9a-fA-F]+") ; pointer
(progn
(goto-char (match-end 0))
(not (looking-at " +\"")))) ; but not string
(setq dereference-p t))
;; Now, if this variable is buried in a structure, compose a complete
;; reference-chain to it.
(goto-char (extent-start-position extent))
(let ((done nil))
(while (not done)
(skip-chars-backward " \t")
(if (or (and (/= (preceding-char) ?\n)
(/= (preceding-char) ?\,)
(/= (preceding-char) ?\{))
(<= (buffer-syntactic-context-depth) 0))
(setq done t)
(let ((p (scan-lists (point) -1 1)))
(if (null p)
(setq done t)
(goto-char (setq p (- p 3)))
(cond
((looking-at " = {")
(skip-chars-backward "a-zA-Z0-9_")
(if (= (preceding-char) ?\$)
(forward-char -1))
(setq name (concat (buffer-substring (point) p) "." name)))
((looking-at "}, +{")
(forward-char 1)
(let ((parse-sexp-ignore-comments nil)
(count 0))
(while (setq p (scan-sexps (point) -1 nil t))
(goto-char p)
(setq count (1+ count)))
(setq name (format "[%d].%s" count name))
;; up out of the list
(skip-chars-backward " \t\n")
(if (= (preceding-char) ?\{)
(forward-char -1))
;; we might be tightly nested in slot 0...
(while (= (preceding-char) ?\{)
(forward-char -1)
(setq name (concat "[0]" name)))
(skip-chars-backward " \t")
(if (= (preceding-char) ?=) (forward-char -1))
(skip-chars-backward " \t")
(setq p (point))
(skip-chars-backward "a-zA-Z0-9_")
(if (= (preceding-char) ?\$)
(forward-char -1))
(setq name (concat (buffer-substring (point) p) name))
))
(t
(setq done t)))))))))
(if dereference-p
(setq name (concat "*" name)))
name)))
(defun gdb-mouse-print-variable (event)
"Print the value of this variable.
Finds a variable under the mouse, and figures out whether it is inside of
a structure, and composes and executes a `print' command. If the variable
seems to hold a pointer, prints the object pointed to."
(interactive "@*e")
(gdb-menu-command (concat "print "
(gdb-mouse-get-variable-reference event))
t))
(defun gdb-mouse-print-variable-type (event)
"Describe the type of this variable.
Finds a variable under the mouse, and figures out whether it is inside of
a structure, and composes and executes a `whatis' command. If the variable
seems to hold a pointer, describes the type of the object pointed to."
(interactive "@*e")
(gdb-menu-command (concat "whatis "
(gdb-mouse-get-variable-reference event))
t))
(defun gdb-mouse-print-type (event)
"Describe this type.
Finds a type description under the mouse, and executes a `ptype' command."
(interactive "@*e")
(let* ((extent (save-excursion
(mouse-set-point event)
(extent-at (point) nil 'gdb-token)))
name)
(or (and extent
(eq (extent-property extent 'gdb-token) 'gdb-type-name-token))
(error "not over a type name"))
(setq name (buffer-substring (extent-start-position extent)
(extent-end-position extent)))
(gdb-menu-command (format "ptype %s" name)
t))
nil)
;;; Popup menus
(defun gdb-menu-command (command &optional scroll-to-bottom)
"Sends the command to gdb.
If gdb is not sitting at a prompt, interrupts it first
\(as if with \\[gdb-control-c-subjob]), executes the command, and then lets
the debugged program continue.
If scroll-to-bottom is true, then point will be moved to after the new
output. Otherwise, an effort is made to avoid scrolling the window and
to keep point where it was."
;; this is kinda like gdb-call except for the interrupt-first behavior,
;; but also it leaves the commands in the buffer instead of trying to
;; hide them.
(let* ((proc (or (get-buffer-process (current-buffer))
(error "no process in %s" (buffer-name (current-buffer)))))
(window (selected-window))
wstart
(opoint (point))
was-at-bottom
running-p)
(if (not (eq (current-buffer) (window-buffer window)))
(setq window (get-buffer-window (current-buffer))))
(setq wstart (window-start window))
(let ((pmark (process-mark proc)))
(setq was-at-bottom (>= (point) pmark))
(goto-char pmark)
(delete-region (point) (point-max)))
(setq running-p (bolp)) ; maybe not the best way to tell...
(cond (running-p
(message "Program is running -- interrupting first...")
(gdb-control-c-subjob)
(while (accept-process-output proc 1)
;; continue accepting output as long as it's arriving
)))
(message "%s" command)
(goto-char (process-mark proc))
(insert command)
(comint-send-input)
;; wait for the command to be accepted
(accept-process-output proc)
(goto-char (process-mark proc))
;; continue, if we had interrupted
(cond (running-p
(insert "continue")
(comint-send-input)))
(if scroll-to-bottom
(goto-char (process-mark proc))
(set-window-start window wstart)
(goto-char opoint)
(if was-at-bottom
(if (pos-visible-in-window-p (process-mark proc) window)
(goto-char (process-mark proc))
(goto-char (window-end window))
(forward-line -2))))
)
nil)
(defun gdb-make-context-menu (event)
"Returns a menu-desc corresponding to the stack-frame line under the mouse.
Returns nil if not over a stack-frame."
(save-excursion
(mouse-set-point event)
(let* ((extents (gdb-get-line-token-extents
'(gdb-breakpoint-number-token
gdb-info-breakpoint-number-token
gdb-enabled-token
gdb-frame-number-token
gdb-function-name-token
gdb-function-location-token
gdb-arglist-token
gdb-arglist-types-token
gdb-variable-name-token
gdb-type-name-token
)))
(bnumber (or (nth 0 extents)
(nth 1 extents)))
(enabled-p (nth 2 extents))
(fnumber (nth 3 extents))
(name (nth 4 extents))
(loc (nth 5 extents))
(al (nth 6 extents))
(alt (nth 7 extents))
(var (nth 8 extents))
(type (nth 9 extents))
(var-e var))
;; If this line has an arglist, only document variables and types
;; if the mouse is directly over them.
(if (or al alt)
(setq var nil
type nil))
;; Always prefer the object under the mouse to one elsewhere on the line.
(let* ((e (extent-at (point) nil 'gdb-token))
(p (and e (extent-property e 'gdb-token))))
(cond ((eq p 'gdb-function-name-token) (setq name e))
((eq p 'gdb-variable-name-token) (setq var e var-e e))
((eq p 'gdb-type-name-token) (setq type e))
))
;; Extract the frame number (it may begin with "#".)
(cond (fnumber
(goto-char (extent-start-position fnumber))
(if (eq (following-char) ?#)
(forward-char 1))
(setq fnumber
(string-to-int
(buffer-substring (point)
(extent-end-position fnumber))))))
;; Extract the breakpoint number (it may begin with "Breakpoint ".)
(cond (bnumber
(setq bnumber
(buffer-substring (extent-start-position bnumber)
(extent-end-position bnumber)))
(if (string-match " [0-9]+\\'" bnumber)
(setq bnumber (substring bnumber (1+ (match-beginning 0)))))
(setq bnumber (string-to-int bnumber))
(or (> bnumber 0)
(error "couldn't parse breakpoint number"))))
(cond ((null enabled-p)
(setq enabled-p 'unknown))
((memq (char-after (extent-start-position enabled-p)) '(?y ?Y))
(setq enabled-p 't))
((memq (char-after (extent-start-position enabled-p)) '(?n ?N))
(setq enabled-p 'nil))
(t
(setq enabled-p 'unknown)))
;; Convert the extents to strings.
;;
(if name
(setq name (buffer-substring (extent-start-position name)
(extent-end-position name))))
(if loc
(setq loc (buffer-substring (extent-start-position loc)
(extent-end-position loc))))
(if var
(setq var (buffer-substring (extent-start-position var)
(extent-end-position var))))
(if type
(setq type (buffer-substring (extent-start-position type)
(extent-end-position type))))
;; Return a menu description list.
;;
(nconc
(if (and bnumber (not (eq enabled-p 'nil)))
(list (vector (format "Disable Breakpoint %d"
bnumber)
(list 'gdb-mouse-disable-breakpoint event)
t)))
(if (and bnumber (not (eq enabled-p 't)))
(list (vector (format "Enable Breakpoint %d"
bnumber)
(list 'gdb-mouse-enable-breakpoint event)
t)))
(if bnumber
(list (vector (format "Delete Breakpoint %d" bnumber)
(list 'gdb-menu-command (format "delete %d" bnumber)
nil)
t)))
(if var
(list (vector (format "Print Value of `%s'" var)
(list 'gdb-mouse-print-variable var-e)
t)
(vector (format "Print Type of `%s'" var)
(list 'gdb-mouse-print-variable-type var-e)
t)))
(if name
(list (vector (format "Edit Definition of `%s'" name)
(list 'gdb-mouse-edit-function event)
t)
(vector (format "Set Breakpoint on `%s'" name)
(list 'gdb-menu-command (format "break %s" name) nil)
t)))
(if loc
(list (vector (format "Visit Source Line (%s)" loc)
(list 'gdb-mouse-edit-function-location event)
t)))
(if type
(list (vector (format "Describe Type `%s'" type)
(list 'gdb-menu-command (format "ptype %s" type) t)
t)))
(if fnumber
(list (vector (format "Select Stack Frame %d" fnumber)
(list 'gdb-menu-command (format "frame %d" fnumber) t)
t)))
))))
(defun gdb-popup-menu (event)
"Pop up a context-sensitive menu of gdb-mode commands."
(interactive "_@e")
(select-window (event-window event))
(let (menu)
(save-excursion
(setq menu (append (if (boundp 'gdb-popup-menu)
(append (cdr gdb-popup-menu)
'("---")))
(if (boundp 'comint-popup-menu)
(cdr comint-popup-menu))))
(let ((history (if (fboundp 'comint-make-history-menu)
(comint-make-history-menu)))
(context (gdb-make-context-menu event)))
(if history
(setq menu
(append menu (list "---" (cons "Command History" history)))))
(if context
(setq menu (append context (cons "---" menu))))
)
(setq menu (cons (if (boundp 'gdb-popup-menu)
(car gdb-popup-menu)
"GDB Commands")
menu)))
(popup-menu menu event)))
;;; Patch it in...
(or (fboundp 'gdb-highlight-orig-filter)
(fset 'gdb-highlight-orig-filter (symbol-function 'gdb-filter)))
(defun gdb-highlight-filter (proc string)
(let ((p (marker-position (process-mark proc))))
(prog1
(gdb-highlight-orig-filter proc string)
(save-match-data
;;
;; If there are no newlines in this string at all, then don't
;; bother processing it -- we will pick up these characters on
;; the next time around, when the line's newline gets inserted.
;;
(cond
((string-match "\n" string)
(save-excursion
(set-buffer (process-buffer proc))
(goto-char p)
(let ((p2 (marker-position (process-mark proc)))
p3)
;;
;; If gdb has given us a full pathname, remember it. (Do this
;; before emitting any gdb-token extents, so that we attach it
;; to the buffer *before* any of the extents to which it is
;; known to correspond.
;;
(gdb-highlight-remember-directory)
;;
;; Now highlight each line that has been written. If we wrote
;; the last half of a line, re-highlight that whole line. (We
;; need to do that so that the regexps will match properly;
;; the "\n" test above also depends on this behavior.)
;;
;; But don't highlight lines longer than 5000 characters -- that
;; probably means something is spewing, and we'll just get stuck
;; hard in the regexp matcher.
;;
(beginning-of-line)
(while (< (point) p2)
(goto-char (prog1
(point)
(forward-line 1)
(setq p3 (point))))
(if (< (- p3 (point)) 5000)
(gdb-highlight-line))
(goto-char p3))))))))))
(fset 'gdb-filter 'gdb-highlight-filter)
(provide 'gdb-highlight)
;;; gdb-highlight.el ends here
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;[[[
;;; gdb.el --- run gdb under Emacs
;; Author: W. Schelter, University of Texas
;; wfs@rascal.ics.utexas.edu
;; Rewritten by rms.
;; Keywords: c, unix, tools, debugging
;; Some ideas are due to Masanobu.
;; This file is part of XEmacs.
;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;; Synched up with: Not in FSF
;;; Commentary:
;; Description of GDB interface:
;; A facility is provided for the simultaneous display of the source code
;; in one window, while using gdb to step through a function in the
;; other. A small arrow in the source window, indicates the current
;; line.
;; Starting up:
;; In order to use this facility, invoke the command GDB to obtain a
;; shell window with the appropriate command bindings. You will be asked
;; for the name of a file to run. Gdb will be invoked on this file, in a
;; window named *gdb-foo* if the file is foo.
;; M-s steps by one line, and redisplays the source file and line.
;; You may easily create additional commands and bindings to interact
;; with the display. For example to put the gdb command next on \M-n
;; (def-gdb next "\M-n")
;; This causes the emacs command gdb-next to be defined, and runs
;; gdb-display-frame after the command.
;; gdb-display-frame is the basic display function. It tries to display
;; in the other window, the file and line corresponding to the current
;; position in the gdb window. For example after a gdb-step, it would
;; display the line corresponding to the position for the last step. Or
;; if you have done a backtrace in the gdb buffer, and move the cursor
;; into one of the frames, it would display the position corresponding to
;; that frame.
;; gdb-display-frame is invoked automatically when a filename-and-line-number
;; appears in the output.
;;; Code:
(require 'comint)
(require 'shell)
(if (featurep 'toolbar)
(require 'debug-toolbar))
(defvar gdb-last-frame)
(defvar gdb-delete-prompt-marker)
(defvar gdb-filter-accumulator)
(defvar gdb-last-frame-displayed-p)
(defvar gdb-arrow-extent nil)
(or (fboundp 'make-glyph) (fset 'make-glyph 'identity)) ; work w/ pre beta v12
(defvar gdb-arrow-glyph (make-glyph "=>"))
(make-face 'gdb-arrow-face)
(or (face-differs-from-default-p 'gdb-arrow-face)
;; Usually has a better default value than highlight does
(copy-face 'isearch 'gdb-arrow-face))
;; Hooks can side-effect extent arg to change extent properties
(defvar gdb-arrow-extent-hooks '())
(defvar gdb-prompt-pattern "^>\\|^(.*gdb[+]?) *\\|^---Type to.*--- *"
"A regexp to recognize the prompt for gdb or gdb+.")
(defvar gdb-mode-map nil
"Keymap for gdb-mode.")
(defvar gdb-toolbar
'([debug::toolbar-stop-at-icon
gdb-toolbar-break
t
"Stop at selected position"]
[debug::toolbar-stop-in-icon
gdb-toolbar-break
t
"Stop in function whose name is selected"]
[debug::toolbar-clear-at-icon
gdb-toolbar-clear
t
"Clear at selected position"]
[debug::toolbar-evaluate-icon
nil
nil
"Evaluate selected expression; shows in separate XEmacs frame"]
[debug::toolbar-evaluate-star-icon
nil
nil
"Evaluate selected expression as a pointer; shows in separate XEmacs frame"]
[debug::toolbar-run-icon
gdb-run
t
"Run current program"]
[debug::toolbar-cont-icon
gdb-cont
t
"Continue current program"]
[debug::toolbar-step-over-icon
gdb-next
t
"Step over (aka next)"]
[debug::toolbar-step-into-icon
gdb-step
t
"Step into (aka step)"]
[debug::toolbar-finish-icon
gdb-finish
t
"Complete current frame"]
[debug::toolbar-up-icon
gdb-up
t
"Stack Up (towards \"cooler\" - less recently visited - frames)"]
[debug::toolbar-down-icon
gdb-down
t
"Stack Down (towards \"warmer\" - more recently visited - frames)"]
[debug::toolbar-fix-icon nil nil "Fix (not available with gdb)"]
[debug::toolbar-build-icon
toolbar-compile
t
"Build (aka make -NYI)"]
))
(if gdb-mode-map
nil
(setq gdb-mode-map (make-sparse-keymap))
(set-keymap-name gdb-mode-map 'gdb-mode-map)
(set-keymap-parents gdb-mode-map (list comint-mode-map))
(define-key gdb-mode-map "\C-l" 'gdb-refresh)
(define-key gdb-mode-map "\C-c\C-c" 'gdb-control-c-subjob)
(define-key gdb-mode-map "\t" 'comint-dynamic-complete)
(define-key gdb-mode-map "\M-?" 'comint-dynamic-list-completions))
(define-key ctl-x-map " " 'gdb-break)
(define-key ctl-x-map "&" 'send-gdb-command)
;;Of course you may use `def-gdb' with any other gdb command, including
;;user defined ones.
(defmacro def-gdb (name key &optional doc &rest forms)
(let* ((fun (intern (format "gdb-%s" name)))
(cstr (list 'if '(not (= 1 arg))
(list 'format "%s %s" name 'arg)
name)))
(list 'progn
(nconc (list 'defun fun '(arg)
(or doc "")
'(interactive "p")
(list 'gdb-call cstr))
forms)
(and key (list 'define-key 'gdb-mode-map key (list 'quote fun))))))
(def-gdb "step" "\M-s" "Step one source line with display"
(gdb-delete-arrow-extent))
(def-gdb "stepi" "\M-i" "Step one instruction with display"
(gdb-delete-arrow-extent))
(def-gdb "finish" "\C-c\C-f" "Finish executing current function"
(gdb-delete-arrow-extent))
(def-gdb "run" nil "Run the current program"
(gdb-delete-arrow-extent))
;;"next" and "cont" were bound to M-n and M-c in Emacs 18, but these are
;;poor choices, since M-n is used for history navigation and M-c is
;;capitalize-word. These are defined without key bindings so that users
;;may choose their own bindings.
(def-gdb "next" "\C-c\C-n" "Step one source line (skip functions)"
(gdb-delete-arrow-extent))
(def-gdb "cont" "\C-c\M-c" "Proceed with the program"
(gdb-delete-arrow-extent))
(def-gdb "up" "\C-c<" "Go up N stack frames (numeric arg) with display")
(def-gdb "down" "\C-c>" "Go down N stack frames (numeric arg) with display")
(defvar gdb-display-mode nil
"Minor mode for gdb frame display")
(or (assq 'gdb-display-mode minor-mode-alist)
(setq minor-mode-alist
(purecopy
(append minor-mode-alist
'((gdb-display-mode " Frame"))))))
(defun gdb-display-mode (&optional arg)
"Toggle GDB Frame display mode.
With arg, turn display mode on if and only if arg is positive.
In the display minor mode, source file are displayed in another
window for respective \\[gdb-display-frame] commands."
(interactive "P")
(setq gdb-display-mode (if (null arg)
(not gdb-display-mode)
(> (prefix-numeric-value arg) 0))))
;; Using cc-mode's syntax table is broken.
(defvar gdb-mode-syntax-table nil
"Syntax table for GDB mode.")
;; This is adapted from CC Mode 5.11.
(unless gdb-mode-syntax-table
(setq gdb-mode-syntax-table (make-syntax-table))
;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS!
(modify-syntax-entry ?_ "_" gdb-mode-syntax-table)
(modify-syntax-entry ?\\ "\\" gdb-mode-syntax-table)
(modify-syntax-entry ?+ "." gdb-mode-syntax-table)
(modify-syntax-entry ?- "." gdb-mode-syntax-table)
(modify-syntax-entry ?= "." gdb-mode-syntax-table)
(modify-syntax-entry ?% "." gdb-mode-syntax-table)
(modify-syntax-entry ?< "." gdb-mode-syntax-table)
(modify-syntax-entry ?> "." gdb-mode-syntax-table)
(modify-syntax-entry ?& "." gdb-mode-syntax-table)
(modify-syntax-entry ?| "." gdb-mode-syntax-table)
(modify-syntax-entry ?\' "\"" gdb-mode-syntax-table)
;; add extra comment syntax
(modify-syntax-entry ?/ ". 14" gdb-mode-syntax-table)
(modify-syntax-entry ?* ". 23" gdb-mode-syntax-table))
(defun gdb-mode ()
"Major mode for interacting with an inferior Gdb process.
The following commands are available:
\\{gdb-mode-map}
\\[gdb-display-frame] displays in the other window
the last line referred to in the gdb buffer. See also
\\[gdb-display-mode].
\\[gdb-step],\\[gdb-next], and \\[gdb-nexti] in the gdb window,
call gdb to step,next or nexti and then update the other window
with the current file and position.
If you are in a source file, you may select a point to break
at, by doing \\[gdb-break].
Commands:
Many commands are inherited from comint mode.
Additionally we have:
\\[gdb-display-frame] display frames file in other window
\\[gdb-step] advance one line in program
\\[send-gdb-command] used for special printing of an arg at the current point.
C-x SPACE sets break point at current line."
(interactive)
(comint-mode)
(use-local-map gdb-mode-map)
(set-syntax-table gdb-mode-syntax-table)
(make-local-variable 'gdb-last-frame-displayed-p)
(make-local-variable 'gdb-last-frame)
(make-local-variable 'gdb-delete-prompt-marker)
(make-local-variable 'gdb-display-mode)
(make-local-variable' gdb-filter-accumulator)
(setq gdb-last-frame nil
gdb-delete-prompt-marker nil
gdb-filter-accumulator nil
gdb-display-mode t
major-mode 'gdb-mode
mode-name "Inferior GDB"
comint-prompt-regexp gdb-prompt-pattern
gdb-last-frame-displayed-p t)
(set (make-local-variable 'shell-dirtrackp) t)
;;(make-local-variable 'gdb-arrow-extent)
(and (extentp gdb-arrow-extent)
(delete-extent gdb-arrow-extent))
(setq gdb-arrow-extent nil)
;; XEmacs change:
(make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'gdb-delete-arrow-extent nil t)
(add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)
(run-hooks 'gdb-mode-hook))
(defun gdb-delete-arrow-extent ()
(let ((inhibit-quit t))
(if gdb-arrow-extent
(delete-extent gdb-arrow-extent))
(setq gdb-arrow-extent nil)))
(defvar current-gdb-buffer nil)
;;;###autoload
(defvar gdb-command-name "gdb"
"Pathname for executing gdb.")
;;;###autoload
(defun gdb (path &optional corefile)
"Run gdb on program FILE in buffer *gdb-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for GDB. If you wish to change this, use
the GDB commands `cd DIR' and `directory'."
(interactive "FRun gdb on file: ")
(setq path (file-truename (expand-file-name path)))
(let ((file (file-name-nondirectory path)))
(switch-to-buffer (concat "*gdb-" file "*"))
(setq default-directory (file-name-directory path))
(or (bolp) (newline))
(insert "Current directory is " default-directory "\n")
(apply 'make-comint
(concat "gdb-" file)
(substitute-in-file-name gdb-command-name)
nil
"-fullname"
"-cd" default-directory
file
(and corefile (list corefile)))
(set-process-filter (get-buffer-process (current-buffer)) 'gdb-filter)
(set-process-sentinel (get-buffer-process (current-buffer)) 'gdb-sentinel)
;; XEmacs change: turn on gdb mode after setting up the proc filters
;; for the benefit of shell-font.el
(gdb-mode)
(gdb-set-buffer)))
;;;###autoload
(defun gdb-with-core (file corefile)
"Debug a program using a corefile."
(interactive "fProgram to debug: \nfCore file to use: ")
(gdb file corefile))
(defun gdb-set-buffer ()
(cond ((eq major-mode 'gdb-mode)
(setq current-gdb-buffer (current-buffer))
(if (featurep 'debug-toolbar)
(set-specifier default-toolbar (cons (current-buffer)
gdb-toolbar))))))
;; This function is responsible for inserting output from GDB
;; into the buffer.
;; Aside from inserting the text, it notices and deletes
;; each filename-and-line-number;
;; that GDB prints to identify the selected frame.
;; It records the filename and line number, and maybe displays that file.
(defun gdb-filter (proc string)
(let ((inhibit-quit t))
(save-current-buffer
(set-buffer (process-buffer proc))
(if gdb-filter-accumulator
(gdb-filter-accumulate-marker
proc (concat gdb-filter-accumulator string))
(gdb-filter-scan-input proc string)))))
(defun gdb-filter-accumulate-marker (proc string)
(setq gdb-filter-accumulator nil)
(if (> (length string) 1)
(if (= (aref string 1) ?\032)
(let ((end (string-match "\n" string)))
(if end
(progn
(let* ((first-colon (string-match ":" string 2))
(second-colon
(string-match ":" string (1+ first-colon))))
(setq gdb-last-frame
(cons (substring string 2 first-colon)
(string-to-int
(substring string (1+ first-colon)
second-colon)))))
(setq gdb-last-frame-displayed-p nil)
(gdb-filter-scan-input proc
(substring string (1+ end))))
(setq gdb-filter-accumulator string)))
(gdb-filter-insert proc "\032")
(gdb-filter-scan-input proc (substring string 1)))
(setq gdb-filter-accumulator string)))
(defun gdb-filter-scan-input (proc string)
(if (equal string "")
(setq gdb-filter-accumulator nil)
(let ((start (string-match "\032" string)))
(if start
(progn (gdb-filter-insert proc (substring string 0 start))
(gdb-filter-accumulate-marker proc
(substring string start)))
(gdb-filter-insert proc string)))))
(defun gdb-filter-insert (proc string)
(let ((moving (= (point) (process-mark proc)))
(output-after-point (< (point) (process-mark proc))))
(save-excursion
;; Insert the text, moving the process-marker.
(goto-char (process-mark proc))
(insert-before-markers string)
(set-marker (process-mark proc) (point))
(gdb-maybe-delete-prompt)
;; Check for a filename-and-line number.
(gdb-display-frame
;; Don't display the specified file
;; unless (1) point is at or after the position where output appears
;; and (2) this buffer is on the screen.
(or output-after-point
(not (get-buffer-window (current-buffer))))
;; Display a file only when a new filename-and-line-number appears.
t))
(if moving (goto-char (process-mark proc))))
(let (s)
(if (and (should-use-dialog-box-p)
(setq s (or (string-match " (y or n) *\\'" string)
(string-match " (yes or no) *\\'" string))))
(gdb-mouse-prompt-hack (substring string 0 s) (current-buffer))))
)
(defun gdb-mouse-prompt-hack (prompt buffer)
(popup-dialog-box
(list prompt
(vector "Yes" (list 'gdb-mouse-prompt-hack-answer 't buffer) t)
(vector "No" (list 'gdb-mouse-prompt-hack-answer 'nil buffer) t)
nil
(vector "Cancel" (list 'gdb-mouse-prompt-hack-answer 'nil buffer) t)
)))
(defun gdb-mouse-prompt-hack-answer (answer buffer)
(let ((b (current-buffer)))
(unwind-protect
(progn
(set-buffer buffer)
(goto-char (process-mark (get-buffer-process buffer)))
(delete-region (point) (point-max))
(insert (if answer "yes" "no"))
(comint-send-input))
(set-buffer b))))
(defun gdb-sentinel (proc msg)
(cond ((null (buffer-name (process-buffer proc)))
;; buffer killed
;; Stop displaying an arrow in a source file.
;(setq overlay-arrow-position nil) -- done by kill-buffer-hook
(set-process-buffer proc nil))
((memq (process-status proc) '(signal exit))
;; Stop displaying an arrow in a source file.
(gdb-delete-arrow-extent)
;; Fix the mode line.
(setq modeline-process
(concat ": gdb " (symbol-name (process-status proc))))
(let* ((obuf (current-buffer)))
;; save-excursion isn't the right thing if
;; process-buffer is current-buffer
(unwind-protect
(progn
;; Write something in *compilation* and hack its mode line,
(set-buffer (process-buffer proc))
;; Force mode line redisplay soon
(set-buffer-modified-p (buffer-modified-p))
(if (eobp)
(insert ?\n mode-name " " msg)
(save-excursion
(goto-char (point-max))
(insert ?\n mode-name " " msg)))
;; If buffer and mode line will show that the process
;; is dead, we can delete it now. Otherwise it
;; will stay around until M-x list-processes.
(delete-process proc))
;; Restore old buffer, but don't restore old point
;; if obuf is the gdb buffer.
(set-buffer obuf))))))
(defun gdb-refresh (&optional arg)
"Fix up a possibly garbled display, and redraw the arrow."
(interactive "P")
(recenter arg)
(gdb-display-frame))
(defun gdb-display-frame (&optional nodisplay noauto)
"Find, obey and delete the last filename-and-line marker from GDB.
The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
Obeying it means displaying in another window the specified file and line."
(interactive)
(gdb-set-buffer)
(and gdb-last-frame (not nodisplay)
gdb-display-mode
(or (not gdb-last-frame-displayed-p) (not noauto))
(progn (gdb-display-line (car gdb-last-frame) (cdr gdb-last-frame))
(setq gdb-last-frame-displayed-p t))))
;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
;; and that its line LINE is visible.
;; Put the overlay-arrow on the line LINE in that buffer.
;; David Hughes 24th April 1998
(defun gdb-display-window (source-buffer line)
;; Searches frame for the most appropriate source window
;; BUFFER to display
;; LINE number to display
(let ((source-pos
(eval-in-buffer source-buffer
(save-excursion (goto-line line) (point)))))
(catch 'found
(save-window-excursion
(select-window (or (get-buffer-window current-gdb-buffer)
(selected-window)))
(walk-windows
(function
(lambda (w)
(and (eq source-buffer (window-buffer w))
(pos-visible-in-window-p source-pos w)
(throw 'found w))))))
(display-buffer source-buffer))))
(defun gdb-display-line (true-file line &optional select-method)
;; FILE to display
;; LINE number to highlight and make visible
;; SELECT-METHOD 'source, 'debugger, or 'none. (default is 'debugger)
(and (null select-method) (setq select-method 'debugger))
(let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen
(pop-up-windows t)
(source-buffer (find-file-noselect true-file))
(source-window (gdb-display-window source-buffer line))
(debugger-window (get-buffer-window current-gdb-buffer))
(extent gdb-arrow-extent)
pos)
;; XEmacs change: make sure we find a window displaying the source file
;; even if we are already sitting in it when a breakpoint is hit.
;; Otherwise the t argument to display-buffer will prevent it from being
;; displayed.
(save-excursion
(cond ((eq select-method 'debugger)
;; might not already be displayed
(setq debugger-window (display-buffer current-gdb-buffer))
(select-window debugger-window))
((eq select-method 'source)
(select-window source-window))))
(and extent
(not (eq (extent-object extent) source-buffer))
(setq extent (delete-extent extent)))
(or extent
(progn
(setq extent (make-extent 1 1 source-buffer))
(set-extent-face extent 'gdb-arrow-face)
(set-extent-begin-glyph extent gdb-arrow-glyph)
(set-extent-begin-glyph-layout extent 'whitespace)
(set-extent-priority extent 2000)
(setq gdb-arrow-extent extent)))
(save-current-buffer
(set-buffer source-buffer)
(save-restriction
(widen)
(goto-line line)
(set-window-point source-window (point))
(setq pos (point))
(end-of-line)
(set-extent-endpoints extent pos (point))
(run-hook-with-args 'gdb-arrow-extent-hooks extent))
(cond ((or (< pos (point-min)) (> pos (point-max)))
(widen)
(goto-char pos))))
;; Added by Stig. It caused lots of problems for several users
;; and since its purpose is unclear it is getting commented out.
;;(and debugger-window
;; (set-window-point debugger-window pos))
))
(defun gdb-call (command)
"Invoke gdb COMMAND displaying source in other window."
(interactive)
(goto-char (point-max))
;; Record info on the last prompt in the buffer and its position.
;; This is used in gdb-maybe-delete-prompt
;; to prevent multiple prompts from accumulating.
(save-excursion
(goto-char (process-mark (get-buffer-process current-gdb-buffer)))
(let ((pt (point)))
(beginning-of-line)
(setq gdb-delete-prompt-marker
(if (= (point) pt)
nil
(list (point-marker) (- pt (point))
(buffer-substring (point) pt))))))
(gdb-set-buffer)
(process-send-string (get-buffer-process current-gdb-buffer)
(concat command "\n")))
(defun gdb-maybe-delete-prompt ()
(if gdb-delete-prompt-marker
;; Get the string that we used as the prompt before.
(let ((prompt (nth 2 gdb-delete-prompt-marker))
(length (nth 1 gdb-delete-prompt-marker)))
;; Position after it.
(goto-char (+ (car gdb-delete-prompt-marker) length))
;; Delete any duplicates of it which follow right after.
(while (and (<= (+ (point) length) (point-max))
(string= prompt
(buffer-substring (point) (+ (point) length))))
(delete-region (point) (+ (point) length)))
;; If that didn't take us to where output is arriving,
;; we have encountered something other than a prompt,
;; so stop trying to delete any more prompts.
(if (not (= (point)
(process-mark (get-buffer-process current-gdb-buffer))))
(progn
(set-marker (car gdb-delete-prompt-marker) nil)
(setq gdb-delete-prompt-marker nil))))))
(defun gdb-break (temp)
"Set GDB breakpoint at this source line. With ARG set temporary breakpoint."
(interactive "P")
(let* ((file-name (file-name-nondirectory buffer-file-name))
(line (save-restriction
(widen)
(beginning-of-line)
(1+ (count-lines 1 (point)))))
(cmd (concat (if temp "tbreak " "break ") file-name ":"
(int-to-string line))))
(set-buffer current-gdb-buffer)
(goto-char (process-mark (get-buffer-process current-gdb-buffer)))
(delete-region (point) (point-max))
(insert cmd)
(comint-send-input)
;;(process-send-string (get-buffer-process current-gdb-buffer) cmd)
))
(defun gdb-clear ()
"Set GDB breakpoint at this source line."
(interactive)
(let* ((file-name (file-name-nondirectory buffer-file-name))
(line (save-restriction
(widen)
(beginning-of-line)
(1+ (count-lines 1 (point)))))
(cmd (concat "clear " file-name ":"
(int-to-string line))))
(set-buffer current-gdb-buffer)
(goto-char (process-mark (get-buffer-process current-gdb-buffer)))
(delete-region (point) (point-max))
(insert cmd)
(comint-send-input)
;;(process-send-string (get-buffer-process current-gdb-buffer) cmd)
))
(defun gdb-read-address()
"Return a string containing the core-address found in the buffer at point."
(save-excursion
(let ((pt (point)) found begin)
(setq found (if (search-backward "0x" (- pt 7) t)(point)))
(cond (found (forward-char 2)
(buffer-substring found
(progn (re-search-forward "[^0-9a-f]")
(forward-char -1)
(point))))
(t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
(point)))
(forward-char 1)
(re-search-forward "[^0-9]")
(forward-char -1)
(buffer-substring begin (point)))))))
(defvar gdb-commands nil
"List of strings or functions used by send-gdb-command.
It is for customization by you.")
(defun send-gdb-command (arg)
"This command reads the number where the cursor is positioned. It
then inserts this ADDR at the end of the gdb buffer. A numeric arg
selects the ARG'th member COMMAND of the list gdb-print-command. If
COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
(funcall COMMAND ADDR) is inserted. eg. \"p (rtx)%s->fld[0].rtint\"
is a possible string to be a member of gdb-commands. "
(interactive "P")
(let (comm addr)
(if arg (setq comm (nth arg gdb-commands)))
(setq addr (gdb-read-address))
(if (eq (current-buffer) current-gdb-buffer)
(set-mark (point)))
(cond (comm
(setq comm
(if (stringp comm) (format comm addr) (funcall comm addr))))
(t (setq comm addr)))
(switch-to-buffer current-gdb-buffer)
(goto-char (point-max))
(insert comm)))
(fset 'gdb-control-c-subjob 'comint-interrupt-subjob)
;(defun gdb-control-c-subjob ()
; "Send a Control-C to the subprocess."
; (interactive)
; (process-send-string (get-buffer-process (current-buffer))
; "\C-c"))
(defun gdb-toolbar-break ()
(interactive)
(save-excursion
(message (car gdb-last-frame))
(set-buffer (find-file-noselect (car gdb-last-frame)))
(gdb-break nil)))
(defun gdb-toolbar-clear ()
(interactive)
(save-excursion
(message (car gdb-last-frame))
(set-buffer (find-file-noselect (car gdb-last-frame)))
(gdb-clear)))
(provide 'gdb)
;;; gdb.el ends here
