Mercurial > emacs
comparison lisp/gdb-ui.el @ 48292:27d9e4538750
New file.
| author | Nick Roberts <nickrob@snap.net.nz> |
|---|---|
| date | Thu, 14 Nov 2002 01:53:27 +0000 |
| parents | |
| children | 69646014abb3 |
comparison
equal
deleted
inserted
replaced
| 48291:46a4047710f4 | 48292:27d9e4538750 |
|---|---|
| 1 ;;; gdb-ui.el --- User Interface for running GDB | |
| 2 | |
| 3 ;; Author: Nick Roberts <nick@nick.uklinux.net> | |
| 4 ;; Maintainer: FSF | |
| 5 ;; Keywords: unix, tools | |
| 6 | |
| 7 ;; Copyright (C) 2002 Free Software Foundation, Inc. | |
| 8 | |
| 9 ;; This file is part of GNU Emacs. | |
| 10 | |
| 11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 12 ;; it under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 19 ;; GNU General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; Extension of gdba.el written by Jim Kingdon from gdb 5.0 | |
| 29 | |
| 30 ;;; Code: | |
| 31 | |
| 32 (require 'mygud) | |
| 33 | |
| 34 (defcustom gdb-many-windows t | |
| 35 "If t, using gdba, start gdb with ancillary buffers visible. | |
| 36 Use `toggle-gdb-windows' to change this value during a gdb session" | |
| 37 :type 'boolean | |
| 38 :group 'gud) | |
| 39 | |
| 40 (defvar gdb-main-file nil "Source file from which program execution begins.") | |
| 41 (defvar gdb-cdir nil "Compilation directory.") | |
| 42 (defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.") | |
| 43 (defvar gdb-prev-main-or-pc nil) | |
| 44 | |
| 45 (defun gdba (command-line) | |
| 46 "Run gdb on program FILE in buffer *gdb-FILE*. | |
| 47 The directory containing FILE becomes the initial working directory | |
| 48 and source-file directory for your debugger. | |
| 49 | |
| 50 If `gdb-many-windows' is set to t this works best in X (depending on the size | |
| 51 of your monitor) using most of the screen. After a short delay the following | |
| 52 layout will appear (keybindings given in relevant buffer) : | |
| 53 | |
| 54 --------------------------------------------------------------------- | |
| 55 GDB Toolbar | |
| 56 --------------------------------------------------------------------- | |
| 57 GUD buffer (I/O of gdb) | Locals buffer | |
| 58 | | |
| 59 | | |
| 60 | | |
| 61 --------------------------------------------------------------------- | |
| 62 Source buffer | Input/Output (of debuggee) buffer | |
| 63 | (comint-mode) | |
| 64 | | |
| 65 | | |
| 66 | | |
| 67 | | |
| 68 | | |
| 69 | | |
| 70 --------------------------------------------------------------------- | |
| 71 Stack buffer | Breakpoints buffer | |
| 72 \[mouse-2\] gdb-frames-select | SPC gdb-toggle-bp-this-line | |
| 73 | g gdb-goto-bp-this-line | |
| 74 | d gdb-delete-bp-this-line | |
| 75 --------------------------------------------------------------------- | |
| 76 | |
| 77 All the buffers share the toolbar and source should always display in the same | |
| 78 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint | |
| 79 icons are displayed both by setting a break with gud-break and by typing break | |
| 80 in the GUD buffer. | |
| 81 | |
| 82 Displayed expressions appear in separate frames. Arrays may be displayed | |
| 83 as slices and visualised using the graph program from plotutils if installed. | |
| 84 | |
| 85 If `gdb-many-windows' is set to nil then gdb starts with just two windows : | |
| 86 the GUD and the source buffer. | |
| 87 | |
| 88 The following interactive lisp functions help control operation : | |
| 89 | |
| 90 `toggle-gdb-windows' - Toggle the number of windows gdb uses. | |
| 91 `gdb-restore-windows' - to restore the layout if its lost. | |
| 92 `gdb-quit' - to delete (most) of the buffers used by gdb." | |
| 93 | |
| 94 (interactive (list (gud-query-cmdline 'gdba))) | |
| 95 | |
| 96 (gdba-common-init command-line nil | |
| 97 'gdba-marker-filter 'gud-gdb-find-file) | |
| 98 | |
| 99 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 100 | |
| 101 ; (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") | |
| 102 (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.") | |
| 103 ; (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") | |
| 104 (gud-def gud-run "run" nil "Run the program.") | |
| 105 (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") | |
| 106 (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") | |
| 107 (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") | |
| 108 (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") | |
| 109 (gud-def gud-cont "cont" "\C-r" "Continue with display.") | |
| 110 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") | |
| 111 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") | |
| 112 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") | |
| 113 (gud-def gud-goto "until %f:%l" "\C-u" "Continue up to current line.") | |
| 114 | |
| 115 (define-key gud-mode-map "\C-c\C-b" 'gud-break) | |
| 116 (define-key global-map "\C-x\C-a\C-b" 'gud-break) | |
| 117 | |
| 118 (define-key gud-mode-map "\C-c\C-d" 'gud-remove) | |
| 119 (define-key global-map "\C-x\C-a\C-d" 'gud-remove) | |
| 120 | |
| 121 (local-set-key "\C-i" 'gud-gdb-complete-command) | |
| 122 | |
| 123 (setq comint-prompt-regexp "^(.*gdb[+]?) *") | |
| 124 (setq comint-input-sender 'gdb-send) | |
| 125 | |
| 126 ; (re-)initialise | |
| 127 (setq gdb-main-or-pc "main") | |
| 128 (setq gdb-current-address nil) | |
| 129 (setq gdb-display-in-progress nil) | |
| 130 (setq gdb-dive nil) | |
| 131 (setq gud-last-last-frame nil) | |
| 132 | |
| 133 (run-hooks 'gdb-mode-hook) | |
| 134 (let ((instance | |
| 135 (make-gdb-instance (get-buffer-process (current-buffer))))) | |
| 136 (if gdb-first-time (gdb-clear-inferior-io instance)) | |
| 137 | |
| 138 ; find source file and compilation directory here | |
| 139 (gdb-instance-enqueue-idle-input instance (list "server list\n" | |
| 140 '(lambda () nil))) | |
| 141 (gdb-instance-enqueue-idle-input instance (list "server info source\n" | |
| 142 '(lambda () (gdb-source-info)))))) | |
| 143 | |
| 144 (defun gud-break (arg) | |
| 145 "Set breakpoint at current line or address." | |
| 146 (interactive "p") | |
| 147 (if (not (string-equal mode-name "Assembler")) | |
| 148 (gud-call "break %f:%l" arg) | |
| 149 ;else | |
| 150 (save-excursion | |
| 151 (beginning-of-line) | |
| 152 (forward-char 2) | |
| 153 (gud-call "break *%a" arg)))) | |
| 154 | |
| 155 (defun gud-remove (arg) | |
| 156 "Remove breakpoint at current line or address." | |
| 157 (interactive "p") | |
| 158 (if (not (string-equal mode-name "Assembler")) | |
| 159 (gud-call "clear %f:%l" arg) | |
| 160 ;else | |
| 161 (save-excursion | |
| 162 (beginning-of-line) | |
| 163 (forward-char 2) | |
| 164 (gud-call "clear *%a" arg)))) | |
| 165 | |
| 166 (defun gud-display () | |
| 167 "Display (possibly dereferenced) C expression at point." | |
| 168 (interactive) | |
| 169 (save-excursion | |
| 170 (let ((expr (gud-find-c-expr))) | |
| 171 (gdb-instance-enqueue-idle-input | |
| 172 gdb-buffer-instance | |
| 173 (list (concat "server whatis " expr "\n") | |
| 174 `(lambda () (gud-display1 ,expr))))))) | |
| 175 | |
| 176 (defun gud-display1 (expr) | |
| 177 (goto-char (point-min)) | |
| 178 (if (re-search-forward "\*" nil t) | |
| 179 (gdb-instance-enqueue-idle-input | |
| 180 gdb-buffer-instance | |
| 181 (list (concat "server display* " expr "\n") | |
| 182 '(lambda () nil))) | |
| 183 ;else | |
| 184 (gdb-instance-enqueue-idle-input | |
| 185 gdb-buffer-instance | |
| 186 (list (concat "server display " expr "\n") | |
| 187 '(lambda () nil))))) | |
| 188 | |
| 189 | |
| 190 ;; The completion process filter is installed temporarily to slurp the | |
| 191 ;; output of GDB up to the next prompt and build the completion list. | |
| 192 ;; It must also handle annotations. | |
| 193 (defun gdba-complete-filter (string) | |
| 194 (gdb-output-burst gdb-buffer-instance string) | |
| 195 (while (string-match "\n\032\032\\(.*\\)\n" string) | |
| 196 (setq string (concat (substring string 0 (match-beginning 0)) | |
| 197 (substring string (match-end 0))))) | |
| 198 (setq string (concat gud-gdb-complete-string string)) | |
| 199 (while (string-match "\n" string) | |
| 200 (setq gud-gdb-complete-list | |
| 201 (cons (substring string gud-gdb-complete-break (match-beginning 0)) | |
| 202 gud-gdb-complete-list)) | |
| 203 (setq string (substring string (match-end 0)))) | |
| 204 (if (string-match comint-prompt-regexp string) | |
| 205 (progn | |
| 206 (setq gud-gdb-complete-in-progress nil) | |
| 207 string) | |
| 208 (progn | |
| 209 (setq gud-gdb-complete-string string) | |
| 210 ""))) | |
| 211 | |
| 212 | |
| 213 (defun gdba-common-init (command-line massage-args marker-filter &optional find-file) | |
| 214 | |
| 215 (let* ((words (split-string command-line)) | |
| 216 (program (car words)) | |
| 217 | |
| 218 ;; Extract the file name from WORDS | |
| 219 ;; and put t in its place. | |
| 220 ;; Later on we will put the modified file name arg back there. | |
| 221 (file-word (let ((w (cdr words))) | |
| 222 (while (and w (= ?- (aref (car w) 0))) | |
| 223 (setq w (cdr w))) | |
| 224 (and w | |
| 225 (prog1 (car w) | |
| 226 (setcar w t))))) | |
| 227 (file-subst | |
| 228 (and file-word (substitute-in-file-name file-word))) | |
| 229 | |
| 230 (args (cdr words)) | |
| 231 | |
| 232 ;; If a directory was specified, expand the file name. | |
| 233 ;; Otherwise, don't expand it, so GDB can use the PATH. | |
| 234 ;; A file name without directory is literally valid | |
| 235 ;; only if the file exists in ., and in that case, | |
| 236 ;; omitting the expansion here has no visible effect. | |
| 237 (file (and file-word | |
| 238 (if (file-name-directory file-subst) | |
| 239 (expand-file-name file-subst) | |
| 240 file-subst))) | |
| 241 (filepart (and file-word (file-name-nondirectory file))) | |
| 242 (buffer-name (concat "*gdb-" filepart "*"))) | |
| 243 | |
| 244 (setq gdb-first-time (not (get-buffer-process buffer-name))) | |
| 245 | |
| 246 (switch-to-buffer buffer-name) | |
| 247 ;; Set default-directory to the file's directory. | |
| 248 (and file-word | |
| 249 gud-chdir-before-run | |
| 250 ;; Don't set default-directory if no directory was specified. | |
| 251 ;; In that case, either the file is found in the current directory, | |
| 252 ;; in which case this setq is a no-op, | |
| 253 ;; or it is found by searching PATH, | |
| 254 ;; in which case we don't know what directory it was found in. | |
| 255 (file-name-directory file) | |
| 256 (setq default-directory (file-name-directory file))) | |
| 257 (or (bolp) (newline)) | |
| 258 (insert "Current directory is " default-directory "\n") | |
| 259 ;; Put the substituted and expanded file name back in its place. | |
| 260 (let ((w args)) | |
| 261 (while (and w (not (eq (car w) t))) | |
| 262 (setq w (cdr w))) | |
| 263 (if w | |
| 264 (setcar w file))) | |
| 265 (let ((old-instance gdb-buffer-instance)) | |
| 266 (apply 'make-comint (concat "gdb-" filepart) program nil args) | |
| 267 (gud-mode) | |
| 268 (make-variable-buffer-local 'old-gdb-buffer-instance) | |
| 269 (setq old-gdb-buffer-instance old-instance)) | |
| 270 (setq gdb-target-name filepart)) | |
| 271 (make-local-variable 'gud-marker-filter) | |
| 272 (setq gud-marker-filter marker-filter) | |
| 273 (if find-file (set (make-local-variable 'gud-find-file) find-file)) | |
| 274 | |
| 275 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) | |
| 276 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) | |
| 277 (gud-set-buffer)) | |
| 278 | |
| 279 | |
| 280 ;; ====================================================================== | |
| 281 ;; | |
| 282 ;; In this world, there are gdb instance objects (of unspecified | |
| 283 ;; representation) and buffers associated with those objects. | |
| 284 ;; | |
| 285 | |
| 286 ;; | |
| 287 ;; gdb-instance objects | |
| 288 ;; | |
| 289 | |
| 290 (defun make-gdb-instance (proc) | |
| 291 "Create a gdb instance object from a gdb process." | |
| 292 (setq last-proc proc) | |
| 293 (let ((instance (cons 'gdb-instance proc))) | |
| 294 (save-excursion | |
| 295 (set-buffer (process-buffer proc)) | |
| 296 (setq gdb-buffer-instance instance) | |
| 297 (progn | |
| 298 (mapcar 'make-variable-buffer-local gdb-instance-variables) | |
| 299 (setq gdb-buffer-type 'gdba) | |
| 300 ;; If we're taking over the buffer of another process, | |
| 301 ;; take over it's ancillery buffers as well. | |
| 302 ;; | |
| 303 (let ((dead (or old-gdb-buffer-instance))) | |
| 304 (mapcar | |
| 305 (function | |
| 306 (lambda (b) | |
| 307 (progn | |
| 308 (set-buffer b) | |
| 309 (if (eq dead gdb-buffer-instance) | |
| 310 (setq gdb-buffer-instance instance))))) | |
| 311 (buffer-list))))) | |
| 312 instance)) | |
| 313 | |
| 314 (defun gdb-instance-process (inst) (cdr inst)) | |
| 315 | |
| 316 ;;; The list of instance variables is built up by the expansions of | |
| 317 ;;; DEF-GDB-VARIABLE | |
| 318 ;;; | |
| 319 (defvar gdb-instance-variables '() | |
| 320 "A list of variables that are local to the GUD buffer associated | |
| 321 with a gdb instance.") | |
| 322 | |
| 323 (defmacro def-gdb-variable | |
| 324 (name accessor setter &optional default doc) | |
| 325 `(progn | |
| 326 (defvar ,name ,default ,(or doc "undocumented")) | |
| 327 (if (not (memq ',name gdb-instance-variables)) | |
| 328 (setq gdb-instance-variables | |
| 329 (cons ',name gdb-instance-variables))) | |
| 330 ,(and accessor | |
| 331 `(defun ,accessor (instance) | |
| 332 (let | |
| 333 ((buffer (gdb-get-instance-buffer instance 'gdba))) | |
| 334 (and buffer | |
| 335 (save-excursion | |
| 336 (set-buffer buffer) | |
| 337 ,name))))) | |
| 338 ,(and setter | |
| 339 `(defun ,setter (instance val) | |
| 340 (let | |
| 341 ((buffer (gdb-get-instance-buffer instance 'gdba))) | |
| 342 (and buffer | |
| 343 (save-excursion | |
| 344 (set-buffer buffer) | |
| 345 (setq ,name val)))))))) | |
| 346 | |
| 347 (defmacro def-gdb-var (root-symbol &optional default doc) | |
| 348 (let* ((root (symbol-name root-symbol)) | |
| 349 (accessor (intern (concat "gdb-instance-" root))) | |
| 350 (setter (intern (concat "set-gdb-instance-" root))) | |
| 351 (var-name (intern (concat "gdb-" root)))) | |
| 352 `(def-gdb-variable | |
| 353 ,var-name ,accessor ,setter | |
| 354 ,default ,doc))) | |
| 355 | |
| 356 (def-gdb-var buffer-instance nil | |
| 357 "In an instance buffer, the buffer's instance.") | |
| 358 | |
| 359 (def-gdb-var buffer-type nil | |
| 360 "One of the symbols bound in gdb-instance-buffer-rules") | |
| 361 | |
| 362 (def-gdb-var burst "" | |
| 363 "A string of characters from gdb that have not yet been processed.") | |
| 364 | |
| 365 (def-gdb-var input-queue () | |
| 366 "A list of high priority gdb command objects.") | |
| 367 | |
| 368 (def-gdb-var idle-input-queue () | |
| 369 "A list of low priority gdb command objects.") | |
| 370 | |
| 371 (def-gdb-var prompting nil | |
| 372 "True when gdb is idle with no pending input.") | |
| 373 | |
| 374 (def-gdb-var output-sink 'user | |
| 375 "The disposition of the output of the current gdb command. | |
| 376 Possible values are these symbols: | |
| 377 | |
| 378 user -- gdb output should be copied to the GUD buffer | |
| 379 for the user to see. | |
| 380 | |
| 381 inferior -- gdb output should be copied to the inferior-io buffer | |
| 382 | |
| 383 pre-emacs -- output should be ignored util the post-prompt | |
| 384 annotation is received. Then the output-sink | |
| 385 becomes:... | |
| 386 emacs -- output should be collected in the partial-output-buffer | |
| 387 for subsequent processing by a command. This is the | |
| 388 disposition of output generated by commands that | |
| 389 gdb mode sends to gdb on its own behalf. | |
| 390 post-emacs -- ignore input until the prompt annotation is | |
| 391 received, then go to USER disposition. | |
| 392 ") | |
| 393 | |
| 394 (def-gdb-var current-item nil | |
| 395 "The most recent command item sent to gdb.") | |
| 396 | |
| 397 (def-gdb-var pending-triggers '() | |
| 398 "A list of trigger functions that have run later than their output | |
| 399 handlers.") | |
| 400 | |
| 401 (defun in-gdb-instance-context (instance form) | |
| 402 "Funcall FORM in the GUD buffer of INSTANCE." | |
| 403 (save-excursion | |
| 404 (set-buffer (gdb-get-instance-buffer instance 'gdba)) | |
| 405 (funcall form))) | |
| 406 | |
| 407 ;; end of instance vars | |
| 408 | |
| 409 ;; | |
| 410 ;; finding instances | |
| 411 ;; | |
| 412 | |
| 413 (defun gdb-proc->instance (proc) | |
| 414 (save-excursion | |
| 415 (set-buffer (process-buffer proc)) | |
| 416 gdb-buffer-instance)) | |
| 417 | |
| 418 (defun gdb-mru-instance-buffer () | |
| 419 "Return the most recently used (non-auxiliary) GUD buffer." | |
| 420 (save-excursion | |
| 421 (gdb-goto-first-gdb-instance (buffer-list)))) | |
| 422 | |
| 423 (defun gdb-goto-first-gdb-instance (blist) | |
| 424 "Use gdb-mru-instance-buffer -- not this." | |
| 425 (and blist | |
| 426 (progn | |
| 427 (set-buffer (car blist)) | |
| 428 (or (and gdb-buffer-instance | |
| 429 (eq gdb-buffer-type 'gdba) | |
| 430 (car blist)) | |
| 431 (gdb-goto-first-gdb-instance (cdr blist)))))) | |
| 432 | |
| 433 (defun buffer-gdb-instance (buf) | |
| 434 (save-excursion | |
| 435 (set-buffer buf) | |
| 436 gdb-buffer-instance)) | |
| 437 | |
| 438 (defun gdb-needed-default-instance () | |
| 439 "Return the most recently used gdb instance or signal an error." | |
| 440 (let ((buffer (gdb-mru-instance-buffer))) | |
| 441 (or (and buffer (buffer-gdb-instance buffer)) | |
| 442 (error "No instance of gdb found")))) | |
| 443 | |
| 444 (defun gdb-instance-target-string (instance) | |
| 445 "The apparent name of the program being debugged by a gdb instance. | |
| 446 For sure this the root string used in smashing together the gdb | |
| 447 buffer's name, even if that doesn't happen to be the name of a | |
| 448 program." | |
| 449 (in-gdb-instance-context | |
| 450 instance | |
| 451 (function (lambda () gdb-target-name)))) | |
| 452 | |
| 453 | |
| 454 | |
| 455 ;; | |
| 456 ;; Instance Buffers. | |
| 457 ;; | |
| 458 | |
| 459 ;; More than one buffer can be associated with a gdb instance. | |
| 460 ;; | |
| 461 ;; Each buffer has a TYPE -- a symbol that identifies the function | |
| 462 ;; of that particular buffer. | |
| 463 ;; | |
| 464 ;; The usual gdb interaction buffer is given the type `gdb' and | |
| 465 ;; is constructed specially. | |
| 466 ;; | |
| 467 ;; Others are constructed by gdb-get-create-instance-buffer and | |
| 468 ;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc | |
| 469 | |
| 470 (defun gdb-get-instance-buffer (instance key) | |
| 471 "Return the instance buffer for INSTANCE tagged with type KEY. | |
| 472 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |
| 473 (save-excursion | |
| 474 (gdb-look-for-tagged-buffer instance key (buffer-list)))) | |
| 475 | |
| 476 (defun gdb-get-create-instance-buffer (instance key) | |
| 477 "Create a new gdb instance buffer of the type specified by KEY. | |
| 478 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |
| 479 (or (gdb-get-instance-buffer instance key) | |
| 480 (let* ((rules (assoc key gdb-instance-buffer-rules-assoc)) | |
| 481 (name (funcall (gdb-rules-name-maker rules) instance)) | |
| 482 (new (get-buffer-create name))) | |
| 483 (save-excursion | |
| 484 (set-buffer new) | |
| 485 (make-variable-buffer-local 'gdb-buffer-type) | |
| 486 (setq gdb-buffer-type key) | |
| 487 (make-variable-buffer-local 'gdb-buffer-instance) | |
| 488 (setq gdb-buffer-instance instance) | |
| 489 (if (cdr (cdr rules)) | |
| 490 (funcall (car (cdr (cdr rules))))) | |
| 491 new)))) | |
| 492 | |
| 493 (defun gdb-rules-name-maker (rules) (car (cdr rules))) | |
| 494 | |
| 495 (defun gdb-look-for-tagged-buffer (instance key bufs) | |
| 496 (let ((retval nil)) | |
| 497 (while (and (not retval) bufs) | |
| 498 (set-buffer (car bufs)) | |
| 499 (if (and (eq gdb-buffer-instance instance) | |
| 500 (eq gdb-buffer-type key)) | |
| 501 (setq retval (car bufs))) | |
| 502 (setq bufs (cdr bufs))) | |
| 503 retval)) | |
| 504 | |
| 505 (defun gdb-instance-buffer-p (buf) | |
| 506 (save-excursion | |
| 507 (set-buffer buf) | |
| 508 (and gdb-buffer-type | |
| 509 (not (eq gdb-buffer-type 'gdba))))) | |
| 510 | |
| 511 ;; | |
| 512 ;; This assoc maps buffer type symbols to rules. Each rule is a list of | |
| 513 ;; at least one and possible more functions. The functions have these | |
| 514 ;; roles in defining a buffer type: | |
| 515 ;; | |
| 516 ;; NAME - take an instance, return a name for this type buffer for that | |
| 517 ;; instance. | |
| 518 ;; The remaining function(s) are optional: | |
| 519 ;; | |
| 520 ;; MODE - called in new new buffer with no arguments, should establish | |
| 521 ;; the proper mode for the buffer. | |
| 522 ;; | |
| 523 | |
| 524 (defvar gdb-instance-buffer-rules-assoc '()) | |
| 525 | |
| 526 (defun gdb-set-instance-buffer-rules (buffer-type &rest rules) | |
| 527 (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc))) | |
| 528 (if binding | |
| 529 (setcdr binding rules) | |
| 530 (setq gdb-instance-buffer-rules-assoc | |
| 531 (cons (cons buffer-type rules) | |
| 532 gdb-instance-buffer-rules-assoc))))) | |
| 533 | |
| 534 ; GUD buffers are an exception to the rules | |
| 535 (gdb-set-instance-buffer-rules 'gdba 'error) | |
| 536 | |
| 537 ;; | |
| 538 ;; partial-output buffers | |
| 539 ;; | |
| 540 ;; These accumulate output from a command executed on | |
| 541 ;; behalf of emacs (rather than the user). | |
| 542 ;; | |
| 543 | |
| 544 (gdb-set-instance-buffer-rules 'gdb-partial-output-buffer | |
| 545 'gdb-partial-output-name) | |
| 546 | |
| 547 (defun gdb-partial-output-name (instance) | |
| 548 (concat "*partial-output-" | |
| 549 (gdb-instance-target-string instance) | |
| 550 "*")) | |
| 551 | |
| 552 | |
| 553 (gdb-set-instance-buffer-rules 'gdb-inferior-io | |
| 554 'gdb-inferior-io-name | |
| 555 'gdb-inferior-io-mode) | |
| 556 | |
| 557 (defun gdb-inferior-io-name (instance) | |
| 558 (concat "*input/output of " | |
| 559 (gdb-instance-target-string instance) | |
| 560 "*")) | |
| 561 | |
| 562 (defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map)) | |
| 563 (define-key comint-mode-map "\C-c\C-c" 'gdb-inferior-io-interrupt) | |
| 564 (define-key comint-mode-map "\C-c\C-z" 'gdb-inferior-io-stop) | |
| 565 (define-key comint-mode-map "\C-c\C-\\" 'gdb-inferior-io-quit) | |
| 566 (define-key comint-mode-map "\C-c\C-d" 'gdb-inferior-io-eof) | |
| 567 | |
| 568 (defun gdb-inferior-io-mode () | |
| 569 "Major mode for gdb inferior-io. | |
| 570 | |
| 571 \\{comint-mode-map}" | |
| 572 ;; We want to use comint because it has various nifty and familiar | |
| 573 ;; features. We don't need a process, but comint wants one, so create | |
| 574 ;; a dummy one. | |
| 575 (make-comint (substring (buffer-name) 1 (- (length (buffer-name)) 1)) | |
| 576 "/bin/cat") | |
| 577 (setq major-mode 'gdb-inferior-io-mode) | |
| 578 (setq mode-name "Debuggee I/O") | |
| 579 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 580 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | |
| 581 (setq comint-input-sender 'gdb-inferior-io-sender)) | |
| 582 | |
| 583 (defun gdb-inferior-io-sender (proc string) | |
| 584 (save-excursion | |
| 585 (set-buffer (process-buffer proc)) | |
| 586 (let ((instance gdb-buffer-instance)) | |
| 587 (set-buffer (gdb-get-instance-buffer instance 'gdba)) | |
| 588 (let ((gdb-proc (get-buffer-process (current-buffer)))) | |
| 589 (process-send-string gdb-proc string) | |
| 590 (process-send-string gdb-proc "\n"))))) | |
| 591 | |
| 592 (defun gdb-inferior-io-interrupt (instance) | |
| 593 "Interrupt the program being debugged." | |
| 594 (interactive (list (gdb-needed-default-instance))) | |
| 595 (interrupt-process | |
| 596 (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp)) | |
| 597 | |
| 598 (defun gdb-inferior-io-quit (instance) | |
| 599 "Send quit signal to the program being debugged." | |
| 600 (interactive (list (gdb-needed-default-instance))) | |
| 601 (quit-process | |
| 602 (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp)) | |
| 603 | |
| 604 (defun gdb-inferior-io-stop (instance) | |
| 605 "Stop the program being debugged." | |
| 606 (interactive (list (gdb-needed-default-instance))) | |
| 607 (stop-process | |
| 608 (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp)) | |
| 609 | |
| 610 (defun gdb-inferior-io-eof (instance) | |
| 611 "Send end-of-file to the program being debugged." | |
| 612 (interactive (list (gdb-needed-default-instance))) | |
| 613 (process-send-eof | |
| 614 (get-buffer-process (gdb-get-instance-buffer instance 'gdba)))) | |
| 615 | |
| 616 | |
| 617 ;; | |
| 618 ;; gdb communications | |
| 619 ;; | |
| 620 | |
| 621 ;; INPUT: things sent to gdb | |
| 622 ;; | |
| 623 ;; Each instance has a high and low priority | |
| 624 ;; input queue. Low priority input is sent only | |
| 625 ;; when the high priority queue is idle. | |
| 626 ;; | |
| 627 ;; The queues are lists. Each element is either | |
| 628 ;; a string (indicating user or user-like input) | |
| 629 ;; or a list of the form: | |
| 630 ;; | |
| 631 ;; (INPUT-STRING HANDLER-FN) | |
| 632 ;; | |
| 633 ;; | |
| 634 ;; The handler function will be called from the | |
| 635 ;; partial-output buffer when the command completes. | |
| 636 ;; This is the way to write commands which | |
| 637 ;; invoke gdb commands autonomously. | |
| 638 ;; | |
| 639 ;; These lists are consumed tail first. | |
| 640 ;; | |
| 641 | |
| 642 (defun gdb-send (proc string) | |
| 643 "A comint send filter for gdb. | |
| 644 This filter may simply queue output for a later time." | |
| 645 (let ((instance (gdb-proc->instance proc))) | |
| 646 (gdb-instance-enqueue-input instance (concat string "\n")))) | |
| 647 | |
| 648 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it | |
| 649 ;; is a query, or other non-top-level prompt. To guarantee stuff will get | |
| 650 ;; sent to the top-level prompt, currently it must be put in the idle queue. | |
| 651 ;; ^^^^^^^^^ | |
| 652 ;; [This should encourage gdb extensions that invoke gdb commands to let | |
| 653 ;; the user go first; it is not a bug. -t] | |
| 654 ;; | |
| 655 | |
| 656 (defun gdb-instance-enqueue-input (instance item) | |
| 657 (if (gdb-instance-prompting instance) | |
| 658 (progn | |
| 659 (gdb-send-item instance item) | |
| 660 (set-gdb-instance-prompting instance nil)) | |
| 661 (set-gdb-instance-input-queue | |
| 662 instance | |
| 663 (cons item (gdb-instance-input-queue instance))))) | |
| 664 | |
| 665 (defun gdb-instance-dequeue-input (instance) | |
| 666 (let ((queue (gdb-instance-input-queue instance))) | |
| 667 (and queue | |
| 668 (if (not (cdr queue)) | |
| 669 (let ((answer (car queue))) | |
| 670 (set-gdb-instance-input-queue instance '()) | |
| 671 answer) | |
| 672 (gdb-take-last-elt queue))))) | |
| 673 | |
| 674 (defun gdb-instance-enqueue-idle-input (instance item) | |
| 675 (if (and (gdb-instance-prompting instance) | |
| 676 (not (gdb-instance-input-queue instance))) | |
| 677 (progn | |
| 678 (gdb-send-item instance item) | |
| 679 (set-gdb-instance-prompting instance nil)) | |
| 680 (set-gdb-instance-idle-input-queue | |
| 681 instance | |
| 682 (cons item (gdb-instance-idle-input-queue instance))))) | |
| 683 | |
| 684 (defun gdb-instance-dequeue-idle-input (instance) | |
| 685 (let ((queue (gdb-instance-idle-input-queue instance))) | |
| 686 (and queue | |
| 687 (if (not (cdr queue)) | |
| 688 (let ((answer (car queue))) | |
| 689 (set-gdb-instance-idle-input-queue instance '()) | |
| 690 answer) | |
| 691 (gdb-take-last-elt queue))))) | |
| 692 | |
| 693 ; Don't use this in general. | |
| 694 (defun gdb-take-last-elt (l) | |
| 695 (if (cdr (cdr l)) | |
| 696 (gdb-take-last-elt (cdr l)) | |
| 697 (let ((answer (car (cdr l)))) | |
| 698 (setcdr l '()) | |
| 699 answer))) | |
| 700 | |
| 701 | |
| 702 ;; | |
| 703 ;; output -- things gdb prints to emacs | |
| 704 ;; | |
| 705 ;; GDB output is a stream interrupted by annotations. | |
| 706 ;; Annotations can be recognized by their beginning | |
| 707 ;; with \C-j\C-z\C-z<tag><opt>\C-j | |
| 708 ;; | |
| 709 ;; The tag is a string obeying symbol syntax. | |
| 710 ;; | |
| 711 ;; The optional part `<opt>' can be either the empty string | |
| 712 ;; or a space followed by more data relating to the annotation. | |
| 713 ;; For example, the SOURCE annotation is followed by a filename, | |
| 714 ;; line number and various useless goo. This data must not include | |
| 715 ;; any newlines. | |
| 716 ;; | |
| 717 | |
| 718 (defcustom gud-gdba-command-name "gdb -annotate=2" | |
| 719 "Default command to execute an executable under the GDB debugger (gdb-ui.el)." | |
| 720 :type 'string | |
| 721 :group 'gud) | |
| 722 | |
| 723 (defun gdba-marker-filter (string) | |
| 724 "A gud marker filter for gdb." | |
| 725 ;; Bogons don't tell us the process except through scoping crud. | |
| 726 (let ((instance (gdb-proc->instance proc))) | |
| 727 (gdb-output-burst instance string))) | |
| 728 | |
| 729 (defvar gdb-annotation-rules | |
| 730 '(("frames-invalid" gdb-invalidate-frame-and-assembler) | |
| 731 ("breakpoints-invalid" gdb-invalidate-breakpoints-and-assembler) | |
| 732 ("pre-prompt" gdb-pre-prompt) | |
| 733 ("prompt" gdb-prompt) | |
| 734 ("commands" gdb-subprompt) | |
| 735 ("overload-choice" gdb-subprompt) | |
| 736 ("query" gdb-subprompt) | |
| 737 ("prompt-for-continue" gdb-subprompt) | |
| 738 ("post-prompt" gdb-post-prompt) | |
| 739 ("source" gdb-source) | |
| 740 ("starting" gdb-starting) | |
| 741 ("exited" gdb-stopping) | |
| 742 ("signalled" gdb-stopping) | |
| 743 ("signal" gdb-stopping) | |
| 744 ("breakpoint" gdb-stopping) | |
| 745 ("watchpoint" gdb-stopping) | |
| 746 ("frame-begin" gdb-frame-begin) | |
| 747 ("stopped" gdb-stopped) | |
| 748 ("display-begin" gdb-display-begin) | |
| 749 ("display-end" gdb-display-end) | |
| 750 ("display-number-end" gdb-display-number-end) | |
| 751 ("array-section-begin" gdb-array-section-begin) | |
| 752 ("array-section-end" gdb-array-section-end) | |
| 753 ; ("elt" gdb-elt) | |
| 754 ("field-begin" gdb-field-begin) | |
| 755 ("field-end" gdb-field-end) | |
| 756 ) "An assoc mapping annotation tags to functions which process them.") | |
| 757 | |
| 758 (defun gdb-ignore-annotation (instance args) | |
| 759 nil) | |
| 760 | |
| 761 (defconst gdb-source-spec-regexp | |
| 762 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)") | |
| 763 | |
| 764 ;; Do not use this except as an annotation handler." | |
| 765 (defun gdb-source (instance args) | |
| 766 (string-match gdb-source-spec-regexp args) | |
| 767 ;; Extract the frame position from the marker. | |
| 768 (setq gud-last-frame | |
| 769 (cons | |
| 770 (substring args (match-beginning 1) (match-end 1)) | |
| 771 (string-to-int (substring args | |
| 772 (match-beginning 2) | |
| 773 (match-end 2))))) | |
| 774 (setq gdb-current-address (substring args (match-beginning 3) | |
| 775 (match-end 3))) | |
| 776 (setq gdb-main-or-pc gdb-current-address) | |
| 777 ;update with new frame for machine code if necessary | |
| 778 (gdb-invalidate-assembler instance)) | |
| 779 | |
| 780 ;; An annotation handler for `prompt'. | |
| 781 ;; This sends the next command (if any) to gdb. | |
| 782 (defun gdb-prompt (instance ignored) | |
| 783 (let ((sink (gdb-instance-output-sink instance))) | |
| 784 (cond | |
| 785 ((eq sink 'user) t) | |
| 786 ((eq sink 'post-emacs) | |
| 787 (set-gdb-instance-output-sink instance 'user)) | |
| 788 (t | |
| 789 (set-gdb-instance-output-sink instance 'user) | |
| 790 (error "Phase error in gdb-prompt (got %s)" sink)))) | |
| 791 (let ((highest (gdb-instance-dequeue-input instance))) | |
| 792 (if highest | |
| 793 (gdb-send-item instance highest) | |
| 794 (let ((lowest (gdb-instance-dequeue-idle-input instance))) | |
| 795 (if lowest | |
| 796 (gdb-send-item instance lowest) | |
| 797 (progn | |
| 798 (set-gdb-instance-prompting instance t) | |
| 799 (gud-display-frame))))))) | |
| 800 | |
| 801 ;; An annotation handler for non-top-level prompts. | |
| 802 (defun gdb-subprompt (instance ignored) | |
| 803 (let ((highest (gdb-instance-dequeue-input instance))) | |
| 804 (if highest | |
| 805 (gdb-send-item instance highest) | |
| 806 (set-gdb-instance-prompting instance t)))) | |
| 807 | |
| 808 (defun gdb-send-item (instance item) | |
| 809 (set-gdb-instance-current-item instance item) | |
| 810 (if (stringp item) | |
| 811 (progn | |
| 812 (set-gdb-instance-output-sink instance 'user) | |
| 813 (process-send-string (gdb-instance-process instance) | |
| 814 item)) | |
| 815 (progn | |
| 816 (gdb-clear-partial-output instance) | |
| 817 (set-gdb-instance-output-sink instance 'pre-emacs) | |
| 818 (process-send-string (gdb-instance-process instance) | |
| 819 (car item))))) | |
| 820 | |
| 821 ;; An annotation handler for `pre-prompt'. | |
| 822 ;; This terminates the collection of output from a previous | |
| 823 ;; command if that happens to be in effect. | |
| 824 (defun gdb-pre-prompt (instance ignored) | |
| 825 (let ((sink (gdb-instance-output-sink instance))) | |
| 826 (cond | |
| 827 ((eq sink 'user) t) | |
| 828 ((eq sink 'emacs) | |
| 829 (set-gdb-instance-output-sink instance 'post-emacs) | |
| 830 (let ((handler | |
| 831 (car (cdr (gdb-instance-current-item instance))))) | |
| 832 (save-excursion | |
| 833 (set-buffer (gdb-get-create-instance-buffer | |
| 834 instance 'gdb-partial-output-buffer)) | |
| 835 (funcall handler)))) | |
| 836 (t | |
| 837 (set-gdb-instance-output-sink instance 'user) | |
| 838 (error "Output sink phase error 1"))))) | |
| 839 | |
| 840 ;; An annotation handler for `starting'. This says that I/O for the subprocess | |
| 841 ;; is now the program being debugged, not GDB. | |
| 842 (defun gdb-starting (instance ignored) | |
| 843 (let ((sink (gdb-instance-output-sink instance))) | |
| 844 (cond | |
| 845 ((eq sink 'user) | |
| 846 (set-gdb-instance-output-sink instance 'inferior)) | |
| 847 (t (error "Unexpected `starting' annotation"))))) | |
| 848 | |
| 849 ;; An annotation handler for `exited' and other annotations which say that | |
| 850 ;; I/O for the subprocess is now GDB, not the program being debugged. | |
| 851 (defun gdb-stopping (instance ignored) | |
| 852 (let ((sink (gdb-instance-output-sink instance))) | |
| 853 (cond | |
| 854 ((eq sink 'inferior) | |
| 855 (set-gdb-instance-output-sink instance 'user)) | |
| 856 (t (error "Unexpected stopping annotation"))))) | |
| 857 | |
| 858 ;; An annotation handler for `stopped'. It is just like gdb-stopping, except | |
| 859 ;; that if we already set the output sink to 'user in gdb-stopping, that is | |
| 860 ;; fine. | |
| 861 (defun gdb-stopped (instance ignored) | |
| 862 (let ((sink (gdb-instance-output-sink instance))) | |
| 863 (cond | |
| 864 ((eq sink 'inferior) | |
| 865 (set-gdb-instance-output-sink instance 'user)) | |
| 866 ((eq sink 'user) t) | |
| 867 (t (error "Unexpected stopped annotation"))))) | |
| 868 | |
| 869 (defun gdb-frame-begin (instance ignored) | |
| 870 (let ((sink (gdb-instance-output-sink instance))) | |
| 871 (cond | |
| 872 ((eq sink 'inferior) | |
| 873 (set-gdb-instance-output-sink instance 'user)) | |
| 874 ((eq sink 'user) t) | |
| 875 ((eq sink 'emacs) t) | |
| 876 (t (error "Unexpected frame-begin annotation (%S)" sink))))) | |
| 877 | |
| 878 ;; An annotation handler for `post-prompt'. | |
| 879 ;; This begins the collection of output from the current | |
| 880 ;; command if that happens to be appropriate." | |
| 881 (defun gdb-post-prompt (instance ignored) | |
| 882 (if (not (gdb-instance-pending-triggers instance)) | |
| 883 (progn | |
| 884 (gdb-invalidate-registers instance ignored) | |
| 885 (gdb-invalidate-locals instance ignored) | |
| 886 (gdb-invalidate-display instance ignored))) | |
| 887 (let ((sink (gdb-instance-output-sink instance))) | |
| 888 (cond | |
| 889 ((eq sink 'user) t) | |
| 890 ((eq sink 'pre-emacs) | |
| 891 (set-gdb-instance-output-sink instance 'emacs)) | |
| 892 | |
| 893 (t | |
| 894 (set-gdb-instance-output-sink instance 'user) | |
| 895 (error "Output sink phase error 3"))))) | |
| 896 | |
| 897 ;; If we get an error whilst evaluating one of the expressions | |
| 898 ;; we won't get the display-end annotation. Set the sink back to | |
| 899 ;; user to make sure that the error message is seen | |
| 900 | |
| 901 (defun gdb-error-begin (instance ignored) | |
| 902 (set-gdb-instance-output-sink instance 'user)) | |
| 903 | |
| 904 (defun gdb-display-begin (instance ignored) | |
| 905 (if (gdb-get-instance-buffer instance 'gdb-display-buffer) | |
| 906 (progn | |
| 907 (set-gdb-instance-output-sink instance 'emacs) | |
| 908 (gdb-clear-partial-output instance) | |
| 909 (setq gdb-display-in-progress t)) | |
| 910 (set-gdb-instance-output-sink instance 'user))) | |
| 911 | |
| 912 (defun gdb-display-number-end (instance ignored) | |
| 913 (set-buffer (gdb-get-instance-buffer | |
| 914 instance 'gdb-partial-output-buffer)) | |
| 915 (setq gdb-display-number (buffer-string)) | |
| 916 (setq gdb-expression-buffer-name | |
| 917 (concat "*display " gdb-display-number "*")) | |
| 918 (save-excursion | |
| 919 (if (progn | |
| 920 (set-buffer (window-buffer)) | |
| 921 gdb-dive) | |
| 922 (progn | |
| 923 (let ((number gdb-display-number)) | |
| 924 (switch-to-buffer | |
| 925 (set-buffer (get-buffer-create gdb-expression-buffer-name))) | |
| 926 (gdb-expressions-mode) | |
| 927 (setq gdb-dive-display-number number))) | |
| 928 ;else | |
| 929 (set-buffer (get-buffer-create gdb-expression-buffer-name)) | |
| 930 (if (and (display-graphic-p) (not gdb-dive)) | |
| 931 (catch 'frame-exists | |
| 932 (let ((frames (frame-list))) | |
| 933 (while frames | |
| 934 (if (string-equal (frame-parameter (car frames) 'name) | |
| 935 gdb-expression-buffer-name) | |
| 936 (throw 'frame-exists nil)) | |
| 937 (setq frames (cdr frames))) | |
| 938 (if (not frames) | |
| 939 (progn | |
| 940 (gdb-expressions-mode) | |
| 941 (make-frame '((height . 20) (width . 40) | |
| 942 (tool-bar-lines . nil) | |
| 943 (menu-bar-lines . nil) | |
| 944 (minibuffer . nil)))))))))) | |
| 945 (set-buffer (gdb-get-instance-buffer | |
| 946 instance 'gdb-partial-output-buffer)) | |
| 947 (setq gdb-dive nil)) | |
| 948 | |
| 949 (defun gdb-display-end (instance ignored) | |
| 950 (set-buffer (gdb-get-instance-buffer instance 'gdb-partial-output-buffer)) | |
| 951 (goto-char (point-min)) | |
| 952 (search-forward ": ") | |
| 953 (looking-at "\\(.*?\\) =") | |
| 954 (let ((char "") | |
| 955 (gdb-temp-value (buffer-substring (match-beginning 1) | |
| 956 (match-end 1)))) | |
| 957 ;move * to front of expression if necessary | |
| 958 (if (looking-at ".*\\*") | |
| 959 (progn | |
| 960 (setq char "*") | |
| 961 (setq gdb-temp-value (substring gdb-temp-value 1 nil)))) | |
| 962 (save-excursion | |
| 963 (set-buffer gdb-expression-buffer-name) | |
| 964 (setq gdb-expression gdb-temp-value) | |
| 965 (if (not (string-match "::" gdb-expression)) | |
| 966 (setq gdb-expression (concat char gdb-current-frame | |
| 967 "::" gdb-expression)) | |
| 968 ;else put * back on if necessary | |
| 969 (setq gdb-expression (concat char gdb-expression))) | |
| 970 (setq header-line-format (concat "-- " gdb-expression " %-")))) | |
| 971 | |
| 972 ;-if scalar/string | |
| 973 (if (not (re-search-forward "##" nil t)) | |
| 974 (progn | |
| 975 (save-excursion | |
| 976 (set-buffer gdb-expression-buffer-name) | |
| 977 (setq buffer-read-only nil) | |
| 978 (delete-region (point-min) (point-max)) | |
| 979 (insert-buffer (gdb-get-instance-buffer | |
| 980 instance 'gdb-partial-output-buffer)) | |
| 981 (setq buffer-read-only t))) | |
| 982 ; else | |
| 983 ; display expression name... | |
| 984 (goto-char (point-min)) | |
| 985 (let ((start (progn (point))) | |
| 986 (end (progn (end-of-line) (point)))) | |
| 987 (save-excursion | |
| 988 (set-buffer gdb-expression-buffer-name) | |
| 989 (setq buffer-read-only nil) | |
| 990 (delete-region (point-min) (point-max)) | |
| 991 (insert-buffer-substring (gdb-get-instance-buffer | |
| 992 gdb-buffer-instance | |
| 993 'gdb-partial-output-buffer) | |
| 994 start end) | |
| 995 (insert "\n"))) | |
| 996 | |
| 997 (goto-char (point-min)) | |
| 998 (re-search-forward "##" nil t) | |
| 999 (setq gdb-nesting-level 0) | |
| 1000 (if (looking-at "array-section-begin") | |
| 1001 (progn | |
| 1002 (gdb-delete-line) | |
| 1003 (beginning-of-line) | |
| 1004 (setq gdb-point (point)) | |
| 1005 (gdb-array-format))) | |
| 1006 (if (looking-at "field-begin \\(.\\)") | |
| 1007 (progn | |
| 1008 (setq gdb-annotation-arg (buffer-substring (match-beginning 1) | |
| 1009 (match-end 1))) | |
| 1010 (gdb-field-format-begin)))) | |
| 1011 (save-excursion | |
| 1012 (set-buffer gdb-expression-buffer-name) | |
| 1013 (if gdb-dive-display-number | |
| 1014 (progn | |
| 1015 (setq buffer-read-only nil) | |
| 1016 (goto-char (point-max)) | |
| 1017 (insert "\n") | |
| 1018 (insert-text-button "[back]" 'type 'gdb-display-back) | |
| 1019 (setq buffer-read-only t)))) | |
| 1020 (gdb-clear-partial-output instance) | |
| 1021 (set-gdb-instance-output-sink instance 'user) | |
| 1022 (setq gdb-display-in-progress nil)) | |
| 1023 | |
| 1024 (define-button-type 'gdb-display-back | |
| 1025 'help-echo (purecopy "mouse-2, RET: go back to previous display buffer") | |
| 1026 'action (lambda (button) (gdb-display-go-back))) | |
| 1027 | |
| 1028 (defun gdb-display-go-back () | |
| 1029 ; delete display so they don't accumulate and delete buffer | |
| 1030 (let ((number gdb-display-number)) | |
| 1031 (gdb-instance-enqueue-idle-input | |
| 1032 gdb-buffer-instance | |
| 1033 (list (concat "server delete display " number "\n") | |
| 1034 '(lambda () nil))) | |
| 1035 (switch-to-buffer (concat "*display " gdb-dive-display-number "*")) | |
| 1036 (kill-buffer (get-buffer (concat "*display " number "*"))))) | |
| 1037 | |
| 1038 ; prefix annotations with ## and process whole output in one chunk | |
| 1039 ; in gdb-partial-output-buffer (to allow recursion). | |
| 1040 | |
| 1041 ; array-section flags are just removed again but after counting. They | |
| 1042 ; might also be useful for arrays of structures and structures with arrays. | |
| 1043 (defun gdb-array-section-begin (instance args) | |
| 1044 (if gdb-display-in-progress | |
| 1045 (progn | |
| 1046 (save-excursion | |
| 1047 (set-buffer (gdb-get-instance-buffer | |
| 1048 instance 'gdb-partial-output-buffer)) | |
| 1049 (goto-char (point-max)) | |
| 1050 (insert (concat "\n##array-section-begin " args "\n")))))) | |
| 1051 | |
| 1052 (defun gdb-array-section-end (instance ignored) | |
| 1053 (if gdb-display-in-progress | |
| 1054 (progn | |
| 1055 (save-excursion | |
| 1056 (set-buffer (gdb-get-instance-buffer | |
| 1057 instance 'gdb-partial-output-buffer)) | |
| 1058 (goto-char (point-max)) | |
| 1059 (insert "\n##array-section-end\n"))))) | |
| 1060 | |
| 1061 (defun gdb-field-begin (instance args) | |
| 1062 (if gdb-display-in-progress | |
| 1063 (progn | |
| 1064 (save-excursion | |
| 1065 (set-buffer (gdb-get-instance-buffer | |
| 1066 instance 'gdb-partial-output-buffer)) | |
| 1067 (goto-char (point-max)) | |
| 1068 (insert (concat "\n##field-begin " args "\n")))))) | |
| 1069 | |
| 1070 (defun gdb-field-end (instance ignored) | |
| 1071 (if gdb-display-in-progress | |
| 1072 (progn | |
| 1073 (save-excursion | |
| 1074 (set-buffer (gdb-get-instance-buffer | |
| 1075 instance 'gdb-partial-output-buffer)) | |
| 1076 (goto-char (point-max)) | |
| 1077 (insert "\n##field-end\n"))))) | |
| 1078 | |
| 1079 (defun gdb-elt (instance ignored) | |
| 1080 (if gdb-display-in-progress | |
| 1081 (progn | |
| 1082 (goto-char (point-max)) | |
| 1083 (insert "\n##elt\n")))) | |
| 1084 | |
| 1085 (defun gdb-field-format-begin () | |
| 1086 ; get rid of ##field-begin | |
| 1087 (gdb-delete-line) | |
| 1088 (gdb-insert-field) | |
| 1089 (setq gdb-nesting-level (+ gdb-nesting-level 1)) | |
| 1090 (while (re-search-forward "##" nil t) | |
| 1091 ; keep making recursive calls... | |
| 1092 (if (looking-at "field-begin \\(.\\)") | |
| 1093 (progn | |
| 1094 (setq gdb-annotation-arg (buffer-substring (match-beginning 1) | |
| 1095 (match-end 1))) | |
| 1096 (gdb-field-format-begin))) | |
| 1097 ; until field-end. | |
| 1098 (if (looking-at "field-end") (gdb-field-format-end)))) | |
| 1099 | |
| 1100 (defun gdb-field-format-end () | |
| 1101 ; get rid of ##field-end and `,' or `}' | |
| 1102 (gdb-delete-line) | |
| 1103 (gdb-delete-line) | |
| 1104 (setq gdb-nesting-level (- gdb-nesting-level 1))) | |
| 1105 | |
| 1106 (defun gdb-insert-field () | |
| 1107 (let ((start (progn (point))) | |
| 1108 (end (progn (next-line) (point))) | |
| 1109 (num 0)) | |
| 1110 (save-excursion | |
| 1111 (set-buffer gdb-expression-buffer-name) | |
| 1112 (setq buffer-read-only nil) | |
| 1113 (if (string-equal gdb-annotation-arg "\*") (insert "\*")) | |
| 1114 (while (<= num gdb-nesting-level) | |
| 1115 (insert "\t") | |
| 1116 (setq num (+ num 1))) | |
| 1117 (insert-buffer-substring (gdb-get-instance-buffer | |
| 1118 gdb-buffer-instance | |
| 1119 'gdb-partial-output-buffer) | |
| 1120 start end) | |
| 1121 (put-text-property (- (point) (- end start)) (- (point) 1) | |
| 1122 'mouse-face 'highlight) | |
| 1123 (put-text-property (- (point) (- end start)) (- (point) 1) | |
| 1124 'local-map gdb-dive-map) | |
| 1125 (setq buffer-read-only t)) | |
| 1126 (delete-region start end))) | |
| 1127 | |
| 1128 (defun gdb-array-format () | |
| 1129 (while (re-search-forward "##" nil t) | |
| 1130 ; keep making recursive calls... | |
| 1131 (if (looking-at "array-section-begin") | |
| 1132 (progn | |
| 1133 ;get rid of ##array-section-begin | |
| 1134 (gdb-delete-line) | |
| 1135 (setq gdb-nesting-level (+ gdb-nesting-level 1)) | |
| 1136 (gdb-array-format))) | |
| 1137 ;until *matching* array-section-end is found | |
| 1138 (if (looking-at "array-section-end") | |
| 1139 (if (eq gdb-nesting-level 0) | |
| 1140 (progn | |
| 1141 (let ((values (buffer-substring gdb-point (- (point) 2)))) | |
| 1142 (save-excursion | |
| 1143 (set-buffer gdb-expression-buffer-name) | |
| 1144 (setq gdb-values | |
| 1145 (concat "{" (replace-regexp-in-string "\n" "" values) | |
| 1146 "}")) | |
| 1147 (gdb-array-format1)))) | |
| 1148 ;else get rid of ##array-section-end etc | |
| 1149 (gdb-delete-line) | |
| 1150 (setq gdb-nesting-level (- gdb-nesting-level 1)) | |
| 1151 (gdb-array-format))))) | |
| 1152 | |
| 1153 (defun gdb-array-format1 () | |
| 1154 (setq gdb-display-string "") | |
| 1155 (setq buffer-read-only nil) | |
| 1156 (delete-region (point-min) (point-max)) | |
| 1157 (let ((gdb-value-list (split-string gdb-values ", "))) | |
| 1158 (string-match "\\({+\\)" (car gdb-value-list)) | |
| 1159 (let* ((depth (- (match-end 1) (match-beginning 1))) | |
| 1160 (indices (make-vector depth '0)) | |
| 1161 (index 0) (num 0) (array-start "") | |
| 1162 (array-stop "") (array-slice "") | |
| 1163 (flag t) (indices-string "")) | |
| 1164 (while gdb-value-list | |
| 1165 (string-match "{*\\([^}]*\\)\\(}*\\)" (car gdb-value-list)) | |
| 1166 (setq num 0) | |
| 1167 (while (< num depth) | |
| 1168 (setq indices-string | |
| 1169 (concat indices-string | |
| 1170 "[" (int-to-string (aref indices num)) "]")) | |
| 1171 (if (not (= (aref gdb-array-start num) -1)) | |
| 1172 (if (or (< (aref indices num) (aref gdb-array-start num)) | |
| 1173 (> (aref indices num) (aref gdb-array-stop num))) | |
| 1174 (setq flag nil)) | |
| 1175 (aset gdb-array-size num (aref indices num))) | |
| 1176 (setq num (+ num 1))) | |
| 1177 (if flag | |
| 1178 (let ((gdb-display-value (substring (car gdb-value-list) | |
| 1179 (match-beginning 1) | |
| 1180 (match-end 1)))) | |
| 1181 (setq gdb-display-string (concat gdb-display-string " " | |
| 1182 gdb-display-value)) | |
| 1183 (insert | |
| 1184 (concat indices-string "\t" gdb-display-value "\n")))) | |
| 1185 (setq indices-string "") | |
| 1186 (setq flag t) | |
| 1187 ; 0<= index < depth, start at right : (- depth 1) | |
| 1188 (setq index (- (- depth 1) | |
| 1189 (- (match-end 2) (match-beginning 2)))) | |
| 1190 ;don't set for very last brackets | |
| 1191 (if (>= index 0) | |
| 1192 (progn | |
| 1193 (aset indices index (+ 1 (aref indices index))) | |
| 1194 (setq num (+ 1 index)) | |
| 1195 (while (< num depth) | |
| 1196 (aset indices num 0) | |
| 1197 (setq num (+ num 1))))) | |
| 1198 (setq gdb-value-list (cdr gdb-value-list))) | |
| 1199 (setq num 0) | |
| 1200 (while (< num depth) | |
| 1201 (if (= (aref gdb-array-start num) -1) | |
| 1202 (progn | |
| 1203 (aset gdb-array-start num 0) | |
| 1204 (aset gdb-array-stop num (aref indices num)))) | |
| 1205 (setq array-start (int-to-string (aref gdb-array-start num))) | |
| 1206 (setq array-stop (int-to-string (aref gdb-array-stop num))) | |
| 1207 (setq array-range (concat "[" array-start | |
| 1208 ":" array-stop "]")) | |
| 1209 (put-text-property 1 (+ (length array-start) | |
| 1210 (length array-stop) 2) | |
| 1211 'mouse-face 'highlight array-range) | |
| 1212 (put-text-property 1 (+ (length array-start) | |
| 1213 (length array-stop) 2) | |
| 1214 'local-map gdb-array-slice-map array-range) | |
| 1215 (goto-char (point-min)) | |
| 1216 (setq array-slice (concat array-slice array-range)) | |
| 1217 (setq num (+ num 1))) | |
| 1218 (goto-char (point-min)) | |
| 1219 (insert "Array Size : ") | |
| 1220 (setq num 0) | |
| 1221 (while (< num depth) | |
| 1222 (insert | |
| 1223 (concat "[" | |
| 1224 (int-to-string (+ (aref gdb-array-size num) 1)) "]")) | |
| 1225 (setq num (+ num 1))) | |
| 1226 (insert | |
| 1227 (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n")))) | |
| 1228 (setq buffer-read-only t)) | |
| 1229 | |
| 1230 (defvar gdb-dive-map nil) | |
| 1231 (setq gdb-dive-map (make-keymap)) | |
| 1232 (define-key gdb-dive-map [mouse-2] 'gdb-dive) | |
| 1233 (define-key gdb-dive-map [S-mouse-2] 'gdb-dive-new-frame) | |
| 1234 | |
| 1235 (defun gdb-dive (event) | |
| 1236 "Dive into structure." | |
| 1237 (interactive "e") | |
| 1238 (setq gdb-dive t) | |
| 1239 (gdb-dive-new-frame event)) | |
| 1240 | |
| 1241 (defun gdb-dive-new-frame (event) | |
| 1242 "Dive into structure and display in a new frame." | |
| 1243 (interactive "e") | |
| 1244 (save-excursion | |
| 1245 (mouse-set-point event) | |
| 1246 (let ((point (point)) (gdb-full-expression gdb-expression) | |
| 1247 (end (progn (end-of-line) (point))) | |
| 1248 (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil)) | |
| 1249 (beginning-of-line) | |
| 1250 (if (looking-at "\*") (setq gdb-display-char "*")) | |
| 1251 (re-search-forward "\\(\\S-+\\) = " end t) | |
| 1252 (setq gdb-last-field (buffer-substring-no-properties | |
| 1253 (match-beginning 1) | |
| 1254 (match-end 1))) | |
| 1255 (goto-char (match-beginning 1)) | |
| 1256 (let ((last-column (current-column))) | |
| 1257 (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t) | |
| 1258 (goto-char (match-beginning 1)) | |
| 1259 (if (and (< (current-column) last-column) | |
| 1260 (> (count-lines 1 (point)) 1)) | |
| 1261 (progn | |
| 1262 (setq gdb-part-expression | |
| 1263 (concat "." (buffer-substring-no-properties | |
| 1264 (match-beginning 1) | |
| 1265 (match-end 1)) gdb-part-expression)) | |
| 1266 (setq last-column (current-column)))))) | |
| 1267 ; * not needed for components of a pointer to a structure in gdb | |
| 1268 (if (string-equal "*" (substring gdb-full-expression 0 1)) | |
| 1269 (setq gdb-full-expression (substring gdb-full-expression 1 nil))) | |
| 1270 (setq gdb-full-expression | |
| 1271 (concat gdb-full-expression gdb-part-expression "." gdb-last-field)) | |
| 1272 (gdb-instance-enqueue-idle-input gdb-buffer-instance | |
| 1273 (list | |
| 1274 (concat "server display" gdb-display-char | |
| 1275 " " gdb-full-expression "\n") | |
| 1276 '(lambda () nil)))))) | |
| 1277 | |
| 1278 ;; Handle a burst of output from a gdb instance. | |
| 1279 ;; This function is (indirectly) used as a gud-marker-filter. | |
| 1280 ;; It must return output (if any) to be insterted in the gdb | |
| 1281 ;; buffer. | |
| 1282 | |
| 1283 (defun gdb-output-burst (instance string) | |
| 1284 "Handle a burst of output from a gdb instance. | |
| 1285 This function is (indirectly) used as a gud-marker-filter. | |
| 1286 It must return output (if any) to be insterted in the gdb | |
| 1287 buffer." | |
| 1288 | |
| 1289 (save-match-data | |
| 1290 (let ( | |
| 1291 ;; Recall the left over burst from last time | |
| 1292 (burst (concat (gdb-instance-burst instance) string)) | |
| 1293 ;; Start accumulating output for the GUD buffer | |
| 1294 (output "")) | |
| 1295 | |
| 1296 ;; Process all the complete markers in this chunk. | |
| 1297 | |
| 1298 (while (string-match "\n\032\032\\(.*\\)\n" burst) | |
| 1299 (let ((annotation (substring burst | |
| 1300 (match-beginning 1) | |
| 1301 (match-end 1)))) | |
| 1302 | |
| 1303 ;; Stuff prior to the match is just ordinary output. | |
| 1304 ;; It is either concatenated to OUTPUT or directed | |
| 1305 ;; elsewhere. | |
| 1306 (setq output | |
| 1307 (gdb-concat-output | |
| 1308 instance | |
| 1309 output | |
| 1310 (substring burst 0 (match-beginning 0)))) | |
| 1311 | |
| 1312 ;; Take that stuff off the burst. | |
| 1313 (setq burst (substring burst (match-end 0))) | |
| 1314 | |
| 1315 ;; Parse the tag from the annotation, and maybe its arguments. | |
| 1316 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) | |
| 1317 (let* ((annotation-type (substring annotation | |
| 1318 (match-beginning 1) | |
| 1319 (match-end 1))) | |
| 1320 (annotation-arguments (substring annotation | |
| 1321 (match-beginning 2) | |
| 1322 (match-end 2))) | |
| 1323 (annotation-rule (assoc annotation-type | |
| 1324 gdb-annotation-rules))) | |
| 1325 ;; Call the handler for this annotation. | |
| 1326 (if annotation-rule | |
| 1327 (funcall (car (cdr annotation-rule)) | |
| 1328 instance | |
| 1329 annotation-arguments) | |
| 1330 ;; Else the annotation is not recognized. Ignore it silently, | |
| 1331 ;; so that GDB can add new annotations without causing | |
| 1332 ;; us to blow up. | |
| 1333 )))) | |
| 1334 | |
| 1335 | |
| 1336 ;; Does the remaining text end in a partial line? | |
| 1337 ;; If it does, then keep part of the burst until we get more. | |
| 1338 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" | |
| 1339 burst) | |
| 1340 (progn | |
| 1341 ;; Everything before the potential marker start can be output. | |
| 1342 (setq output | |
| 1343 (gdb-concat-output | |
| 1344 instance | |
| 1345 output | |
| 1346 (substring burst 0 (match-beginning 0)))) | |
| 1347 | |
| 1348 ;; Everything after, we save, to combine with later input. | |
| 1349 (setq burst (substring burst (match-beginning 0)))) | |
| 1350 | |
| 1351 ;; In case we know the burst contains no partial annotations: | |
| 1352 (progn | |
| 1353 (setq output (gdb-concat-output instance output burst)) | |
| 1354 (setq burst ""))) | |
| 1355 | |
| 1356 ;; Save the remaining burst for the next call to this function. | |
| 1357 (set-gdb-instance-burst instance burst) | |
| 1358 output))) | |
| 1359 | |
| 1360 (defun gdb-concat-output (instance so-far new) | |
| 1361 (let ((sink (gdb-instance-output-sink instance))) | |
| 1362 (cond | |
| 1363 ((eq sink 'user) (concat so-far new)) | |
| 1364 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) | |
| 1365 ((eq sink 'emacs) | |
| 1366 (gdb-append-to-partial-output instance new) | |
| 1367 so-far) | |
| 1368 ((eq sink 'inferior) | |
| 1369 (gdb-append-to-inferior-io instance new) | |
| 1370 so-far) | |
| 1371 (t (error "Bogon output sink %S" sink))))) | |
| 1372 | |
| 1373 (defun gdb-append-to-partial-output (instance string) | |
| 1374 (save-excursion | |
| 1375 (set-buffer | |
| 1376 (gdb-get-create-instance-buffer | |
| 1377 instance 'gdb-partial-output-buffer)) | |
| 1378 (goto-char (point-max)) | |
| 1379 (insert string))) | |
| 1380 | |
| 1381 (defun gdb-clear-partial-output (instance) | |
| 1382 (save-excursion | |
| 1383 (set-buffer | |
| 1384 (gdb-get-create-instance-buffer | |
| 1385 instance 'gdb-partial-output-buffer)) | |
| 1386 (delete-region (point-min) (point-max)))) | |
| 1387 | |
| 1388 (defun gdb-append-to-inferior-io (instance string) | |
| 1389 (save-excursion | |
| 1390 (set-buffer | |
| 1391 (gdb-get-create-instance-buffer | |
| 1392 instance 'gdb-inferior-io)) | |
| 1393 (goto-char (point-max)) | |
| 1394 (insert-before-markers string)) | |
| 1395 (gdb-display-buffer | |
| 1396 (gdb-get-create-instance-buffer instance | |
| 1397 'gdb-inferior-io))) | |
| 1398 | |
| 1399 (defun gdb-clear-inferior-io (instance) | |
| 1400 (save-excursion | |
| 1401 (set-buffer | |
| 1402 (gdb-get-create-instance-buffer | |
| 1403 instance 'gdb-inferior-io)) | |
| 1404 (delete-region (point-min) (point-max)))) | |
| 1405 | |
| 1406 | |
| 1407 | |
| 1408 ;; One trick is to have a command who's output is always available in | |
| 1409 ;; a buffer of it's own, and is always up to date. We build several | |
| 1410 ;; buffers of this type. | |
| 1411 ;; | |
| 1412 ;; There are two aspects to this: gdb has to tell us when the output | |
| 1413 ;; for that command might have changed, and we have to be able to run | |
| 1414 ;; the command behind the user's back. | |
| 1415 ;; | |
| 1416 ;; The idle input queue and the output phasing associated with | |
| 1417 ;; the instance variable `(gdb-instance-output-sink instance)' help | |
| 1418 ;; us to run commands behind the user's back. | |
| 1419 ;; | |
| 1420 ;; Below is the code for specificly managing buffers of output from one | |
| 1421 ;; command. | |
| 1422 ;; | |
| 1423 | |
| 1424 | |
| 1425 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES | |
| 1426 ;; It adds an idle input for the command we are tracking. It should be the | |
| 1427 ;; annotation rule binding of whatever gdb sends to tell us this command | |
| 1428 ;; might have changed it's output. | |
| 1429 ;; | |
| 1430 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed. | |
| 1431 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the | |
| 1432 ;; input in the input queue (see comment about ``gdb communications'' above). | |
| 1433 (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler) | |
| 1434 `(defun ,name (instance &optional ignored) | |
| 1435 (if (and (,demand-predicate instance) | |
| 1436 (not (member ',name | |
| 1437 (gdb-instance-pending-triggers instance)))) | |
| 1438 (progn | |
| 1439 (gdb-instance-enqueue-idle-input | |
| 1440 instance | |
| 1441 (list ,gdb-command ',output-handler)) | |
| 1442 (set-gdb-instance-pending-triggers | |
| 1443 instance | |
| 1444 (cons ',name | |
| 1445 (gdb-instance-pending-triggers instance))))))) | |
| 1446 | |
| 1447 (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) | |
| 1448 `(defun ,name () | |
| 1449 (set-gdb-instance-pending-triggers | |
| 1450 instance | |
| 1451 (delq ',trigger | |
| 1452 (gdb-instance-pending-triggers instance))) | |
| 1453 (let ((buf (gdb-get-instance-buffer instance | |
| 1454 ',buf-key))) | |
| 1455 (and buf | |
| 1456 (save-excursion | |
| 1457 (set-buffer buf) | |
| 1458 (let ((p (point)) | |
| 1459 (buffer-read-only nil)) | |
| 1460 (delete-region (point-min) (point-max)) | |
| 1461 (insert-buffer (gdb-get-create-instance-buffer | |
| 1462 instance | |
| 1463 'gdb-partial-output-buffer)) | |
| 1464 (goto-char p))))) | |
| 1465 ; put customisation here | |
| 1466 (,custom-defun))) | |
| 1467 | |
| 1468 (defmacro def-gdb-auto-updated-buffer | |
| 1469 (buffer-key trigger-name gdb-command output-handler-name custom-defun) | |
| 1470 `(progn | |
| 1471 (def-gdb-auto-update-trigger ,trigger-name | |
| 1472 ;; The demand predicate: | |
| 1473 (lambda (instance) | |
| 1474 (gdb-get-instance-buffer instance ',buffer-key)) | |
| 1475 ,gdb-command | |
| 1476 ,output-handler-name) | |
| 1477 (def-gdb-auto-update-handler ,output-handler-name | |
| 1478 ,trigger-name ,buffer-key ,custom-defun))) | |
| 1479 | |
| 1480 | |
| 1481 ;; | |
| 1482 ;; Breakpoint buffers | |
| 1483 ;; | |
| 1484 ;; These display the output of `info breakpoints'. | |
| 1485 ;; | |
| 1486 | |
| 1487 | |
| 1488 (gdb-set-instance-buffer-rules 'gdb-breakpoints-buffer | |
| 1489 'gdb-breakpoints-buffer-name | |
| 1490 'gdb-breakpoints-mode) | |
| 1491 | |
| 1492 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer | |
| 1493 ;; This defines the auto update rule for buffers of type | |
| 1494 ;; `gdb-breakpoints-buffer'. | |
| 1495 ;; | |
| 1496 ;; It defines a function to serve as the annotation handler that | |
| 1497 ;; handles the `foo-invalidated' message. That function is called: | |
| 1498 gdb-invalidate-breakpoints | |
| 1499 | |
| 1500 ;; To update the buffer, this command is sent to gdb. | |
| 1501 "server info breakpoints\n" | |
| 1502 | |
| 1503 ;; This also defines a function to be the handler for the output | |
| 1504 ;; from the command above. That function will copy the output into | |
| 1505 ;; the appropriately typed buffer. That function will be called: | |
| 1506 gdb-info-breakpoints-handler | |
| 1507 ;; buffer specific functions | |
| 1508 gdb-info-breakpoints-custom) | |
| 1509 | |
| 1510 ;-put breakpoint icons in relevant margins (even those set in the GUD buffer) | |
| 1511 (defun gdb-info-breakpoints-custom () | |
| 1512 (let ((flag)(address)) | |
| 1513 | |
| 1514 ; remove all breakpoint-icons in source buffers but not assembler buffer | |
| 1515 (let ((buffers (buffer-list))) | |
| 1516 (save-excursion | |
| 1517 (while buffers | |
| 1518 (set-buffer (car buffers)) | |
| 1519 (if (and (eq gud-minor-mode 'gdba) | |
| 1520 (not (string-match "^\*" (buffer-name)))) | |
| 1521 (if (display-graphic-p) | |
| 1522 (remove-images (point-min) (point-max)) | |
| 1523 (remove-strings (point-min) (point-max)))) | |
| 1524 (setq buffers (cdr buffers))))) | |
| 1525 | |
| 1526 (save-excursion | |
| 1527 (set-buffer (gdb-get-instance-buffer instance 'gdb-breakpoints-buffer)) | |
| 1528 (save-excursion | |
| 1529 (goto-char (point-min)) | |
| 1530 (while (< (point) (- (point-max) 1)) | |
| 1531 (forward-line 1) | |
| 1532 (if (looking-at "[^\t].*breakpoint") | |
| 1533 (progn | |
| 1534 (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)") | |
| 1535 (setq flag (char-after (match-beginning 2))) | |
| 1536 (beginning-of-line) | |
| 1537 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+") | |
| 1538 (looking-at "\\(\\S-*\\):\\([0-9]+\\)") | |
| 1539 (let ((line (buffer-substring (match-beginning 2) | |
| 1540 (match-end 2))) | |
| 1541 (file (buffer-substring (match-beginning 1) | |
| 1542 (match-end 1)))) | |
| 1543 (save-excursion | |
| 1544 (set-buffer | |
| 1545 (if (file-exists-p file) | |
| 1546 (find-file-noselect file) | |
| 1547 ;else | |
| 1548 (find-file-noselect (concat gdb-cdir "/" file)))) | |
| 1549 (with-current-buffer (current-buffer) | |
| 1550 (progn | |
| 1551 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 1552 (set (make-local-variable 'tool-bar-map) | |
| 1553 gud-tool-bar-map) | |
| 1554 (set (make-variable-buffer-local 'left-margin-width) 2) | |
| 1555 (if (get-buffer-window (current-buffer)) | |
| 1556 (set-window-margins (get-buffer-window | |
| 1557 (current-buffer)) | |
| 1558 left-margin-width | |
| 1559 right-margin-width)))) | |
| 1560 ; only want one breakpoint icon at each location | |
| 1561 (save-excursion | |
| 1562 (goto-line (string-to-number line)) | |
| 1563 (let ((start (progn (beginning-of-line) (- (point) 1))) | |
| 1564 (end (progn (end-of-line) (+ (point) 1)))) | |
| 1565 (if (display-graphic-p) | |
| 1566 (progn | |
| 1567 (remove-images start end) | |
| 1568 (if (eq ?y flag) | |
| 1569 (put-image breakpoint-enabled-icon (point) | |
| 1570 "breakpoint icon enabled" | |
| 1571 'left-margin) | |
| 1572 (put-image breakpoint-disabled-icon (point) | |
| 1573 "breakpoint icon disabled" | |
| 1574 'left-margin))) | |
| 1575 (remove-strings start end) | |
| 1576 (if (eq ?y flag) | |
| 1577 (put-string "B" (point) "enabled" | |
| 1578 'left-margin) | |
| 1579 (put-string "b" (point) "disabled" | |
| 1580 'left-margin))))))))) | |
| 1581 (end-of-line)))))) | |
| 1582 | |
| 1583 (defun gdb-breakpoints-buffer-name (instance) | |
| 1584 (save-excursion | |
| 1585 (set-buffer (process-buffer (gdb-instance-process instance))) | |
| 1586 (concat "*breakpoints of " (gdb-instance-target-string instance) "*"))) | |
| 1587 | |
| 1588 (defun gdb-display-breakpoints-buffer (instance) | |
| 1589 (interactive (list (gdb-needed-default-instance))) | |
| 1590 (gdb-display-buffer | |
| 1591 (gdb-get-create-instance-buffer instance | |
| 1592 'gdb-breakpoints-buffer))) | |
| 1593 | |
| 1594 (defun gdb-frame-breakpoints-buffer (instance) | |
| 1595 (interactive (list (gdb-needed-default-instance))) | |
| 1596 (switch-to-buffer-other-frame | |
| 1597 (gdb-get-create-instance-buffer instance | |
| 1598 'gdb-breakpoints-buffer))) | |
| 1599 | |
| 1600 (defvar gdb-breakpoints-mode-map nil) | |
| 1601 (setq gdb-breakpoints-mode-map (make-keymap)) | |
| 1602 (suppress-keymap gdb-breakpoints-mode-map) | |
| 1603 | |
| 1604 (define-key gdb-breakpoints-mode-map [menu-bar breakpoints] | |
| 1605 (cons "Breakpoints" (make-sparse-keymap "Breakpoints"))) | |
| 1606 (define-key gdb-breakpoints-mode-map [menu-bar breakpoints toggle] | |
| 1607 '("Toggle" . gdb-toggle-bp-this-line)) | |
| 1608 (define-key gdb-breakpoints-mode-map [menu-bar breakpoints delete] | |
| 1609 '("Delete" . gdb-delete-bp-this-line)) | |
| 1610 (define-key gdb-breakpoints-mode-map [menu-bar breakpoints goto] | |
| 1611 '("Goto" . gdb-goto-bp-this-line)) | |
| 1612 | |
| 1613 (define-key gdb-breakpoints-mode-map " " 'gdb-toggle-bp-this-line) | |
| 1614 (define-key gdb-breakpoints-mode-map "d" 'gdb-delete-bp-this-line) | |
| 1615 (define-key gdb-breakpoints-mode-map "g" 'gdb-goto-bp-this-line) | |
| 1616 | |
| 1617 (defun gdb-breakpoints-mode () | |
| 1618 "Major mode for gdb breakpoints. | |
| 1619 | |
| 1620 \\{gdb-breakpoints-mode-map}" | |
| 1621 (setq major-mode 'gdb-breakpoints-mode) | |
| 1622 (setq mode-name "Breakpoints") | |
| 1623 (use-local-map gdb-breakpoints-mode-map) | |
| 1624 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 1625 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | |
| 1626 (setq buffer-read-only t) | |
| 1627 (gdb-invalidate-breakpoints gdb-buffer-instance)) | |
| 1628 | |
| 1629 (defun gdb-toggle-bp-this-line () | |
| 1630 (interactive) | |
| 1631 (save-excursion | |
| 1632 (beginning-of-line 1) | |
| 1633 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) | |
| 1634 (error "Not recognized as break/watchpoint line") | |
| 1635 (Gdb-instance-enqueue-idle-input | |
| 1636 gdb-buffer-instance | |
| 1637 (list | |
| 1638 (concat | |
| 1639 (if (eq ?y (char-after (match-beginning 2))) | |
| 1640 "server disable " | |
| 1641 "server enable ") | |
| 1642 (buffer-substring (match-beginning 0) | |
| 1643 (match-end 1)) | |
| 1644 "\n") | |
| 1645 '(lambda () nil)))))) | |
| 1646 | |
| 1647 (defun gdb-delete-bp-this-line () | |
| 1648 (interactive) | |
| 1649 (beginning-of-line 1) | |
| 1650 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) | |
| 1651 (error "Not recognized as break/watchpoint line") | |
| 1652 (gdb-instance-enqueue-idle-input | |
| 1653 gdb-buffer-instance | |
| 1654 (list | |
| 1655 (concat | |
| 1656 "server delete " | |
| 1657 (buffer-substring (match-beginning 0) | |
| 1658 (match-end 1)) | |
| 1659 "\n") | |
| 1660 '(lambda () nil))))) | |
| 1661 | |
| 1662 (defun gdb-goto-bp-this-line () | |
| 1663 "Display the file at the breakpoint specified." | |
| 1664 (interactive) | |
| 1665 (save-excursion | |
| 1666 (beginning-of-line 1) | |
| 1667 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+") | |
| 1668 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")) | |
| 1669 (let ((line (buffer-substring (match-beginning 2) | |
| 1670 (match-end 2))) | |
| 1671 (file (buffer-substring (match-beginning 1) | |
| 1672 (match-end 1)))) | |
| 1673 (if (file-exists-p file) | |
| 1674 (set-window-buffer gdb-source-window (find-file-noselect file)) | |
| 1675 ;else | |
| 1676 (setq file (concat gdb-cdir "/" file)) | |
| 1677 (set-window-buffer gdb-source-window (find-file-noselect file))) | |
| 1678 (goto-line (string-to-number line)))) | |
| 1679 | |
| 1680 ;; | |
| 1681 ;; Frames buffers. These display a perpetually correct bactracktrace | |
| 1682 ;; (from the command `where'). | |
| 1683 ;; | |
| 1684 ;; Alas, if your stack is deep, they are costly. | |
| 1685 ;; | |
| 1686 | |
| 1687 (gdb-set-instance-buffer-rules 'gdb-stack-buffer | |
| 1688 'gdb-stack-buffer-name | |
| 1689 'gdb-frames-mode) | |
| 1690 | |
| 1691 (def-gdb-auto-updated-buffer gdb-stack-buffer | |
| 1692 gdb-invalidate-frames | |
| 1693 "server where\n" | |
| 1694 gdb-info-frames-handler | |
| 1695 gdb-info-frames-custom) | |
| 1696 | |
| 1697 (defun gdb-info-frames-custom () | |
| 1698 (save-excursion | |
| 1699 (set-buffer (gdb-get-instance-buffer instance 'gdb-stack-buffer)) | |
| 1700 (let ((buffer-read-only nil)) | |
| 1701 (goto-char (point-min)) | |
| 1702 (looking-at "\\S-*\\s-*\\(\\S-*\\)") | |
| 1703 (setq gdb-current-frame (buffer-substring (match-beginning 1) (match-end 1))) | |
| 1704 (while (< (point) (point-max)) | |
| 1705 (put-text-property (progn (beginning-of-line) (point)) | |
| 1706 (progn (end-of-line) (point)) | |
| 1707 'mouse-face 'highlight) | |
| 1708 (forward-line 1))))) | |
| 1709 | |
| 1710 (defun gdb-stack-buffer-name (instance) | |
| 1711 (save-excursion | |
| 1712 (set-buffer (process-buffer (gdb-instance-process instance))) | |
| 1713 (concat "*stack frames of " | |
| 1714 (gdb-instance-target-string instance) "*"))) | |
| 1715 | |
| 1716 (defun gdb-display-stack-buffer (instance) | |
| 1717 (interactive (list (gdb-needed-default-instance))) | |
| 1718 (gdb-display-buffer | |
| 1719 (gdb-get-create-instance-buffer instance | |
| 1720 'gdb-stack-buffer))) | |
| 1721 | |
| 1722 (defun gdb-frame-stack-buffer (instance) | |
| 1723 (interactive (list (gdb-needed-default-instance))) | |
| 1724 (switch-to-buffer-other-frame | |
| 1725 (gdb-get-create-instance-buffer instance | |
| 1726 'gdb-stack-buffer))) | |
| 1727 | |
| 1728 (defvar gdb-frames-mode-map nil) | |
| 1729 (setq gdb-frames-mode-map (make-keymap)) | |
| 1730 (suppress-keymap gdb-frames-mode-map) | |
| 1731 (define-key gdb-frames-mode-map [mouse-2] | |
| 1732 'gdb-frames-select-by-mouse) | |
| 1733 | |
| 1734 (defun gdb-frames-mode () | |
| 1735 "Major mode for gdb frames. | |
| 1736 | |
| 1737 \\{gdb-frames-mode-map}" | |
| 1738 (setq major-mode 'gdb-frames-mode) | |
| 1739 (setq mode-name "Frames") | |
| 1740 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 1741 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | |
| 1742 (setq buffer-read-only t) | |
| 1743 (use-local-map gdb-frames-mode-map) | |
| 1744 (gdb-invalidate-frames gdb-buffer-instance)) | |
| 1745 | |
| 1746 (defun gdb-get-frame-number () | |
| 1747 (save-excursion | |
| 1748 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t)) | |
| 1749 (n (or (and pos | |
| 1750 (string-to-int | |
| 1751 (buffer-substring (match-beginning 1) | |
| 1752 (match-end 1)))) | |
| 1753 0))) | |
| 1754 n))) | |
| 1755 | |
| 1756 (defun gdb-frames-select-by-mouse (e) | |
| 1757 "Display the source of the selected frame." | |
| 1758 (interactive "e") | |
| 1759 (let (selection) | |
| 1760 (save-excursion | |
| 1761 (set-buffer (window-buffer (posn-window (event-end e)))) | |
| 1762 (save-excursion | |
| 1763 (goto-char (posn-point (event-end e))) | |
| 1764 (setq selection (gdb-get-frame-number)))) | |
| 1765 (select-window (posn-window (event-end e))) | |
| 1766 (save-excursion | |
| 1767 (set-buffer (gdb-get-instance-buffer (gdb-needed-default-instance) 'gdba)) | |
| 1768 (gdb-instance-enqueue-idle-input | |
| 1769 gdb-buffer-instance | |
| 1770 (list | |
| 1771 (concat (gud-format-command "server frame %p" selection) | |
| 1772 "\n") | |
| 1773 '(lambda () nil))) | |
| 1774 (gud-display-frame)))) | |
| 1775 | |
| 1776 | |
| 1777 ;; | |
| 1778 ;; Registers buffers | |
| 1779 ;; | |
| 1780 | |
| 1781 (def-gdb-auto-updated-buffer gdb-registers-buffer | |
| 1782 gdb-invalidate-registers | |
| 1783 "server info registers\n" | |
| 1784 gdb-info-registers-handler | |
| 1785 gdb-info-registers-custom) | |
| 1786 | |
| 1787 (defun gdb-info-registers-custom ()) | |
| 1788 | |
| 1789 (gdb-set-instance-buffer-rules 'gdb-registers-buffer | |
| 1790 'gdb-registers-buffer-name | |
| 1791 'gdb-registers-mode) | |
| 1792 | |
| 1793 (defvar gdb-registers-mode-map nil) | |
| 1794 (setq gdb-registers-mode-map (make-keymap)) | |
| 1795 (suppress-keymap gdb-registers-mode-map) | |
| 1796 | |
| 1797 (defun gdb-registers-mode () | |
| 1798 "Major mode for gdb registers. | |
| 1799 | |
| 1800 \\{gdb-registers-mode-map}" | |
| 1801 (setq major-mode 'gdb-registers-mode) | |
| 1802 (setq mode-name "Registers") | |
| 1803 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 1804 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | |
| 1805 (setq buffer-read-only t) | |
| 1806 (use-local-map gdb-registers-mode-map) | |
| 1807 (gdb-invalidate-registers gdb-buffer-instance)) | |
| 1808 | |
| 1809 (defun gdb-registers-buffer-name (instance) | |
| 1810 (save-excursion | |
| 1811 (set-buffer (process-buffer (gdb-instance-process instance))) | |
| 1812 (concat "*registers of " (gdb-instance-target-string instance) "*"))) | |
| 1813 | |
| 1814 (defun gdb-display-registers-buffer (instance) | |
| 1815 (interactive (list (gdb-needed-default-instance))) | |
| 1816 (gdb-display-buffer | |
| 1817 (gdb-get-create-instance-buffer instance | |
| 1818 'gdb-registers-buffer))) | |
| 1819 | |
| 1820 (defun gdb-frame-registers-buffer (instance) | |
| 1821 (interactive (list (gdb-needed-default-instance))) | |
| 1822 (switch-to-buffer-other-frame | |
| 1823 (gdb-get-create-instance-buffer instance | |
| 1824 'gdb-registers-buffer))) | |
| 1825 | |
| 1826 ;; | |
| 1827 ;; Locals buffers | |
| 1828 ;; | |
| 1829 | |
| 1830 (def-gdb-auto-updated-buffer gdb-locals-buffer | |
| 1831 gdb-invalidate-locals | |
| 1832 "server info locals\n" | |
| 1833 gdb-info-locals-handler | |
| 1834 gdb-info-locals-custom) | |
| 1835 | |
| 1836 | |
| 1837 ;Abbreviate for arrays and structures. These can be expanded using gud-display | |
| 1838 (defun gdb-info-locals-handler nil | |
| 1839 (set-gdb-instance-pending-triggers | |
| 1840 instance (delq (quote gdb-invalidate-locals) | |
| 1841 (gdb-instance-pending-triggers instance))) | |
| 1842 (let ((buf (gdb-get-instance-buffer instance | |
| 1843 (quote gdb-partial-output-buffer)))) | |
| 1844 (save-excursion | |
| 1845 (set-buffer buf) | |
| 1846 (goto-char (point-min)) | |
| 1847 (replace-regexp "^ .*\n" "") | |
| 1848 (goto-char (point-min)) | |
| 1849 (replace-regexp "{[-0-9, {}\]*\n" "(array);\n"))) | |
| 1850 (goto-char (point-min)) | |
| 1851 (replace-regexp "{.*=.*\n" "(structure);\n") | |
| 1852 (let ((buf (gdb-get-instance-buffer instance (quote gdb-locals-buffer)))) | |
| 1853 (and buf (save-excursion | |
| 1854 (set-buffer buf) | |
| 1855 (let ((p (point)) | |
| 1856 (buffer-read-only nil)) | |
| 1857 (delete-region (point-min) (point-max)) | |
| 1858 (insert-buffer (gdb-get-create-instance-buffer | |
| 1859 instance | |
| 1860 (quote gdb-partial-output-buffer))) | |
| 1861 (goto-char p))))) | |
| 1862 (run-hooks (quote gdb-info-locals-hook))) | |
| 1863 | |
| 1864 (defun gdb-info-locals-custom () | |
| 1865 nil) | |
| 1866 | |
| 1867 (gdb-set-instance-buffer-rules 'gdb-locals-buffer | |
| 1868 'gdb-locals-buffer-name | |
| 1869 'gdb-locals-mode) | |
| 1870 | |
| 1871 (defvar gdb-locals-mode-map nil) | |
| 1872 (setq gdb-locals-mode-map (make-keymap)) | |
| 1873 (suppress-keymap gdb-locals-mode-map) | |
| 1874 | |
| 1875 (defun gdb-locals-mode () | |
| 1876 "Major mode for gdb locals. | |
| 1877 | |
| 1878 \\{gdb-locals-mode-map}" | |
| 1879 (setq major-mode 'gdb-locals-mode) | |
| 1880 (setq mode-name "Locals") | |
| 1881 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 1882 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | |
| 1883 (setq buffer-read-only t) | |
| 1884 (use-local-map gdb-locals-mode-map) | |
| 1885 (gdb-invalidate-locals gdb-buffer-instance)) | |
| 1886 | |
| 1887 (defun gdb-locals-buffer-name (instance) | |
| 1888 (save-excursion | |
| 1889 (set-buffer (process-buffer (gdb-instance-process instance))) | |
| 1890 (concat "*locals of " (gdb-instance-target-string instance) "*"))) | |
| 1891 | |
| 1892 (defun gdb-display-locals-buffer (instance) | |
| 1893 (interactive (list (gdb-needed-default-instance))) | |
| 1894 (gdb-display-buffer | |
| 1895 (gdb-get-create-instance-buffer instance | |
| 1896 'gdb-locals-buffer))) | |
| 1897 | |
| 1898 (defun gdb-frame-locals-buffer (instance) | |
| 1899 (interactive (list (gdb-needed-default-instance))) | |
| 1900 (switch-to-buffer-other-frame | |
| 1901 (gdb-get-create-instance-buffer instance | |
| 1902 'gdb-locals-buffer))) | |
| 1903 ;; | |
| 1904 ;; Display expression buffers (just allow one to start with) | |
| 1905 ;; | |
| 1906 (gdb-set-instance-buffer-rules 'gdb-display-buffer | |
| 1907 'gdb-display-buffer-name | |
| 1908 'gdb-display-mode) | |
| 1909 | |
| 1910 (def-gdb-auto-updated-buffer gdb-display-buffer | |
| 1911 ;; This defines the auto update rule for buffers of type | |
| 1912 ;; `gdb-display-buffer'. | |
| 1913 ;; | |
| 1914 ;; It defines a function to serve as the annotation handler that | |
| 1915 ;; handles the `foo-invalidated' message. That function is called: | |
| 1916 gdb-invalidate-display | |
| 1917 | |
| 1918 ;; To update the buffer, this command is sent to gdb. | |
| 1919 "server info display\n" | |
| 1920 | |
| 1921 ;; This also defines a function to be the handler for the output | |
| 1922 ;; from the command above. That function will copy the output into | |
| 1923 ;; the appropriately typed buffer. That function will be called: | |
| 1924 gdb-info-display-handler | |
| 1925 ; buffer specific functions | |
| 1926 gdb-info-display-custom) | |
| 1927 | |
| 1928 (defun gdb-info-display-custom () | |
| 1929 ; TODO: ensure frames of expressions that have been deleted are also deleted | |
| 1930 ; these can be missed currently eg through GUD buffer, restarting a | |
| 1931 ; recompiled program. | |
| 1932 ) | |
| 1933 | |
| 1934 (defvar gdb-display-mode-map nil) | |
| 1935 (setq gdb-display-mode-map (make-keymap)) | |
| 1936 (suppress-keymap gdb-display-mode-map) | |
| 1937 | |
| 1938 (define-key gdb-display-mode-map [menu-bar display] | |
| 1939 (cons "Display" (make-sparse-keymap "Display"))) | |
| 1940 (define-key gdb-display-mode-map [menu-bar display toggle] | |
| 1941 '("Toggle" . gdb-toggle-disp-this-line)) | |
| 1942 (define-key gdb-display-mode-map [menu-bar display delete] | |
| 1943 '("Delete" . gdb-delete-disp-this-line)) | |
| 1944 | |
| 1945 (define-key gdb-display-mode-map " " 'gdb-toggle-disp-this-line) | |
| 1946 (define-key gdb-display-mode-map "d" 'gdb-delete-disp-this-line) | |
| 1947 | |
| 1948 (defun gdb-display-mode () | |
| 1949 "Major mode for gdb display. | |
| 1950 | |
| 1951 \\{gdb-display-mode-map}" | |
| 1952 (setq major-mode 'gdb-display-mode) | |
| 1953 (setq mode-name "Display") | |
| 1954 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 1955 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | |
| 1956 (setq buffer-read-only t) | |
| 1957 (use-local-map gdb-display-mode-map) | |
| 1958 (gdb-invalidate-display gdb-buffer-instance)) | |
| 1959 | |
| 1960 (defun gdb-display-buffer-name (instance) | |
| 1961 (save-excursion | |
| 1962 (set-buffer (process-buffer (gdb-instance-process instance))) | |
| 1963 (concat "*Displayed expressions of " (gdb-instance-target-string instance) "*"))) | |
| 1964 | |
| 1965 (defun gdb-display-display-buffer (instance) | |
| 1966 (interactive (list (gdb-needed-default-instance))) | |
| 1967 (gdb-display-buffer | |
| 1968 (gdb-get-create-instance-buffer instance | |
| 1969 'gdb-display-buffer))) | |
| 1970 | |
| 1971 (defun gdb-frame-display-buffer (instance) | |
| 1972 (interactive (list (gdb-needed-default-instance))) | |
| 1973 (switch-to-buffer-other-frame | |
| 1974 (gdb-get-create-instance-buffer instance | |
| 1975 'gdb-display-buffer))) | |
| 1976 | |
| 1977 (defun gdb-toggle-disp-this-line () | |
| 1978 (interactive) | |
| 1979 (save-excursion | |
| 1980 (beginning-of-line 1) | |
| 1981 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) | |
| 1982 (error "No expression on this line") | |
| 1983 (gdb-instance-enqueue-idle-input | |
| 1984 gdb-buffer-instance | |
| 1985 (list | |
| 1986 (concat | |
| 1987 (if (eq ?y (char-after (match-beginning 2))) | |
| 1988 "server disable display " | |
| 1989 "server enable display ") | |
| 1990 (buffer-substring (match-beginning 0) | |
| 1991 (match-end 1)) | |
| 1992 "\n") | |
| 1993 '(lambda () nil)))))) | |
| 1994 | |
| 1995 (defun gdb-delete-disp-this-line () | |
| 1996 (interactive) | |
| 1997 (save-excursion | |
| 1998 (set-buffer | |
| 1999 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-display-buffer)) | |
| 2000 (beginning-of-line 1) | |
| 2001 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) | |
| 2002 (error "No expression on this line") | |
| 2003 (let ((number (buffer-substring (match-beginning 0) | |
| 2004 (match-end 1)))) | |
| 2005 (gdb-instance-enqueue-idle-input | |
| 2006 gdb-buffer-instance | |
| 2007 (list (concat "server delete display " number "\n") | |
| 2008 '(lambda () nil))) | |
| 2009 (if (not (display-graphic-p)) | |
| 2010 (kill-buffer (get-buffer (concat "*display " number "*"))) | |
| 2011 ;else | |
| 2012 (catch 'frame-found | |
| 2013 (let ((frames (frame-list))) | |
| 2014 (while frames | |
| 2015 (if (string-equal (frame-parameter (car frames) 'name) | |
| 2016 (concat "*display " number "*")) | |
| 2017 (progn (kill-buffer | |
| 2018 (get-buffer (concat "*display " number "*"))) | |
| 2019 (delete-frame (car frames)) | |
| 2020 (throw 'frame-found nil))) | |
| 2021 (setq frames (cdr frames)))))))))) | |
| 2022 | |
| 2023 (defvar gdb-expressions-mode-map nil) | |
| 2024 (setq gdb-expressions-mode-map (make-keymap)) | |
| 2025 (suppress-keymap gdb-expressions-mode-map) | |
| 2026 | |
| 2027 (defvar gdb-expressions-mode-menu | |
| 2028 '("GDB Expressions Commands" | |
| 2029 "----" | |
| 2030 ["Visualise" gdb-array-visualise t] | |
| 2031 ["Delete" gdb-delete-display t]) | |
| 2032 "Menu for `gdb-expressions-mode'.") | |
| 2033 | |
| 2034 (define-key gdb-expressions-mode-map "v" 'gdb-array-visualise) | |
| 2035 (define-key gdb-expressions-mode-map "q" 'gdb-delete-display) | |
| 2036 (define-key gdb-expressions-mode-map [mouse-3] 'gdb-expressions-popup-menu) | |
| 2037 | |
| 2038 (defun gdb-expressions-popup-menu (event) | |
| 2039 "Explicit Popup menu as this buffer doesn't have a menubar." | |
| 2040 (interactive "@e") | |
| 2041 (mouse-set-point event) | |
| 2042 (popup-menu gdb-expressions-mode-menu)) | |
| 2043 | |
| 2044 (defun gdb-expressions-mode () | |
| 2045 "Major mode for display expressions. | |
| 2046 | |
| 2047 \\{gdb-expressions-mode-map}" | |
| 2048 (setq major-mode 'gdb-expressions-mode) | |
| 2049 (setq mode-name "Expressions") | |
| 2050 (use-local-map gdb-expressions-mode-map) | |
| 2051 (make-local-variable 'gdb-display-number) | |
| 2052 (make-local-variable 'gdb-values) | |
| 2053 (make-local-variable 'gdb-expression) | |
| 2054 (set (make-local-variable 'gdb-display-string) nil) | |
| 2055 (set (make-local-variable 'gdb-dive-display-number) nil) | |
| 2056 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 2057 (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1)) | |
| 2058 (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1)) | |
| 2059 (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1)) | |
| 2060 (setq buffer-read-only t)) | |
| 2061 | |
| 2062 | |
| 2063 ;;;; Window management | |
| 2064 | |
| 2065 ;;; FIXME: This should only return true for buffers in the current instance | |
| 2066 (defun gdb-protected-buffer-p (buffer) | |
| 2067 "Is BUFFER a buffer which we want to leave displayed?" | |
| 2068 (save-excursion | |
| 2069 (set-buffer buffer) | |
| 2070 (or gdb-buffer-type | |
| 2071 overlay-arrow-position))) | |
| 2072 | |
| 2073 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems | |
| 2074 ;;; to do the right thing. Seeing as there is no way for Lisp code to | |
| 2075 ;;; get at the use_time field of a window, I'm not sure there exists a | |
| 2076 ;;; more elegant solution without writing C code. | |
| 2077 | |
| 2078 (defun gdb-display-buffer (buf &optional size) | |
| 2079 (let ((must-split nil) | |
| 2080 (answer nil)) | |
| 2081 (unwind-protect | |
| 2082 (progn | |
| 2083 (walk-windows | |
| 2084 '(lambda (win) | |
| 2085 (if (gdb-protected-buffer-p (window-buffer win)) | |
| 2086 (set-window-dedicated-p win t)))) | |
| 2087 (setq answer (get-buffer-window buf)) | |
| 2088 (if (not answer) | |
| 2089 (let ((window (get-lru-window))) | |
| 2090 (if window | |
| 2091 (progn | |
| 2092 (set-window-buffer window buf) | |
| 2093 (setq answer window)) | |
| 2094 (setq must-split t))))) | |
| 2095 (walk-windows | |
| 2096 '(lambda (win) | |
| 2097 (if (gdb-protected-buffer-p (window-buffer win)) | |
| 2098 (set-window-dedicated-p win nil))))) | |
| 2099 (if must-split | |
| 2100 (let* ((largest (get-largest-window)) | |
| 2101 (cur-size (window-height largest)) | |
| 2102 (new-size (and size (< size cur-size) (- cur-size size)))) | |
| 2103 (setq answer (split-window largest new-size)) | |
| 2104 (set-window-buffer answer buf))) | |
| 2105 answer)) | |
| 2106 | |
| 2107 (defun gdb-display-source-buffer (buffer) | |
| 2108 (set-window-buffer gdb-source-window buffer)) | |
| 2109 | |
| 2110 | |
| 2111 ;;; Shared keymap initialization: | |
| 2112 | |
| 2113 (defun gdb-display-gdb-buffer (instance) | |
| 2114 (interactive (list (gdb-needed-default-instance))) | |
| 2115 (gdb-display-buffer | |
| 2116 (gdb-get-create-instance-buffer instance 'gdba))) | |
| 2117 | |
| 2118 (defun make-windows-menu (map) | |
| 2119 (define-key map [menu-bar displays] | |
| 2120 (cons "GDB-Windows" (make-sparse-keymap "GDB-Windows"))) | |
| 2121 (define-key map [menu-bar displays gdb] | |
| 2122 '("Gdb" . gdb-display-gdb-buffer)) | |
| 2123 (define-key map [menu-bar displays locals] | |
| 2124 '("Locals" . gdb-display-locals-buffer)) | |
| 2125 (define-key map [menu-bar displays registers] | |
| 2126 '("Registers" . gdb-display-registers-buffer)) | |
| 2127 (define-key map [menu-bar displays frames] | |
| 2128 '("Stack" . gdb-display-stack-buffer)) | |
| 2129 (define-key map [menu-bar displays breakpoints] | |
| 2130 '("Breakpoints" . gdb-display-breakpoints-buffer)) | |
| 2131 (define-key map [menu-bar displays display] | |
| 2132 '("Display" . gdb-display-display-buffer)) | |
| 2133 (define-key map [menu-bar displays assembler] | |
| 2134 '("Assembler" . gdb-display-assembler-buffer))) | |
| 2135 | |
| 2136 (define-key gud-minor-mode-map "\C-c\M-\C-r" 'gdb-display-registers-buffer) | |
| 2137 (define-key gud-minor-mode-map "\C-c\M-\C-f" 'gdb-display-stack-buffer) | |
| 2138 (define-key gud-minor-mode-map "\C-c\M-\C-b" 'gdb-display-breakpoints-buffer) | |
| 2139 | |
| 2140 (make-windows-menu gud-minor-mode-map) | |
| 2141 | |
| 2142 (defun gdb-frame-gdb-buffer (instance) | |
| 2143 (interactive (list (gdb-needed-default-instance))) | |
| 2144 (switch-to-buffer-other-frame | |
| 2145 (gdb-get-create-instance-buffer instance 'gdba))) | |
| 2146 | |
| 2147 (defun make-frames-menu (map) | |
| 2148 (define-key map [menu-bar frames] | |
| 2149 (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames"))) | |
| 2150 (define-key map [menu-bar frames gdb] | |
| 2151 '("Gdb" . gdb-frame-gdb-buffer)) | |
| 2152 (define-key map [menu-bar frames locals] | |
| 2153 '("Locals" . gdb-frame-locals-buffer)) | |
| 2154 (define-key map [menu-bar frames registers] | |
| 2155 '("Registers" . gdb-frame-registers-buffer)) | |
| 2156 (define-key map [menu-bar frames frames] | |
| 2157 '("Stack" . gdb-frame-stack-buffer)) | |
| 2158 (define-key map [menu-bar frames breakpoints] | |
| 2159 '("Breakpoints" . gdb-frame-breakpoints-buffer)) | |
| 2160 (define-key map [menu-bar frames display] | |
| 2161 '("Display" . gdb-frame-display-buffer)) | |
| 2162 (define-key map [menu-bar frames assembler] | |
| 2163 '("Assembler" . gdb-frame-assembler-buffer))) | |
| 2164 | |
| 2165 (if (display-graphic-p) | |
| 2166 (make-frames-menu gud-minor-mode-map)) | |
| 2167 | |
| 2168 (defvar gdb-target-name "--unknown--" | |
| 2169 "The apparent name of the program being debugged in a gud buffer.") | |
| 2170 | |
| 2171 (defun gdb-proc-died (proc) | |
| 2172 ;; Stop displaying an arrow in a source file. | |
| 2173 (setq overlay-arrow-position nil) | |
| 2174 | |
| 2175 ;; Kill the dummy process, so that C-x C-c won't worry about it. | |
| 2176 (save-excursion | |
| 2177 (set-buffer (process-buffer proc)) | |
| 2178 (kill-process | |
| 2179 (get-buffer-process | |
| 2180 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-inferior-io))))) | |
| 2181 ;; end of functions from gdba.el | |
| 2182 | |
| 2183 ;; new functions for gdb-ui.el | |
| 2184 ;; layout for all the windows | |
| 2185 (defun gdb-setup-windows (instance) | |
| 2186 (gdb-display-locals-buffer instance) | |
| 2187 (gdb-display-stack-buffer instance) | |
| 2188 (delete-other-windows) | |
| 2189 (gdb-display-breakpoints-buffer instance) | |
| 2190 (gdb-display-display-buffer instance) | |
| 2191 (delete-other-windows) | |
| 2192 (split-window nil ( / ( * (window-height) 3) 4)) | |
| 2193 (split-window nil ( / (window-height) 3)) | |
| 2194 (split-window-horizontally) | |
| 2195 (other-window 1) | |
| 2196 (switch-to-buffer (gdb-locals-buffer-name instance)) | |
| 2197 (other-window 1) | |
| 2198 (switch-to-buffer | |
| 2199 (if gud-last-last-frame | |
| 2200 (gud-find-file (car gud-last-last-frame)) | |
| 2201 (gud-find-file gdb-main-file))) | |
| 2202 (setq gdb-source-window (get-buffer-window (current-buffer))) | |
| 2203 (split-window-horizontally) | |
| 2204 (other-window 1) | |
| 2205 (switch-to-buffer (gdb-inferior-io-name instance)) | |
| 2206 (other-window 1) | |
| 2207 (switch-to-buffer (gdb-stack-buffer-name instance)) | |
| 2208 (split-window-horizontally) | |
| 2209 (other-window 1) | |
| 2210 (switch-to-buffer (gdb-breakpoints-buffer-name instance)) | |
| 2211 (other-window 1)) | |
| 2212 | |
| 2213 (defun gdb-restore-windows () | |
| 2214 "Restore the basic arrangement of windows used by gdba. | |
| 2215 This arrangement depends on the value of `gdb-many-windows'" | |
| 2216 (interactive) | |
| 2217 (if gdb-many-windows | |
| 2218 (progn | |
| 2219 (switch-to-buffer gud-comint-buffer) | |
| 2220 (delete-other-windows) | |
| 2221 (gdb-setup-windows gdb-buffer-instance)) | |
| 2222 ;else | |
| 2223 (switch-to-buffer gud-comint-buffer) | |
| 2224 (delete-other-windows) | |
| 2225 (split-window) | |
| 2226 (other-window 1) | |
| 2227 (switch-to-buffer | |
| 2228 (if gud-last-last-frame | |
| 2229 (gud-find-file (car gud-last-last-frame)) | |
| 2230 (gud-find-file gdb-main-file))) | |
| 2231 (other-window 1))) | |
| 2232 | |
| 2233 (defun toggle-gdb-windows () | |
| 2234 "Toggle the number of windows in the basic arrangement." | |
| 2235 (interactive) | |
| 2236 (if gdb-many-windows | |
| 2237 (progn | |
| 2238 (switch-to-buffer gud-comint-buffer) | |
| 2239 (delete-other-windows) | |
| 2240 (split-window) | |
| 2241 (other-window 1) | |
| 2242 (switch-to-buffer | |
| 2243 (if gud-last-last-frame | |
| 2244 (gud-find-file (car gud-last-last-frame)) | |
| 2245 (gud-find-file gdb-main-file))) | |
| 2246 (other-window 1) | |
| 2247 (setq gdb-many-windows nil)) | |
| 2248 ;else | |
| 2249 (switch-to-buffer gud-comint-buffer) | |
| 2250 (delete-other-windows) | |
| 2251 (gdb-setup-windows gdb-buffer-instance) | |
| 2252 (setq gdb-many-windows t))) | |
| 2253 | |
| 2254 (defconst breakpoint-xpm-data "/* XPM */ | |
| 2255 static char *magick[] = { | |
| 2256 /* columns rows colors chars-per-pixel */ | |
| 2257 \"12 12 2 1\", | |
| 2258 \" c red\", | |
| 2259 \"+ c None\", | |
| 2260 /* pixels */ | |
| 2261 \"+++++ +++++\", | |
| 2262 \"+++ +++\", | |
| 2263 \"++ ++\", | |
| 2264 \"+ +\", | |
| 2265 \"+ +\", | |
| 2266 \" \", | |
| 2267 \" \", | |
| 2268 \"+ +\", | |
| 2269 \"+ +\", | |
| 2270 \"++ ++\", | |
| 2271 \"+++ +++\", | |
| 2272 \"+++++ +++++\" | |
| 2273 };" | |
| 2274 "XPM file used for breakpoint icon.") | |
| 2275 | |
| 2276 (setq breakpoint-enabled-icon (find-image | |
| 2277 `((:type xpm :data ,breakpoint-xpm-data)))) | |
| 2278 (setq breakpoint-disabled-icon (find-image | |
| 2279 `((:type xpm :data ,breakpoint-xpm-data | |
| 2280 :conversion laplace)))) | |
| 2281 | |
| 2282 (defun gdb-quit () | |
| 2283 "Kill the GUD and ancillary (including source) buffers. | |
| 2284 Just the partial-output buffer is left." | |
| 2285 (interactive) | |
| 2286 (let ((buffers (buffer-list))) | |
| 2287 (save-excursion | |
| 2288 (while buffers | |
| 2289 (set-buffer (car buffers)) | |
| 2290 (if (eq gud-minor-mode 'gdba) | |
| 2291 (if (string-match "^\*" (buffer-name)) | |
| 2292 (kill-buffer nil) | |
| 2293 (if (display-graphic-p) | |
| 2294 (remove-images (point-min) (point-max)) | |
| 2295 (remove-strings (point-min) (point-max))) | |
| 2296 (setq left-margin-width 0) | |
| 2297 (if (get-buffer-window (current-buffer)) | |
| 2298 (set-window-margins (get-buffer-window | |
| 2299 (current-buffer)) | |
| 2300 left-margin-width | |
| 2301 right-margin-width)))) | |
| 2302 (setq buffers (cdr buffers))))) | |
| 2303 (if (eq (selected-window) (minibuffer-window)) | |
| 2304 (other-window 1)) | |
| 2305 (delete-other-windows)) | |
| 2306 | |
| 2307 (defun gdb-source-info () | |
| 2308 (goto-char (point-min)) | |
| 2309 (re-search-forward "directory is ") | |
| 2310 (looking-at "\\(\\S-*\\)") | |
| 2311 (setq gdb-cdir (buffer-substring (match-beginning 1) (match-end 1))) | |
| 2312 (re-search-forward "Located in ") | |
| 2313 (looking-at "\\(\\S-*\\)") | |
| 2314 (setq gdb-main-file (buffer-substring (match-beginning 1) (match-end 1))) | |
| 2315 ;; Make sure we are not in the minibuffer window when we try to delete | |
| 2316 ;; all other windows. | |
| 2317 (if (eq (selected-window) (minibuffer-window)) | |
| 2318 (other-window 1)) | |
| 2319 (delete-other-windows) | |
| 2320 (if gdb-many-windows | |
| 2321 (gdb-setup-windows gdb-buffer-instance) | |
| 2322 ;else | |
| 2323 (gdb-display-breakpoints-buffer gdb-buffer-instance) | |
| 2324 (gdb-display-display-buffer instance) | |
| 2325 (gdb-display-stack-buffer instance) | |
| 2326 (delete-other-windows) | |
| 2327 (split-window) | |
| 2328 (other-window 1) | |
| 2329 (switch-to-buffer (gud-find-file gdb-main-file)) | |
| 2330 (other-window 1) | |
| 2331 (setq gdb-source-window (get-buffer-window (current-buffer))))) | |
| 2332 | |
| 2333 ;from put-image | |
| 2334 (defun put-string (putstring pos &optional string area) | |
| 2335 "Put string PUTSTRING in front of POS in the current buffer. | |
| 2336 PUTSTRING is displayed by putting an overlay into the current buffer with a | |
| 2337 `before-string' STRING that has a `display' property whose value is | |
| 2338 PUTSTRING. STRING is defaulted if you omit it. | |
| 2339 POS may be an integer or marker. | |
| 2340 AREA is where to display the string. AREA nil or omitted means | |
| 2341 display it in the text area, a value of `left-margin' means | |
| 2342 display it in the left marginal area, a value of `right-margin' | |
| 2343 means display it in the right marginal area." | |
| 2344 (unless string (setq string "x")) | |
| 2345 (let ((buffer (current-buffer))) | |
| 2346 (unless (or (null area) (memq area '(left-margin right-margin))) | |
| 2347 (error "Invalid area %s" area)) | |
| 2348 (setq string (copy-sequence string)) | |
| 2349 (let ((overlay (make-overlay pos pos buffer)) | |
| 2350 (prop (if (null area) putstring (list (list 'margin area) putstring)))) | |
| 2351 (put-text-property 0 (length string) 'display prop string) | |
| 2352 (overlay-put overlay 'put-text t) | |
| 2353 (overlay-put overlay 'before-string string)))) | |
| 2354 | |
| 2355 ;from remove-images | |
| 2356 (defun remove-strings (start end &optional buffer) | |
| 2357 "Remove strings between START and END in BUFFER. | |
| 2358 Remove only images that were put in BUFFER with calls to `put-string'. | |
| 2359 BUFFER nil or omitted means use the current buffer." | |
| 2360 (unless buffer | |
| 2361 (setq buffer (current-buffer))) | |
| 2362 (let ((overlays (overlays-in start end))) | |
| 2363 (while overlays | |
| 2364 (let ((overlay (car overlays))) | |
| 2365 (when (overlay-get overlay 'put-text) | |
| 2366 (delete-overlay overlay))) | |
| 2367 (setq overlays (cdr overlays))))) | |
| 2368 | |
| 2369 (defun put-arrow (putstring pos &optional string area) | |
| 2370 "Put arrow string PUTSTRING in front of POS in the current buffer. | |
| 2371 PUTSTRING is displayed by putting an overlay into the current buffer with a | |
| 2372 `before-string' \"gdb-arrow\" that has a `display' property whose value is | |
| 2373 PUTSTRING. STRING is defaulted if you omit it. | |
| 2374 POS may be an integer or marker. | |
| 2375 AREA is where to display the string. AREA nil or omitted means | |
| 2376 display it in the text area, a value of `left-margin' means | |
| 2377 display it in the left marginal area, a value of `right-margin' | |
| 2378 means display it in the right marginal area." | |
| 2379 (setq string "gdb-arrow") | |
| 2380 (let ((buffer (current-buffer))) | |
| 2381 (unless (or (null area) (memq area '(left-margin right-margin))) | |
| 2382 (error "Invalid area %s" area)) | |
| 2383 (setq string (copy-sequence string)) | |
| 2384 (let ((overlay (make-overlay pos pos buffer)) | |
| 2385 (prop (if (null area) putstring (list (list 'margin area) putstring)))) | |
| 2386 (put-text-property 0 (length string) 'display prop string) | |
| 2387 (overlay-put overlay 'put-text t) | |
| 2388 (overlay-put overlay 'before-string string)))) | |
| 2389 | |
| 2390 (defun remove-arrow (&optional buffer) | |
| 2391 "Remove arrow in BUFFER. | |
| 2392 Remove only images that were put in BUFFER with calls to `put-arrow'. | |
| 2393 BUFFER nil or omitted means use the current buffer." | |
| 2394 (unless buffer | |
| 2395 (setq buffer (current-buffer))) | |
| 2396 (let ((overlays (overlays-in (point-min) (point-max)))) | |
| 2397 (while overlays | |
| 2398 (let ((overlay (car overlays))) | |
| 2399 (when (string-equal (overlay-get overlay 'before-string) "gdb-arrow") | |
| 2400 (delete-overlay overlay))) | |
| 2401 (setq overlays (cdr overlays))))) | |
| 2402 | |
| 2403 (defvar gdb-array-slice-map nil) | |
| 2404 (setq gdb-array-slice-map (make-keymap)) | |
| 2405 (define-key gdb-array-slice-map [mouse-2] 'gdb-array-slice) | |
| 2406 | |
| 2407 (defun gdb-array-slice (event) | |
| 2408 "Select an array slice to display." | |
| 2409 (interactive "e") | |
| 2410 (mouse-set-point event) | |
| 2411 (save-excursion | |
| 2412 (let ((n -1) (stop 0) (start 0) (point (point))) | |
| 2413 (beginning-of-line) | |
| 2414 (while (search-forward "[" point t) | |
| 2415 (setq n (+ n 1))) | |
| 2416 (setq start (string-to-int (read-string "Start index: "))) | |
| 2417 (aset gdb-array-start n start) | |
| 2418 (setq stop (string-to-int (read-string "Stop index: "))) | |
| 2419 (aset gdb-array-stop n stop))) | |
| 2420 (gdb-array-format1)) | |
| 2421 | |
| 2422 (defun gdb-array-visualise () | |
| 2423 "Visualise arrays and slices using graph program from plotutils." | |
| 2424 (Interactive) | |
| 2425 (if (and (display-graphic-p) gdb-display-string) | |
| 2426 (let ((n 0) m) | |
| 2427 (catch 'multi-dimensional | |
| 2428 (while (eq (aref gdb-array-start n) (aref gdb-array-stop n)) | |
| 2429 (setq n (+ n 1))) | |
| 2430 (setq m (+ n 1)) | |
| 2431 (while (< m (length gdb-array-start)) | |
| 2432 (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m))) | |
| 2433 (progn | |
| 2434 (x-popup-dialog | |
| 2435 t `(,(concat "Only one dimensional data can be visualised.\n" | |
| 2436 "Use an array slice to reduce the number of\n" | |
| 2437 "dimensions") ("OK" t))) | |
| 2438 (throw 'multi-dimensional)) | |
| 2439 (setq m (+ m 1)))) | |
| 2440 (shell-command (concat "echo" gdb-display-string " | graph -a 1 " | |
| 2441 (int-to-string (aref gdb-array-start n)) | |
| 2442 " -x " | |
| 2443 (int-to-string (aref gdb-array-start n)) | |
| 2444 " " | |
| 2445 (int-to-string (aref gdb-array-stop n)) | |
| 2446 " 1 -T X")))))) | |
| 2447 | |
| 2448 (defun gdb-delete-display () | |
| 2449 "Delete displayed expression and its frame." | |
| 2450 (interactive) | |
| 2451 (gdb-instance-enqueue-idle-input | |
| 2452 gdb-buffer-instance | |
| 2453 (list (concat "server delete display " gdb-display-number "\n") | |
| 2454 '(lambda () nil))) | |
| 2455 (kill-buffer nil) | |
| 2456 (delete-frame)) | |
| 2457 | |
| 2458 ;; | |
| 2459 ;; Assembler buffer | |
| 2460 ;; | |
| 2461 | |
| 2462 (def-gdb-auto-updated-buffer gdb-assembler-buffer | |
| 2463 gdb-invalidate-assembler | |
| 2464 (concat "server disassemble " gdb-main-or-pc "\n") | |
| 2465 gdb-assembler-handler | |
| 2466 gdb-assembler-custom) | |
| 2467 | |
| 2468 (defun gdb-assembler-custom () | |
| 2469 (let ((buffer (gdb-get-instance-buffer gdb-buffer-instance | |
| 2470 'gdb-assembler-buffer)) | |
| 2471 (gdb-arrow-position)) | |
| 2472 (if gdb-current-address | |
| 2473 (progn | |
| 2474 (save-excursion | |
| 2475 (set-buffer buffer) | |
| 2476 (remove-arrow) | |
| 2477 (goto-char (point-min)) | |
| 2478 (re-search-forward gdb-current-address) | |
| 2479 (setq gdb-arrow-position (point)) | |
| 2480 (put-arrow "=>" gdb-arrow-position nil 'left-margin)))) | |
| 2481 | |
| 2482 ; remove all breakpoint-icons in assembler buffer before updating. | |
| 2483 (save-excursion | |
| 2484 (set-buffer buffer) | |
| 2485 (if (display-graphic-p) | |
| 2486 (remove-images (point-min) (point-max)) | |
| 2487 (remove-strings (point-min) (point-max)))) | |
| 2488 (save-excursion | |
| 2489 (set-buffer (gdb-get-instance-buffer instance 'gdb-breakpoints-buffer)) | |
| 2490 (goto-char (point-min)) | |
| 2491 (while (< (point) (- (point-max) 1)) | |
| 2492 (forward-line 1) | |
| 2493 (if (looking-at "[^\t].*breakpoint") | |
| 2494 (progn | |
| 2495 (looking-at | |
| 2496 "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x0\\(\\S-*\\)") | |
| 2497 ; info break gives '0x0' (8 digit) while dump gives '0x' (7 digit) | |
| 2498 (setq address (concat "0x" (buffer-substring (match-beginning 3) | |
| 2499 (match-end 3)))) | |
| 2500 (setq flag (char-after (match-beginning 2))) | |
| 2501 (save-excursion | |
| 2502 (set-buffer buffer) | |
| 2503 (goto-char (point-min)) | |
| 2504 (if (re-search-forward address nil t) | |
| 2505 (let ((start (progn (beginning-of-line) (- (point) 1))) | |
| 2506 (end (progn (end-of-line) (+ (point) 1)))) | |
| 2507 (if (display-graphic-p) | |
| 2508 (progn | |
| 2509 (remove-images start end) | |
| 2510 (if (eq ?y flag) | |
| 2511 (put-image breakpoint-enabled-icon (point) | |
| 2512 "breakpoint icon enabled" | |
| 2513 'left-margin) | |
| 2514 (put-image breakpoint-disabled-icon (point) | |
| 2515 "breakpoint icon disabled" | |
| 2516 'left-margin))) | |
| 2517 (remove-strings start end) | |
| 2518 (if (eq ?y flag) | |
| 2519 (put-string "B" (point) "enabled" 'left-margin) | |
| 2520 (put-string "b" (point) "disabled" | |
| 2521 'left-margin)))))))))) | |
| 2522 (if gdb-current-address | |
| 2523 (set-window-point (get-buffer-window buffer) gdb-arrow-position)))) | |
| 2524 | |
| 2525 (gdb-set-instance-buffer-rules 'gdb-assembler-buffer | |
| 2526 'gdb-assembler-buffer-name | |
| 2527 'gdb-assembler-mode) | |
| 2528 | |
| 2529 (defvar gdb-assembler-mode-map nil) | |
| 2530 (setq gdb-assembler-mode-map (make-keymap)) | |
| 2531 (suppress-keymap gdb-assembler-mode-map) | |
| 2532 | |
| 2533 (defun gdb-assembler-mode () | |
| 2534 "Major mode for viewing code assembler. | |
| 2535 | |
| 2536 \\{gdb-assembler-mode-map}" | |
| 2537 (setq major-mode 'gdb-assembler-mode) | |
| 2538 (setq mode-name "Assembler") | |
| 2539 (set (make-local-variable 'gud-minor-mode) 'gdba) | |
| 2540 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | |
| 2541 (set (make-variable-buffer-local 'left-margin-width) 2) | |
| 2542 (setq buffer-read-only t) | |
| 2543 (use-local-map gdb-assembler-mode-map) | |
| 2544 (gdb-invalidate-assembler gdb-buffer-instance) | |
| 2545 (gdb-invalidate-breakpoints gdb-buffer-instance)) | |
| 2546 | |
| 2547 (defun gdb-assembler-buffer-name (instance) | |
| 2548 (save-excursion | |
| 2549 (set-buffer (process-buffer (gdb-instance-process instance))) | |
| 2550 (concat "*Machine Code " (gdb-instance-target-string instance) "*"))) | |
| 2551 | |
| 2552 (defun gdb-display-assembler-buffer (instance) | |
| 2553 (interactive (list (gdb-needed-default-instance))) | |
| 2554 (gdb-display-buffer | |
| 2555 (gdb-get-create-instance-buffer instance | |
| 2556 'gdb-assembler-buffer))) | |
| 2557 | |
| 2558 (defun gdb-frame-assembler-buffer (instance) | |
| 2559 (interactive (list (gdb-needed-default-instance))) | |
| 2560 (switch-to-buffer-other-frame | |
| 2561 (gdb-get-create-instance-buffer instance | |
| 2562 'gdb-assembler-buffer))) | |
| 2563 | |
| 2564 (defun gdb-invalidate-frame-and-assembler (instance &optional ignored) | |
| 2565 (gdb-invalidate-frames instance) | |
| 2566 (gdb-invalidate-assembler instance)) | |
| 2567 | |
| 2568 (defun gdb-invalidate-breakpoints-and-assembler (instance &optional ignored) | |
| 2569 (gdb-invalidate-breakpoints instance) | |
| 2570 (gdb-invalidate-assembler instance)) | |
| 2571 | |
| 2572 ; modified because if gdb-main-or-pc has changed value a new command | |
| 2573 ; must be enqueued to update the buffer with the new output | |
| 2574 (defun gdb-invalidate-assembler (instance &optional ignored) | |
| 2575 (if (and ((lambda (instance) | |
| 2576 (gdb-get-instance-buffer instance | |
| 2577 (quote gdb-assembler-buffer))) instance) | |
| 2578 (or (not (member (quote gdb-invalidate-assembler) | |
| 2579 (gdb-instance-pending-triggers instance))) | |
| 2580 (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc)))) | |
| 2581 (progn | |
| 2582 | |
| 2583 ; take previous disassemble command off the queue | |
| 2584 (save-excursion | |
| 2585 (set-buffer (gdb-get-instance-buffer instance 'gdba)) | |
| 2586 (let ((queue gdb-idle-input-queue) (item)) | |
| 2587 (while queue | |
| 2588 (setq item (car queue)) | |
| 2589 (if (equal (cdr item) '(gdb-assembler-handler)) | |
| 2590 (delete item gdb-idle-input-queue)) | |
| 2591 (setq queue (cdr queue))))) | |
| 2592 | |
| 2593 (gdb-instance-enqueue-idle-input | |
| 2594 instance (list (concat "server disassemble " gdb-main-or-pc "\n") | |
| 2595 (quote gdb-assembler-handler))) | |
| 2596 (set-gdb-instance-pending-triggers | |
| 2597 instance (cons (quote gdb-invalidate-assembler) | |
| 2598 (gdb-instance-pending-triggers instance))) | |
| 2599 (setq gdb-prev-main-or-pc gdb-main-or-pc)))) | |
| 2600 | |
| 2601 (defun gdb-delete-line () | |
| 2602 "Delete current line." | |
| 2603 (interactive) | |
| 2604 (let ((start (progn (beginning-of-line) (point))) | |
| 2605 (end (progn (end-of-line) (+ (point) 1)))) | |
| 2606 (delete-region start end))) | |
| 2607 | |
| 2608 (provide 'gdb-ui) | |
| 2609 | |
| 2610 ;;; gdb-ui.el ends here |