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