diff options
| -rw-r--r-- | lisp/gdb-ui.el | 782 |
1 files changed, 153 insertions, 629 deletions
diff --git a/lisp/gdb-ui.el b/lisp/gdb-ui.el index 1ae70eb6f8b..736f7c46b0c 100644 --- a/lisp/gdb-ui.el +++ b/lisp/gdb-ui.el | |||
| @@ -50,29 +50,19 @@ | |||
| 50 | 50 | ||
| 51 | (require 'gud) | 51 | (require 'gud) |
| 52 | 52 | ||
| 53 | (defcustom gdb-window-height 20 | ||
| 54 | "Number of lines in a frame for a displayed expression in GDB-UI." | ||
| 55 | :type 'integer | ||
| 56 | :group 'gud) | ||
| 57 | |||
| 58 | (defcustom gdb-window-width 30 | ||
| 59 | "Width of a frame for a displayed expression in GDB-UI." | ||
| 60 | :type 'integer | ||
| 61 | :group 'gud) | ||
| 62 | |||
| 63 | (defvar gdb-current-address "main" "Initialisation for Assembler buffer.") | 53 | (defvar gdb-current-address "main" "Initialisation for Assembler buffer.") |
| 64 | (defvar gdb-previous-address nil) | 54 | (defvar gdb-previous-address nil) |
| 65 | (defvar gdb-previous-frame nil) | 55 | (defvar gdb-previous-frame nil) |
| 66 | (defvar gdb-current-frame "main") | 56 | (defvar gdb-current-frame "main") |
| 67 | (defvar gdb-display-in-progress nil) | ||
| 68 | (defvar gdb-dive nil) | ||
| 69 | (defvar gdb-view-source t "Non-nil means that source code can be viewed") | 57 | (defvar gdb-view-source t "Non-nil means that source code can be viewed") |
| 70 | (defvar gdb-selected-view 'source "Code type that user wishes to view") | 58 | (defvar gdb-selected-view 'source "Code type that user wishes to view") |
| 59 | (defvar gdb-var-list nil "List of variables in watch window") | ||
| 60 | (defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed") | ||
| 61 | (defvar gdb-update-flag t "Non-il means update buffers") | ||
| 71 | (defvar gdb-buffer-type nil) | 62 | (defvar gdb-buffer-type nil) |
| 72 | (defvar gdb-variables '() | 63 | (defvar gdb-variables '() |
| 73 | "A list of variables that are local to the GUD buffer.") | 64 | "A list of variables that are local to the GUD buffer.") |
| 74 | 65 | ||
| 75 | |||
| 76 | ;;;###autoload | 66 | ;;;###autoload |
| 77 | (defun gdba (command-line) | 67 | (defun gdba (command-line) |
| 78 | "Run gdb on program FILE in buffer *gud-FILE*. | 68 | "Run gdb on program FILE in buffer *gud-FILE*. |
| @@ -162,10 +152,11 @@ The following interactive lisp functions help control operation : | |||
| 162 | (setq gdb-previous-address nil) | 152 | (setq gdb-previous-address nil) |
| 163 | (setq gdb-previous-frame nil) | 153 | (setq gdb-previous-frame nil) |
| 164 | (setq gdb-current-frame "main") | 154 | (setq gdb-current-frame "main") |
| 165 | (setq gdb-display-in-progress nil) | ||
| 166 | (setq gdb-dive nil) | ||
| 167 | (setq gdb-view-source t) | 155 | (setq gdb-view-source t) |
| 168 | (setq gdb-selected-view 'source) | 156 | (setq gdb-selected-view 'source) |
| 157 | (setq gdb-var-list nil) | ||
| 158 | (setq gdb-var-changed nil) | ||
| 159 | (setq gdb-update-flag t) | ||
| 169 | ;; | 160 | ;; |
| 170 | (mapc 'make-local-variable gdb-variables) | 161 | (mapc 'make-local-variable gdb-variables) |
| 171 | (setq gdb-buffer-type 'gdba) | 162 | (setq gdb-buffer-type 'gdba) |
| @@ -182,30 +173,148 @@ The following interactive lisp functions help control operation : | |||
| 182 | ;; | 173 | ;; |
| 183 | (run-hooks 'gdba-mode-hook)) | 174 | (run-hooks 'gdba-mode-hook)) |
| 184 | 175 | ||
| 185 | (defun gud-display () | 176 | (defun gud-watch () |
| 186 | "Auto-display (possibly dereferenced) C expression at point." | 177 | "Watch expression." |
| 187 | (interactive) | 178 | (interactive) |
| 188 | (save-excursion | 179 | (let ((expr (tooltip-identifier-from-point (point)))) |
| 189 | (let ((expr (gud-find-c-expr))) | 180 | (setq expr (concat gdb-current-frame "::" expr)) |
| 181 | (catch 'already-watched | ||
| 182 | (dolist (var gdb-var-list) | ||
| 183 | (if (string-equal expr (car var)) (throw 'already-watched nil))) | ||
| 190 | (gdb-enqueue-input | 184 | (gdb-enqueue-input |
| 191 | (list (concat "server ptype " expr "\n") | 185 | (list (concat "interpreter mi \"-var-create - * " expr "\"\n") |
| 192 | `(lambda () (gud-display1 ,expr))))))) | 186 | `(lambda () (gdb-var-create-handler ,expr)))))) |
| 187 | (select-window (get-buffer-window gud-comint-buffer))) | ||
| 193 | 188 | ||
| 194 | (defun gud-display1 (expr) | 189 | (defconst gdb-var-create-regexp |
| 195 | (goto-char (point-min)) | 190 | "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") |
| 196 | (if (looking-at "No symbol") | 191 | |
| 192 | (defun gdb-var-create-handler (expr) | ||
| 193 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | ||
| 194 | (goto-char (point-min)) | ||
| 195 | (if (re-search-forward gdb-var-create-regexp nil t) | ||
| 196 | (let ((var (list expr | ||
| 197 | (match-string-no-properties 1) | ||
| 198 | (match-string-no-properties 2) | ||
| 199 | (match-string-no-properties 3) | ||
| 200 | nil))) | ||
| 201 | (push var gdb-var-list) | ||
| 202 | (speedbar 1) | ||
| 203 | (if (equal (nth 2 var) "0") | ||
| 204 | (gdb-enqueue-input | ||
| 205 | (list (concat "interpreter mi \"-var-evaluate-expression " | ||
| 206 | (nth 1 var) "\"\n") | ||
| 207 | `(lambda () (gdb-var-evaluate-expression-handler | ||
| 208 | ,(nth 1 var))))) | ||
| 209 | (setq gdb-var-changed t))) | ||
| 210 | (if (re-search-forward "Undefined command" nil t) | ||
| 211 | (message "Watching expressions requires gdb 6.0 onwards") | ||
| 212 | (message "No symbol %s in current context." expr))))) | ||
| 213 | |||
| 214 | (defun gdb-var-evaluate-expression-handler (varnum) | ||
| 215 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | ||
| 216 | (goto-char (point-min)) | ||
| 217 | (re-search-forward ".*value=\"\\(.*?\\)\"" nil t) | ||
| 218 | (let ((var-list nil)) | ||
| 219 | (dolist (var gdb-var-list) | ||
| 220 | (if (string-equal varnum (cadr var)) | ||
| 221 | (progn | ||
| 222 | (push (nreverse (cons (match-string-no-properties 1) | ||
| 223 | (cdr (nreverse var)))) var-list)) | ||
| 224 | (push var var-list))) | ||
| 225 | (setq gdb-var-list (nreverse var-list)))) | ||
| 226 | (setq gdb-var-changed t)) | ||
| 227 | |||
| 228 | (defun gdb-var-list-children (varnum) | ||
| 229 | (gdb-enqueue-input | ||
| 230 | (list (concat "interpreter mi \"-var-list-children " varnum "\"\n") | ||
| 231 | `(lambda () (gdb-var-list-children-handler ,varnum))))) | ||
| 232 | |||
| 233 | (defconst gdb-var-list-children-regexp | ||
| 234 | "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") | ||
| 235 | |||
| 236 | (defun gdb-var-list-children-handler (varnum) | ||
| 237 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | ||
| 238 | (goto-char (point-min)) | ||
| 239 | (let ((var-list nil)) | ||
| 240 | (catch 'child-already-watched | ||
| 241 | (dolist (var gdb-var-list) | ||
| 242 | (if (string-equal varnum (cadr var)) | ||
| 243 | (progn | ||
| 244 | (push var var-list) | ||
| 245 | (while (re-search-forward gdb-var-list-children-regexp nil t) | ||
| 246 | (let ((varchild (list (match-string-no-properties 2) | ||
| 247 | (match-string-no-properties 1) | ||
| 248 | (match-string-no-properties 3) | ||
| 249 | (match-string-no-properties 4) | ||
| 250 | nil))) | ||
| 251 | (dolist (var1 gdb-var-list) | ||
| 252 | (if (string-equal (cadr var1) (cadr varchild)) | ||
| 253 | (throw 'child-already-watched nil))) | ||
| 254 | (push varchild var-list) | ||
| 255 | (if (equal (nth 2 varchild) "0") | ||
| 256 | (gdb-enqueue-input | ||
| 257 | (list | ||
| 258 | (concat "interpreter mi \"-var-evaluate-expression " | ||
| 259 | (nth 1 varchild) "\"\n") | ||
| 260 | `(lambda () (gdb-var-evaluate-expression-handler | ||
| 261 | ,(nth 1 varchild))))))))) | ||
| 262 | (push var var-list))) | ||
| 263 | (setq gdb-var-list (nreverse var-list)))))) | ||
| 264 | |||
| 265 | (defun gdb-var-update () | ||
| 266 | (setq gdb-update-flag nil) | ||
| 267 | (if (not (member 'gdb-var-update (gdb-get-pending-triggers))) | ||
| 197 | (progn | 268 | (progn |
| 198 | (gdb-set-output-sink 'user) | 269 | (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n" |
| 199 | (gud-call (concat "server ptype " expr))) | 270 | 'gdb-var-update-handler)) |
| 200 | (goto-char (- (point-max) 1)) | 271 | (gdb-set-pending-triggers (cons 'gdb-var-update |
| 201 | (if (equal (char-before) (string-to-char "\*")) | 272 | (gdb-get-pending-triggers)))))) |
| 202 | (gud-call (concat "display* " expr)) | ||
| 203 | (gud-call (concat "display " expr))))) | ||
| 204 | 273 | ||
| 205 | ; this would messy because these bindings don't work with M-x gdb | 274 | (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"") |
| 206 | ; (define-key global-map "\C-x\C-a\C-a" 'gud-display) | ||
| 207 | ; (define-key gud-minor-mode-map "\C-c\C-a" 'gud-display) | ||
| 208 | 275 | ||
| 276 | (defun gdb-var-update-handler () | ||
| 277 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | ||
| 278 | (goto-char (point-min)) | ||
| 279 | (while (re-search-forward gdb-var-update-regexp nil t) | ||
| 280 | (let ((varnum (match-string-no-properties 1))) | ||
| 281 | (gdb-enqueue-input | ||
| 282 | (list (concat "interpreter mi \"-var-evaluate-expression " | ||
| 283 | varnum "\"\n") | ||
| 284 | `(lambda () (gdb-var-evaluate-expression-handler | ||
| 285 | ,varnum))))))) | ||
| 286 | (gdb-set-pending-triggers | ||
| 287 | (delq 'gdb-var-update (gdb-get-pending-triggers)))) | ||
| 288 | |||
| 289 | (defun gdb-var-delete (text token indent) | ||
| 290 | "Delete watched expression." | ||
| 291 | (interactive) | ||
| 292 | (when (eq indent 0) | ||
| 293 | (string-match "\\(\\S-+\\)" text) | ||
| 294 | (let* ((expr (match-string 1 text)) | ||
| 295 | (var (assoc expr gdb-var-list)) | ||
| 296 | (varnum (cadr var))) | ||
| 297 | (gdb-enqueue-input | ||
| 298 | (list (concat "interpreter mi \"-var-delete " varnum "\"\n") | ||
| 299 | 'ignore)) | ||
| 300 | (setq gdb-var-list (delq var gdb-var-list)) | ||
| 301 | (dolist (varchild gdb-var-list) | ||
| 302 | (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild)) | ||
| 303 | (setq gdb-var-list (delq varchild gdb-var-list))))) | ||
| 304 | (setq gdb-var-changed t))) | ||
| 305 | |||
| 306 | (defun gdb-speedbar-expand-node (text token indent) | ||
| 307 | "Expand the node the user clicked on. | ||
| 308 | TEXT is the text of the button we clicked on, a + or - item. | ||
| 309 | TOKEN is data related to this node. | ||
| 310 | INDENT is the current indentation depth." | ||
| 311 | (cond ((string-match "+" text) ;expand this node | ||
| 312 | (gdb-var-list-children token)) | ||
| 313 | ((string-match "-" text) ;contract this node | ||
| 314 | (dolist (var gdb-var-list) | ||
| 315 | (if (string-match (concat token "\\.") (nth 1 var)) | ||
| 316 | (setq gdb-var-list (delq var gdb-var-list)))) | ||
| 317 | (setq gdb-var-changed t)))) | ||
| 209 | 318 | ||
| 210 | 319 | ||
| 211 | ;; ====================================================================== | 320 | ;; ====================================================================== |
| @@ -445,7 +554,7 @@ This filter may simply queue output for a later time." | |||
| 445 | (gdb-enqueue-input (concat string "\n"))) | 554 | (gdb-enqueue-input (concat string "\n"))) |
| 446 | 555 | ||
| 447 | ;; Note: Stuff enqueued here will be sent to the next prompt, even if it | 556 | ;; Note: Stuff enqueued here will be sent to the next prompt, even if it |
| 448 | ;; is a query, or other non-top-level prompt. | 557 | ;; is a query, or other non-top-level prompt. |
| 449 | 558 | ||
| 450 | (defun gdb-enqueue-input (item) | 559 | (defun gdb-enqueue-input (item) |
| 451 | (if (gdb-get-prompting) | 560 | (if (gdb-get-prompting) |
| @@ -489,7 +598,7 @@ This filter may simply queue output for a later time." | |||
| 489 | ;; any newlines. | 598 | ;; any newlines. |
| 490 | ;; | 599 | ;; |
| 491 | 600 | ||
| 492 | (defcustom gud-gdba-command-name "gdb -annotate=2 -noasync" | 601 | (defcustom gud-gdba-command-name "~/gdb/gdb/gdb -annotate=3" |
| 493 | "Default command to execute an executable under the GDB-UI debugger." | 602 | "Default command to execute an executable under the GDB-UI debugger." |
| 494 | :type 'string | 603 | :type 'string |
| 495 | :group 'gud) | 604 | :group 'gud) |
| @@ -511,18 +620,6 @@ This filter may simply queue output for a later time." | |||
| 511 | ("watchpoint" gdb-stopping) | 620 | ("watchpoint" gdb-stopping) |
| 512 | ("frame-begin" gdb-frame-begin) | 621 | ("frame-begin" gdb-frame-begin) |
| 513 | ("stopped" gdb-stopped) | 622 | ("stopped" gdb-stopped) |
| 514 | ("display-begin" gdb-display-begin) | ||
| 515 | ("display-end" gdb-display-end) | ||
| 516 | ; GDB commands info stack, info locals and frame generate an error-begin | ||
| 517 | ; annotation at start when there is no stack but this is a quirk/bug in | ||
| 518 | ; annotations. | ||
| 519 | ; ("error-begin" gdb-error-begin) | ||
| 520 | ("display-number-end" gdb-display-number-end) | ||
| 521 | ("array-section-begin" gdb-array-section-begin) | ||
| 522 | ("array-section-end" gdb-array-section-end) | ||
| 523 | ;; ("elt" gdb-elt) | ||
| 524 | ("field-begin" gdb-field-begin) | ||
| 525 | ("field-end" gdb-field-end) | ||
| 526 | ) "An assoc mapping annotation tags to functions which process them.") | 623 | ) "An assoc mapping annotation tags to functions which process them.") |
| 527 | 624 | ||
| 528 | (defconst gdb-source-spec-regexp | 625 | (defconst gdb-source-spec-regexp |
| @@ -558,11 +655,7 @@ output from a previous command if that happens to be in effect." | |||
| 558 | (cond | 655 | (cond |
| 559 | ((eq sink 'user) t) | 656 | ((eq sink 'user) t) |
| 560 | ((eq sink 'emacs) | 657 | ((eq sink 'emacs) |
| 561 | (gdb-set-output-sink 'post-emacs) | 658 | (gdb-set-output-sink 'post-emacs)) |
| 562 | (let ((handler | ||
| 563 | (car (cdr (gdb-get-current-item))))) | ||
| 564 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | ||
| 565 | (funcall handler)))) | ||
| 566 | (t | 659 | (t |
| 567 | (gdb-set-output-sink 'user) | 660 | (gdb-set-output-sink 'user) |
| 568 | (error "Phase error in gdb-pre-prompt (got %s)" sink))))) | 661 | (error "Phase error in gdb-pre-prompt (got %s)" sink))))) |
| @@ -574,7 +667,11 @@ This sends the next command (if any) to gdb." | |||
| 574 | (cond | 667 | (cond |
| 575 | ((eq sink 'user) t) | 668 | ((eq sink 'user) t) |
| 576 | ((eq sink 'post-emacs) | 669 | ((eq sink 'post-emacs) |
| 577 | (gdb-set-output-sink 'user)) | 670 | (gdb-set-output-sink 'user) |
| 671 | (let ((handler | ||
| 672 | (car (cdr (gdb-get-current-item))))) | ||
| 673 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | ||
| 674 | (funcall handler)))) | ||
| 578 | (t | 675 | (t |
| 579 | (gdb-set-output-sink 'user) | 676 | (gdb-set-output-sink 'user) |
| 580 | (error "Phase error in gdb-prompt (got %s)" sink)))) | 677 | (error "Phase error in gdb-prompt (got %s)" sink)))) |
| @@ -632,7 +729,7 @@ that if we already set the output sink to 'user in gdb-stopping, that is fine." | |||
| 632 | (defun gdb-post-prompt (ignored) | 729 | (defun gdb-post-prompt (ignored) |
| 633 | "An annotation handler for `post-prompt'. This begins the collection of | 730 | "An annotation handler for `post-prompt'. This begins the collection of |
| 634 | output from the current command if that happens to be appropriate." | 731 | output from the current command if that happens to be appropriate." |
| 635 | (if (not (gdb-get-pending-triggers)) | 732 | (if (and (not (gdb-get-pending-triggers)) gdb-update-flag) |
| 636 | (progn | 733 | (progn |
| 637 | (gdb-get-current-frame) | 734 | (gdb-get-current-frame) |
| 638 | (gdb-invalidate-frames) | 735 | (gdb-invalidate-frames) |
| @@ -640,8 +737,8 @@ output from the current command if that happens to be appropriate." | |||
| 640 | (gdb-invalidate-assembler) | 737 | (gdb-invalidate-assembler) |
| 641 | (gdb-invalidate-registers) | 738 | (gdb-invalidate-registers) |
| 642 | (gdb-invalidate-locals) | 739 | (gdb-invalidate-locals) |
| 643 | (gdb-invalidate-display) | ||
| 644 | (gdb-invalidate-threads))) | 740 | (gdb-invalidate-threads))) |
| 741 | (setq gdb-update-flag t) | ||
| 645 | (let ((sink (gdb-get-output-sink))) | 742 | (let ((sink (gdb-get-output-sink))) |
| 646 | (cond | 743 | (cond |
| 647 | ((eq sink 'user) t) | 744 | ((eq sink 'user) t) |
| @@ -651,392 +748,6 @@ output from the current command if that happens to be appropriate." | |||
| 651 | (gdb-set-output-sink 'user) | 748 | (gdb-set-output-sink 'user) |
| 652 | (error "Phase error in gdb-post-prompt (got %s)" sink))))) | 749 | (error "Phase error in gdb-post-prompt (got %s)" sink))))) |
| 653 | 750 | ||
| 654 | ;; If we get an error whilst evaluating one of the expressions | ||
| 655 | ;; we won't get the display-end annotation. Set the sink back to | ||
| 656 | ;; user to make sure that the error message is seen. | ||
| 657 | ;; NOT USED: see annotation-rules for reason. | ||
| 658 | ;(defun gdb-error-begin (ignored) | ||
| 659 | ; (gdb-set-output-sink 'user)) | ||
| 660 | |||
| 661 | (defun gdb-display-begin (ignored) | ||
| 662 | (gdb-set-output-sink 'emacs) | ||
| 663 | (gdb-clear-partial-output) | ||
| 664 | (setq gdb-display-in-progress t)) | ||
| 665 | |||
| 666 | (defvar gdb-expression-buffer-name nil) | ||
| 667 | (defvar gdb-display-number nil) | ||
| 668 | (defvar gdb-dive-display-number nil) | ||
| 669 | |||
| 670 | (defun gdb-display-number-end (ignored) | ||
| 671 | (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) | ||
| 672 | (setq gdb-display-number (buffer-string)) | ||
| 673 | (setq gdb-expression-buffer-name | ||
| 674 | (concat "*display " gdb-display-number "*")) | ||
| 675 | (save-excursion | ||
| 676 | (if (progn | ||
| 677 | (set-buffer (window-buffer)) | ||
| 678 | gdb-dive) | ||
| 679 | (progn | ||
| 680 | (let ((number gdb-display-number)) | ||
| 681 | (switch-to-buffer | ||
| 682 | (set-buffer (get-buffer-create gdb-expression-buffer-name))) | ||
| 683 | (gdb-expressions-mode) | ||
| 684 | (setq gdb-dive-display-number number))) | ||
| 685 | (set-buffer (get-buffer-create gdb-expression-buffer-name)) | ||
| 686 | (if (display-graphic-p) | ||
| 687 | (catch 'frame-exists | ||
| 688 | (dolist (frame (frame-list)) | ||
| 689 | (if (string-equal (frame-parameter frame 'name) | ||
| 690 | gdb-expression-buffer-name) | ||
| 691 | (throw 'frame-exists nil))) | ||
| 692 | (gdb-expressions-mode) | ||
| 693 | (make-frame `((height . ,gdb-window-height) | ||
| 694 | (width . ,gdb-window-width) | ||
| 695 | (tool-bar-lines . nil) | ||
| 696 | (menu-bar-lines . nil) | ||
| 697 | (minibuffer . nil)))) | ||
| 698 | (gdb-expressions-mode) | ||
| 699 | (gdb-display-buffer (get-buffer gdb-expression-buffer-name))))) | ||
| 700 | (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) | ||
| 701 | (setq gdb-dive nil)) | ||
| 702 | |||
| 703 | (defvar gdb-nesting-level nil) | ||
| 704 | (defvar gdb-expression nil) | ||
| 705 | (defvar gdb-point nil) | ||
| 706 | (defvar gdb-annotation-arg nil) | ||
| 707 | |||
| 708 | (defun gdb-delete-line () | ||
| 709 | "Delete the current line." | ||
| 710 | (delete-region (line-beginning-position) (line-beginning-position 2))) | ||
| 711 | |||
| 712 | (defun gdb-display-end (ignored) | ||
| 713 | (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) | ||
| 714 | (goto-char (point-min)) | ||
| 715 | (search-forward ": ") | ||
| 716 | (looking-at "\\(.*?\\) =") | ||
| 717 | (let ((char "") | ||
| 718 | (gdb-temp-value (match-string 1))) | ||
| 719 | ;;move * to front of expression if necessary | ||
| 720 | (if (looking-at ".*\\*") | ||
| 721 | (progn | ||
| 722 | (setq char "*") | ||
| 723 | (setq gdb-temp-value (substring gdb-temp-value 1 nil)))) | ||
| 724 | (with-current-buffer gdb-expression-buffer-name | ||
| 725 | (setq gdb-expression gdb-temp-value) | ||
| 726 | (if (not (string-match "::" gdb-expression)) | ||
| 727 | (setq gdb-expression (concat char gdb-current-frame | ||
| 728 | "::" gdb-expression)) | ||
| 729 | ;;else put * back on if necessary | ||
| 730 | (setq gdb-expression (concat char gdb-expression))) | ||
| 731 | (if (not header-line-format) | ||
| 732 | (setq header-line-format (concat "-- " gdb-expression " %-"))))) | ||
| 733 | ;; | ||
| 734 | ;;-if scalar/string | ||
| 735 | (if (not (re-search-forward "##" nil t)) | ||
| 736 | (progn | ||
| 737 | (with-current-buffer gdb-expression-buffer-name | ||
| 738 | (let ((buffer-read-only nil)) | ||
| 739 | (delete-region (point-min) (point-max)) | ||
| 740 | (insert-buffer-substring | ||
| 741 | (gdb-get-buffer 'gdb-partial-output-buffer))))) | ||
| 742 | ;; display expression name... | ||
| 743 | (goto-char (point-min)) | ||
| 744 | (let ((start (progn (point))) | ||
| 745 | (end (progn (end-of-line) (point)))) | ||
| 746 | (with-current-buffer gdb-expression-buffer-name | ||
| 747 | (let ((buffer-read-only nil)) | ||
| 748 | (delete-region (point-min) (point-max)) | ||
| 749 | (insert-buffer-substring (gdb-get-buffer | ||
| 750 | 'gdb-partial-output-buffer) | ||
| 751 | start end) | ||
| 752 | (insert "\n")))) | ||
| 753 | (goto-char (point-min)) | ||
| 754 | (re-search-forward "##" nil t) | ||
| 755 | (setq gdb-nesting-level 0) | ||
| 756 | (if (looking-at "array-section-begin") | ||
| 757 | (progn | ||
| 758 | (gdb-delete-line) | ||
| 759 | (setq gdb-point (point)) | ||
| 760 | (gdb-array-format))) | ||
| 761 | (if (looking-at "field-begin \\(.\\)") | ||
| 762 | (progn | ||
| 763 | (setq gdb-annotation-arg (match-string 1)) | ||
| 764 | (gdb-field-format-begin)))) | ||
| 765 | (with-current-buffer gdb-expression-buffer-name | ||
| 766 | (if gdb-dive-display-number | ||
| 767 | (progn | ||
| 768 | (let ((buffer-read-only nil)) | ||
| 769 | (goto-char (point-max)) | ||
| 770 | (insert "\n") | ||
| 771 | (insert-text-button "[back]" 'type 'gdb-display-back))))) | ||
| 772 | (gdb-clear-partial-output) | ||
| 773 | (gdb-set-output-sink 'user) | ||
| 774 | (setq gdb-display-in-progress nil)) | ||
| 775 | |||
| 776 | (define-button-type 'gdb-display-back | ||
| 777 | 'help-echo "mouse-2, RET: go back to previous display buffer" | ||
| 778 | 'action (lambda (button) (gdb-display-go-back))) | ||
| 779 | |||
| 780 | (defun gdb-display-go-back () | ||
| 781 | ;; delete display so they don't accumulate and delete buffer | ||
| 782 | (let ((number gdb-display-number)) | ||
| 783 | (gdb-enqueue-input | ||
| 784 | (list (concat "server delete display " number "\n") 'ignore)) | ||
| 785 | (switch-to-buffer (concat "*display " gdb-dive-display-number "*")) | ||
| 786 | (kill-buffer (get-buffer (concat "*display " number "*"))))) | ||
| 787 | |||
| 788 | ;; prefix annotations with ## and process whole output in one chunk | ||
| 789 | ;; in gdb-partial-output-buffer (to allow recursion). | ||
| 790 | |||
| 791 | ;; array-section flags are just removed again but after counting. They | ||
| 792 | ;; might also be useful for arrays of structures and structures with arrays. | ||
| 793 | (defun gdb-array-section-begin (args) | ||
| 794 | (if gdb-display-in-progress | ||
| 795 | (progn | ||
| 796 | (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) | ||
| 797 | (goto-char (point-max)) | ||
| 798 | (insert (concat "\n##array-section-begin " args "\n")))))) | ||
| 799 | |||
| 800 | (defun gdb-array-section-end (ignored) | ||
| 801 | (if gdb-display-in-progress | ||
| 802 | (progn | ||
| 803 | (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) | ||
| 804 | (goto-char (point-max)) | ||
| 805 | (insert "\n##array-section-end\n"))))) | ||
| 806 | |||
| 807 | (defun gdb-field-begin (args) | ||
| 808 | (if gdb-display-in-progress | ||
| 809 | (progn | ||
| 810 | (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) | ||
| 811 | (goto-char (point-max)) | ||
| 812 | (insert (concat "\n##field-begin " args "\n")))))) | ||
| 813 | |||
| 814 | (defun gdb-field-end (ignored) | ||
| 815 | (if gdb-display-in-progress | ||
| 816 | (progn | ||
| 817 | (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) | ||
| 818 | (goto-char (point-max)) | ||
| 819 | (insert "\n##field-end\n"))))) | ||
| 820 | |||
| 821 | (defun gdb-elt (ignored) | ||
| 822 | (if gdb-display-in-progress | ||
| 823 | (progn | ||
| 824 | (goto-char (point-max)) | ||
| 825 | (insert "\n##elt\n")))) | ||
| 826 | |||
| 827 | (defun gdb-field-format-begin () | ||
| 828 | ;; get rid of ##field-begin | ||
| 829 | (gdb-delete-line) | ||
| 830 | (gdb-insert-field) | ||
| 831 | (setq gdb-nesting-level (+ gdb-nesting-level 1)) | ||
| 832 | (while (re-search-forward "##" nil t) | ||
| 833 | ;; keep making recursive calls... | ||
| 834 | (if (looking-at "field-begin \\(.\\)") | ||
| 835 | (progn | ||
| 836 | (setq gdb-annotation-arg (match-string 1)) | ||
| 837 | (gdb-field-format-begin))) | ||
| 838 | ;; until field-end. | ||
| 839 | (if (looking-at "field-end") (gdb-field-format-end)))) | ||
| 840 | |||
| 841 | (defun gdb-field-format-end () | ||
| 842 | ;; get rid of ##field-end and `,' or `}' | ||
| 843 | (gdb-delete-line) | ||
| 844 | (gdb-delete-line) | ||
| 845 | (setq gdb-nesting-level (- gdb-nesting-level 1))) | ||
| 846 | |||
| 847 | (defvar gdb-dive-map | ||
| 848 | (let ((map (make-sparse-keymap))) | ||
| 849 | (define-key map [mouse-2] 'gdb-dive) | ||
| 850 | (define-key map [S-mouse-2] 'gdb-dive-new-frame) | ||
| 851 | map)) | ||
| 852 | |||
| 853 | (defun gdb-dive (event) | ||
| 854 | "Dive into structure." | ||
| 855 | (interactive "e") | ||
| 856 | (setq gdb-dive t) | ||
| 857 | (gdb-dive-new-frame event)) | ||
| 858 | |||
| 859 | (defun gdb-dive-new-frame (event) | ||
| 860 | "Dive into structure and display in a new frame." | ||
| 861 | (interactive "e") | ||
| 862 | (save-excursion | ||
| 863 | (mouse-set-point event) | ||
| 864 | (let ((point (point)) (gdb-full-expression gdb-expression) | ||
| 865 | (end (progn (end-of-line) (point))) | ||
| 866 | (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil)) | ||
| 867 | (beginning-of-line) | ||
| 868 | (if (looking-at "\*") (setq gdb-display-char "*")) | ||
| 869 | (re-search-forward "\\(\\S-+\\) = " end t) | ||
| 870 | (setq gdb-last-field (match-string-no-properties 1)) | ||
| 871 | (goto-char (match-beginning 1)) | ||
| 872 | (let ((last-column (current-column))) | ||
| 873 | (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t) | ||
| 874 | (goto-char (match-beginning 1)) | ||
| 875 | (if (and (< (current-column) last-column) | ||
| 876 | (> (count-lines 1 (point)) 1)) | ||
| 877 | (progn | ||
| 878 | (setq gdb-part-expression | ||
| 879 | (concat "." (match-string-no-properties 1) | ||
| 880 | gdb-part-expression)) | ||
| 881 | (setq last-column (current-column)))))) | ||
| 882 | ;; * not needed for components of a pointer to a structure in gdb | ||
| 883 | (if (string-equal "*" (substring gdb-full-expression 0 1)) | ||
| 884 | (setq gdb-full-expression (substring gdb-full-expression 1 nil))) | ||
| 885 | (setq gdb-full-expression | ||
| 886 | (concat gdb-full-expression gdb-part-expression "." gdb-last-field)) | ||
| 887 | (gdb-enqueue-input | ||
| 888 | (list (concat "server display" gdb-display-char | ||
| 889 | " " gdb-full-expression "\n") | ||
| 890 | 'ignore))))) | ||
| 891 | |||
| 892 | (defun gdb-insert-field () | ||
| 893 | (let ((start (progn (point))) | ||
| 894 | (end (progn (next-line) (point))) | ||
| 895 | (num 0)) | ||
| 896 | (with-current-buffer gdb-expression-buffer-name | ||
| 897 | (let ((buffer-read-only nil)) | ||
| 898 | (if (string-equal gdb-annotation-arg "\*") (insert "\*")) | ||
| 899 | (while (<= num gdb-nesting-level) | ||
| 900 | (insert "\t") | ||
| 901 | (setq num (+ num 1))) | ||
| 902 | (insert-buffer-substring (gdb-get-buffer | ||
| 903 | 'gdb-partial-output-buffer) | ||
| 904 | start end) | ||
| 905 | (add-text-properties | ||
| 906 | (- (point) (- end start)) (- (point) 1) | ||
| 907 | `(mouse-face highlight | ||
| 908 | local-map ,gdb-dive-map | ||
| 909 | help-echo "mouse-2: dive, S-mouse-2: dive in a new frame")))) | ||
| 910 | (delete-region start end))) | ||
| 911 | |||
| 912 | (defvar gdb-values nil) | ||
| 913 | |||
| 914 | (defun gdb-array-format () | ||
| 915 | (while (re-search-forward "##" nil t) | ||
| 916 | ;; keep making recursive calls... | ||
| 917 | (if (looking-at "array-section-begin") | ||
| 918 | (progn | ||
| 919 | ;;get rid of ##array-section-begin | ||
| 920 | (gdb-delete-line) | ||
| 921 | (setq gdb-nesting-level (+ gdb-nesting-level 1)) | ||
| 922 | (gdb-array-format))) | ||
| 923 | ;;until *matching* array-section-end is found | ||
| 924 | (if (looking-at "array-section-end") | ||
| 925 | (if (eq gdb-nesting-level 0) | ||
| 926 | (progn | ||
| 927 | (let ((values (buffer-substring gdb-point (- (point) 2)))) | ||
| 928 | (with-current-buffer gdb-expression-buffer-name | ||
| 929 | (setq gdb-values | ||
| 930 | (concat "{" (replace-regexp-in-string "\n" "" values) | ||
| 931 | "}")) | ||
| 932 | (gdb-array-format1)))) | ||
| 933 | ;;else get rid of ##array-section-end etc | ||
| 934 | (gdb-delete-line) | ||
| 935 | (setq gdb-nesting-level (- gdb-nesting-level 1)) | ||
| 936 | (gdb-array-format))))) | ||
| 937 | |||
| 938 | (defvar gdb-array-start nil) | ||
| 939 | (defvar gdb-array-stop nil) | ||
| 940 | |||
| 941 | (defvar gdb-array-slice-map | ||
| 942 | (let ((map (make-sparse-keymap))) | ||
| 943 | (define-key map "\r" 'gdb-array-slice) | ||
| 944 | (define-key map [mouse-2] 'gdb-mouse-array-slice) | ||
| 945 | map)) | ||
| 946 | |||
| 947 | (defun gdb-mouse-array-slice (event) | ||
| 948 | "Select an array slice to display." | ||
| 949 | (interactive "e") | ||
| 950 | (mouse-set-point event) | ||
| 951 | (gdb-array-slice)) | ||
| 952 | |||
| 953 | (defun gdb-array-slice () | ||
| 954 | (interactive) | ||
| 955 | (save-excursion | ||
| 956 | (let ((n -1) (stop 0) (start 0) (point (point))) | ||
| 957 | (beginning-of-line) | ||
| 958 | (while (search-forward "[" point t) | ||
| 959 | (setq n (+ n 1))) | ||
| 960 | (setq start (string-to-int (read-string "Start index: "))) | ||
| 961 | (aset gdb-array-start n start) | ||
| 962 | (setq stop (string-to-int (read-string "Stop index: "))) | ||
| 963 | (aset gdb-array-stop n stop))) | ||
| 964 | (gdb-array-format1)) | ||
| 965 | |||
| 966 | (defvar gdb-display-string nil) | ||
| 967 | (defvar gdb-array-size nil) | ||
| 968 | |||
| 969 | (defun gdb-array-format1 () | ||
| 970 | (setq gdb-display-string "") | ||
| 971 | (let ((buffer-read-only nil)) | ||
| 972 | (delete-region (point-min) (point-max)) | ||
| 973 | (let ((gdb-value-list (split-string gdb-values ", "))) | ||
| 974 | (string-match "\\({+\\)" (car gdb-value-list)) | ||
| 975 | (let* ((depth (- (match-end 1) (match-beginning 1))) | ||
| 976 | (indices (make-vector depth '0)) | ||
| 977 | (index 0) (num 0) (array-start "") | ||
| 978 | (array-stop "") (array-slice "") (array-range nil) | ||
| 979 | (flag t) (indices-string "")) | ||
| 980 | (dolist (gdb-value gdb-value-list) | ||
| 981 | (string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value) | ||
| 982 | (setq num 0) | ||
| 983 | (while (< num depth) | ||
| 984 | (setq indices-string | ||
| 985 | (concat indices-string | ||
| 986 | "[" (int-to-string (aref indices num)) "]")) | ||
| 987 | (if (not (= (aref gdb-array-start num) -1)) | ||
| 988 | (if (or (< (aref indices num) (aref gdb-array-start num)) | ||
| 989 | (> (aref indices num) (aref gdb-array-stop num))) | ||
| 990 | (setq flag nil)) | ||
| 991 | (aset gdb-array-size num (aref indices num))) | ||
| 992 | (setq num (+ num 1))) | ||
| 993 | (if flag | ||
| 994 | (let ((gdb-display-value (match-string 1 gdb-value))) | ||
| 995 | (setq gdb-display-string (concat gdb-display-string " " | ||
| 996 | gdb-display-value)) | ||
| 997 | (insert | ||
| 998 | (concat indices-string "\t" gdb-display-value "\n")))) | ||
| 999 | (setq indices-string "") | ||
| 1000 | (setq flag t) | ||
| 1001 | ;; 0<= index < depth, start at right : (- depth 1) | ||
| 1002 | (setq index (- (- depth 1) | ||
| 1003 | (- (match-end 2) (match-beginning 2)))) | ||
| 1004 | ;;don't set for very last brackets | ||
| 1005 | (when (>= index 0) | ||
| 1006 | (aset indices index (+ 1 (aref indices index))) | ||
| 1007 | (setq num (+ 1 index)) | ||
| 1008 | (while (< num depth) | ||
| 1009 | (aset indices num 0) | ||
| 1010 | (setq num (+ num 1))))) | ||
| 1011 | (setq num 0) | ||
| 1012 | (while (< num depth) | ||
| 1013 | (if (= (aref gdb-array-start num) -1) | ||
| 1014 | (progn | ||
| 1015 | (aset gdb-array-start num 0) | ||
| 1016 | (aset gdb-array-stop num (aref indices num)))) | ||
| 1017 | (setq array-start (int-to-string (aref gdb-array-start num))) | ||
| 1018 | (setq array-stop (int-to-string (aref gdb-array-stop num))) | ||
| 1019 | (setq array-range (concat "[" array-start | ||
| 1020 | ":" array-stop "]")) | ||
| 1021 | (add-text-properties | ||
| 1022 | 1 (+ (length array-start) (length array-stop) 2) | ||
| 1023 | `(mouse-face highlight | ||
| 1024 | local-map ,gdb-array-slice-map | ||
| 1025 | help-echo "mouse-2, RET: select slice for this index") array-range) | ||
| 1026 | (goto-char (point-min)) | ||
| 1027 | (setq array-slice (concat array-slice array-range)) | ||
| 1028 | (setq num (+ num 1))) | ||
| 1029 | (goto-char (point-min)) | ||
| 1030 | (insert "Array Size : ") | ||
| 1031 | (setq num 0) | ||
| 1032 | (while (< num depth) | ||
| 1033 | (insert | ||
| 1034 | (concat "[" | ||
| 1035 | (int-to-string (+ (aref gdb-array-size num) 1)) "]")) | ||
| 1036 | (setq num (+ num 1))) | ||
| 1037 | (insert | ||
| 1038 | (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n")))))) | ||
| 1039 | |||
| 1040 | (defun gud-gdba-marker-filter (string) | 751 | (defun gud-gdba-marker-filter (string) |
| 1041 | "A gud marker filter for gdb. Handle a burst of output from GDB." | 752 | "A gud marker filter for gdb. Handle a burst of output from GDB." |
| 1042 | (let ( | 753 | (let ( |
| @@ -1728,155 +1439,6 @@ the source buffer." | |||
| 1728 | (switch-to-buffer-other-frame | 1439 | (switch-to-buffer-other-frame |
| 1729 | (gdb-get-create-buffer 'gdb-locals-buffer))) | 1440 | (gdb-get-create-buffer 'gdb-locals-buffer))) |
| 1730 | 1441 | ||
| 1731 | ;; | ||
| 1732 | ;; Display expression buffer. | ||
| 1733 | ;; | ||
| 1734 | (gdb-set-buffer-rules 'gdb-display-buffer | ||
| 1735 | 'gdb-display-buffer-name | ||
| 1736 | 'gdb-display-mode) | ||
| 1737 | |||
| 1738 | (def-gdb-auto-updated-buffer gdb-display-buffer | ||
| 1739 | ;; `gdb-display-buffer'. | ||
| 1740 | gdb-invalidate-display | ||
| 1741 | "server info display\n" | ||
| 1742 | gdb-info-display-handler | ||
| 1743 | gdb-info-display-custom) | ||
| 1744 | |||
| 1745 | (defun gdb-info-display-custom () | ||
| 1746 | (let ((display-list nil)) | ||
| 1747 | (with-current-buffer (gdb-get-buffer 'gdb-display-buffer) | ||
| 1748 | (goto-char (point-min)) | ||
| 1749 | (while (< (point) (- (point-max) 1)) | ||
| 1750 | (forward-line 1) | ||
| 1751 | (if (looking-at "\\([0-9]+\\): \\([ny]\\)") | ||
| 1752 | (setq display-list | ||
| 1753 | (cons (string-to-int (match-string 1)) display-list))) | ||
| 1754 | (end-of-line))) | ||
| 1755 | (if (not (display-graphic-p)) | ||
| 1756 | (progn | ||
| 1757 | (dolist (buffer (buffer-list)) | ||
| 1758 | (if (string-match "\\*display \\([0-9]+\\)\\*" (buffer-name buffer)) | ||
| 1759 | (progn | ||
| 1760 | (let ((number | ||
| 1761 | (match-string 1 (buffer-name buffer)))) | ||
| 1762 | (if (not (memq (string-to-int number) display-list)) | ||
| 1763 | (kill-buffer | ||
| 1764 | (get-buffer (concat "*display " number "*"))))))))) | ||
| 1765 | (gdb-delete-frames display-list)))) | ||
| 1766 | |||
| 1767 | (defun gdb-delete-frames (display-list) | ||
| 1768 | (dolist (frame (frame-list)) | ||
| 1769 | (let ((frame-name (frame-parameter frame 'name))) | ||
| 1770 | (if (string-match "\\*display \\([0-9]+\\)\\*" frame-name) | ||
| 1771 | (progn | ||
| 1772 | (let ((number (match-string 1 frame-name))) | ||
| 1773 | (if (not (memq (string-to-int number) display-list)) | ||
| 1774 | (progn (kill-buffer | ||
| 1775 | (get-buffer (concat "*display " number "*"))) | ||
| 1776 | (delete-frame frame))))))))) | ||
| 1777 | |||
| 1778 | (defvar gdb-display-mode-map | ||
| 1779 | (let ((map (make-sparse-keymap)) | ||
| 1780 | (menu (make-sparse-keymap "Display"))) | ||
| 1781 | (define-key menu [toggle] '("Toggle" . gdb-toggle-display)) | ||
| 1782 | (define-key menu [delete] '("Delete" . gdb-delete-display)) | ||
| 1783 | |||
| 1784 | (suppress-keymap map) | ||
| 1785 | (define-key map [menu-bar display] (cons "Display" menu)) | ||
| 1786 | (define-key map " " 'gdb-toggle-display) | ||
| 1787 | (define-key map "d" 'gdb-delete-display) | ||
| 1788 | map)) | ||
| 1789 | |||
| 1790 | (defun gdb-display-mode () | ||
| 1791 | "Major mode for gdb display. | ||
| 1792 | |||
| 1793 | \\{gdb-display-mode-map}" | ||
| 1794 | (setq major-mode 'gdb-display-mode) | ||
| 1795 | (setq mode-name "Display") | ||
| 1796 | (setq buffer-read-only t) | ||
| 1797 | (use-local-map gdb-display-mode-map) | ||
| 1798 | (gdb-invalidate-display)) | ||
| 1799 | |||
| 1800 | (defun gdb-display-buffer-name () | ||
| 1801 | (with-current-buffer gud-comint-buffer | ||
| 1802 | (concat "*Displayed expressions of " (gdb-get-target-string) "*"))) | ||
| 1803 | |||
| 1804 | (defun gdb-display-display-buffer () | ||
| 1805 | (interactive) | ||
| 1806 | (gdb-display-buffer | ||
| 1807 | (gdb-get-create-buffer 'gdb-display-buffer))) | ||
| 1808 | |||
| 1809 | (defun gdb-frame-display-buffer () | ||
| 1810 | (interactive) | ||
| 1811 | (switch-to-buffer-other-frame | ||
| 1812 | (gdb-get-create-buffer 'gdb-display-buffer))) | ||
| 1813 | |||
| 1814 | (defun gdb-toggle-display () | ||
| 1815 | "Enable/disable the displayed expression at current line." | ||
| 1816 | (interactive) | ||
| 1817 | (save-excursion | ||
| 1818 | (beginning-of-line 1) | ||
| 1819 | (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) | ||
| 1820 | (error "No expression on this line") | ||
| 1821 | (gdb-enqueue-input | ||
| 1822 | (list | ||
| 1823 | (concat | ||
| 1824 | (if (eq ?y (char-after (match-beginning 2))) | ||
| 1825 | "server disable display " | ||
| 1826 | "server enable display ") | ||
| 1827 | (match-string 1) "\n") | ||
| 1828 | 'ignore))))) | ||
| 1829 | |||
| 1830 | (defun gdb-delete-display () | ||
| 1831 | "Delete the displayed expression at current line." | ||
| 1832 | (interactive) | ||
| 1833 | (with-current-buffer (gdb-get-buffer 'gdb-display-buffer) | ||
| 1834 | (beginning-of-line 1) | ||
| 1835 | (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) | ||
| 1836 | (error "No expression on this line") | ||
| 1837 | (let ((number (match-string 1))) | ||
| 1838 | (gdb-enqueue-input | ||
| 1839 | (list (concat "server delete display " number "\n") 'ignore)))))) | ||
| 1840 | |||
| 1841 | (defvar gdb-expressions-mode-map | ||
| 1842 | (let ((map (make-sparse-keymap))) | ||
| 1843 | (suppress-keymap map) | ||
| 1844 | (define-key map "v" 'gdb-array-visualise) | ||
| 1845 | (define-key map "q" 'gdb-delete-expression) | ||
| 1846 | (define-key map [mouse-3] 'gdb-expressions-popup-menu) | ||
| 1847 | map)) | ||
| 1848 | |||
| 1849 | (defvar gdb-expressions-mode-menu | ||
| 1850 | '("GDB Expressions Commands" | ||
| 1851 | "----" | ||
| 1852 | ["Visualise" gdb-array-visualise t] | ||
| 1853 | ["Delete" gdb-delete-expression t]) | ||
| 1854 | "Menu for `gdb-expressions-mode'.") | ||
| 1855 | |||
| 1856 | (defun gdb-expressions-popup-menu (event) | ||
| 1857 | "Explicit Popup menu as this buffer doesn't have a menubar." | ||
| 1858 | (interactive "@e") | ||
| 1859 | (mouse-set-point event) | ||
| 1860 | (popup-menu gdb-expressions-mode-menu)) | ||
| 1861 | |||
| 1862 | (defun gdb-expressions-mode () | ||
| 1863 | "Major mode for display expressions. | ||
| 1864 | |||
| 1865 | \\{gdb-expressions-mode-map}" | ||
| 1866 | (setq major-mode 'gdb-expressions-mode) | ||
| 1867 | (setq mode-name "Expressions") | ||
| 1868 | (use-local-map gdb-expressions-mode-map) | ||
| 1869 | (make-local-variable 'gdb-display-number) | ||
| 1870 | (make-local-variable 'gdb-values) | ||
| 1871 | (make-local-variable 'gdb-expression) | ||
| 1872 | (set (make-local-variable 'gdb-display-string) nil) | ||
| 1873 | (set (make-local-variable 'gdb-dive-display-number) nil) | ||
| 1874 | (set (make-local-variable 'gud-minor-mode) 'gdba) | ||
| 1875 | (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1)) | ||
| 1876 | (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1)) | ||
| 1877 | (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1)) | ||
| 1878 | (setq buffer-read-only t)) | ||
| 1879 | |||
| 1880 | 1442 | ||
| 1881 | ;;;; Window management | 1443 | ;;;; Window management |
| 1882 | 1444 | ||
| @@ -1943,7 +1505,6 @@ the source buffer." | |||
| 1943 | (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) | 1505 | (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) |
| 1944 | (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) | 1506 | (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) |
| 1945 | (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) | 1507 | (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) |
| 1946 | (define-key menu [display] '("Display" . gdb-frame-display-buffer)) | ||
| 1947 | (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) | 1508 | (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) |
| 1948 | ; (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer)) | 1509 | ; (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer)) |
| 1949 | ) | 1510 | ) |
| @@ -1956,7 +1517,6 @@ the source buffer." | |||
| 1956 | (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) | 1517 | (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) |
| 1957 | (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) | 1518 | (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) |
| 1958 | (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)) | 1519 | (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)) |
| 1959 | (define-key menu [display] '("Display" . gdb-display-display-buffer)) | ||
| 1960 | (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) | 1520 | (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) |
| 1961 | ; (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer)) | 1521 | ; (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer)) |
| 1962 | ) | 1522 | ) |
| @@ -2021,7 +1581,6 @@ the source buffer." | |||
| 2021 | (gdb-display-stack-buffer) | 1581 | (gdb-display-stack-buffer) |
| 2022 | (delete-other-windows) | 1582 | (delete-other-windows) |
| 2023 | (gdb-display-breakpoints-buffer) | 1583 | (gdb-display-breakpoints-buffer) |
| 2024 | (gdb-display-display-buffer) | ||
| 2025 | (delete-other-windows) | 1584 | (delete-other-windows) |
| 2026 | (switch-to-buffer gud-comint-buffer) | 1585 | (switch-to-buffer gud-comint-buffer) |
| 2027 | (split-window nil ( / ( * (window-height) 3) 4)) | 1586 | (split-window nil ( / ( * (window-height) 3) 4)) |
| @@ -2089,11 +1648,10 @@ This arrangement depends on the value of `gdb-many-windows'." | |||
| 2089 | (defun gdb-reset () | 1648 | (defun gdb-reset () |
| 2090 | "Exit a debugging session cleanly by killing the gdb buffers and resetting | 1649 | "Exit a debugging session cleanly by killing the gdb buffers and resetting |
| 2091 | the source buffers." | 1650 | the source buffers." |
| 2092 | (gdb-delete-frames '()) | ||
| 2093 | (dolist (buffer (buffer-list)) | 1651 | (dolist (buffer (buffer-list)) |
| 2094 | (if (not (eq buffer gud-comint-buffer)) | 1652 | (if (not (eq buffer gud-comint-buffer)) |
| 2095 | (with-current-buffer buffer | 1653 | (with-current-buffer buffer |
| 2096 | (if (eq gud-minor-mode 'gdba) | 1654 | (if (memq gud-minor-mode '(gdba pdb)) |
| 2097 | (if (string-match "^\*.+*$" (buffer-name)) | 1655 | (if (string-match "^\*.+*$" (buffer-name)) |
| 2098 | (kill-buffer nil) | 1656 | (kill-buffer nil) |
| 2099 | (if (display-images-p) | 1657 | (if (display-images-p) |
| @@ -2128,7 +1686,6 @@ buffers." | |||
| 2128 | (if gdb-many-windows | 1686 | (if gdb-many-windows |
| 2129 | (gdb-setup-windows) | 1687 | (gdb-setup-windows) |
| 2130 | (gdb-display-breakpoints-buffer) | 1688 | (gdb-display-breakpoints-buffer) |
| 2131 | (gdb-display-display-buffer) | ||
| 2132 | (delete-other-windows) | 1689 | (delete-other-windows) |
| 2133 | (split-window) | 1690 | (split-window) |
| 2134 | (other-window 1) | 1691 | (other-window 1) |
| @@ -2195,39 +1752,6 @@ BUFFER nil or omitted means use the current buffer." | |||
| 2195 | (when (overlay-get overlay 'put-arrow) | 1752 | (when (overlay-get overlay 'put-arrow) |
| 2196 | (delete-overlay overlay))) | 1753 | (delete-overlay overlay))) |
| 2197 | (setq overlays (cdr overlays))))) | 1754 | (setq overlays (cdr overlays))))) |
| 2198 | |||
| 2199 | (defun gdb-array-visualise () | ||
| 2200 | "Visualise arrays and slices using graph program from plotutils." | ||
| 2201 | (interactive) | ||
| 2202 | (when (and (display-graphic-p) gdb-display-string) | ||
| 2203 | (let ((n 0) m) | ||
| 2204 | (catch 'multi-dimensional | ||
| 2205 | (while (eq (aref gdb-array-start n) (aref gdb-array-stop n)) | ||
| 2206 | (setq n (+ n 1))) | ||
| 2207 | (setq m (+ n 1)) | ||
| 2208 | (while (< m (length gdb-array-start)) | ||
| 2209 | (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m))) | ||
| 2210 | (progn | ||
| 2211 | (x-popup-dialog | ||
| 2212 | t `(,(concat "Only one dimensional data can be visualised.\n" | ||
| 2213 | "Use an array slice to reduce the number of\n" | ||
| 2214 | "dimensions") ("OK" t))) | ||
| 2215 | (throw 'multi-dimensional nil)) | ||
| 2216 | (setq m (+ m 1)))) | ||
| 2217 | (shell-command (concat "echo" gdb-display-string " | graph -a 1 " | ||
| 2218 | (int-to-string (aref gdb-array-start n)) | ||
| 2219 | " -x " | ||
| 2220 | (int-to-string (aref gdb-array-start n)) | ||
| 2221 | " " | ||
| 2222 | (int-to-string (aref gdb-array-stop n)) | ||
| 2223 | " 1 -T X")))))) | ||
| 2224 | |||
| 2225 | (defun gdb-delete-expression () | ||
| 2226 | "Delete displayed expression and its frame." | ||
| 2227 | (interactive) | ||
| 2228 | (gdb-enqueue-input | ||
| 2229 | (list (concat "server delete display " gdb-display-number "\n") | ||
| 2230 | 'ignore))) | ||
| 2231 | 1755 | ||
| 2232 | ;; | 1756 | ;; |
| 2233 | ;; Assembler buffer. | 1757 | ;; Assembler buffer. |