diff options
| -rw-r--r-- | lisp/ChangeLog | 3 | ||||
| -rw-r--r-- | lisp/gdb-ui.el | 920 |
2 files changed, 398 insertions, 525 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 113add1006c..a5b211ae393 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,8 @@ | |||
| 1 | 2002-11-23 Nick Roberts <nick@nick.uklinux.net> | 1 | 2002-11-23 Nick Roberts <nick@nick.uklinux.net> |
| 2 | 2 | ||
| 3 | * tooltip.el (tooltip-gud-print-command): Add server prefix to the | ||
| 4 | print command for gdb to keep it out of the command history. | ||
| 5 | |||
| 3 | * gdb-ui.el: Major re-organisation. Simplify legacy gdba | 6 | * gdb-ui.el: Major re-organisation. Simplify legacy gdba |
| 4 | code to allow only one gdb process. | 7 | code to allow only one gdb process. |
| 5 | 8 | ||
diff --git a/lisp/gdb-ui.el b/lisp/gdb-ui.el index 735efcbada5..336c9d94826 100644 --- a/lisp/gdb-ui.el +++ b/lisp/gdb-ui.el | |||
| @@ -37,38 +37,14 @@ Use `toggle-gdb-windows' to change this value during a gdb session" | |||
| 37 | :type 'boolean | 37 | :type 'boolean |
| 38 | :group 'gud) | 38 | :group 'gud) |
| 39 | 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.") | 40 | (defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.") |
| 43 | (defvar gdb-prev-main-or-pc nil) | ||
| 44 | (defvar gdb-current-address nil) | 41 | (defvar gdb-current-address nil) |
| 45 | (defvar gdb-current-frame nil) | ||
| 46 | (defvar gdb-display-in-progress nil) | 42 | (defvar gdb-display-in-progress nil) |
| 47 | (defvar gdb-dive nil) | 43 | (defvar gdb-dive nil) |
| 48 | (defvar gdb-first-time nil) | 44 | (defvar gdb-first-time nil) |
| 49 | (defvar breakpoint-enabled-icon | 45 | (defvar gdb-proc nil "The process associated with gdb.") |
| 50 | "Icon for enabled breakpoint in display margin") | ||
| 51 | (defvar breakpoint-disabled-icon | ||
| 52 | "Icon for disabled breakpoint in display margin") | ||
| 53 | (defvar gdb-nesting-level) | ||
| 54 | (defvar gdb-expression-buffer-name) | ||
| 55 | (defvar gdb-expression) | ||
| 56 | (defvar gdb-point) | ||
| 57 | (defvar gdb-annotation-arg) | ||
| 58 | (defvar gdb-array-start) | ||
| 59 | (defvar gdb-array-stop) | ||
| 60 | (defvar gdb-display-number) | ||
| 61 | (defvar gdb-dive-display-number) | ||
| 62 | (defvar gdb-dive-map nil) | ||
| 63 | (defvar gdb-display-string) | ||
| 64 | (defvar gdb-values) | ||
| 65 | (defvar gdb-array-size) | ||
| 66 | (defvar gdb-array-slice-map nil) | ||
| 67 | (defvar gdb-buffer-instance nil) | ||
| 68 | (defvar gdb-source-window nil) | ||
| 69 | (defvar gdb-target-name "--unknown--" | ||
| 70 | "The apparent name of the program being debugged in a gud buffer.") | ||
| 71 | 46 | ||
| 47 | ;;;###autoload | ||
| 72 | (defun gdba (command-line) | 48 | (defun gdba (command-line) |
| 73 | "Run gdb on program FILE in buffer *gdb-FILE*. | 49 | "Run gdb on program FILE in buffer *gdb-FILE*. |
| 74 | The directory containing FILE becomes the initial working directory | 50 | The directory containing FILE becomes the initial working directory |
| @@ -125,9 +101,7 @@ The following interactive lisp functions help control operation : | |||
| 125 | 101 | ||
| 126 | (set (make-local-variable 'gud-minor-mode) 'gdba) | 102 | (set (make-local-variable 'gud-minor-mode) 'gdba) |
| 127 | 103 | ||
| 128 | ; (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") | ||
| 129 | (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.") | 104 | (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.") |
| 130 | ; (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") | ||
| 131 | (gud-def gud-run "run" nil "Run the program.") | 105 | (gud-def gud-run "run" nil "Run the program.") |
| 132 | (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") | 106 | (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") |
| 133 | (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") | 107 | (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") |
| @@ -158,15 +132,15 @@ The following interactive lisp functions help control operation : | |||
| 158 | (setq gud-last-last-frame nil) | 132 | (setq gud-last-last-frame nil) |
| 159 | 133 | ||
| 160 | (run-hooks 'gdb-mode-hook) | 134 | (run-hooks 'gdb-mode-hook) |
| 161 | (let ((instance | 135 | (setq gdb-proc (get-buffer-process (current-buffer))) |
| 162 | (make-gdb-instance (get-buffer-process (current-buffer))))) | 136 | (gdb-make-instance) |
| 163 | (if gdb-first-time (gdb-clear-inferior-io instance)) | 137 | (if gdb-first-time (gdb-clear-inferior-io)) |
| 164 | 138 | ||
| 165 | ; find source file and compilation directory here | 139 | ; find source file and compilation directory here |
| 166 | (gdb-instance-enqueue-idle-input instance (list "server list\n" | 140 | (gdb-instance-enqueue-idle-input (list "server list\n" |
| 167 | '(lambda () nil))) | 141 | '(lambda () nil))) |
| 168 | (gdb-instance-enqueue-idle-input instance (list "server info source\n" | 142 | (gdb-instance-enqueue-idle-input (list "server info source\n" |
| 169 | '(lambda () (gdb-source-info)))))) | 143 | '(lambda () (gdb-source-info))))) |
| 170 | 144 | ||
| 171 | (defun gud-break (arg) | 145 | (defun gud-break (arg) |
| 172 | "Set breakpoint at current line or address." | 146 | "Set breakpoint at current line or address." |
| @@ -196,7 +170,6 @@ The following interactive lisp functions help control operation : | |||
| 196 | (save-excursion | 170 | (save-excursion |
| 197 | (let ((expr (gud-find-c-expr))) | 171 | (let ((expr (gud-find-c-expr))) |
| 198 | (gdb-instance-enqueue-idle-input | 172 | (gdb-instance-enqueue-idle-input |
| 199 | gdb-buffer-instance | ||
| 200 | (list (concat "server whatis " expr "\n") | 173 | (list (concat "server whatis " expr "\n") |
| 201 | `(lambda () (gud-display1 ,expr))))))) | 174 | `(lambda () (gud-display1 ,expr))))))) |
| 202 | 175 | ||
| @@ -204,12 +177,10 @@ The following interactive lisp functions help control operation : | |||
| 204 | (goto-char (point-min)) | 177 | (goto-char (point-min)) |
| 205 | (if (re-search-forward "\*" nil t) | 178 | (if (re-search-forward "\*" nil t) |
| 206 | (gdb-instance-enqueue-idle-input | 179 | (gdb-instance-enqueue-idle-input |
| 207 | gdb-buffer-instance | ||
| 208 | (list (concat "server display* " expr "\n") | 180 | (list (concat "server display* " expr "\n") |
| 209 | '(lambda () nil))) | 181 | '(lambda () nil))) |
| 210 | ;else | 182 | ;else |
| 211 | (gdb-instance-enqueue-idle-input | 183 | (gdb-instance-enqueue-idle-input |
| 212 | gdb-buffer-instance | ||
| 213 | (list (concat "server display " expr "\n") | 184 | (list (concat "server display " expr "\n") |
| 214 | '(lambda () nil))))) | 185 | '(lambda () nil))))) |
| 215 | 186 | ||
| @@ -218,7 +189,7 @@ The following interactive lisp functions help control operation : | |||
| 218 | ;; output of GDB up to the next prompt and build the completion list. | 189 | ;; output of GDB up to the next prompt and build the completion list. |
| 219 | ;; It must also handle annotations. | 190 | ;; It must also handle annotations. |
| 220 | (defun gdba-complete-filter (string) | 191 | (defun gdba-complete-filter (string) |
| 221 | (gdb-output-burst gdb-buffer-instance string) | 192 | (gdb-output-burst string) |
| 222 | (while (string-match "\n\032\032\\(.*\\)\n" string) | 193 | (while (string-match "\n\032\032\\(.*\\)\n" string) |
| 223 | (setq string (concat (substring string 0 (match-beginning 0)) | 194 | (setq string (concat (substring string 0 (match-beginning 0)) |
| 224 | (substring string (match-end 0))))) | 195 | (substring string (match-end 0))))) |
| @@ -236,6 +207,8 @@ The following interactive lisp functions help control operation : | |||
| 236 | (setq gud-gdb-complete-string string) | 207 | (setq gud-gdb-complete-string string) |
| 237 | ""))) | 208 | ""))) |
| 238 | 209 | ||
| 210 | (defvar gdb-target-name "--unknown--" | ||
| 211 | "The apparent name of the program being debugged in a gud buffer.") | ||
| 239 | 212 | ||
| 240 | (defun gdba-common-init (command-line massage-args marker-filter &optional find-file) | 213 | (defun gdba-common-init (command-line massage-args marker-filter &optional find-file) |
| 241 | 214 | ||
| @@ -289,11 +262,8 @@ The following interactive lisp functions help control operation : | |||
| 289 | (setq w (cdr w))) | 262 | (setq w (cdr w))) |
| 290 | (if w | 263 | (if w |
| 291 | (setcar w file))) | 264 | (setcar w file))) |
| 292 | (let ((old-instance gdb-buffer-instance)) | 265 | (apply 'make-comint (concat "gdb-" filepart) program nil args) |
| 293 | (apply 'make-comint (concat "gdb-" filepart) program nil args) | 266 | (gud-mode) |
| 294 | (gud-mode) | ||
| 295 | (make-variable-buffer-local 'old-gdb-buffer-instance) | ||
| 296 | (setq old-gdb-buffer-instance old-instance)) | ||
| 297 | (setq gdb-target-name filepart)) | 267 | (setq gdb-target-name filepart)) |
| 298 | (make-local-variable 'gud-marker-filter) | 268 | (make-local-variable 'gud-marker-filter) |
| 299 | (setq gud-marker-filter marker-filter) | 269 | (setq gud-marker-filter marker-filter) |
| @@ -314,55 +284,31 @@ The following interactive lisp functions help control operation : | |||
| 314 | ;; gdb-instance objects | 284 | ;; gdb-instance objects |
| 315 | ;; | 285 | ;; |
| 316 | 286 | ||
| 317 | (defun make-gdb-instance (proc) | 287 | (defvar gdb-instance-variables '() |
| 318 | "Create a gdb instance object from a gdb process." | 288 | "A list of variables that are local to the GUD buffer associated |
| 319 | (let ((instance (cons 'gdb-instance proc))) | 289 | with a gdb instance.") |
| 320 | (with-current-buffer (process-buffer proc) | ||
| 321 | (setq gdb-buffer-instance instance) | ||
| 322 | (progn | ||
| 323 | (mapc 'make-local-variable gdb-instance-variables) | ||
| 324 | (setq gdb-buffer-type 'gdba) | ||
| 325 | ;; If we're taking over the buffer of another process, | ||
| 326 | ;; take over it's ancillary buffers as well. | ||
| 327 | ;; | ||
| 328 | (let ((dead old-gdb-buffer-instance)) | ||
| 329 | (dolist (b (buffer-list)) | ||
| 330 | (set-buffer b) | ||
| 331 | (if (eq dead gdb-buffer-instance) | ||
| 332 | (setq gdb-buffer-instance instance)))))) | ||
| 333 | instance)) | ||
| 334 | |||
| 335 | (defun gdb-instance-process (inst) (cdr inst)) | ||
| 336 | 290 | ||
| 337 | ;;; The list of instance variables is built up by the expansions of | 291 | ;;; The list of instance variables is built up by the expansions of |
| 338 | ;;; DEF-GDB-VARIABLE | 292 | ;;; DEF-GDB-VARIABLE |
| 339 | ;;; | 293 | ;;; |
| 340 | (defvar gdb-instance-variables '() | ||
| 341 | "A list of variables that are local to the GUD buffer associated | ||
| 342 | with a gdb instance.") | ||
| 343 | 294 | ||
| 344 | (defmacro def-gdb-variable (name accessor setter &optional default doc) | 295 | (defmacro def-gdb-variable (name accessor setter &optional default doc) |
| 345 | `(progn | 296 | `(progn |
| 346 | (defvar ,name ,default ,(or doc "undocumented")) | 297 | (defvar ,name ,default ,doc) |
| 347 | (if (not (memq ',name gdb-instance-variables)) | 298 | (if (not (memq ',name gdb-instance-variables)) |
| 348 | (setq gdb-instance-variables | 299 | (push ',name gdb-instance-variables)) |
| 349 | (cons ',name gdb-instance-variables))) | ||
| 350 | ,(and accessor | 300 | ,(and accessor |
| 351 | `(defun ,accessor (instance) | 301 | `(defun ,accessor () |
| 352 | (let | 302 | (let ((buffer (gdb-get-instance-buffer 'gdba))) |
| 353 | ((buffer (gdb-get-instance-buffer instance 'gdba))) | 303 | (and buffer (save-excursion |
| 354 | (and buffer | 304 | (set-buffer buffer) |
| 355 | (save-excursion | 305 | ,name))))) |
| 356 | (set-buffer buffer) | ||
| 357 | ,name))))) | ||
| 358 | ,(and setter | 306 | ,(and setter |
| 359 | `(defun ,setter (instance val) | 307 | `(defun ,setter (val) |
| 360 | (let | 308 | (let ((buffer (gdb-get-instance-buffer 'gdba))) |
| 361 | ((buffer (gdb-get-instance-buffer instance 'gdba))) | 309 | (and buffer (save-excursion |
| 362 | (and buffer | 310 | (set-buffer buffer) |
| 363 | (save-excursion | 311 | (setq ,name val)))))))) |
| 364 | (set-buffer buffer) | ||
| 365 | (setq ,name val)))))))) | ||
| 366 | 312 | ||
| 367 | (defmacro def-gdb-var (root-symbol &optional default doc) | 313 | (defmacro def-gdb-var (root-symbol &optional default doc) |
| 368 | (let* ((root (symbol-name root-symbol)) | 314 | (let* ((root (symbol-name root-symbol)) |
| @@ -373,9 +319,6 @@ with a gdb instance.") | |||
| 373 | ,var-name ,accessor ,setter | 319 | ,var-name ,accessor ,setter |
| 374 | ,default ,doc))) | 320 | ,default ,doc))) |
| 375 | 321 | ||
| 376 | (def-gdb-var buffer-instance nil | ||
| 377 | "In an instance buffer, the buffer's instance.") | ||
| 378 | |||
| 379 | (def-gdb-var buffer-type nil | 322 | (def-gdb-var buffer-type nil |
| 380 | "One of the symbols bound in gdb-instance-buffer-rules") | 323 | "One of the symbols bound in gdb-instance-buffer-rules") |
| 381 | 324 | ||
| @@ -418,58 +361,28 @@ Possible values are these symbols: | |||
| 418 | "A list of trigger functions that have run later than their output | 361 | "A list of trigger functions that have run later than their output |
| 419 | handlers.") | 362 | handlers.") |
| 420 | 363 | ||
| 421 | (defun in-gdb-instance-context (instance form) | 364 | (defun in-gdb-instance-context (form) |
| 422 | "Funcall FORM in the GUD buffer of INSTANCE." | 365 | "Funcall FORM in the GUD buffer." |
| 423 | (save-excursion | 366 | (save-excursion |
| 424 | (set-buffer (gdb-get-instance-buffer instance 'gdba)) | 367 | (set-buffer (gdb-get-instance-buffer 'gdba)) |
| 425 | (funcall form))) | 368 | (funcall form))) |
| 426 | 369 | ||
| 427 | ;; end of instance vars | 370 | ;; end of instance vars |
| 428 | 371 | ||
| 429 | ;; | 372 | (defun gdb-make-instance () |
| 430 | ;; finding instances | 373 | "Create a gdb instance object from a gdb process." |
| 431 | ;; | 374 | (with-current-buffer (process-buffer gdb-proc) |
| 432 | 375 | (progn | |
| 433 | (defun gdb-proc->instance (proc) | 376 | (mapc 'make-local-variable gdb-instance-variables) |
| 434 | (save-excursion | 377 | (setq gdb-buffer-type 'gdba)))) |
| 435 | (set-buffer (process-buffer proc)) | ||
| 436 | gdb-buffer-instance)) | ||
| 437 | |||
| 438 | (defun gdb-mru-instance-buffer () | ||
| 439 | "Return the most recently used (non-auxiliary) GUD buffer." | ||
| 440 | (save-excursion | ||
| 441 | (gdb-goto-first-gdb-instance (buffer-list)))) | ||
| 442 | |||
| 443 | (defun gdb-goto-first-gdb-instance (blist) | ||
| 444 | "Use gdb-mru-instance-buffer -- not this." | ||
| 445 | (and blist | ||
| 446 | (progn | ||
| 447 | (set-buffer (car blist)) | ||
| 448 | (or (and gdb-buffer-instance | ||
| 449 | (eq gdb-buffer-type 'gdba) | ||
| 450 | (car blist)) | ||
| 451 | (gdb-goto-first-gdb-instance (cdr blist)))))) | ||
| 452 | |||
| 453 | (defun buffer-gdb-instance (buf) | ||
| 454 | (save-excursion | ||
| 455 | (set-buffer buf) | ||
| 456 | gdb-buffer-instance)) | ||
| 457 | |||
| 458 | (defun gdb-needed-default-instance () | ||
| 459 | "Return the most recently used gdb instance or signal an error." | ||
| 460 | (let ((buffer (gdb-mru-instance-buffer))) | ||
| 461 | (or (and buffer (buffer-gdb-instance buffer)) | ||
| 462 | (error "No instance of gdb found")))) | ||
| 463 | 378 | ||
| 464 | (defun gdb-instance-target-string (instance) | 379 | (defun gdb-instance-target-string () |
| 465 | "The apparent name of the program being debugged by a gdb instance. | 380 | "The apparent name of the program being debugged by a gdb instance. |
| 466 | For sure this the root string used in smashing together the gdb | 381 | For sure this the root string used in smashing together the gdb |
| 467 | buffer's name, even if that doesn't happen to be the name of a | 382 | buffer's name, even if that doesn't happen to be the name of a |
| 468 | program." | 383 | program." |
| 469 | (in-gdb-instance-context | 384 | (in-gdb-instance-context |
| 470 | instance | ||
| 471 | (function (lambda () gdb-target-name)))) | 385 | (function (lambda () gdb-target-name)))) |
| 472 | |||
| 473 | 386 | ||
| 474 | 387 | ||
| 475 | ;; | 388 | ;; |
| @@ -487,47 +400,40 @@ program." | |||
| 487 | ;; Others are constructed by gdb-get-create-instance-buffer and | 400 | ;; Others are constructed by gdb-get-create-instance-buffer and |
| 488 | ;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc | 401 | ;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc |
| 489 | 402 | ||
| 490 | (defun gdb-get-instance-buffer (instance key) | 403 | (defvar gdb-instance-buffer-rules-assoc '()) |
| 491 | "Return the instance buffer for INSTANCE tagged with type KEY. | 404 | |
| 405 | (defun gdb-get-instance-buffer (key) | ||
| 406 | "Return the instance buffer tagged with type KEY. | ||
| 492 | The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | 407 | The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." |
| 493 | (save-excursion | 408 | (save-excursion |
| 494 | (gdb-look-for-tagged-buffer instance key (buffer-list)))) | 409 | (gdb-look-for-tagged-buffer key (buffer-list)))) |
| 495 | 410 | ||
| 496 | (defun gdb-get-create-instance-buffer (instance key) | 411 | (defun gdb-get-create-instance-buffer (key) |
| 497 | "Create a new gdb instance buffer of the type specified by KEY. | 412 | "Create a new gdb instance buffer of the type specified by KEY. |
| 498 | The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | 413 | The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." |
| 499 | (or (gdb-get-instance-buffer instance key) | 414 | (or (gdb-get-instance-buffer key) |
| 500 | (let* ((rules (assoc key gdb-instance-buffer-rules-assoc)) | 415 | (let* ((rules (assoc key gdb-instance-buffer-rules-assoc)) |
| 501 | (name (funcall (gdb-rules-name-maker rules) instance)) | 416 | (name (funcall (gdb-rules-name-maker rules))) |
| 502 | (new (get-buffer-create name))) | 417 | (new (get-buffer-create name))) |
| 503 | (save-excursion | 418 | (save-excursion |
| 504 | (set-buffer new) | 419 | (set-buffer new) |
| 505 | (make-variable-buffer-local 'gdb-buffer-type) | 420 | (make-variable-buffer-local 'gdb-buffer-type) |
| 506 | (setq gdb-buffer-type key) | 421 | (setq gdb-buffer-type key) |
| 507 | (make-variable-buffer-local 'gdb-buffer-instance) | ||
| 508 | (setq gdb-buffer-instance instance) | ||
| 509 | (if (cdr (cdr rules)) | 422 | (if (cdr (cdr rules)) |
| 510 | (funcall (car (cdr (cdr rules))))) | 423 | (funcall (car (cdr (cdr rules))))) |
| 511 | new)))) | 424 | new)))) |
| 512 | 425 | ||
| 513 | (defun gdb-rules-name-maker (rules) (car (cdr rules))) | 426 | (defun gdb-rules-name-maker (rules) (car (cdr rules))) |
| 514 | 427 | ||
| 515 | (defun gdb-look-for-tagged-buffer (instance key bufs) | 428 | (defun gdb-look-for-tagged-buffer (key bufs) |
| 516 | (let ((retval nil)) | 429 | (let ((retval nil)) |
| 517 | (while (and (not retval) bufs) | 430 | (while (and (not retval) bufs) |
| 518 | (set-buffer (car bufs)) | 431 | (set-buffer (car bufs)) |
| 519 | (if (and (eq gdb-buffer-instance instance) | 432 | (if (eq gdb-buffer-type key) |
| 520 | (eq gdb-buffer-type key)) | ||
| 521 | (setq retval (car bufs))) | 433 | (setq retval (car bufs))) |
| 522 | (setq bufs (cdr bufs))) | 434 | (setq bufs (cdr bufs))) |
| 523 | retval)) | 435 | retval)) |
| 524 | 436 | ||
| 525 | (defun gdb-instance-buffer-p (buf) | ||
| 526 | (save-excursion | ||
| 527 | (set-buffer buf) | ||
| 528 | (and gdb-buffer-type | ||
| 529 | (not (eq gdb-buffer-type 'gdba))))) | ||
| 530 | |||
| 531 | ;; | 437 | ;; |
| 532 | ;; This assoc maps buffer type symbols to rules. Each rule is a list of | 438 | ;; This assoc maps buffer type symbols to rules. Each rule is a list of |
| 533 | ;; at least one and possible more functions. The functions have these | 439 | ;; at least one and possible more functions. The functions have these |
| @@ -541,8 +447,6 @@ The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |||
| 541 | ;; the proper mode for the buffer. | 447 | ;; the proper mode for the buffer. |
| 542 | ;; | 448 | ;; |
| 543 | 449 | ||
| 544 | (defvar gdb-instance-buffer-rules-assoc '()) | ||
| 545 | |||
| 546 | (defun gdb-set-instance-buffer-rules (buffer-type &rest rules) | 450 | (defun gdb-set-instance-buffer-rules (buffer-type &rest rules) |
| 547 | (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc))) | 451 | (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc))) |
| 548 | (if binding | 452 | (if binding |
| @@ -564,9 +468,9 @@ The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |||
| 564 | (gdb-set-instance-buffer-rules 'gdb-partial-output-buffer | 468 | (gdb-set-instance-buffer-rules 'gdb-partial-output-buffer |
| 565 | 'gdb-partial-output-name) | 469 | 'gdb-partial-output-name) |
| 566 | 470 | ||
| 567 | (defun gdb-partial-output-name (instance) | 471 | (defun gdb-partial-output-name () |
| 568 | (concat "*partial-output-" | 472 | (concat "*partial-output-" |
| 569 | (gdb-instance-target-string instance) | 473 | (gdb-instance-target-string) |
| 570 | "*")) | 474 | "*")) |
| 571 | 475 | ||
| 572 | 476 | ||
| @@ -574,9 +478,9 @@ The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |||
| 574 | 'gdb-inferior-io-name | 478 | 'gdb-inferior-io-name |
| 575 | 'gdb-inferior-io-mode) | 479 | 'gdb-inferior-io-mode) |
| 576 | 480 | ||
| 577 | (defun gdb-inferior-io-name (instance) | 481 | (defun gdb-inferior-io-name () |
| 578 | (concat "*input/output of " | 482 | (concat "*input/output of " |
| 579 | (gdb-instance-target-string instance) | 483 | (gdb-instance-target-string) |
| 580 | "*")) | 484 | "*")) |
| 581 | 485 | ||
| 582 | (defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map)) | 486 | (defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map)) |
| @@ -603,35 +507,33 @@ The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |||
| 603 | (defun gdb-inferior-io-sender (proc string) | 507 | (defun gdb-inferior-io-sender (proc string) |
| 604 | (save-excursion | 508 | (save-excursion |
| 605 | (set-buffer (process-buffer proc)) | 509 | (set-buffer (process-buffer proc)) |
| 606 | (let ((instance gdb-buffer-instance)) | 510 | (set-buffer (gdb-get-instance-buffer 'gdba)) |
| 607 | (set-buffer (gdb-get-instance-buffer instance 'gdba)) | ||
| 608 | (let ((gdb-proc (get-buffer-process (current-buffer)))) | ||
| 609 | (process-send-string gdb-proc string) | 511 | (process-send-string gdb-proc string) |
| 610 | (process-send-string gdb-proc "\n"))))) | 512 | (process-send-string gdb-proc "\n"))) |
| 611 | 513 | ||
| 612 | (defun gdb-inferior-io-interrupt (instance) | 514 | (defun gdb-inferior-io-interrupt () |
| 613 | "Interrupt the program being debugged." | 515 | "Interrupt the program being debugged." |
| 614 | (interactive (list (gdb-needed-default-instance))) | 516 | (interactive (list gdb-proc)) |
| 615 | (interrupt-process | 517 | (interrupt-process |
| 616 | (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp)) | 518 | (get-buffer-process (gdb-get-instance-buffer 'gdba)) comint-ptyp)) |
| 617 | 519 | ||
| 618 | (defun gdb-inferior-io-quit (instance) | 520 | (defun gdb-inferior-io-quit () |
| 619 | "Send quit signal to the program being debugged." | 521 | "Send quit signal to the program being debugged." |
| 620 | (interactive (list (gdb-needed-default-instance))) | 522 | (interactive (list gdb-proc)) |
| 621 | (quit-process | 523 | (quit-process |
| 622 | (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp)) | 524 | (get-buffer-process (gdb-get-instance-buffer 'gdba)) comint-ptyp)) |
| 623 | 525 | ||
| 624 | (defun gdb-inferior-io-stop (instance) | 526 | (defun gdb-inferior-io-stop () |
| 625 | "Stop the program being debugged." | 527 | "Stop the program being debugged." |
| 626 | (interactive (list (gdb-needed-default-instance))) | 528 | (interactive (list gdb-proc)) |
| 627 | (stop-process | 529 | (stop-process |
| 628 | (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp)) | 530 | (get-buffer-process (gdb-get-instance-buffer 'gdba)) comint-ptyp)) |
| 629 | 531 | ||
| 630 | (defun gdb-inferior-io-eof (instance) | 532 | (defun gdb-inferior-io-eof () |
| 631 | "Send end-of-file to the program being debugged." | 533 | "Send end-of-file to the program being debugged." |
| 632 | (interactive (list (gdb-needed-default-instance))) | 534 | (interactive (list gdb-proc)) |
| 633 | (process-send-eof | 535 | (process-send-eof |
| 634 | (get-buffer-process (gdb-get-instance-buffer instance 'gdba)))) | 536 | (get-buffer-process (gdb-get-instance-buffer 'gdba)))) |
| 635 | 537 | ||
| 636 | 538 | ||
| 637 | ;; | 539 | ;; |
| @@ -662,8 +564,7 @@ The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |||
| 662 | (defun gdb-send (proc string) | 564 | (defun gdb-send (proc string) |
| 663 | "A comint send filter for gdb. | 565 | "A comint send filter for gdb. |
| 664 | This filter may simply queue output for a later time." | 566 | This filter may simply queue output for a later time." |
| 665 | (let ((instance (gdb-proc->instance proc))) | 567 | (gdb-instance-enqueue-input (concat string "\n"))) |
| 666 | (gdb-instance-enqueue-input instance (concat string "\n")))) | ||
| 667 | 568 | ||
| 668 | ;; Note: Stuff enqueued here will be sent to the next prompt, even if it | 569 | ;; Note: Stuff enqueued here will be sent to the next prompt, even if it |
| 669 | ;; is a query, or other non-top-level prompt. To guarantee stuff will get | 570 | ;; is a query, or other non-top-level prompt. To guarantee stuff will get |
| @@ -673,40 +574,38 @@ This filter may simply queue output for a later time." | |||
| 673 | ;; the user go first; it is not a bug. -t] | 574 | ;; the user go first; it is not a bug. -t] |
| 674 | ;; | 575 | ;; |
| 675 | 576 | ||
| 676 | (defun gdb-instance-enqueue-input (instance item) | 577 | (defun gdb-instance-enqueue-input (item) |
| 677 | (if (gdb-instance-prompting instance) | 578 | (if (gdb-instance-prompting) |
| 678 | (progn | 579 | (progn |
| 679 | (gdb-send-item instance item) | 580 | (gdb-send-item item) |
| 680 | (set-gdb-instance-prompting instance nil)) | 581 | (set-gdb-instance-prompting nil)) |
| 681 | (set-gdb-instance-input-queue | 582 | (set-gdb-instance-input-queue |
| 682 | instance | 583 | (cons item (gdb-instance-input-queue))))) |
| 683 | (cons item (gdb-instance-input-queue instance))))) | ||
| 684 | 584 | ||
| 685 | (defun gdb-instance-dequeue-input (instance) | 585 | (defun gdb-instance-dequeue-input () |
| 686 | (let ((queue (gdb-instance-input-queue instance))) | 586 | (let ((queue (gdb-instance-input-queue))) |
| 687 | (and queue | 587 | (and queue |
| 688 | (if (not (cdr queue)) | 588 | (if (not (cdr queue)) |
| 689 | (let ((answer (car queue))) | 589 | (let ((answer (car queue))) |
| 690 | (set-gdb-instance-input-queue instance '()) | 590 | (set-gdb-instance-input-queue '()) |
| 691 | answer) | 591 | answer) |
| 692 | (gdb-take-last-elt queue))))) | 592 | (gdb-take-last-elt queue))))) |
| 693 | 593 | ||
| 694 | (defun gdb-instance-enqueue-idle-input (instance item) | 594 | (defun gdb-instance-enqueue-idle-input (item) |
| 695 | (if (and (gdb-instance-prompting instance) | 595 | (if (and (gdb-instance-prompting) |
| 696 | (not (gdb-instance-input-queue instance))) | 596 | (not (gdb-instance-input-queue))) |
| 697 | (progn | 597 | (progn |
| 698 | (gdb-send-item instance item) | 598 | (gdb-send-item item) |
| 699 | (set-gdb-instance-prompting instance nil)) | 599 | (set-gdb-instance-prompting nil)) |
| 700 | (set-gdb-instance-idle-input-queue | 600 | (set-gdb-instance-idle-input-queue |
| 701 | instance | 601 | (cons item (gdb-instance-idle-input-queue))))) |
| 702 | (cons item (gdb-instance-idle-input-queue instance))))) | ||
| 703 | 602 | ||
| 704 | (defun gdb-instance-dequeue-idle-input (instance) | 603 | (defun gdb-instance-dequeue-idle-input () |
| 705 | (let ((queue (gdb-instance-idle-input-queue instance))) | 604 | (let ((queue (gdb-instance-idle-input-queue))) |
| 706 | (and queue | 605 | (and queue |
| 707 | (if (not (cdr queue)) | 606 | (if (not (cdr queue)) |
| 708 | (let ((answer (car queue))) | 607 | (let ((answer (car queue))) |
| 709 | (set-gdb-instance-idle-input-queue instance '()) | 608 | (set-gdb-instance-idle-input-queue '()) |
| 710 | answer) | 609 | answer) |
| 711 | (gdb-take-last-elt queue))))) | 610 | (gdb-take-last-elt queue))))) |
| 712 | 611 | ||
| @@ -743,8 +642,7 @@ This filter may simply queue output for a later time." | |||
| 743 | (defun gdba-marker-filter (string) | 642 | (defun gdba-marker-filter (string) |
| 744 | "A gud marker filter for gdb." | 643 | "A gud marker filter for gdb." |
| 745 | ;; Bogons don't tell us the process except through scoping crud. | 644 | ;; Bogons don't tell us the process except through scoping crud. |
| 746 | (let ((instance (gdb-proc->instance proc))) | 645 | (gdb-output-burst string)) |
| 747 | (gdb-output-burst instance string))) | ||
| 748 | 646 | ||
| 749 | (defvar gdb-annotation-rules | 647 | (defvar gdb-annotation-rules |
| 750 | '(("frames-invalid" gdb-invalidate-frame-and-assembler) | 648 | '(("frames-invalid" gdb-invalidate-frame-and-assembler) |
| @@ -775,14 +673,14 @@ This filter may simply queue output for a later time." | |||
| 775 | ("field-end" gdb-field-end) | 673 | ("field-end" gdb-field-end) |
| 776 | ) "An assoc mapping annotation tags to functions which process them.") | 674 | ) "An assoc mapping annotation tags to functions which process them.") |
| 777 | 675 | ||
| 778 | (defun gdb-ignore-annotation (instance args) | 676 | (defun gdb-ignore-annotation (args) |
| 779 | nil) | 677 | nil) |
| 780 | 678 | ||
| 781 | (defconst gdb-source-spec-regexp | 679 | (defconst gdb-source-spec-regexp |
| 782 | "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)") | 680 | "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)") |
| 783 | 681 | ||
| 784 | ;; Do not use this except as an annotation handler." | 682 | ;; Do not use this except as an annotation handler." |
| 785 | (defun gdb-source (instance args) | 683 | (defun gdb-source (args) |
| 786 | (string-match gdb-source-spec-regexp args) | 684 | (string-match gdb-source-spec-regexp args) |
| 787 | ;; Extract the frame position from the marker. | 685 | ;; Extract the frame position from the marker. |
| 788 | (setq gud-last-frame | 686 | (setq gud-last-frame |
| @@ -795,102 +693,100 @@ This filter may simply queue output for a later time." | |||
| 795 | (match-end 3))) | 693 | (match-end 3))) |
| 796 | (setq gdb-main-or-pc gdb-current-address) | 694 | (setq gdb-main-or-pc gdb-current-address) |
| 797 | ;update with new frame for machine code if necessary | 695 | ;update with new frame for machine code if necessary |
| 798 | (gdb-invalidate-assembler instance)) | 696 | (gdb-invalidate-assembler)) |
| 799 | 697 | ||
| 800 | ;; An annotation handler for `prompt'. | 698 | ;; An annotation handler for `prompt'. |
| 801 | ;; This sends the next command (if any) to gdb. | 699 | ;; This sends the next command (if any) to gdb. |
| 802 | (defun gdb-prompt (instance ignored) | 700 | (defun gdb-prompt (ignored) |
| 803 | (let ((sink (gdb-instance-output-sink instance))) | 701 | (let ((sink (gdb-instance-output-sink))) |
| 804 | (cond | 702 | (cond |
| 805 | ((eq sink 'user) t) | 703 | ((eq sink 'user) t) |
| 806 | ((eq sink 'post-emacs) | 704 | ((eq sink 'post-emacs) |
| 807 | (set-gdb-instance-output-sink instance 'user)) | 705 | (set-gdb-instance-output-sink 'user)) |
| 808 | (t | 706 | (t |
| 809 | (set-gdb-instance-output-sink instance 'user) | 707 | (set-gdb-instance-output-sink 'user) |
| 810 | (error "Phase error in gdb-prompt (got %s)" sink)))) | 708 | (error "Phase error in gdb-prompt (got %s)" sink)))) |
| 811 | (let ((highest (gdb-instance-dequeue-input instance))) | 709 | (let ((highest (gdb-instance-dequeue-input))) |
| 812 | (if highest | 710 | (if highest |
| 813 | (gdb-send-item instance highest) | 711 | (gdb-send-item highest) |
| 814 | (let ((lowest (gdb-instance-dequeue-idle-input instance))) | 712 | (let ((lowest (gdb-instance-dequeue-idle-input))) |
| 815 | (if lowest | 713 | (if lowest |
| 816 | (gdb-send-item instance lowest) | 714 | (gdb-send-item lowest) |
| 817 | (progn | 715 | (progn |
| 818 | (set-gdb-instance-prompting instance t) | 716 | (set-gdb-instance-prompting t) |
| 819 | (gud-display-frame))))))) | 717 | (gud-display-frame))))))) |
| 820 | 718 | ||
| 821 | ;; An annotation handler for non-top-level prompts. | 719 | ;; An annotation handler for non-top-level prompts. |
| 822 | (defun gdb-subprompt (instance ignored) | 720 | (defun gdb-subprompt (ignored) |
| 823 | (let ((highest (gdb-instance-dequeue-input instance))) | 721 | (let ((highest (gdb-instance-dequeue-input))) |
| 824 | (if highest | 722 | (if highest |
| 825 | (gdb-send-item instance highest) | 723 | (gdb-send-item highest) |
| 826 | (set-gdb-instance-prompting instance t)))) | 724 | (set-gdb-instance-prompting t)))) |
| 827 | 725 | ||
| 828 | (defun gdb-send-item (instance item) | 726 | (defun gdb-send-item (item) |
| 829 | (set-gdb-instance-current-item instance item) | 727 | (set-gdb-instance-current-item item) |
| 830 | (if (stringp item) | 728 | (if (stringp item) |
| 831 | (progn | 729 | (progn |
| 832 | (set-gdb-instance-output-sink instance 'user) | 730 | (set-gdb-instance-output-sink 'user) |
| 833 | (process-send-string (gdb-instance-process instance) | 731 | (process-send-string gdb-proc item)) |
| 834 | item)) | ||
| 835 | (progn | 732 | (progn |
| 836 | (gdb-clear-partial-output instance) | 733 | (gdb-clear-partial-output) |
| 837 | (set-gdb-instance-output-sink instance 'pre-emacs) | 734 | (set-gdb-instance-output-sink 'pre-emacs) |
| 838 | (process-send-string (gdb-instance-process instance) | 735 | (process-send-string gdb-proc (car item))))) |
| 839 | (car item))))) | ||
| 840 | 736 | ||
| 841 | ;; An annotation handler for `pre-prompt'. | 737 | ;; An annotation handler for `pre-prompt'. |
| 842 | ;; This terminates the collection of output from a previous | 738 | ;; This terminates the collection of output from a previous |
| 843 | ;; command if that happens to be in effect. | 739 | ;; command if that happens to be in effect. |
| 844 | (defun gdb-pre-prompt (instance ignored) | 740 | (defun gdb-pre-prompt (ignored) |
| 845 | (let ((sink (gdb-instance-output-sink instance))) | 741 | (let ((sink (gdb-instance-output-sink))) |
| 846 | (cond | 742 | (cond |
| 847 | ((eq sink 'user) t) | 743 | ((eq sink 'user) t) |
| 848 | ((eq sink 'emacs) | 744 | ((eq sink 'emacs) |
| 849 | (set-gdb-instance-output-sink instance 'post-emacs) | 745 | (set-gdb-instance-output-sink 'post-emacs) |
| 850 | (let ((handler | 746 | (let ((handler |
| 851 | (car (cdr (gdb-instance-current-item instance))))) | 747 | (car (cdr (gdb-instance-current-item))))) |
| 852 | (save-excursion | 748 | (save-excursion |
| 853 | (set-buffer (gdb-get-create-instance-buffer | 749 | (set-buffer (gdb-get-create-instance-buffer |
| 854 | instance 'gdb-partial-output-buffer)) | 750 | 'gdb-partial-output-buffer)) |
| 855 | (funcall handler)))) | 751 | (funcall handler)))) |
| 856 | (t | 752 | (t |
| 857 | (set-gdb-instance-output-sink instance 'user) | 753 | (set-gdb-instance-output-sink 'user) |
| 858 | (error "Output sink phase error 1"))))) | 754 | (error "Output sink phase error 1"))))) |
| 859 | 755 | ||
| 860 | ;; An annotation handler for `starting'. This says that I/O for the subprocess | 756 | ;; An annotation handler for `starting'. This says that I/O for the subprocess |
| 861 | ;; is now the program being debugged, not GDB. | 757 | ;; is now the program being debugged, not GDB. |
| 862 | (defun gdb-starting (instance ignored) | 758 | (defun gdb-starting (ignored) |
| 863 | (let ((sink (gdb-instance-output-sink instance))) | 759 | (let ((sink (gdb-instance-output-sink))) |
| 864 | (cond | 760 | (cond |
| 865 | ((eq sink 'user) | 761 | ((eq sink 'user) |
| 866 | (set-gdb-instance-output-sink instance 'inferior)) | 762 | (set-gdb-instance-output-sink 'inferior)) |
| 867 | (t (error "Unexpected `starting' annotation"))))) | 763 | (t (error "Unexpected `starting' annotation"))))) |
| 868 | 764 | ||
| 869 | ;; An annotation handler for `exited' and other annotations which say that | 765 | ;; An annotation handler for `exited' and other annotations which say that |
| 870 | ;; I/O for the subprocess is now GDB, not the program being debugged. | 766 | ;; I/O for the subprocess is now GDB, not the program being debugged. |
| 871 | (defun gdb-stopping (instance ignored) | 767 | (defun gdb-stopping (ignored) |
| 872 | (let ((sink (gdb-instance-output-sink instance))) | 768 | (let ((sink (gdb-instance-output-sink))) |
| 873 | (cond | 769 | (cond |
| 874 | ((eq sink 'inferior) | 770 | ((eq sink 'inferior) |
| 875 | (set-gdb-instance-output-sink instance 'user)) | 771 | (set-gdb-instance-output-sink 'user)) |
| 876 | (t (error "Unexpected stopping annotation"))))) | 772 | (t (error "Unexpected stopping annotation"))))) |
| 877 | 773 | ||
| 878 | ;; An annotation handler for `stopped'. It is just like gdb-stopping, except | 774 | ;; An annotation handler for `stopped'. It is just like gdb-stopping, except |
| 879 | ;; that if we already set the output sink to 'user in gdb-stopping, that is | 775 | ;; that if we already set the output sink to 'user in gdb-stopping, that is |
| 880 | ;; fine. | 776 | ;; fine. |
| 881 | (defun gdb-stopped (instance ignored) | 777 | (defun gdb-stopped (ignored) |
| 882 | (let ((sink (gdb-instance-output-sink instance))) | 778 | (let ((sink (gdb-instance-output-sink))) |
| 883 | (cond | 779 | (cond |
| 884 | ((eq sink 'inferior) | 780 | ((eq sink 'inferior) |
| 885 | (set-gdb-instance-output-sink instance 'user)) | 781 | (set-gdb-instance-output-sink 'user)) |
| 886 | ((eq sink 'user) t) | 782 | ((eq sink 'user) t) |
| 887 | (t (error "Unexpected stopped annotation"))))) | 783 | (t (error "Unexpected stopped annotation"))))) |
| 888 | 784 | ||
| 889 | (defun gdb-frame-begin (instance ignored) | 785 | (defun gdb-frame-begin (ignored) |
| 890 | (let ((sink (gdb-instance-output-sink instance))) | 786 | (let ((sink (gdb-instance-output-sink))) |
| 891 | (cond | 787 | (cond |
| 892 | ((eq sink 'inferior) | 788 | ((eq sink 'inferior) |
| 893 | (set-gdb-instance-output-sink instance 'user)) | 789 | (set-gdb-instance-output-sink 'user)) |
| 894 | ((eq sink 'user) t) | 790 | ((eq sink 'user) t) |
| 895 | ((eq sink 'emacs) t) | 791 | ((eq sink 'emacs) t) |
| 896 | (t (error "Unexpected frame-begin annotation (%S)" sink))))) | 792 | (t (error "Unexpected frame-begin annotation (%S)" sink))))) |
| @@ -898,40 +794,43 @@ This filter may simply queue output for a later time." | |||
| 898 | ;; An annotation handler for `post-prompt'. | 794 | ;; An annotation handler for `post-prompt'. |
| 899 | ;; This begins the collection of output from the current | 795 | ;; This begins the collection of output from the current |
| 900 | ;; command if that happens to be appropriate." | 796 | ;; command if that happens to be appropriate." |
| 901 | (defun gdb-post-prompt (instance ignored) | 797 | (defun gdb-post-prompt (ignored) |
| 902 | (if (not (gdb-instance-pending-triggers instance)) | 798 | (if (not (gdb-instance-pending-triggers)) |
| 903 | (progn | 799 | (progn |
| 904 | (gdb-invalidate-registers instance ignored) | 800 | (gdb-invalidate-registers ignored) |
| 905 | (gdb-invalidate-locals instance ignored) | 801 | (gdb-invalidate-locals ignored) |
| 906 | (gdb-invalidate-display instance ignored))) | 802 | (gdb-invalidate-display ignored))) |
| 907 | (let ((sink (gdb-instance-output-sink instance))) | 803 | (let ((sink (gdb-instance-output-sink))) |
| 908 | (cond | 804 | (cond |
| 909 | ((eq sink 'user) t) | 805 | ((eq sink 'user) t) |
| 910 | ((eq sink 'pre-emacs) | 806 | ((eq sink 'pre-emacs) |
| 911 | (set-gdb-instance-output-sink instance 'emacs)) | 807 | (set-gdb-instance-output-sink 'emacs)) |
| 912 | 808 | ||
| 913 | (t | 809 | (t |
| 914 | (set-gdb-instance-output-sink instance 'user) | 810 | (set-gdb-instance-output-sink 'user) |
| 915 | (error "Output sink phase error 3"))))) | 811 | (error "Output sink phase error 3"))))) |
| 916 | 812 | ||
| 917 | ;; If we get an error whilst evaluating one of the expressions | 813 | ;; If we get an error whilst evaluating one of the expressions |
| 918 | ;; we won't get the display-end annotation. Set the sink back to | 814 | ;; we won't get the display-end annotation. Set the sink back to |
| 919 | ;; user to make sure that the error message is seen | 815 | ;; user to make sure that the error message is seen |
| 920 | 816 | ||
| 921 | (defun gdb-error-begin (instance ignored) | 817 | (defun gdb-error-begin (ignored) |
| 922 | (set-gdb-instance-output-sink instance 'user)) | 818 | (set-gdb-instance-output-sink 'user)) |
| 923 | 819 | ||
| 924 | (defun gdb-display-begin (instance ignored) | 820 | (defun gdb-display-begin (ignored) |
| 925 | (if (gdb-get-instance-buffer instance 'gdb-display-buffer) | 821 | (if (gdb-get-instance-buffer 'gdb-display-buffer) |
| 926 | (progn | 822 | (progn |
| 927 | (set-gdb-instance-output-sink instance 'emacs) | 823 | (set-gdb-instance-output-sink 'emacs) |
| 928 | (gdb-clear-partial-output instance) | 824 | (gdb-clear-partial-output) |
| 929 | (setq gdb-display-in-progress t)) | 825 | (setq gdb-display-in-progress t)) |
| 930 | (set-gdb-instance-output-sink instance 'user))) | 826 | (set-gdb-instance-output-sink 'user))) |
| 931 | 827 | ||
| 932 | (defun gdb-display-number-end (instance ignored) | 828 | (defvar gdb-expression-buffer-name) |
| 933 | (set-buffer (gdb-get-instance-buffer | 829 | (defvar gdb-display-number) |
| 934 | instance 'gdb-partial-output-buffer)) | 830 | (defvar gdb-dive-display-number) |
| 831 | |||
| 832 | (defun gdb-display-number-end (ignored) | ||
| 833 | (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer)) | ||
| 935 | (setq gdb-display-number (buffer-string)) | 834 | (setq gdb-display-number (buffer-string)) |
| 936 | (setq gdb-expression-buffer-name | 835 | (setq gdb-expression-buffer-name |
| 937 | (concat "*display " gdb-display-number "*")) | 836 | (concat "*display " gdb-display-number "*")) |
| @@ -962,12 +861,17 @@ This filter may simply queue output for a later time." | |||
| 962 | (tool-bar-lines . nil) | 861 | (tool-bar-lines . nil) |
| 963 | (menu-bar-lines . nil) | 862 | (menu-bar-lines . nil) |
| 964 | (minibuffer . nil)))))))))) | 863 | (minibuffer . nil)))))))))) |
| 965 | (set-buffer (gdb-get-instance-buffer | 864 | (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer)) |
| 966 | instance 'gdb-partial-output-buffer)) | ||
| 967 | (setq gdb-dive nil)) | 865 | (setq gdb-dive nil)) |
| 968 | 866 | ||
| 969 | (defun gdb-display-end (instance ignored) | 867 | (defvar gdb-current-frame nil) |
| 970 | (set-buffer (gdb-get-instance-buffer instance 'gdb-partial-output-buffer)) | 868 | (defvar gdb-nesting-level) |
| 869 | (defvar gdb-expression) | ||
| 870 | (defvar gdb-point) | ||
| 871 | (defvar gdb-annotation-arg) | ||
| 872 | |||
| 873 | (defun gdb-display-end (ignored) | ||
| 874 | (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer)) | ||
| 971 | (goto-char (point-min)) | 875 | (goto-char (point-min)) |
| 972 | (search-forward ": ") | 876 | (search-forward ": ") |
| 973 | (looking-at "\\(.*?\\) =") | 877 | (looking-at "\\(.*?\\) =") |
| @@ -996,8 +900,7 @@ This filter may simply queue output for a later time." | |||
| 996 | (set-buffer gdb-expression-buffer-name) | 900 | (set-buffer gdb-expression-buffer-name) |
| 997 | (setq buffer-read-only nil) | 901 | (setq buffer-read-only nil) |
| 998 | (delete-region (point-min) (point-max)) | 902 | (delete-region (point-min) (point-max)) |
| 999 | (insert-buffer (gdb-get-instance-buffer | 903 | (insert-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer)) |
| 1000 | instance 'gdb-partial-output-buffer)) | ||
| 1001 | (setq buffer-read-only t))) | 904 | (setq buffer-read-only t))) |
| 1002 | ; else | 905 | ; else |
| 1003 | ; display expression name... | 906 | ; display expression name... |
| @@ -1009,7 +912,6 @@ This filter may simply queue output for a later time." | |||
| 1009 | (setq buffer-read-only nil) | 912 | (setq buffer-read-only nil) |
| 1010 | (delete-region (point-min) (point-max)) | 913 | (delete-region (point-min) (point-max)) |
| 1011 | (insert-buffer-substring (gdb-get-instance-buffer | 914 | (insert-buffer-substring (gdb-get-instance-buffer |
| 1012 | gdb-buffer-instance | ||
| 1013 | 'gdb-partial-output-buffer) | 915 | 'gdb-partial-output-buffer) |
| 1014 | start end) | 916 | start end) |
| 1015 | (insert "\n"))) | 917 | (insert "\n"))) |
| @@ -1037,8 +939,8 @@ This filter may simply queue output for a later time." | |||
| 1037 | (insert "\n") | 939 | (insert "\n") |
| 1038 | (insert-text-button "[back]" 'type 'gdb-display-back) | 940 | (insert-text-button "[back]" 'type 'gdb-display-back) |
| 1039 | (setq buffer-read-only t)))) | 941 | (setq buffer-read-only t)))) |
| 1040 | (gdb-clear-partial-output instance) | 942 | (gdb-clear-partial-output) |
| 1041 | (set-gdb-instance-output-sink instance 'user) | 943 | (set-gdb-instance-output-sink 'user) |
| 1042 | (setq gdb-display-in-progress nil)) | 944 | (setq gdb-display-in-progress nil)) |
| 1043 | 945 | ||
| 1044 | (define-button-type 'gdb-display-back | 946 | (define-button-type 'gdb-display-back |
| @@ -1049,7 +951,6 @@ This filter may simply queue output for a later time." | |||
| 1049 | ; delete display so they don't accumulate and delete buffer | 951 | ; delete display so they don't accumulate and delete buffer |
| 1050 | (let ((number gdb-display-number)) | 952 | (let ((number gdb-display-number)) |
| 1051 | (gdb-instance-enqueue-idle-input | 953 | (gdb-instance-enqueue-idle-input |
| 1052 | gdb-buffer-instance | ||
| 1053 | (list (concat "server delete display " number "\n") | 954 | (list (concat "server delete display " number "\n") |
| 1054 | '(lambda () nil))) | 955 | '(lambda () nil))) |
| 1055 | (switch-to-buffer (concat "*display " gdb-dive-display-number "*")) | 956 | (switch-to-buffer (concat "*display " gdb-dive-display-number "*")) |
| @@ -1060,43 +961,39 @@ This filter may simply queue output for a later time." | |||
| 1060 | 961 | ||
| 1061 | ; array-section flags are just removed again but after counting. They | 962 | ; array-section flags are just removed again but after counting. They |
| 1062 | ; might also be useful for arrays of structures and structures with arrays. | 963 | ; might also be useful for arrays of structures and structures with arrays. |
| 1063 | (defun gdb-array-section-begin (instance args) | 964 | (defun gdb-array-section-begin (args) |
| 1064 | (if gdb-display-in-progress | 965 | (if gdb-display-in-progress |
| 1065 | (progn | 966 | (progn |
| 1066 | (save-excursion | 967 | (save-excursion |
| 1067 | (set-buffer (gdb-get-instance-buffer | 968 | (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer)) |
| 1068 | instance 'gdb-partial-output-buffer)) | ||
| 1069 | (goto-char (point-max)) | 969 | (goto-char (point-max)) |
| 1070 | (insert (concat "\n##array-section-begin " args "\n")))))) | 970 | (insert (concat "\n##array-section-begin " args "\n")))))) |
| 1071 | 971 | ||
| 1072 | (defun gdb-array-section-end (instance ignored) | 972 | (defun gdb-array-section-end (ignored) |
| 1073 | (if gdb-display-in-progress | 973 | (if gdb-display-in-progress |
| 1074 | (progn | 974 | (progn |
| 1075 | (save-excursion | 975 | (save-excursion |
| 1076 | (set-buffer (gdb-get-instance-buffer | 976 | (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer)) |
| 1077 | instance 'gdb-partial-output-buffer)) | ||
| 1078 | (goto-char (point-max)) | 977 | (goto-char (point-max)) |
| 1079 | (insert "\n##array-section-end\n"))))) | 978 | (insert "\n##array-section-end\n"))))) |
| 1080 | 979 | ||
| 1081 | (defun gdb-field-begin (instance args) | 980 | (defun gdb-field-begin (args) |
| 1082 | (if gdb-display-in-progress | 981 | (if gdb-display-in-progress |
| 1083 | (progn | 982 | (progn |
| 1084 | (save-excursion | 983 | (save-excursion |
| 1085 | (set-buffer (gdb-get-instance-buffer | 984 | (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer)) |
| 1086 | instance 'gdb-partial-output-buffer)) | ||
| 1087 | (goto-char (point-max)) | 985 | (goto-char (point-max)) |
| 1088 | (insert (concat "\n##field-begin " args "\n")))))) | 986 | (insert (concat "\n##field-begin " args "\n")))))) |
| 1089 | 987 | ||
| 1090 | (defun gdb-field-end (instance ignored) | 988 | (defun gdb-field-end (ignored) |
| 1091 | (if gdb-display-in-progress | 989 | (if gdb-display-in-progress |
| 1092 | (progn | 990 | (progn |
| 1093 | (save-excursion | 991 | (save-excursion |
| 1094 | (set-buffer (gdb-get-instance-buffer | 992 | (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer)) |
| 1095 | instance 'gdb-partial-output-buffer)) | ||
| 1096 | (goto-char (point-max)) | 993 | (goto-char (point-max)) |
| 1097 | (insert "\n##field-end\n"))))) | 994 | (insert "\n##field-end\n"))))) |
| 1098 | 995 | ||
| 1099 | (defun gdb-elt (instance ignored) | 996 | (defun gdb-elt (ignored) |
| 1100 | (if gdb-display-in-progress | 997 | (if gdb-display-in-progress |
| 1101 | (progn | 998 | (progn |
| 1102 | (goto-char (point-max)) | 999 | (goto-char (point-max)) |
| @@ -1123,6 +1020,54 @@ This filter may simply queue output for a later time." | |||
| 1123 | (gdb-delete-line) | 1020 | (gdb-delete-line) |
| 1124 | (setq gdb-nesting-level (- gdb-nesting-level 1))) | 1021 | (setq gdb-nesting-level (- gdb-nesting-level 1))) |
| 1125 | 1022 | ||
| 1023 | (defvar gdb-dive-map nil) | ||
| 1024 | |||
| 1025 | (setq gdb-dive-map (make-keymap)) | ||
| 1026 | (define-key gdb-dive-map [mouse-2] 'gdb-dive) | ||
| 1027 | (define-key gdb-dive-map [S-mouse-2] 'gdb-dive-new-frame) | ||
| 1028 | |||
| 1029 | (defun gdb-dive (event) | ||
| 1030 | "Dive into structure." | ||
| 1031 | (interactive "e") | ||
| 1032 | (setq gdb-dive t) | ||
| 1033 | (gdb-dive-new-frame event)) | ||
| 1034 | |||
| 1035 | (defun gdb-dive-new-frame (event) | ||
| 1036 | "Dive into structure and display in a new frame." | ||
| 1037 | (interactive "e") | ||
| 1038 | (save-excursion | ||
| 1039 | (mouse-set-point event) | ||
| 1040 | (let ((point (point)) (gdb-full-expression gdb-expression) | ||
| 1041 | (end (progn (end-of-line) (point))) | ||
| 1042 | (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil)) | ||
| 1043 | (beginning-of-line) | ||
| 1044 | (if (looking-at "\*") (setq gdb-display-char "*")) | ||
| 1045 | (re-search-forward "\\(\\S-+\\) = " end t) | ||
| 1046 | (setq gdb-last-field (buffer-substring-no-properties | ||
| 1047 | (match-beginning 1) | ||
| 1048 | (match-end 1))) | ||
| 1049 | (goto-char (match-beginning 1)) | ||
| 1050 | (let ((last-column (current-column))) | ||
| 1051 | (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t) | ||
| 1052 | (goto-char (match-beginning 1)) | ||
| 1053 | (if (and (< (current-column) last-column) | ||
| 1054 | (> (count-lines 1 (point)) 1)) | ||
| 1055 | (progn | ||
| 1056 | (setq gdb-part-expression | ||
| 1057 | (concat "." (buffer-substring-no-properties | ||
| 1058 | (match-beginning 1) | ||
| 1059 | (match-end 1)) gdb-part-expression)) | ||
| 1060 | (setq last-column (current-column)))))) | ||
| 1061 | ; * not needed for components of a pointer to a structure in gdb | ||
| 1062 | (if (string-equal "*" (substring gdb-full-expression 0 1)) | ||
| 1063 | (setq gdb-full-expression (substring gdb-full-expression 1 nil))) | ||
| 1064 | (setq gdb-full-expression | ||
| 1065 | (concat gdb-full-expression gdb-part-expression "." gdb-last-field)) | ||
| 1066 | (gdb-instance-enqueue-idle-input (list | ||
| 1067 | (concat "server display" gdb-display-char | ||
| 1068 | " " gdb-full-expression "\n") | ||
| 1069 | '(lambda () nil)))))) | ||
| 1070 | |||
| 1126 | (defun gdb-insert-field () | 1071 | (defun gdb-insert-field () |
| 1127 | (let ((start (progn (point))) | 1072 | (let ((start (progn (point))) |
| 1128 | (end (progn (next-line) (point))) | 1073 | (end (progn (next-line) (point))) |
| @@ -1135,7 +1080,6 @@ This filter may simply queue output for a later time." | |||
| 1135 | (insert "\t") | 1080 | (insert "\t") |
| 1136 | (setq num (+ num 1))) | 1081 | (setq num (+ num 1))) |
| 1137 | (insert-buffer-substring (gdb-get-instance-buffer | 1082 | (insert-buffer-substring (gdb-get-instance-buffer |
| 1138 | gdb-buffer-instance | ||
| 1139 | 'gdb-partial-output-buffer) | 1083 | 'gdb-partial-output-buffer) |
| 1140 | start end) | 1084 | start end) |
| 1141 | (put-text-property (- (point) (- end start)) (- (point) 1) | 1085 | (put-text-property (- (point) (- end start)) (- (point) 1) |
| @@ -1145,6 +1089,8 @@ This filter may simply queue output for a later time." | |||
| 1145 | (setq buffer-read-only t)) | 1089 | (setq buffer-read-only t)) |
| 1146 | (delete-region start end))) | 1090 | (delete-region start end))) |
| 1147 | 1091 | ||
| 1092 | (defvar gdb-values) | ||
| 1093 | |||
| 1148 | (defun gdb-array-format () | 1094 | (defun gdb-array-format () |
| 1149 | (while (re-search-forward "##" nil t) | 1095 | (while (re-search-forward "##" nil t) |
| 1150 | ; keep making recursive calls... | 1096 | ; keep making recursive calls... |
| @@ -1170,6 +1116,31 @@ This filter may simply queue output for a later time." | |||
| 1170 | (setq gdb-nesting-level (- gdb-nesting-level 1)) | 1116 | (setq gdb-nesting-level (- gdb-nesting-level 1)) |
| 1171 | (gdb-array-format))))) | 1117 | (gdb-array-format))))) |
| 1172 | 1118 | ||
| 1119 | (defvar gdb-array-start) | ||
| 1120 | (defvar gdb-array-stop) | ||
| 1121 | |||
| 1122 | (defvar gdb-array-slice-map nil) | ||
| 1123 | (setq gdb-array-slice-map (make-keymap)) | ||
| 1124 | (define-key gdb-array-slice-map [mouse-2] 'gdb-array-slice) | ||
| 1125 | |||
| 1126 | (defun gdb-array-slice (event) | ||
| 1127 | "Select an array slice to display." | ||
| 1128 | (interactive "e") | ||
| 1129 | (mouse-set-point event) | ||
| 1130 | (save-excursion | ||
| 1131 | (let ((n -1) (stop 0) (start 0) (point (point))) | ||
| 1132 | (beginning-of-line) | ||
| 1133 | (while (search-forward "[" point t) | ||
| 1134 | (setq n (+ n 1))) | ||
| 1135 | (setq start (string-to-int (read-string "Start index: "))) | ||
| 1136 | (aset gdb-array-start n start) | ||
| 1137 | (setq stop (string-to-int (read-string "Stop index: "))) | ||
| 1138 | (aset gdb-array-stop n stop))) | ||
| 1139 | (gdb-array-format1)) | ||
| 1140 | |||
| 1141 | (defvar gdb-display-string) | ||
| 1142 | (defvar gdb-array-size) | ||
| 1143 | |||
| 1173 | (defun gdb-array-format1 () | 1144 | (defun gdb-array-format1 () |
| 1174 | (setq gdb-display-string "") | 1145 | (setq gdb-display-string "") |
| 1175 | (setq buffer-read-only nil) | 1146 | (setq buffer-read-only nil) |
| @@ -1247,59 +1218,12 @@ This filter may simply queue output for a later time." | |||
| 1247 | (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n")))) | 1218 | (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n")))) |
| 1248 | (setq buffer-read-only t)) | 1219 | (setq buffer-read-only t)) |
| 1249 | 1220 | ||
| 1250 | (setq gdb-dive-map (make-keymap)) | ||
| 1251 | (define-key gdb-dive-map [mouse-2] 'gdb-dive) | ||
| 1252 | (define-key gdb-dive-map [S-mouse-2] 'gdb-dive-new-frame) | ||
| 1253 | |||
| 1254 | (defun gdb-dive (event) | ||
| 1255 | "Dive into structure." | ||
| 1256 | (interactive "e") | ||
| 1257 | (setq gdb-dive t) | ||
| 1258 | (gdb-dive-new-frame event)) | ||
| 1259 | |||
| 1260 | (defun gdb-dive-new-frame (event) | ||
| 1261 | "Dive into structure and display in a new frame." | ||
| 1262 | (interactive "e") | ||
| 1263 | (save-excursion | ||
| 1264 | (mouse-set-point event) | ||
| 1265 | (let ((point (point)) (gdb-full-expression gdb-expression) | ||
| 1266 | (end (progn (end-of-line) (point))) | ||
| 1267 | (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil)) | ||
| 1268 | (beginning-of-line) | ||
| 1269 | (if (looking-at "\*") (setq gdb-display-char "*")) | ||
| 1270 | (re-search-forward "\\(\\S-+\\) = " end t) | ||
| 1271 | (setq gdb-last-field (buffer-substring-no-properties | ||
| 1272 | (match-beginning 1) | ||
| 1273 | (match-end 1))) | ||
| 1274 | (goto-char (match-beginning 1)) | ||
| 1275 | (let ((last-column (current-column))) | ||
| 1276 | (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t) | ||
| 1277 | (goto-char (match-beginning 1)) | ||
| 1278 | (if (and (< (current-column) last-column) | ||
| 1279 | (> (count-lines 1 (point)) 1)) | ||
| 1280 | (progn | ||
| 1281 | (setq gdb-part-expression | ||
| 1282 | (concat "." (buffer-substring-no-properties | ||
| 1283 | (match-beginning 1) | ||
| 1284 | (match-end 1)) gdb-part-expression)) | ||
| 1285 | (setq last-column (current-column)))))) | ||
| 1286 | ; * not needed for components of a pointer to a structure in gdb | ||
| 1287 | (if (string-equal "*" (substring gdb-full-expression 0 1)) | ||
| 1288 | (setq gdb-full-expression (substring gdb-full-expression 1 nil))) | ||
| 1289 | (setq gdb-full-expression | ||
| 1290 | (concat gdb-full-expression gdb-part-expression "." gdb-last-field)) | ||
| 1291 | (gdb-instance-enqueue-idle-input gdb-buffer-instance | ||
| 1292 | (list | ||
| 1293 | (concat "server display" gdb-display-char | ||
| 1294 | " " gdb-full-expression "\n") | ||
| 1295 | '(lambda () nil)))))) | ||
| 1296 | |||
| 1297 | ;; Handle a burst of output from a gdb instance. | 1221 | ;; Handle a burst of output from a gdb instance. |
| 1298 | ;; This function is (indirectly) used as a gud-marker-filter. | 1222 | ;; This function is (indirectly) used as a gud-marker-filter. |
| 1299 | ;; It must return output (if any) to be insterted in the gdb | 1223 | ;; It must return output (if any) to be insterted in the gdb |
| 1300 | ;; buffer. | 1224 | ;; buffer. |
| 1301 | 1225 | ||
| 1302 | (defun gdb-output-burst (instance string) | 1226 | (defun gdb-output-burst (string) |
| 1303 | "Handle a burst of output from a gdb instance. | 1227 | "Handle a burst of output from a gdb instance. |
| 1304 | This function is (indirectly) used as a gud-marker-filter. | 1228 | This function is (indirectly) used as a gud-marker-filter. |
| 1305 | It must return output (if any) to be insterted in the gdb | 1229 | It must return output (if any) to be insterted in the gdb |
| @@ -1308,7 +1232,7 @@ buffer." | |||
| 1308 | (save-match-data | 1232 | (save-match-data |
| 1309 | (let ( | 1233 | (let ( |
| 1310 | ;; Recall the left over burst from last time | 1234 | ;; Recall the left over burst from last time |
| 1311 | (burst (concat (gdb-instance-burst instance) string)) | 1235 | (burst (concat (gdb-instance-burst) string)) |
| 1312 | ;; Start accumulating output for the GUD buffer | 1236 | ;; Start accumulating output for the GUD buffer |
| 1313 | (output "")) | 1237 | (output "")) |
| 1314 | 1238 | ||
| @@ -1323,9 +1247,7 @@ buffer." | |||
| 1323 | ;; It is either concatenated to OUTPUT or directed | 1247 | ;; It is either concatenated to OUTPUT or directed |
| 1324 | ;; elsewhere. | 1248 | ;; elsewhere. |
| 1325 | (setq output | 1249 | (setq output |
| 1326 | (gdb-concat-output | 1250 | (gdb-concat-output output |
| 1327 | instance | ||
| 1328 | output | ||
| 1329 | (substring burst 0 (match-beginning 0)))) | 1251 | (substring burst 0 (match-beginning 0)))) |
| 1330 | 1252 | ||
| 1331 | ;; Take that stuff off the burst. | 1253 | ;; Take that stuff off the burst. |
| @@ -1344,7 +1266,6 @@ buffer." | |||
| 1344 | ;; Call the handler for this annotation. | 1266 | ;; Call the handler for this annotation. |
| 1345 | (if annotation-rule | 1267 | (if annotation-rule |
| 1346 | (funcall (car (cdr annotation-rule)) | 1268 | (funcall (car (cdr annotation-rule)) |
| 1347 | instance | ||
| 1348 | annotation-arguments) | 1269 | annotation-arguments) |
| 1349 | ;; Else the annotation is not recognized. Ignore it silently, | 1270 | ;; Else the annotation is not recognized. Ignore it silently, |
| 1350 | ;; so that GDB can add new annotations without causing | 1271 | ;; so that GDB can add new annotations without causing |
| @@ -1359,9 +1280,7 @@ buffer." | |||
| 1359 | (progn | 1280 | (progn |
| 1360 | ;; Everything before the potential marker start can be output. | 1281 | ;; Everything before the potential marker start can be output. |
| 1361 | (setq output | 1282 | (setq output |
| 1362 | (gdb-concat-output | 1283 | (gdb-concat-output output |
| 1363 | instance | ||
| 1364 | output | ||
| 1365 | (substring burst 0 (match-beginning 0)))) | 1284 | (substring burst 0 (match-beginning 0)))) |
| 1366 | 1285 | ||
| 1367 | ;; Everything after, we save, to combine with later input. | 1286 | ;; Everything after, we save, to combine with later input. |
| @@ -1369,57 +1288,52 @@ buffer." | |||
| 1369 | 1288 | ||
| 1370 | ;; In case we know the burst contains no partial annotations: | 1289 | ;; In case we know the burst contains no partial annotations: |
| 1371 | (progn | 1290 | (progn |
| 1372 | (setq output (gdb-concat-output instance output burst)) | 1291 | (setq output (gdb-concat-output output burst)) |
| 1373 | (setq burst ""))) | 1292 | (setq burst ""))) |
| 1374 | 1293 | ||
| 1375 | ;; Save the remaining burst for the next call to this function. | 1294 | ;; Save the remaining burst for the next call to this function. |
| 1376 | (set-gdb-instance-burst instance burst) | 1295 | (set-gdb-instance-burst burst) |
| 1377 | output))) | 1296 | output))) |
| 1378 | 1297 | ||
| 1379 | (defun gdb-concat-output (instance so-far new) | 1298 | (defun gdb-concat-output (so-far new) |
| 1380 | (let ((sink (gdb-instance-output-sink instance))) | 1299 | (let ((sink (gdb-instance-output-sink ))) |
| 1381 | (cond | 1300 | (cond |
| 1382 | ((eq sink 'user) (concat so-far new)) | 1301 | ((eq sink 'user) (concat so-far new)) |
| 1383 | ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) | 1302 | ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) |
| 1384 | ((eq sink 'emacs) | 1303 | ((eq sink 'emacs) |
| 1385 | (gdb-append-to-partial-output instance new) | 1304 | (gdb-append-to-partial-output new) |
| 1386 | so-far) | 1305 | so-far) |
| 1387 | ((eq sink 'inferior) | 1306 | ((eq sink 'inferior) |
| 1388 | (gdb-append-to-inferior-io instance new) | 1307 | (gdb-append-to-inferior-io new) |
| 1389 | so-far) | 1308 | so-far) |
| 1390 | (t (error "Bogon output sink %S" sink))))) | 1309 | (t (error "Bogon output sink %S" sink))))) |
| 1391 | 1310 | ||
| 1392 | (defun gdb-append-to-partial-output (instance string) | 1311 | (defun gdb-append-to-partial-output (string) |
| 1393 | (save-excursion | 1312 | (save-excursion |
| 1394 | (set-buffer | 1313 | (set-buffer |
| 1395 | (gdb-get-create-instance-buffer | 1314 | (gdb-get-create-instance-buffer 'gdb-partial-output-buffer)) |
| 1396 | instance 'gdb-partial-output-buffer)) | ||
| 1397 | (goto-char (point-max)) | 1315 | (goto-char (point-max)) |
| 1398 | (insert string))) | 1316 | (insert string))) |
| 1399 | 1317 | ||
| 1400 | (defun gdb-clear-partial-output (instance) | 1318 | (defun gdb-clear-partial-output () |
| 1401 | (save-excursion | 1319 | (save-excursion |
| 1402 | (set-buffer | 1320 | (set-buffer |
| 1403 | (gdb-get-create-instance-buffer | 1321 | (gdb-get-create-instance-buffer 'gdb-partial-output-buffer)) |
| 1404 | instance 'gdb-partial-output-buffer)) | ||
| 1405 | (delete-region (point-min) (point-max)))) | 1322 | (delete-region (point-min) (point-max)))) |
| 1406 | 1323 | ||
| 1407 | (defun gdb-append-to-inferior-io (instance string) | 1324 | (defun gdb-append-to-inferior-io (string) |
| 1408 | (save-excursion | 1325 | (save-excursion |
| 1409 | (set-buffer | 1326 | (set-buffer |
| 1410 | (gdb-get-create-instance-buffer | 1327 | (gdb-get-create-instance-buffer 'gdb-inferior-io)) |
| 1411 | instance 'gdb-inferior-io)) | ||
| 1412 | (goto-char (point-max)) | 1328 | (goto-char (point-max)) |
| 1413 | (insert-before-markers string)) | 1329 | (insert-before-markers string)) |
| 1414 | (gdb-display-buffer | 1330 | (gdb-display-buffer |
| 1415 | (gdb-get-create-instance-buffer instance | 1331 | (gdb-get-create-instance-buffer 'gdb-inferior-io))) |
| 1416 | 'gdb-inferior-io))) | ||
| 1417 | 1332 | ||
| 1418 | (defun gdb-clear-inferior-io (instance) | 1333 | (defun gdb-clear-inferior-io () |
| 1419 | (save-excursion | 1334 | (save-excursion |
| 1420 | (set-buffer | 1335 | (set-buffer |
| 1421 | (gdb-get-create-instance-buffer | 1336 | (gdb-get-create-instance-buffer 'gdb-inferior-io)) |
| 1422 | instance 'gdb-inferior-io)) | ||
| 1423 | (delete-region (point-min) (point-max)))) | 1337 | (delete-region (point-min) (point-max)))) |
| 1424 | 1338 | ||
| 1425 | 1339 | ||
| @@ -1433,7 +1347,7 @@ buffer." | |||
| 1433 | ;; the command behind the user's back. | 1347 | ;; the command behind the user's back. |
| 1434 | ;; | 1348 | ;; |
| 1435 | ;; The idle input queue and the output phasing associated with | 1349 | ;; The idle input queue and the output phasing associated with |
| 1436 | ;; the instance variable `(gdb-instance-output-sink instance)' help | 1350 | ;; the instance variable `(gdb-instance-output-sink)' help |
| 1437 | ;; us to run commands behind the user's back. | 1351 | ;; us to run commands behind the user's back. |
| 1438 | ;; | 1352 | ;; |
| 1439 | ;; Below is the code for specificly managing buffers of output from one | 1353 | ;; Below is the code for specificly managing buffers of output from one |
| @@ -1450,27 +1364,23 @@ buffer." | |||
| 1450 | ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the | 1364 | ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the |
| 1451 | ;; input in the input queue (see comment about ``gdb communications'' above). | 1365 | ;; input in the input queue (see comment about ``gdb communications'' above). |
| 1452 | (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler) | 1366 | (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler) |
| 1453 | `(defun ,name (instance &optional ignored) | 1367 | `(defun ,name (&optional ignored) |
| 1454 | (if (and (,demand-predicate instance) | 1368 | (if (and (,demand-predicate) |
| 1455 | (not (member ',name | 1369 | (not (member ',name |
| 1456 | (gdb-instance-pending-triggers instance)))) | 1370 | (gdb-instance-pending-triggers)))) |
| 1457 | (progn | 1371 | (progn |
| 1458 | (gdb-instance-enqueue-idle-input | 1372 | (gdb-instance-enqueue-idle-input |
| 1459 | instance | ||
| 1460 | (list ,gdb-command ',output-handler)) | 1373 | (list ,gdb-command ',output-handler)) |
| 1461 | (set-gdb-instance-pending-triggers | 1374 | (set-gdb-instance-pending-triggers |
| 1462 | instance | ||
| 1463 | (cons ',name | 1375 | (cons ',name |
| 1464 | (gdb-instance-pending-triggers instance))))))) | 1376 | (gdb-instance-pending-triggers))))))) |
| 1465 | 1377 | ||
| 1466 | (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) | 1378 | (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) |
| 1467 | `(defun ,name () | 1379 | `(defun ,name () |
| 1468 | (set-gdb-instance-pending-triggers | 1380 | (set-gdb-instance-pending-triggers |
| 1469 | instance | ||
| 1470 | (delq ',trigger | 1381 | (delq ',trigger |
| 1471 | (gdb-instance-pending-triggers instance))) | 1382 | (gdb-instance-pending-triggers))) |
| 1472 | (let ((buf (gdb-get-instance-buffer instance | 1383 | (let ((buf (gdb-get-instance-buffer ',buf-key))) |
| 1473 | ',buf-key))) | ||
| 1474 | (and buf | 1384 | (and buf |
| 1475 | (save-excursion | 1385 | (save-excursion |
| 1476 | (set-buffer buf) | 1386 | (set-buffer buf) |
| @@ -1478,7 +1388,6 @@ buffer." | |||
| 1478 | (buffer-read-only nil)) | 1388 | (buffer-read-only nil)) |
| 1479 | (delete-region (point-min) (point-max)) | 1389 | (delete-region (point-min) (point-max)) |
| 1480 | (insert-buffer (gdb-get-create-instance-buffer | 1390 | (insert-buffer (gdb-get-create-instance-buffer |
| 1481 | instance | ||
| 1482 | 'gdb-partial-output-buffer)) | 1391 | 'gdb-partial-output-buffer)) |
| 1483 | (goto-char p))))) | 1392 | (goto-char p))))) |
| 1484 | ; put customisation here | 1393 | ; put customisation here |
| @@ -1489,8 +1398,8 @@ buffer." | |||
| 1489 | `(progn | 1398 | `(progn |
| 1490 | (def-gdb-auto-update-trigger ,trigger-name | 1399 | (def-gdb-auto-update-trigger ,trigger-name |
| 1491 | ;; The demand predicate: | 1400 | ;; The demand predicate: |
| 1492 | (lambda (instance) | 1401 | (lambda () |
| 1493 | (gdb-get-instance-buffer instance ',buffer-key)) | 1402 | (gdb-get-instance-buffer ',buffer-key)) |
| 1494 | ,gdb-command | 1403 | ,gdb-command |
| 1495 | ,output-handler-name) | 1404 | ,output-handler-name) |
| 1496 | (def-gdb-auto-update-handler ,output-handler-name | 1405 | (def-gdb-auto-update-handler ,output-handler-name |
| @@ -1526,6 +1435,12 @@ buffer." | |||
| 1526 | ;; buffer specific functions | 1435 | ;; buffer specific functions |
| 1527 | gdb-info-breakpoints-custom) | 1436 | gdb-info-breakpoints-custom) |
| 1528 | 1437 | ||
| 1438 | (defvar gdb-cdir nil "Compilation directory.") | ||
| 1439 | (defvar breakpoint-enabled-icon | ||
| 1440 | "Icon for enabled breakpoint in display margin") | ||
| 1441 | (defvar breakpoint-disabled-icon | ||
| 1442 | "Icon for disabled breakpoint in display margin") | ||
| 1443 | |||
| 1529 | ;-put breakpoint icons in relevant margins (even those set in the GUD buffer) | 1444 | ;-put breakpoint icons in relevant margins (even those set in the GUD buffer) |
| 1530 | (defun gdb-info-breakpoints-custom () | 1445 | (defun gdb-info-breakpoints-custom () |
| 1531 | (let ((flag)(address)) | 1446 | (let ((flag)(address)) |
| @@ -1543,7 +1458,7 @@ buffer." | |||
| 1543 | (setq buffers (cdr buffers))))) | 1458 | (setq buffers (cdr buffers))))) |
| 1544 | 1459 | ||
| 1545 | (save-excursion | 1460 | (save-excursion |
| 1546 | (set-buffer (gdb-get-instance-buffer instance 'gdb-breakpoints-buffer)) | 1461 | (set-buffer (gdb-get-instance-buffer 'gdb-breakpoints-buffer)) |
| 1547 | (save-excursion | 1462 | (save-excursion |
| 1548 | (goto-char (point-min)) | 1463 | (goto-char (point-min)) |
| 1549 | (while (< (point) (- (point-max) 1)) | 1464 | (while (< (point) (- (point-max) 1)) |
| @@ -1570,7 +1485,7 @@ buffer." | |||
| 1570 | (set (make-local-variable 'gud-minor-mode) 'gdba) | 1485 | (set (make-local-variable 'gud-minor-mode) 'gdba) |
| 1571 | (set (make-local-variable 'tool-bar-map) | 1486 | (set (make-local-variable 'tool-bar-map) |
| 1572 | gud-tool-bar-map) | 1487 | gud-tool-bar-map) |
| 1573 | (set (make-variable-buffer-local 'left-margin-width) 2) | 1488 | (setq left-margin-width 2) |
| 1574 | (if (get-buffer-window (current-buffer)) | 1489 | (if (get-buffer-window (current-buffer)) |
| 1575 | (set-window-margins (get-buffer-window | 1490 | (set-window-margins (get-buffer-window |
| 1576 | (current-buffer)) | 1491 | (current-buffer)) |
| @@ -1599,22 +1514,20 @@ buffer." | |||
| 1599 | 'left-margin))))))))) | 1514 | 'left-margin))))))))) |
| 1600 | (end-of-line)))))) | 1515 | (end-of-line)))))) |
| 1601 | 1516 | ||
| 1602 | (defun gdb-breakpoints-buffer-name (instance) | 1517 | (defun gdb-breakpoints-buffer-name () |
| 1603 | (save-excursion | 1518 | (save-excursion |
| 1604 | (set-buffer (process-buffer (gdb-instance-process instance))) | 1519 | (set-buffer (process-buffer gdb-proc)) |
| 1605 | (concat "*breakpoints of " (gdb-instance-target-string instance) "*"))) | 1520 | (concat "*breakpoints of " (gdb-instance-target-string) "*"))) |
| 1606 | 1521 | ||
| 1607 | (defun gdb-display-breakpoints-buffer (instance) | 1522 | (defun gdb-display-breakpoints-buffer () |
| 1608 | (interactive (list (gdb-needed-default-instance))) | 1523 | (interactive (list gdb-proc)) |
| 1609 | (gdb-display-buffer | 1524 | (gdb-display-buffer |
| 1610 | (gdb-get-create-instance-buffer instance | 1525 | (gdb-get-create-instance-buffer 'gdb-breakpoints-buffer))) |
| 1611 | 'gdb-breakpoints-buffer))) | ||
| 1612 | 1526 | ||
| 1613 | (defun gdb-frame-breakpoints-buffer (instance) | 1527 | (defun gdb-frame-breakpoints-buffer () |
| 1614 | (interactive (list (gdb-needed-default-instance))) | 1528 | (interactive (list gdb-proc)) |
| 1615 | (switch-to-buffer-other-frame | 1529 | (switch-to-buffer-other-frame |
| 1616 | (gdb-get-create-instance-buffer instance | 1530 | (gdb-get-create-instance-buffer 'gdb-breakpoints-buffer))) |
| 1617 | 'gdb-breakpoints-buffer))) | ||
| 1618 | 1531 | ||
| 1619 | (defvar gdb-breakpoints-mode-map nil) | 1532 | (defvar gdb-breakpoints-mode-map nil) |
| 1620 | (setq gdb-breakpoints-mode-map (make-keymap)) | 1533 | (setq gdb-breakpoints-mode-map (make-keymap)) |
| @@ -1643,7 +1556,7 @@ buffer." | |||
| 1643 | (set (make-local-variable 'gud-minor-mode) 'gdba) | 1556 | (set (make-local-variable 'gud-minor-mode) 'gdba) |
| 1644 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | 1557 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
| 1645 | (setq buffer-read-only t) | 1558 | (setq buffer-read-only t) |
| 1646 | (gdb-invalidate-breakpoints gdb-buffer-instance)) | 1559 | (gdb-invalidate-breakpoints)) |
| 1647 | 1560 | ||
| 1648 | (defun gdb-toggle-bp-this-line () | 1561 | (defun gdb-toggle-bp-this-line () |
| 1649 | (interactive) | 1562 | (interactive) |
| @@ -1652,7 +1565,6 @@ buffer." | |||
| 1652 | (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) | 1565 | (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) |
| 1653 | (error "Not recognized as break/watchpoint line") | 1566 | (error "Not recognized as break/watchpoint line") |
| 1654 | (gdb-instance-enqueue-idle-input | 1567 | (gdb-instance-enqueue-idle-input |
| 1655 | gdb-buffer-instance | ||
| 1656 | (list | 1568 | (list |
| 1657 | (concat | 1569 | (concat |
| 1658 | (if (eq ?y (char-after (match-beginning 2))) | 1570 | (if (eq ?y (char-after (match-beginning 2))) |
| @@ -1669,7 +1581,6 @@ buffer." | |||
| 1669 | (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) | 1581 | (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) |
| 1670 | (error "Not recognized as break/watchpoint line") | 1582 | (error "Not recognized as break/watchpoint line") |
| 1671 | (gdb-instance-enqueue-idle-input | 1583 | (gdb-instance-enqueue-idle-input |
| 1672 | gdb-buffer-instance | ||
| 1673 | (list | 1584 | (list |
| 1674 | (concat | 1585 | (concat |
| 1675 | "server delete " | 1586 | "server delete " |
| @@ -1678,6 +1589,8 @@ buffer." | |||
| 1678 | "\n") | 1589 | "\n") |
| 1679 | '(lambda () nil))))) | 1590 | '(lambda () nil))))) |
| 1680 | 1591 | ||
| 1592 | (defvar gdb-source-window nil) | ||
| 1593 | |||
| 1681 | (defun gdb-goto-bp-this-line () | 1594 | (defun gdb-goto-bp-this-line () |
| 1682 | "Display the file at the breakpoint specified." | 1595 | "Display the file at the breakpoint specified." |
| 1683 | (interactive) | 1596 | (interactive) |
| @@ -1715,7 +1628,7 @@ buffer." | |||
| 1715 | 1628 | ||
| 1716 | (defun gdb-info-frames-custom () | 1629 | (defun gdb-info-frames-custom () |
| 1717 | (save-excursion | 1630 | (save-excursion |
| 1718 | (set-buffer (gdb-get-instance-buffer instance 'gdb-stack-buffer)) | 1631 | (set-buffer (gdb-get-instance-buffer 'gdb-stack-buffer)) |
| 1719 | (let ((buffer-read-only nil)) | 1632 | (let ((buffer-read-only nil)) |
| 1720 | (goto-char (point-min)) | 1633 | (goto-char (point-min)) |
| 1721 | (looking-at "\\S-*\\s-*\\(\\S-*\\)") | 1634 | (looking-at "\\S-*\\s-*\\(\\S-*\\)") |
| @@ -1726,23 +1639,21 @@ buffer." | |||
| 1726 | 'mouse-face 'highlight) | 1639 | 'mouse-face 'highlight) |
| 1727 | (forward-line 1))))) | 1640 | (forward-line 1))))) |
| 1728 | 1641 | ||
| 1729 | (defun gdb-stack-buffer-name (instance) | 1642 | (defun gdb-stack-buffer-name () |
| 1730 | (save-excursion | 1643 | (save-excursion |
| 1731 | (set-buffer (process-buffer (gdb-instance-process instance))) | 1644 | (set-buffer (process-buffer gdb-proc)) |
| 1732 | (concat "*stack frames of " | 1645 | (concat "*stack frames of " |
| 1733 | (gdb-instance-target-string instance) "*"))) | 1646 | (gdb-instance-target-string) "*"))) |
| 1734 | 1647 | ||
| 1735 | (defun gdb-display-stack-buffer (instance) | 1648 | (defun gdb-display-stack-buffer () |
| 1736 | (interactive (list (gdb-needed-default-instance))) | 1649 | (interactive (list gdb-proc)) |
| 1737 | (gdb-display-buffer | 1650 | (gdb-display-buffer |
| 1738 | (gdb-get-create-instance-buffer instance | 1651 | (gdb-get-create-instance-buffer 'gdb-stack-buffer))) |
| 1739 | 'gdb-stack-buffer))) | ||
| 1740 | 1652 | ||
| 1741 | (defun gdb-frame-stack-buffer (instance) | 1653 | (defun gdb-frame-stack-buffer () |
| 1742 | (interactive (list (gdb-needed-default-instance))) | 1654 | (interactive (list gdb-proc)) |
| 1743 | (switch-to-buffer-other-frame | 1655 | (switch-to-buffer-other-frame |
| 1744 | (gdb-get-create-instance-buffer instance | 1656 | (gdb-get-create-instance-buffer 'gdb-stack-buffer))) |
| 1745 | 'gdb-stack-buffer))) | ||
| 1746 | 1657 | ||
| 1747 | (defvar gdb-frames-mode-map nil) | 1658 | (defvar gdb-frames-mode-map nil) |
| 1748 | (setq gdb-frames-mode-map (make-keymap)) | 1659 | (setq gdb-frames-mode-map (make-keymap)) |
| @@ -1760,7 +1671,7 @@ buffer." | |||
| 1760 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | 1671 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
| 1761 | (setq buffer-read-only t) | 1672 | (setq buffer-read-only t) |
| 1762 | (use-local-map gdb-frames-mode-map) | 1673 | (use-local-map gdb-frames-mode-map) |
| 1763 | (gdb-invalidate-frames gdb-buffer-instance)) | 1674 | (gdb-invalidate-frames)) |
| 1764 | 1675 | ||
| 1765 | (defun gdb-get-frame-number () | 1676 | (defun gdb-get-frame-number () |
| 1766 | (save-excursion | 1677 | (save-excursion |
| @@ -1783,9 +1694,8 @@ buffer." | |||
| 1783 | (setq selection (gdb-get-frame-number)))) | 1694 | (setq selection (gdb-get-frame-number)))) |
| 1784 | (select-window (posn-window (event-end e))) | 1695 | (select-window (posn-window (event-end e))) |
| 1785 | (save-excursion | 1696 | (save-excursion |
| 1786 | (set-buffer (gdb-get-instance-buffer (gdb-needed-default-instance) 'gdba)) | 1697 | (set-buffer (gdb-get-instance-buffer 'gdba)) |
| 1787 | (gdb-instance-enqueue-idle-input | 1698 | (gdb-instance-enqueue-idle-input |
| 1788 | gdb-buffer-instance | ||
| 1789 | (list | 1699 | (list |
| 1790 | (concat (gud-format-command "server frame %p" selection) | 1700 | (concat (gud-format-command "server frame %p" selection) |
| 1791 | "\n") | 1701 | "\n") |
| @@ -1823,24 +1733,22 @@ buffer." | |||
| 1823 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | 1733 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
| 1824 | (setq buffer-read-only t) | 1734 | (setq buffer-read-only t) |
| 1825 | (use-local-map gdb-registers-mode-map) | 1735 | (use-local-map gdb-registers-mode-map) |
| 1826 | (gdb-invalidate-registers gdb-buffer-instance)) | 1736 | (gdb-invalidate-registers)) |
| 1827 | 1737 | ||
| 1828 | (defun gdb-registers-buffer-name (instance) | 1738 | (defun gdb-registers-buffer-name () |
| 1829 | (save-excursion | 1739 | (save-excursion |
| 1830 | (set-buffer (process-buffer (gdb-instance-process instance))) | 1740 | (set-buffer (process-buffer gdb-proc)) |
| 1831 | (concat "*registers of " (gdb-instance-target-string instance) "*"))) | 1741 | (concat "*registers of " (gdb-instance-target-string) "*"))) |
| 1832 | 1742 | ||
| 1833 | (defun gdb-display-registers-buffer (instance) | 1743 | (defun gdb-display-registers-buffer () |
| 1834 | (interactive (list (gdb-needed-default-instance))) | 1744 | (interactive (list gdb-proc)) |
| 1835 | (gdb-display-buffer | 1745 | (gdb-display-buffer |
| 1836 | (gdb-get-create-instance-buffer instance | 1746 | (gdb-get-create-instance-buffer 'gdb-registers-buffer))) |
| 1837 | 'gdb-registers-buffer))) | ||
| 1838 | 1747 | ||
| 1839 | (defun gdb-frame-registers-buffer (instance) | 1748 | (defun gdb-frame-registers-buffer () |
| 1840 | (interactive (list (gdb-needed-default-instance))) | 1749 | (interactive (list gdb-proc)) |
| 1841 | (switch-to-buffer-other-frame | 1750 | (switch-to-buffer-other-frame |
| 1842 | (gdb-get-create-instance-buffer instance | 1751 | (gdb-get-create-instance-buffer 'gdb-registers-buffer))) |
| 1843 | 'gdb-registers-buffer))) | ||
| 1844 | 1752 | ||
| 1845 | ;; | 1753 | ;; |
| 1846 | ;; Locals buffers | 1754 | ;; Locals buffers |
| @@ -1855,11 +1763,9 @@ buffer." | |||
| 1855 | 1763 | ||
| 1856 | ;Abbreviate for arrays and structures. These can be expanded using gud-display | 1764 | ;Abbreviate for arrays and structures. These can be expanded using gud-display |
| 1857 | (defun gdb-info-locals-handler nil | 1765 | (defun gdb-info-locals-handler nil |
| 1858 | (set-gdb-instance-pending-triggers | 1766 | (set-gdb-instance-pending-triggers (delq (quote gdb-invalidate-locals) |
| 1859 | instance (delq (quote gdb-invalidate-locals) | 1767 | (gdb-instance-pending-triggers))) |
| 1860 | (gdb-instance-pending-triggers instance))) | 1768 | (let ((buf (gdb-get-instance-buffer (quote gdb-partial-output-buffer)))) |
| 1861 | (let ((buf (gdb-get-instance-buffer instance | ||
| 1862 | (quote gdb-partial-output-buffer)))) | ||
| 1863 | (save-excursion | 1769 | (save-excursion |
| 1864 | (set-buffer buf) | 1770 | (set-buffer buf) |
| 1865 | (goto-char (point-min)) | 1771 | (goto-char (point-min)) |
| @@ -1868,14 +1774,13 @@ buffer." | |||
| 1868 | (replace-regexp "{[-0-9, {}\]*\n" "(array);\n"))) | 1774 | (replace-regexp "{[-0-9, {}\]*\n" "(array);\n"))) |
| 1869 | (goto-char (point-min)) | 1775 | (goto-char (point-min)) |
| 1870 | (replace-regexp "{.*=.*\n" "(structure);\n") | 1776 | (replace-regexp "{.*=.*\n" "(structure);\n") |
| 1871 | (let ((buf (gdb-get-instance-buffer instance (quote gdb-locals-buffer)))) | 1777 | (let ((buf (gdb-get-instance-buffer (quote gdb-locals-buffer)))) |
| 1872 | (and buf (save-excursion | 1778 | (and buf (save-excursion |
| 1873 | (set-buffer buf) | 1779 | (set-buffer buf) |
| 1874 | (let ((p (point)) | 1780 | (let ((p (point)) |
| 1875 | (buffer-read-only nil)) | 1781 | (buffer-read-only nil)) |
| 1876 | (delete-region (point-min) (point-max)) | 1782 | (delete-region (point-min) (point-max)) |
| 1877 | (insert-buffer (gdb-get-create-instance-buffer | 1783 | (insert-buffer (gdb-get-create-instance-buffer |
| 1878 | instance | ||
| 1879 | (quote gdb-partial-output-buffer))) | 1784 | (quote gdb-partial-output-buffer))) |
| 1880 | (goto-char p))))) | 1785 | (goto-char p))))) |
| 1881 | (run-hooks (quote gdb-info-locals-hook))) | 1786 | (run-hooks (quote gdb-info-locals-hook))) |
| @@ -1901,24 +1806,22 @@ buffer." | |||
| 1901 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | 1806 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
| 1902 | (setq buffer-read-only t) | 1807 | (setq buffer-read-only t) |
| 1903 | (use-local-map gdb-locals-mode-map) | 1808 | (use-local-map gdb-locals-mode-map) |
| 1904 | (gdb-invalidate-locals gdb-buffer-instance)) | 1809 | (gdb-invalidate-locals)) |
| 1905 | 1810 | ||
| 1906 | (defun gdb-locals-buffer-name (instance) | 1811 | (defun gdb-locals-buffer-name () |
| 1907 | (save-excursion | 1812 | (save-excursion |
| 1908 | (set-buffer (process-buffer (gdb-instance-process instance))) | 1813 | (set-buffer (process-buffer gdb-proc)) |
| 1909 | (concat "*locals of " (gdb-instance-target-string instance) "*"))) | 1814 | (concat "*locals of " (gdb-instance-target-string) "*"))) |
| 1910 | 1815 | ||
| 1911 | (defun gdb-display-locals-buffer (instance) | 1816 | (defun gdb-display-locals-buffer () |
| 1912 | (interactive (list (gdb-needed-default-instance))) | 1817 | (interactive (list gdb-proc)) |
| 1913 | (gdb-display-buffer | 1818 | (gdb-display-buffer |
| 1914 | (gdb-get-create-instance-buffer instance | 1819 | (gdb-get-create-instance-buffer 'gdb-locals-buffer))) |
| 1915 | 'gdb-locals-buffer))) | ||
| 1916 | 1820 | ||
| 1917 | (defun gdb-frame-locals-buffer (instance) | 1821 | (defun gdb-frame-locals-buffer () |
| 1918 | (interactive (list (gdb-needed-default-instance))) | 1822 | (interactive (list gdb-proc)) |
| 1919 | (switch-to-buffer-other-frame | 1823 | (switch-to-buffer-other-frame |
| 1920 | (gdb-get-create-instance-buffer instance | 1824 | (gdb-get-create-instance-buffer 'gdb-locals-buffer))) |
| 1921 | 'gdb-locals-buffer))) | ||
| 1922 | ;; | 1825 | ;; |
| 1923 | ;; Display expression buffers (just allow one to start with) | 1826 | ;; Display expression buffers (just allow one to start with) |
| 1924 | ;; | 1827 | ;; |
| @@ -1974,24 +1877,22 @@ buffer." | |||
| 1974 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | 1877 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
| 1975 | (setq buffer-read-only t) | 1878 | (setq buffer-read-only t) |
| 1976 | (use-local-map gdb-display-mode-map) | 1879 | (use-local-map gdb-display-mode-map) |
| 1977 | (gdb-invalidate-display gdb-buffer-instance)) | 1880 | (gdb-invalidate-display)) |
| 1978 | 1881 | ||
| 1979 | (defun gdb-display-buffer-name (instance) | 1882 | (defun gdb-display-buffer-name () |
| 1980 | (save-excursion | 1883 | (save-excursion |
| 1981 | (set-buffer (process-buffer (gdb-instance-process instance))) | 1884 | (set-buffer (process-buffer gdb-proc)) |
| 1982 | (concat "*Displayed expressions of " (gdb-instance-target-string instance) "*"))) | 1885 | (concat "*Displayed expressions of " (gdb-instance-target-string) "*"))) |
| 1983 | 1886 | ||
| 1984 | (defun gdb-display-display-buffer (instance) | 1887 | (defun gdb-display-display-buffer () |
| 1985 | (interactive (list (gdb-needed-default-instance))) | 1888 | (interactive (list gdb-proc)) |
| 1986 | (gdb-display-buffer | 1889 | (gdb-display-buffer |
| 1987 | (gdb-get-create-instance-buffer instance | 1890 | (gdb-get-create-instance-buffer 'gdb-display-buffer))) |
| 1988 | 'gdb-display-buffer))) | ||
| 1989 | 1891 | ||
| 1990 | (defun gdb-frame-display-buffer (instance) | 1892 | (defun gdb-frame-display-buffer () |
| 1991 | (interactive (list (gdb-needed-default-instance))) | 1893 | (interactive (list gdb-proc)) |
| 1992 | (switch-to-buffer-other-frame | 1894 | (switch-to-buffer-other-frame |
| 1993 | (gdb-get-create-instance-buffer instance | 1895 | (gdb-get-create-instance-buffer 'gdb-display-buffer))) |
| 1994 | 'gdb-display-buffer))) | ||
| 1995 | 1896 | ||
| 1996 | (defun gdb-toggle-disp-this-line () | 1897 | (defun gdb-toggle-disp-this-line () |
| 1997 | (interactive) | 1898 | (interactive) |
| @@ -2000,7 +1901,6 @@ buffer." | |||
| 2000 | (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) | 1901 | (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) |
| 2001 | (error "No expression on this line") | 1902 | (error "No expression on this line") |
| 2002 | (gdb-instance-enqueue-idle-input | 1903 | (gdb-instance-enqueue-idle-input |
| 2003 | gdb-buffer-instance | ||
| 2004 | (list | 1904 | (list |
| 2005 | (concat | 1905 | (concat |
| 2006 | (if (eq ?y (char-after (match-beginning 2))) | 1906 | (if (eq ?y (char-after (match-beginning 2))) |
| @@ -2015,14 +1915,13 @@ buffer." | |||
| 2015 | (interactive) | 1915 | (interactive) |
| 2016 | (save-excursion | 1916 | (save-excursion |
| 2017 | (set-buffer | 1917 | (set-buffer |
| 2018 | (gdb-get-instance-buffer gdb-buffer-instance 'gdb-display-buffer)) | 1918 | (gdb-get-instance-buffer 'gdb-display-buffer)) |
| 2019 | (beginning-of-line 1) | 1919 | (beginning-of-line 1) |
| 2020 | (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) | 1920 | (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) |
| 2021 | (error "No expression on this line") | 1921 | (error "No expression on this line") |
| 2022 | (let ((number (buffer-substring (match-beginning 0) | 1922 | (let ((number (buffer-substring (match-beginning 0) |
| 2023 | (match-end 1)))) | 1923 | (match-end 1)))) |
| 2024 | (gdb-instance-enqueue-idle-input | 1924 | (gdb-instance-enqueue-idle-input |
| 2025 | gdb-buffer-instance | ||
| 2026 | (list (concat "server delete display " number "\n") | 1925 | (list (concat "server delete display " number "\n") |
| 2027 | '(lambda () nil))) | 1926 | '(lambda () nil))) |
| 2028 | (if (not (display-graphic-p)) | 1927 | (if (not (display-graphic-p)) |
| @@ -2081,7 +1980,7 @@ buffer." | |||
| 2081 | 1980 | ||
| 2082 | ;;;; Window management | 1981 | ;;;; Window management |
| 2083 | 1982 | ||
| 2084 | ;;; FIXME: This should only return true for buffers in the current instance | 1983 | ;;; FIXME: This should only return true for buffers in the current gdb-proc |
| 2085 | (defun gdb-protected-buffer-p (buffer) | 1984 | (defun gdb-protected-buffer-p (buffer) |
| 2086 | "Is BUFFER a buffer which we want to leave displayed?" | 1985 | "Is BUFFER a buffer which we want to leave displayed?" |
| 2087 | (save-excursion | 1986 | (save-excursion |
| @@ -2129,10 +2028,10 @@ buffer." | |||
| 2129 | 2028 | ||
| 2130 | ;;; Shared keymap initialization: | 2029 | ;;; Shared keymap initialization: |
| 2131 | 2030 | ||
| 2132 | (defun gdb-display-gdb-buffer (instance) | 2031 | (defun gdb-display-gdb-buffer () |
| 2133 | (interactive (list (gdb-needed-default-instance))) | 2032 | (interactive (list gdb-proc)) |
| 2134 | (gdb-display-buffer | 2033 | (gdb-display-buffer |
| 2135 | (gdb-get-create-instance-buffer instance 'gdba))) | 2034 | (gdb-get-create-instance-buffer 'gdba))) |
| 2136 | 2035 | ||
| 2137 | (defun gdb-make-windows-menu (map) | 2036 | (defun gdb-make-windows-menu (map) |
| 2138 | ;; FIXME: This adds to the DBX, PerlDB, ... menu as well :-( | 2037 | ;; FIXME: This adds to the DBX, PerlDB, ... menu as well :-( |
| @@ -2161,10 +2060,10 @@ buffer." | |||
| 2161 | 2060 | ||
| 2162 | (gdb-make-windows-menu gud-minor-mode-map) | 2061 | (gdb-make-windows-menu gud-minor-mode-map) |
| 2163 | 2062 | ||
| 2164 | (defun gdb-frame-gdb-buffer (instance) | 2063 | (defun gdb-frame-gdb-buffer () |
| 2165 | (interactive (list (gdb-needed-default-instance))) | 2064 | (interactive (list gdb-proc)) |
| 2166 | (switch-to-buffer-other-frame | 2065 | (switch-to-buffer-other-frame |
| 2167 | (gdb-get-create-instance-buffer instance 'gdba))) | 2066 | (gdb-get-create-instance-buffer 'gdba))) |
| 2168 | 2067 | ||
| 2169 | (defun gdb-make-frames-menu (map) | 2068 | (defun gdb-make-frames-menu (map) |
| 2170 | (define-key map [menu-bar frames] | 2069 | (define-key map [menu-bar frames] |
| @@ -2187,32 +2086,25 @@ buffer." | |||
| 2187 | (if (display-graphic-p) | 2086 | (if (display-graphic-p) |
| 2188 | (gdb-make-frames-menu gud-minor-mode-map)) | 2087 | (gdb-make-frames-menu gud-minor-mode-map)) |
| 2189 | 2088 | ||
| 2190 | (defun gdb-proc-died (proc) | ||
| 2191 | ;; Stop displaying an arrow in a source file. | ||
| 2192 | (setq overlay-arrow-position nil) | ||
| 2193 | |||
| 2194 | ;; Kill the dummy process, so that C-x C-c won't worry about it. | ||
| 2195 | (save-excursion | ||
| 2196 | (set-buffer (process-buffer proc)) | ||
| 2197 | (kill-process | ||
| 2198 | (get-buffer-process | ||
| 2199 | (gdb-get-instance-buffer gdb-buffer-instance 'gdb-inferior-io))))) | ||
| 2200 | ;; end of functions from gdba.el | 2089 | ;; end of functions from gdba.el |
| 2201 | 2090 | ||
| 2202 | ;; new functions for gdb-ui.el | 2091 | ;; new functions for gdb-ui.el |
| 2092 | |||
| 2093 | (defvar gdb-main-file nil "Source file from which program execution begins.") | ||
| 2094 | |||
| 2203 | ;; layout for all the windows | 2095 | ;; layout for all the windows |
| 2204 | (defun gdb-setup-windows (instance) | 2096 | (defun gdb-setup-windows () |
| 2205 | (gdb-display-locals-buffer instance) | 2097 | (gdb-display-locals-buffer) |
| 2206 | (gdb-display-stack-buffer instance) | 2098 | (gdb-display-stack-buffer) |
| 2207 | (delete-other-windows) | 2099 | (delete-other-windows) |
| 2208 | (gdb-display-breakpoints-buffer instance) | 2100 | (gdb-display-breakpoints-buffer) |
| 2209 | (gdb-display-display-buffer instance) | 2101 | (gdb-display-display-buffer) |
| 2210 | (delete-other-windows) | 2102 | (delete-other-windows) |
| 2211 | (split-window nil ( / ( * (window-height) 3) 4)) | 2103 | (split-window nil ( / ( * (window-height) 3) 4)) |
| 2212 | (split-window nil ( / (window-height) 3)) | 2104 | (split-window nil ( / (window-height) 3)) |
| 2213 | (split-window-horizontally) | 2105 | (split-window-horizontally) |
| 2214 | (other-window 1) | 2106 | (other-window 1) |
| 2215 | (switch-to-buffer (gdb-locals-buffer-name instance)) | 2107 | (switch-to-buffer (gdb-locals-buffer-name)) |
| 2216 | (other-window 1) | 2108 | (other-window 1) |
| 2217 | (switch-to-buffer | 2109 | (switch-to-buffer |
| 2218 | (if gud-last-last-frame | 2110 | (if gud-last-last-frame |
| @@ -2221,12 +2113,12 @@ buffer." | |||
| 2221 | (setq gdb-source-window (get-buffer-window (current-buffer))) | 2113 | (setq gdb-source-window (get-buffer-window (current-buffer))) |
| 2222 | (split-window-horizontally) | 2114 | (split-window-horizontally) |
| 2223 | (other-window 1) | 2115 | (other-window 1) |
| 2224 | (switch-to-buffer (gdb-inferior-io-name instance)) | 2116 | (switch-to-buffer (gdb-inferior-io-name)) |
| 2225 | (other-window 1) | 2117 | (other-window 1) |
| 2226 | (switch-to-buffer (gdb-stack-buffer-name instance)) | 2118 | (switch-to-buffer (gdb-stack-buffer-name)) |
| 2227 | (split-window-horizontally) | 2119 | (split-window-horizontally) |
| 2228 | (other-window 1) | 2120 | (other-window 1) |
| 2229 | (switch-to-buffer (gdb-breakpoints-buffer-name instance)) | 2121 | (switch-to-buffer (gdb-breakpoints-buffer-name)) |
| 2230 | (other-window 1)) | 2122 | (other-window 1)) |
| 2231 | 2123 | ||
| 2232 | (defun gdb-restore-windows () | 2124 | (defun gdb-restore-windows () |
| @@ -2237,7 +2129,7 @@ This arrangement depends on the value of `gdb-many-windows'." | |||
| 2237 | (progn | 2129 | (progn |
| 2238 | (switch-to-buffer gud-comint-buffer) | 2130 | (switch-to-buffer gud-comint-buffer) |
| 2239 | (delete-other-windows) | 2131 | (delete-other-windows) |
| 2240 | (gdb-setup-windows gdb-buffer-instance)) | 2132 | (gdb-setup-windows)) |
| 2241 | ;else | 2133 | ;else |
| 2242 | (switch-to-buffer gud-comint-buffer) | 2134 | (switch-to-buffer gud-comint-buffer) |
| 2243 | (delete-other-windows) | 2135 | (delete-other-windows) |
| @@ -2267,7 +2159,7 @@ This arrangement depends on the value of `gdb-many-windows'." | |||
| 2267 | ;else | 2159 | ;else |
| 2268 | (switch-to-buffer gud-comint-buffer) | 2160 | (switch-to-buffer gud-comint-buffer) |
| 2269 | (delete-other-windows) | 2161 | (delete-other-windows) |
| 2270 | (gdb-setup-windows gdb-buffer-instance) | 2162 | (gdb-setup-windows) |
| 2271 | (setq gdb-many-windows t))) | 2163 | (setq gdb-many-windows t))) |
| 2272 | 2164 | ||
| 2273 | (defconst breakpoint-xpm-data "/* XPM */ | 2165 | (defconst breakpoint-xpm-data "/* XPM */ |
| @@ -2337,11 +2229,11 @@ Just the partial-output buffer is left." | |||
| 2337 | (other-window 1)) | 2229 | (other-window 1)) |
| 2338 | (delete-other-windows) | 2230 | (delete-other-windows) |
| 2339 | (if gdb-many-windows | 2231 | (if gdb-many-windows |
| 2340 | (gdb-setup-windows gdb-buffer-instance) | 2232 | (gdb-setup-windows) |
| 2341 | ;else | 2233 | ;else |
| 2342 | (gdb-display-breakpoints-buffer gdb-buffer-instance) | 2234 | (gdb-display-breakpoints-buffer) |
| 2343 | (gdb-display-display-buffer instance) | 2235 | (gdb-display-display-buffer) |
| 2344 | (gdb-display-stack-buffer instance) | 2236 | (gdb-display-stack-buffer) |
| 2345 | (delete-other-windows) | 2237 | (delete-other-windows) |
| 2346 | (split-window) | 2238 | (split-window) |
| 2347 | (other-window 1) | 2239 | (other-window 1) |
| @@ -2419,25 +2311,6 @@ BUFFER nil or omitted means use the current buffer." | |||
| 2419 | (delete-overlay overlay))) | 2311 | (delete-overlay overlay))) |
| 2420 | (setq overlays (cdr overlays))))) | 2312 | (setq overlays (cdr overlays))))) |
| 2421 | 2313 | ||
| 2422 | (defvar gdb-array-slice-map nil) | ||
| 2423 | (setq gdb-array-slice-map (make-keymap)) | ||
| 2424 | (define-key gdb-array-slice-map [mouse-2] 'gdb-array-slice) | ||
| 2425 | |||
| 2426 | (defun gdb-array-slice (event) | ||
| 2427 | "Select an array slice to display." | ||
| 2428 | (interactive "e") | ||
| 2429 | (mouse-set-point event) | ||
| 2430 | (save-excursion | ||
| 2431 | (let ((n -1) (stop 0) (start 0) (point (point))) | ||
| 2432 | (beginning-of-line) | ||
| 2433 | (while (search-forward "[" point t) | ||
| 2434 | (setq n (+ n 1))) | ||
| 2435 | (setq start (string-to-int (read-string "Start index: "))) | ||
| 2436 | (aset gdb-array-start n start) | ||
| 2437 | (setq stop (string-to-int (read-string "Stop index: "))) | ||
| 2438 | (aset gdb-array-stop n stop))) | ||
| 2439 | (gdb-array-format1)) | ||
| 2440 | |||
| 2441 | (defun gdb-array-visualise () | 2314 | (defun gdb-array-visualise () |
| 2442 | "Visualise arrays and slices using graph program from plotutils." | 2315 | "Visualise arrays and slices using graph program from plotutils." |
| 2443 | (interactive) | 2316 | (interactive) |
| @@ -2468,7 +2341,6 @@ BUFFER nil or omitted means use the current buffer." | |||
| 2468 | "Delete displayed expression and its frame." | 2341 | "Delete displayed expression and its frame." |
| 2469 | (interactive) | 2342 | (interactive) |
| 2470 | (gdb-instance-enqueue-idle-input | 2343 | (gdb-instance-enqueue-idle-input |
| 2471 | gdb-buffer-instance | ||
| 2472 | (list (concat "server delete display " gdb-display-number "\n") | 2344 | (list (concat "server delete display " gdb-display-number "\n") |
| 2473 | '(lambda () nil))) | 2345 | '(lambda () nil))) |
| 2474 | (kill-buffer nil) | 2346 | (kill-buffer nil) |
| @@ -2485,8 +2357,7 @@ BUFFER nil or omitted means use the current buffer." | |||
| 2485 | gdb-assembler-custom) | 2357 | gdb-assembler-custom) |
| 2486 | 2358 | ||
| 2487 | (defun gdb-assembler-custom () | 2359 | (defun gdb-assembler-custom () |
| 2488 | (let ((buffer (gdb-get-instance-buffer gdb-buffer-instance | 2360 | (let ((buffer (gdb-get-instance-buffer 'gdb-assembler-buffer)) |
| 2489 | 'gdb-assembler-buffer)) | ||
| 2490 | (gdb-arrow-position) (address) (flag)) | 2361 | (gdb-arrow-position) (address) (flag)) |
| 2491 | (if gdb-current-address | 2362 | (if gdb-current-address |
| 2492 | (progn | 2363 | (progn |
| @@ -2505,7 +2376,7 @@ BUFFER nil or omitted means use the current buffer." | |||
| 2505 | (remove-images (point-min) (point-max)) | 2376 | (remove-images (point-min) (point-max)) |
| 2506 | (remove-strings (point-min) (point-max)))) | 2377 | (remove-strings (point-min) (point-max)))) |
| 2507 | (save-excursion | 2378 | (save-excursion |
| 2508 | (set-buffer (gdb-get-instance-buffer instance 'gdb-breakpoints-buffer)) | 2379 | (set-buffer (gdb-get-instance-buffer 'gdb-breakpoints-buffer)) |
| 2509 | (goto-char (point-min)) | 2380 | (goto-char (point-min)) |
| 2510 | (while (< (point) (- (point-max) 1)) | 2381 | (while (< (point) (- (point-max) 1)) |
| 2511 | (forward-line 1) | 2382 | (forward-line 1) |
| @@ -2557,51 +2428,50 @@ BUFFER nil or omitted means use the current buffer." | |||
| 2557 | (setq mode-name "Assembler") | 2428 | (setq mode-name "Assembler") |
| 2558 | (set (make-local-variable 'gud-minor-mode) 'gdba) | 2429 | (set (make-local-variable 'gud-minor-mode) 'gdba) |
| 2559 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) | 2430 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
| 2560 | (set (make-variable-buffer-local 'left-margin-width) 2) | 2431 | (setq left-margin-width 2) |
| 2561 | (setq buffer-read-only t) | 2432 | (setq buffer-read-only t) |
| 2562 | (use-local-map gdb-assembler-mode-map) | 2433 | (use-local-map gdb-assembler-mode-map) |
| 2563 | (gdb-invalidate-assembler gdb-buffer-instance) | 2434 | (gdb-invalidate-assembler) |
| 2564 | (gdb-invalidate-breakpoints gdb-buffer-instance)) | 2435 | (gdb-invalidate-breakpoints)) |
| 2565 | 2436 | ||
| 2566 | (defun gdb-assembler-buffer-name (instance) | 2437 | (defun gdb-assembler-buffer-name () |
| 2567 | (save-excursion | 2438 | (save-excursion |
| 2568 | (set-buffer (process-buffer (gdb-instance-process instance))) | 2439 | (set-buffer (process-buffer gdb-proc)) |
| 2569 | (concat "*Machine Code " (gdb-instance-target-string instance) "*"))) | 2440 | (concat "*Machine Code " (gdb-instance-target-string) "*"))) |
| 2570 | 2441 | ||
| 2571 | (defun gdb-display-assembler-buffer (instance) | 2442 | (defun gdb-display-assembler-buffer () |
| 2572 | (interactive (list (gdb-needed-default-instance))) | 2443 | (interactive (list gdb-proc)) |
| 2573 | (gdb-display-buffer | 2444 | (gdb-display-buffer |
| 2574 | (gdb-get-create-instance-buffer instance | 2445 | (gdb-get-create-instance-buffer 'gdb-assembler-buffer))) |
| 2575 | 'gdb-assembler-buffer))) | ||
| 2576 | 2446 | ||
| 2577 | (defun gdb-frame-assembler-buffer (instance) | 2447 | (defun gdb-frame-assembler-buffer () |
| 2578 | (interactive (list (gdb-needed-default-instance))) | 2448 | (interactive (list gdb-proc)) |
| 2579 | (switch-to-buffer-other-frame | 2449 | (switch-to-buffer-other-frame |
| 2580 | (gdb-get-create-instance-buffer instance | 2450 | (gdb-get-create-instance-buffer 'gdb-assembler-buffer))) |
| 2581 | 'gdb-assembler-buffer))) | 2451 | |
| 2452 | (defun gdb-invalidate-frame-and-assembler (&optional ignored) | ||
| 2453 | (gdb-invalidate-frames) | ||
| 2454 | (gdb-invalidate-assembler)) | ||
| 2582 | 2455 | ||
| 2583 | (defun gdb-invalidate-frame-and-assembler (instance &optional ignored) | 2456 | (defun gdb-invalidate-breakpoints-and-assembler (&optional ignored) |
| 2584 | (gdb-invalidate-frames instance) | 2457 | (gdb-invalidate-breakpoints) |
| 2585 | (gdb-invalidate-assembler instance)) | 2458 | (gdb-invalidate-assembler)) |
| 2586 | 2459 | ||
| 2587 | (defun gdb-invalidate-breakpoints-and-assembler (instance &optional ignored) | 2460 | (defvar gdb-prev-main-or-pc nil) |
| 2588 | (gdb-invalidate-breakpoints instance) | ||
| 2589 | (gdb-invalidate-assembler instance)) | ||
| 2590 | 2461 | ||
| 2591 | ; modified because if gdb-main-or-pc has changed value a new command | 2462 | ; modified because if gdb-main-or-pc has changed value a new command |
| 2592 | ; must be enqueued to update the buffer with the new output | 2463 | ; must be enqueued to update the buffer with the new output |
| 2593 | (defun gdb-invalidate-assembler (instance &optional ignored) | 2464 | (defun gdb-invalidate-assembler (&optional ignored) |
| 2594 | (if (and ((lambda (instance) | 2465 | (if (and ((lambda () |
| 2595 | (gdb-get-instance-buffer instance | 2466 | (gdb-get-instance-buffer (quote gdb-assembler-buffer)))) |
| 2596 | (quote gdb-assembler-buffer))) instance) | ||
| 2597 | (or (not (member (quote gdb-invalidate-assembler) | 2467 | (or (not (member (quote gdb-invalidate-assembler) |
| 2598 | (gdb-instance-pending-triggers instance))) | 2468 | (gdb-instance-pending-triggers))) |
| 2599 | (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc)))) | 2469 | (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc)))) |
| 2600 | (progn | 2470 | (progn |
| 2601 | 2471 | ||
| 2602 | ; take previous disassemble command off the queue | 2472 | ; take previous disassemble command off the queue |
| 2603 | (save-excursion | 2473 | (save-excursion |
| 2604 | (set-buffer (gdb-get-instance-buffer instance 'gdba)) | 2474 | (set-buffer (gdb-get-instance-buffer 'gdba)) |
| 2605 | (let ((queue gdb-idle-input-queue) (item)) | 2475 | (let ((queue gdb-idle-input-queue) (item)) |
| 2606 | (while queue | 2476 | (while queue |
| 2607 | (setq item (car queue)) | 2477 | (setq item (car queue)) |
| @@ -2610,11 +2480,11 @@ BUFFER nil or omitted means use the current buffer." | |||
| 2610 | (setq queue (cdr queue))))) | 2480 | (setq queue (cdr queue))))) |
| 2611 | 2481 | ||
| 2612 | (gdb-instance-enqueue-idle-input | 2482 | (gdb-instance-enqueue-idle-input |
| 2613 | instance (list (concat "server disassemble " gdb-main-or-pc "\n") | 2483 | (list (concat "server disassemble " gdb-main-or-pc "\n") |
| 2614 | (quote gdb-assembler-handler))) | 2484 | (quote gdb-assembler-handler))) |
| 2615 | (set-gdb-instance-pending-triggers | 2485 | (set-gdb-instance-pending-triggers |
| 2616 | instance (cons (quote gdb-invalidate-assembler) | 2486 | (cons (quote gdb-invalidate-assembler) |
| 2617 | (gdb-instance-pending-triggers instance))) | 2487 | (gdb-instance-pending-triggers))) |
| 2618 | (setq gdb-prev-main-or-pc gdb-main-or-pc)))) | 2488 | (setq gdb-prev-main-or-pc gdb-main-or-pc)))) |
| 2619 | 2489 | ||
| 2620 | (defun gdb-delete-line () | 2490 | (defun gdb-delete-line () |