Mercurial > emacs
diff lisp/gdb-ui.el @ 52698:367c1b29dbee
(gdb-var-list, gdb-var-changed, gdb-update-flag)
(gdb-update-flag): New variables.
(gdb-var-update, gdb-var-update-handler,gdb-var-delete)
(gdb-speedbar-expand-node, gdb-var-evaluate-expression-handler)
(gud-watch, gdb-var-create-handler) : New functions.
(gdb-var-list-children, gdb-var-list-children-handler)
(gdb-var-create-regexp, gdb-var-update-regexp)
(gdb-var-list-children-regexp): New constants.
(gud-gdba-command-name): Don't specify -noasync so that GDB/MI
works.
(gdb-annotation-rules): Reduced annotation set (level 3).
(gdb-pre-prompt, gdb-prompt): Call handler in gdb-prompt.
(gdb-post-prompt): Don't update GDB buffers every time speedbar
updates.
(gdb-window-height, gdb-window-width, gdb-display-in-progress)
(gdb-expression-buffer-name, gdb-display-number, gdb-point)
(gdb-dive-display-number, gdb-nesting-level, gdb-expression)
(gdb-annotation-arg, gdb-dive-map, gdb-values, gdb-array-start)
(gdb-array-stop, gdb-array-slice-map, gdb-display-string)
(gdb-array-size, gdb-display-mode-map, gdb-expressions-mode-map):
(gdb-expressions-mode-menu, gdb-dive): Remove variables.
(gud-display, gud-display1)
(gdb-display-begin,gdb-display-number-end, gdb-delete-line)
(gdb-display-end, gdb-display-go-back, gdb-array-section-end)
(gdb-field-begin, gdb-field-end, gdb-elt,gdb-field-format-begin)
(gdb-field-format-end, gdb-dive, gdb-dive-new-frame)
(gdb-insert-field, gdb-array-format, gdb-mouse-array-slice)
(gdb-array-slice, gdb-array-format1, gdb-info-display-custom)
(gdb-delete-frames, gdb-display-mode, gdb-display-buffer-name)
(gdb-display-display-buffer, gdb-toggle-display)
(gdb-delete-display, gdb-expressions-popup-menu)
(gdb-expressions-mode, gdb-array-visualise): Remove functions.
(gdb-setup-windows, gdb-reset, gdb-source-info): Remove references
to display buffer.
author | Nick Roberts <nickrob@snap.net.nz> |
---|---|
date | Tue, 30 Sep 2003 17:56:24 +0000 |
parents | 31a30e670e11 |
children | f49c1c4d92de |
line wrap: on
line diff
--- a/lisp/gdb-ui.el Tue Sep 30 17:55:08 2003 +0000 +++ b/lisp/gdb-ui.el Tue Sep 30 17:56:24 2003 +0000 @@ -50,29 +50,19 @@ (require 'gud) -(defcustom gdb-window-height 20 - "Number of lines in a frame for a displayed expression in GDB-UI." - :type 'integer - :group 'gud) - -(defcustom gdb-window-width 30 - "Width of a frame for a displayed expression in GDB-UI." - :type 'integer - :group 'gud) - (defvar gdb-current-address "main" "Initialisation for Assembler buffer.") (defvar gdb-previous-address nil) (defvar gdb-previous-frame nil) (defvar gdb-current-frame "main") -(defvar gdb-display-in-progress nil) -(defvar gdb-dive nil) (defvar gdb-view-source t "Non-nil means that source code can be viewed") (defvar gdb-selected-view 'source "Code type that user wishes to view") +(defvar gdb-var-list nil "List of variables in watch window") +(defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed") +(defvar gdb-update-flag t "Non-il means update buffers") (defvar gdb-buffer-type nil) (defvar gdb-variables '() "A list of variables that are local to the GUD buffer.") - ;;;###autoload (defun gdba (command-line) "Run gdb on program FILE in buffer *gud-FILE*. @@ -162,10 +152,11 @@ (setq gdb-previous-address nil) (setq gdb-previous-frame nil) (setq gdb-current-frame "main") - (setq gdb-display-in-progress nil) - (setq gdb-dive nil) (setq gdb-view-source t) (setq gdb-selected-view 'source) + (setq gdb-var-list nil) + (setq gdb-var-changed nil) + (setq gdb-update-flag t) ;; (mapc 'make-local-variable gdb-variables) (setq gdb-buffer-type 'gdba) @@ -182,30 +173,148 @@ ;; (run-hooks 'gdba-mode-hook)) -(defun gud-display () - "Auto-display (possibly dereferenced) C expression at point." +(defun gud-watch () + "Watch expression." (interactive) - (save-excursion - (let ((expr (gud-find-c-expr))) + (let ((expr (tooltip-identifier-from-point (point)))) + (setq expr (concat gdb-current-frame "::" expr)) + (catch 'already-watched + (dolist (var gdb-var-list) + (if (string-equal expr (car var)) (throw 'already-watched nil))) (gdb-enqueue-input - (list (concat "server ptype " expr "\n") - `(lambda () (gud-display1 ,expr))))))) + (list (concat "interpreter mi \"-var-create - * " expr "\"\n") + `(lambda () (gdb-var-create-handler ,expr)))))) + (select-window (get-buffer-window gud-comint-buffer))) + +(defconst gdb-var-create-regexp +"name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") + +(defun gdb-var-create-handler (expr) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (if (re-search-forward gdb-var-create-regexp nil t) + (let ((var (list expr + (match-string-no-properties 1) + (match-string-no-properties 2) + (match-string-no-properties 3) + nil))) + (push var gdb-var-list) + (speedbar 1) + (if (equal (nth 2 var) "0") + (gdb-enqueue-input + (list (concat "interpreter mi \"-var-evaluate-expression " + (nth 1 var) "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler + ,(nth 1 var))))) + (setq gdb-var-changed t))) + (if (re-search-forward "Undefined command" nil t) + (message "Watching expressions requires gdb 6.0 onwards") + (message "No symbol %s in current context." expr))))) + +(defun gdb-var-evaluate-expression-handler (varnum) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (re-search-forward ".*value=\"\\(.*?\\)\"" nil t) + (let ((var-list nil)) + (dolist (var gdb-var-list) + (if (string-equal varnum (cadr var)) + (progn + (push (nreverse (cons (match-string-no-properties 1) + (cdr (nreverse var)))) var-list)) + (push var var-list))) + (setq gdb-var-list (nreverse var-list)))) + (setq gdb-var-changed t)) + +(defun gdb-var-list-children (varnum) + (gdb-enqueue-input + (list (concat "interpreter mi \"-var-list-children " varnum "\"\n") + `(lambda () (gdb-var-list-children-handler ,varnum))))) + +(defconst gdb-var-list-children-regexp +"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") -(defun gud-display1 (expr) - (goto-char (point-min)) - (if (looking-at "No symbol") +(defun gdb-var-list-children-handler (varnum) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (let ((var-list nil)) + (catch 'child-already-watched + (dolist (var gdb-var-list) + (if (string-equal varnum (cadr var)) + (progn + (push var var-list) + (while (re-search-forward gdb-var-list-children-regexp nil t) + (let ((varchild (list (match-string-no-properties 2) + (match-string-no-properties 1) + (match-string-no-properties 3) + (match-string-no-properties 4) + nil))) + (dolist (var1 gdb-var-list) + (if (string-equal (cadr var1) (cadr varchild)) + (throw 'child-already-watched nil))) + (push varchild var-list) + (if (equal (nth 2 varchild) "0") + (gdb-enqueue-input + (list + (concat "interpreter mi \"-var-evaluate-expression " + (nth 1 varchild) "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler + ,(nth 1 varchild))))))))) + (push var var-list))) + (setq gdb-var-list (nreverse var-list)))))) + +(defun gdb-var-update () + (setq gdb-update-flag nil) + (if (not (member 'gdb-var-update (gdb-get-pending-triggers))) (progn - (gdb-set-output-sink 'user) - (gud-call (concat "server ptype " expr))) - (goto-char (- (point-max) 1)) - (if (equal (char-before) (string-to-char "\*")) - (gud-call (concat "display* " expr)) - (gud-call (concat "display " expr))))) + (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n" + 'gdb-var-update-handler)) + (gdb-set-pending-triggers (cons 'gdb-var-update + (gdb-get-pending-triggers)))))) + +(defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"") + +(defun gdb-var-update-handler () + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (while (re-search-forward gdb-var-update-regexp nil t) + (let ((varnum (match-string-no-properties 1))) + (gdb-enqueue-input + (list (concat "interpreter mi \"-var-evaluate-expression " + varnum "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler + ,varnum))))))) + (gdb-set-pending-triggers + (delq 'gdb-var-update (gdb-get-pending-triggers)))) -; this would messy because these bindings don't work with M-x gdb -; (define-key global-map "\C-x\C-a\C-a" 'gud-display) -; (define-key gud-minor-mode-map "\C-c\C-a" 'gud-display) +(defun gdb-var-delete (text token indent) + "Delete watched expression." + (interactive) + (when (eq indent 0) + (string-match "\\(\\S-+\\)" text) + (let* ((expr (match-string 1 text)) + (var (assoc expr gdb-var-list)) + (varnum (cadr var))) + (gdb-enqueue-input + (list (concat "interpreter mi \"-var-delete " varnum "\"\n") + 'ignore)) + (setq gdb-var-list (delq var gdb-var-list)) + (dolist (varchild gdb-var-list) + (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild)) + (setq gdb-var-list (delq varchild gdb-var-list))))) + (setq gdb-var-changed t))) +(defun gdb-speedbar-expand-node (text token indent) + "Expand the node the user clicked on. +TEXT is the text of the button we clicked on, a + or - item. +TOKEN is data related to this node. +INDENT is the current indentation depth." + (cond ((string-match "+" text) ;expand this node + (gdb-var-list-children token)) + ((string-match "-" text) ;contract this node + (dolist (var gdb-var-list) + (if (string-match (concat token "\\.") (nth 1 var)) + (setq gdb-var-list (delq var gdb-var-list)))) + (setq gdb-var-changed t)))) ;; ====================================================================== @@ -445,7 +554,7 @@ (gdb-enqueue-input (concat string "\n"))) ;; Note: Stuff enqueued here will be sent to the next prompt, even if it -;; is a query, or other non-top-level prompt. +;; is a query, or other non-top-level prompt. (defun gdb-enqueue-input (item) (if (gdb-get-prompting) @@ -489,7 +598,7 @@ ;; any newlines. ;; -(defcustom gud-gdba-command-name "gdb -annotate=2 -noasync" +(defcustom gud-gdba-command-name "~/gdb/gdb/gdb -annotate=3" "Default command to execute an executable under the GDB-UI debugger." :type 'string :group 'gud) @@ -511,18 +620,6 @@ ("watchpoint" gdb-stopping) ("frame-begin" gdb-frame-begin) ("stopped" gdb-stopped) - ("display-begin" gdb-display-begin) - ("display-end" gdb-display-end) -; GDB commands info stack, info locals and frame generate an error-begin -; annotation at start when there is no stack but this is a quirk/bug in -; annotations. -; ("error-begin" gdb-error-begin) - ("display-number-end" gdb-display-number-end) - ("array-section-begin" gdb-array-section-begin) - ("array-section-end" gdb-array-section-end) - ;; ("elt" gdb-elt) - ("field-begin" gdb-field-begin) - ("field-end" gdb-field-end) ) "An assoc mapping annotation tags to functions which process them.") (defconst gdb-source-spec-regexp @@ -558,11 +655,7 @@ (cond ((eq sink 'user) t) ((eq sink 'emacs) - (gdb-set-output-sink 'post-emacs) - (let ((handler - (car (cdr (gdb-get-current-item))))) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (funcall handler)))) + (gdb-set-output-sink 'post-emacs)) (t (gdb-set-output-sink 'user) (error "Phase error in gdb-pre-prompt (got %s)" sink))))) @@ -574,7 +667,11 @@ (cond ((eq sink 'user) t) ((eq sink 'post-emacs) - (gdb-set-output-sink 'user)) + (gdb-set-output-sink 'user) + (let ((handler + (car (cdr (gdb-get-current-item))))) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (funcall handler)))) (t (gdb-set-output-sink 'user) (error "Phase error in gdb-prompt (got %s)" sink)))) @@ -632,7 +729,7 @@ (defun gdb-post-prompt (ignored) "An annotation handler for `post-prompt'. This begins the collection of output from the current command if that happens to be appropriate." - (if (not (gdb-get-pending-triggers)) + (if (and (not (gdb-get-pending-triggers)) gdb-update-flag) (progn (gdb-get-current-frame) (gdb-invalidate-frames) @@ -640,8 +737,8 @@ (gdb-invalidate-assembler) (gdb-invalidate-registers) (gdb-invalidate-locals) - (gdb-invalidate-display) (gdb-invalidate-threads))) + (setq gdb-update-flag t) (let ((sink (gdb-get-output-sink))) (cond ((eq sink 'user) t) @@ -651,392 +748,6 @@ (gdb-set-output-sink 'user) (error "Phase error in gdb-post-prompt (got %s)" sink))))) -;; If we get an error whilst evaluating one of the expressions -;; we won't get the display-end annotation. Set the sink back to -;; user to make sure that the error message is seen. -;; NOT USED: see annotation-rules for reason. -;(defun gdb-error-begin (ignored) -; (gdb-set-output-sink 'user)) - -(defun gdb-display-begin (ignored) - (gdb-set-output-sink 'emacs) - (gdb-clear-partial-output) - (setq gdb-display-in-progress t)) - -(defvar gdb-expression-buffer-name nil) -(defvar gdb-display-number nil) -(defvar gdb-dive-display-number nil) - -(defun gdb-display-number-end (ignored) - (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) - (setq gdb-display-number (buffer-string)) - (setq gdb-expression-buffer-name - (concat "*display " gdb-display-number "*")) - (save-excursion - (if (progn - (set-buffer (window-buffer)) - gdb-dive) - (progn - (let ((number gdb-display-number)) - (switch-to-buffer - (set-buffer (get-buffer-create gdb-expression-buffer-name))) - (gdb-expressions-mode) - (setq gdb-dive-display-number number))) - (set-buffer (get-buffer-create gdb-expression-buffer-name)) - (if (display-graphic-p) - (catch 'frame-exists - (dolist (frame (frame-list)) - (if (string-equal (frame-parameter frame 'name) - gdb-expression-buffer-name) - (throw 'frame-exists nil))) - (gdb-expressions-mode) - (make-frame `((height . ,gdb-window-height) - (width . ,gdb-window-width) - (tool-bar-lines . nil) - (menu-bar-lines . nil) - (minibuffer . nil)))) - (gdb-expressions-mode) - (gdb-display-buffer (get-buffer gdb-expression-buffer-name))))) - (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) - (setq gdb-dive nil)) - -(defvar gdb-nesting-level nil) -(defvar gdb-expression nil) -(defvar gdb-point nil) -(defvar gdb-annotation-arg nil) - -(defun gdb-delete-line () - "Delete the current line." - (delete-region (line-beginning-position) (line-beginning-position 2))) - -(defun gdb-display-end (ignored) - (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) - (goto-char (point-min)) - (search-forward ": ") - (looking-at "\\(.*?\\) =") - (let ((char "") - (gdb-temp-value (match-string 1))) - ;;move * to front of expression if necessary - (if (looking-at ".*\\*") - (progn - (setq char "*") - (setq gdb-temp-value (substring gdb-temp-value 1 nil)))) - (with-current-buffer gdb-expression-buffer-name - (setq gdb-expression gdb-temp-value) - (if (not (string-match "::" gdb-expression)) - (setq gdb-expression (concat char gdb-current-frame - "::" gdb-expression)) - ;;else put * back on if necessary - (setq gdb-expression (concat char gdb-expression))) - (if (not header-line-format) - (setq header-line-format (concat "-- " gdb-expression " %-"))))) - ;; - ;;-if scalar/string - (if (not (re-search-forward "##" nil t)) - (progn - (with-current-buffer gdb-expression-buffer-name - (let ((buffer-read-only nil)) - (delete-region (point-min) (point-max)) - (insert-buffer-substring - (gdb-get-buffer 'gdb-partial-output-buffer))))) - ;; display expression name... - (goto-char (point-min)) - (let ((start (progn (point))) - (end (progn (end-of-line) (point)))) - (with-current-buffer gdb-expression-buffer-name - (let ((buffer-read-only nil)) - (delete-region (point-min) (point-max)) - (insert-buffer-substring (gdb-get-buffer - 'gdb-partial-output-buffer) - start end) - (insert "\n")))) - (goto-char (point-min)) - (re-search-forward "##" nil t) - (setq gdb-nesting-level 0) - (if (looking-at "array-section-begin") - (progn - (gdb-delete-line) - (setq gdb-point (point)) - (gdb-array-format))) - (if (looking-at "field-begin \\(.\\)") - (progn - (setq gdb-annotation-arg (match-string 1)) - (gdb-field-format-begin)))) - (with-current-buffer gdb-expression-buffer-name - (if gdb-dive-display-number - (progn - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (insert "\n") - (insert-text-button "[back]" 'type 'gdb-display-back))))) - (gdb-clear-partial-output) - (gdb-set-output-sink 'user) - (setq gdb-display-in-progress nil)) - -(define-button-type 'gdb-display-back - 'help-echo "mouse-2, RET: go back to previous display buffer" - 'action (lambda (button) (gdb-display-go-back))) - -(defun gdb-display-go-back () - ;; delete display so they don't accumulate and delete buffer - (let ((number gdb-display-number)) - (gdb-enqueue-input - (list (concat "server delete display " number "\n") 'ignore)) - (switch-to-buffer (concat "*display " gdb-dive-display-number "*")) - (kill-buffer (get-buffer (concat "*display " number "*"))))) - -;; prefix annotations with ## and process whole output in one chunk -;; in gdb-partial-output-buffer (to allow recursion). - -;; array-section flags are just removed again but after counting. They -;; might also be useful for arrays of structures and structures with arrays. -(defun gdb-array-section-begin (args) - (if gdb-display-in-progress - (progn - (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) - (goto-char (point-max)) - (insert (concat "\n##array-section-begin " args "\n")))))) - -(defun gdb-array-section-end (ignored) - (if gdb-display-in-progress - (progn - (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) - (goto-char (point-max)) - (insert "\n##array-section-end\n"))))) - -(defun gdb-field-begin (args) - (if gdb-display-in-progress - (progn - (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) - (goto-char (point-max)) - (insert (concat "\n##field-begin " args "\n")))))) - -(defun gdb-field-end (ignored) - (if gdb-display-in-progress - (progn - (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) - (goto-char (point-max)) - (insert "\n##field-end\n"))))) - -(defun gdb-elt (ignored) - (if gdb-display-in-progress - (progn - (goto-char (point-max)) - (insert "\n##elt\n")))) - -(defun gdb-field-format-begin () - ;; get rid of ##field-begin - (gdb-delete-line) - (gdb-insert-field) - (setq gdb-nesting-level (+ gdb-nesting-level 1)) - (while (re-search-forward "##" nil t) - ;; keep making recursive calls... - (if (looking-at "field-begin \\(.\\)") - (progn - (setq gdb-annotation-arg (match-string 1)) - (gdb-field-format-begin))) - ;; until field-end. - (if (looking-at "field-end") (gdb-field-format-end)))) - -(defun gdb-field-format-end () - ;; get rid of ##field-end and `,' or `}' - (gdb-delete-line) - (gdb-delete-line) - (setq gdb-nesting-level (- gdb-nesting-level 1))) - -(defvar gdb-dive-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'gdb-dive) - (define-key map [S-mouse-2] 'gdb-dive-new-frame) - map)) - -(defun gdb-dive (event) - "Dive into structure." - (interactive "e") - (setq gdb-dive t) - (gdb-dive-new-frame event)) - -(defun gdb-dive-new-frame (event) - "Dive into structure and display in a new frame." - (interactive "e") - (save-excursion - (mouse-set-point event) - (let ((point (point)) (gdb-full-expression gdb-expression) - (end (progn (end-of-line) (point))) - (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil)) - (beginning-of-line) - (if (looking-at "\*") (setq gdb-display-char "*")) - (re-search-forward "\\(\\S-+\\) = " end t) - (setq gdb-last-field (match-string-no-properties 1)) - (goto-char (match-beginning 1)) - (let ((last-column (current-column))) - (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t) - (goto-char (match-beginning 1)) - (if (and (< (current-column) last-column) - (> (count-lines 1 (point)) 1)) - (progn - (setq gdb-part-expression - (concat "." (match-string-no-properties 1) - gdb-part-expression)) - (setq last-column (current-column)))))) - ;; * not needed for components of a pointer to a structure in gdb - (if (string-equal "*" (substring gdb-full-expression 0 1)) - (setq gdb-full-expression (substring gdb-full-expression 1 nil))) - (setq gdb-full-expression - (concat gdb-full-expression gdb-part-expression "." gdb-last-field)) - (gdb-enqueue-input - (list (concat "server display" gdb-display-char - " " gdb-full-expression "\n") - 'ignore))))) - -(defun gdb-insert-field () - (let ((start (progn (point))) - (end (progn (next-line) (point))) - (num 0)) - (with-current-buffer gdb-expression-buffer-name - (let ((buffer-read-only nil)) - (if (string-equal gdb-annotation-arg "\*") (insert "\*")) - (while (<= num gdb-nesting-level) - (insert "\t") - (setq num (+ num 1))) - (insert-buffer-substring (gdb-get-buffer - 'gdb-partial-output-buffer) - start end) - (add-text-properties - (- (point) (- end start)) (- (point) 1) - `(mouse-face highlight - local-map ,gdb-dive-map - help-echo "mouse-2: dive, S-mouse-2: dive in a new frame")))) - (delete-region start end))) - -(defvar gdb-values nil) - -(defun gdb-array-format () - (while (re-search-forward "##" nil t) - ;; keep making recursive calls... - (if (looking-at "array-section-begin") - (progn - ;;get rid of ##array-section-begin - (gdb-delete-line) - (setq gdb-nesting-level (+ gdb-nesting-level 1)) - (gdb-array-format))) - ;;until *matching* array-section-end is found - (if (looking-at "array-section-end") - (if (eq gdb-nesting-level 0) - (progn - (let ((values (buffer-substring gdb-point (- (point) 2)))) - (with-current-buffer gdb-expression-buffer-name - (setq gdb-values - (concat "{" (replace-regexp-in-string "\n" "" values) - "}")) - (gdb-array-format1)))) - ;;else get rid of ##array-section-end etc - (gdb-delete-line) - (setq gdb-nesting-level (- gdb-nesting-level 1)) - (gdb-array-format))))) - -(defvar gdb-array-start nil) -(defvar gdb-array-stop nil) - -(defvar gdb-array-slice-map - (let ((map (make-sparse-keymap))) - (define-key map "\r" 'gdb-array-slice) - (define-key map [mouse-2] 'gdb-mouse-array-slice) - map)) - -(defun gdb-mouse-array-slice (event) - "Select an array slice to display." - (interactive "e") - (mouse-set-point event) - (gdb-array-slice)) - -(defun gdb-array-slice () - (interactive) - (save-excursion - (let ((n -1) (stop 0) (start 0) (point (point))) - (beginning-of-line) - (while (search-forward "[" point t) - (setq n (+ n 1))) - (setq start (string-to-int (read-string "Start index: "))) - (aset gdb-array-start n start) - (setq stop (string-to-int (read-string "Stop index: "))) - (aset gdb-array-stop n stop))) - (gdb-array-format1)) - -(defvar gdb-display-string nil) -(defvar gdb-array-size nil) - -(defun gdb-array-format1 () - (setq gdb-display-string "") - (let ((buffer-read-only nil)) - (delete-region (point-min) (point-max)) - (let ((gdb-value-list (split-string gdb-values ", "))) - (string-match "\\({+\\)" (car gdb-value-list)) - (let* ((depth (- (match-end 1) (match-beginning 1))) - (indices (make-vector depth '0)) - (index 0) (num 0) (array-start "") - (array-stop "") (array-slice "") (array-range nil) - (flag t) (indices-string "")) - (dolist (gdb-value gdb-value-list) - (string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value) - (setq num 0) - (while (< num depth) - (setq indices-string - (concat indices-string - "[" (int-to-string (aref indices num)) "]")) - (if (not (= (aref gdb-array-start num) -1)) - (if (or (< (aref indices num) (aref gdb-array-start num)) - (> (aref indices num) (aref gdb-array-stop num))) - (setq flag nil)) - (aset gdb-array-size num (aref indices num))) - (setq num (+ num 1))) - (if flag - (let ((gdb-display-value (match-string 1 gdb-value))) - (setq gdb-display-string (concat gdb-display-string " " - gdb-display-value)) - (insert - (concat indices-string "\t" gdb-display-value "\n")))) - (setq indices-string "") - (setq flag t) - ;; 0<= index < depth, start at right : (- depth 1) - (setq index (- (- depth 1) - (- (match-end 2) (match-beginning 2)))) - ;;don't set for very last brackets - (when (>= index 0) - (aset indices index (+ 1 (aref indices index))) - (setq num (+ 1 index)) - (while (< num depth) - (aset indices num 0) - (setq num (+ num 1))))) - (setq num 0) - (while (< num depth) - (if (= (aref gdb-array-start num) -1) - (progn - (aset gdb-array-start num 0) - (aset gdb-array-stop num (aref indices num)))) - (setq array-start (int-to-string (aref gdb-array-start num))) - (setq array-stop (int-to-string (aref gdb-array-stop num))) - (setq array-range (concat "[" array-start - ":" array-stop "]")) - (add-text-properties - 1 (+ (length array-start) (length array-stop) 2) - `(mouse-face highlight - local-map ,gdb-array-slice-map - help-echo "mouse-2, RET: select slice for this index") array-range) - (goto-char (point-min)) - (setq array-slice (concat array-slice array-range)) - (setq num (+ num 1))) - (goto-char (point-min)) - (insert "Array Size : ") - (setq num 0) - (while (< num depth) - (insert - (concat "[" - (int-to-string (+ (aref gdb-array-size num) 1)) "]")) - (setq num (+ num 1))) - (insert - (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n")))))) - (defun gud-gdba-marker-filter (string) "A gud marker filter for gdb. Handle a burst of output from GDB." (let ( @@ -1728,155 +1439,6 @@ (switch-to-buffer-other-frame (gdb-get-create-buffer 'gdb-locals-buffer))) -;; -;; Display expression buffer. -;; -(gdb-set-buffer-rules 'gdb-display-buffer - 'gdb-display-buffer-name - 'gdb-display-mode) - -(def-gdb-auto-updated-buffer gdb-display-buffer - ;; `gdb-display-buffer'. - gdb-invalidate-display - "server info display\n" - gdb-info-display-handler - gdb-info-display-custom) - -(defun gdb-info-display-custom () - (let ((display-list nil)) - (with-current-buffer (gdb-get-buffer 'gdb-display-buffer) - (goto-char (point-min)) - (while (< (point) (- (point-max) 1)) - (forward-line 1) - (if (looking-at "\\([0-9]+\\): \\([ny]\\)") - (setq display-list - (cons (string-to-int (match-string 1)) display-list))) - (end-of-line))) - (if (not (display-graphic-p)) - (progn - (dolist (buffer (buffer-list)) - (if (string-match "\\*display \\([0-9]+\\)\\*" (buffer-name buffer)) - (progn - (let ((number - (match-string 1 (buffer-name buffer)))) - (if (not (memq (string-to-int number) display-list)) - (kill-buffer - (get-buffer (concat "*display " number "*"))))))))) - (gdb-delete-frames display-list)))) - -(defun gdb-delete-frames (display-list) - (dolist (frame (frame-list)) - (let ((frame-name (frame-parameter frame 'name))) - (if (string-match "\\*display \\([0-9]+\\)\\*" frame-name) - (progn - (let ((number (match-string 1 frame-name))) - (if (not (memq (string-to-int number) display-list)) - (progn (kill-buffer - (get-buffer (concat "*display " number "*"))) - (delete-frame frame))))))))) - -(defvar gdb-display-mode-map - (let ((map (make-sparse-keymap)) - (menu (make-sparse-keymap "Display"))) - (define-key menu [toggle] '("Toggle" . gdb-toggle-display)) - (define-key menu [delete] '("Delete" . gdb-delete-display)) - - (suppress-keymap map) - (define-key map [menu-bar display] (cons "Display" menu)) - (define-key map " " 'gdb-toggle-display) - (define-key map "d" 'gdb-delete-display) - map)) - -(defun gdb-display-mode () - "Major mode for gdb display. - -\\{gdb-display-mode-map}" - (setq major-mode 'gdb-display-mode) - (setq mode-name "Display") - (setq buffer-read-only t) - (use-local-map gdb-display-mode-map) - (gdb-invalidate-display)) - -(defun gdb-display-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*Displayed expressions of " (gdb-get-target-string) "*"))) - -(defun gdb-display-display-buffer () - (interactive) - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-display-buffer))) - -(defun gdb-frame-display-buffer () - (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-display-buffer))) - -(defun gdb-toggle-display () - "Enable/disable the displayed expression at current line." - (interactive) - (save-excursion - (beginning-of-line 1) - (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) - (error "No expression on this line") - (gdb-enqueue-input - (list - (concat - (if (eq ?y (char-after (match-beginning 2))) - "server disable display " - "server enable display ") - (match-string 1) "\n") - 'ignore))))) - -(defun gdb-delete-display () - "Delete the displayed expression at current line." - (interactive) - (with-current-buffer (gdb-get-buffer 'gdb-display-buffer) - (beginning-of-line 1) - (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) - (error "No expression on this line") - (let ((number (match-string 1))) - (gdb-enqueue-input - (list (concat "server delete display " number "\n") 'ignore)))))) - -(defvar gdb-expressions-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "v" 'gdb-array-visualise) - (define-key map "q" 'gdb-delete-expression) - (define-key map [mouse-3] 'gdb-expressions-popup-menu) - map)) - -(defvar gdb-expressions-mode-menu - '("GDB Expressions Commands" - "----" - ["Visualise" gdb-array-visualise t] - ["Delete" gdb-delete-expression t]) - "Menu for `gdb-expressions-mode'.") - -(defun gdb-expressions-popup-menu (event) - "Explicit Popup menu as this buffer doesn't have a menubar." - (interactive "@e") - (mouse-set-point event) - (popup-menu gdb-expressions-mode-menu)) - -(defun gdb-expressions-mode () - "Major mode for display expressions. - -\\{gdb-expressions-mode-map}" - (setq major-mode 'gdb-expressions-mode) - (setq mode-name "Expressions") - (use-local-map gdb-expressions-mode-map) - (make-local-variable 'gdb-display-number) - (make-local-variable 'gdb-values) - (make-local-variable 'gdb-expression) - (set (make-local-variable 'gdb-display-string) nil) - (set (make-local-variable 'gdb-dive-display-number) nil) - (set (make-local-variable 'gud-minor-mode) 'gdba) - (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1)) - (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1)) - (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1)) - (setq buffer-read-only t)) - ;;;; Window management @@ -1943,7 +1505,6 @@ (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) - (define-key menu [display] '("Display" . gdb-frame-display-buffer)) (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) ; (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer)) ) @@ -1956,7 +1517,6 @@ (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)) - (define-key menu [display] '("Display" . gdb-display-display-buffer)) (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) ; (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer)) ) @@ -2021,7 +1581,6 @@ (gdb-display-stack-buffer) (delete-other-windows) (gdb-display-breakpoints-buffer) - (gdb-display-display-buffer) (delete-other-windows) (switch-to-buffer gud-comint-buffer) (split-window nil ( / ( * (window-height) 3) 4)) @@ -2089,11 +1648,10 @@ (defun gdb-reset () "Exit a debugging session cleanly by killing the gdb buffers and resetting the source buffers." - (gdb-delete-frames '()) (dolist (buffer (buffer-list)) (if (not (eq buffer gud-comint-buffer)) (with-current-buffer buffer - (if (eq gud-minor-mode 'gdba) + (if (memq gud-minor-mode '(gdba pdb)) (if (string-match "^\*.+*$" (buffer-name)) (kill-buffer nil) (if (display-images-p) @@ -2128,7 +1686,6 @@ (if gdb-many-windows (gdb-setup-windows) (gdb-display-breakpoints-buffer) - (gdb-display-display-buffer) (delete-other-windows) (split-window) (other-window 1) @@ -2195,39 +1752,6 @@ (when (overlay-get overlay 'put-arrow) (delete-overlay overlay))) (setq overlays (cdr overlays))))) - -(defun gdb-array-visualise () - "Visualise arrays and slices using graph program from plotutils." - (interactive) - (when (and (display-graphic-p) gdb-display-string) - (let ((n 0) m) - (catch 'multi-dimensional - (while (eq (aref gdb-array-start n) (aref gdb-array-stop n)) - (setq n (+ n 1))) - (setq m (+ n 1)) - (while (< m (length gdb-array-start)) - (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m))) - (progn - (x-popup-dialog - t `(,(concat "Only one dimensional data can be visualised.\n" - "Use an array slice to reduce the number of\n" - "dimensions") ("OK" t))) - (throw 'multi-dimensional nil)) - (setq m (+ m 1)))) - (shell-command (concat "echo" gdb-display-string " | graph -a 1 " - (int-to-string (aref gdb-array-start n)) - " -x " - (int-to-string (aref gdb-array-start n)) - " " - (int-to-string (aref gdb-array-stop n)) - " 1 -T X")))))) - -(defun gdb-delete-expression () - "Delete displayed expression and its frame." - (interactive) - (gdb-enqueue-input - (list (concat "server delete display " gdb-display-number "\n") - 'ignore))) ;; ;; Assembler buffer.