X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/92219924c8534f7cb999e9254a2a12645f64b707..31c4b81d8177b82875a65c10899ffa292b7af119:/lisp/progmodes/gdb-ui.el diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index cbff1835ca..c6ae98c5b1 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -4,14 +4,14 @@ ;; Maintainer: FSF ;; Keywords: unix, tools -;; Copyright (C) 2002, 2003, 2004, 2005, 2006 +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 ;; Free Software Foundation, Inc. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -34,14 +34,13 @@ ;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar ;; (see the GDB Graphical Interface section in the Emacs info manual). -;; By default, M-x gdb will start the debugger. However, if you have customised -;; gud-gdb-command-name, then start it with M-x gdba. +;; By default, M-x gdb will start the debugger. ;; This file has evolved from gdba.el that was included with GDB 5.0 and ;; written by Tom Lord and Jim Kingdon. It uses GDB's annotation interface. ;; You don't need to know about annotations to use this mode as a debugger, -;; but if you are interested developing the mode itself, then see the -;; Annotations section in the GDB info manual. +;; but if you are interested developing the mode itself, see the Annotations +;; section in the GDB info manual. ;; GDB developers plan to make the annotation interface obsolete. A new ;; interface called GDB/MI (machine interface) has been designed to replace @@ -51,9 +50,9 @@ ;; still under development and is part of a process to migrate Emacs from ;; annotations to GDB/MI. -;; This mode SHOULD WORK WITH GDB 5.0 onwards but you will NEED GDB 6.0 -;; onwards to use watch expressions. It works best with GDB 6.4 where -;; watch expressions will update more quickly. +;; This mode SHOULD WORK WITH GDB 5.0 or later but you will NEED AT LEAST +;; GDB 6.0 to use watch expressions. It works best with GDB 6.4 or later +;; where watch expressions will update more quickly. ;;; Windows Platforms: @@ -71,25 +70,29 @@ ;;; Known Bugs: ;; 1) Strings that are watched don't update in the speedbar when their -;; contents change unless the first character changes. +;; contents change unless the first character changes. ;; 2) Cannot handle multiple debug sessions. -;; 3) Initially, the assembler buffer does not display the cursor at the -;; current line if the line is not visible in the window (but when testing -;; gdb-assembler-custom with a lisp debugger it does!). +;; 3) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead. +;; 4) M-x gdb doesn't work if the corefile is specified in the command in the +;; minibuffer, use M-x gdba instead (or specify the core in the GUD buffer). +;; 5) If you wish to call procedures from your program in GDB +;; e.g "call myproc ()", "p mysquare (5)" then use level 2 annotations +;; "gdb --annotate=2 myprog" to keep source buffer/selected frame fixed. +;; 6) After detaching from a process, clicking on the "GO" icon on toolbar +;; (gud-go) sends "continue" to GDB (should be "run"). ;;; Problems with watch expressions, GDB/MI: ;; 1) They go out of scope when the inferior is re-run. ;; 2) -stack-list-locals has a type field but also prints type in values field. -;; 3) VARNUM increments even when vairable object is not created (maybe trivial). +;; 3) VARNUM increments even when variable object is not created +;; (maybe trivial). ;;; TODO: ;; 1) Use MI command -data-read-memory for memory window. ;; 2) Use tree-widget.el instead of the speedbar for watch-expressions? ;; 3) Mark breakpoint locations on scroll-bar of source buffer? -;; 4) With gud-print and gud-pstar, print the variable name in the GUD -;; buffer instead of the value's history number. ;;; Code: @@ -98,7 +101,9 @@ (defvar tool-bar-map) (defvar speedbar-initial-expansion-list-name) -(defvar gdb-frame-address "main" "Initialization for Assembler buffer.") +(defvar gdb-pc-address nil "Initialization for Assembler buffer. +Set to \"main\" at start if gdb-show-main is t.") +(defvar gdb-frame-address nil "Identity of frame for watch expression.") (defvar gdb-previous-frame-address nil) (defvar gdb-memory-address "main") (defvar gdb-previous-frame nil) @@ -107,24 +112,32 @@ (defvar gdb-current-language nil) (defvar gdb-var-list nil "List of variables in watch window. -Each element has the form (EXPRESSION VARNUM NUMCHILD TYPE VALUE STATUS) where -STATUS is nil (unchanged), `changed' or `out-of-scope'.") -(defvar gdb-force-update t - "Non-nil means that view of watch expressions will be updated in the speedbar.") +Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS FP) +where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame +address for root variables.") (defvar gdb-main-file nil "Source file from which program execution begins.") +(defvar gud-old-arrow nil) (defvar gdb-overlay-arrow-position nil) +(defvar gdb-stack-position nil) (defvar gdb-server-prefix nil) (defvar gdb-flush-pending-output nil) (defvar gdb-location-alist nil - "Alist of breakpoint numbers and full filenames.") -(defvar gdb-active-process nil "GUD tooltips display variable values when t, \ -and #define directives otherwise.") + "Alist of breakpoint numbers and full filenames. Only used for files that +Emacs can't find.") +(defvar gdb-active-process nil + "GUD tooltips display variable values when t, and macro definitions otherwise.") (defvar gdb-error "Non-nil when GDB is reporting an error.") (defvar gdb-macro-info nil "Non-nil if GDB knows that the inferior includes preprocessor macro info.") (defvar gdb-buffer-fringe-width nil) (defvar gdb-signalled nil) (defvar gdb-source-window nil) +(defvar gdb-inferior-status nil) +(defvar gdb-continuation nil) +(defvar gdb-look-up-stack nil) +(defvar gdb-frame-begin nil + "Non-nil when GDB generates frame-begin annotation.") +(defvar gdb-printing t) (defvar gdb-buffer-type nil "One of the symbols bound in `gdb-buffer-rules'.") @@ -204,10 +217,11 @@ handlers.") "List of changed register numbers (strings).") ;;;###autoload -(defun gdba (command-line) +(defun gdb (command-line) "Run gdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger. +The directory containing FILE becomes the initial working +directory and source-file directory for your debugger. + If `gdb-many-windows' is nil (the default value) then gdb just pops up the GUD buffer unless `gdb-show-main' is t. In this case @@ -252,27 +266,78 @@ detailed description of this mode. | RET gdb-frames-select | SPC gdb-toggle-breakpoint | | | RET gdb-goto-breakpoint | | | D gdb-delete-breakpoint | -+-----------------------------------+----------------------------------+" - ;; - (interactive (list (gud-query-cmdline 'gdba))) - ;; - ;; Let's start with a basic gud-gdb buffer and then modify it a bit. - (gdb command-line) - (gdb-init-1)) ++-----------------------------------+----------------------------------+ -(defcustom gdb-debug-ring-max 128 - "Maximum size of `gdb-debug-ring'." +To run GDB in text command mode, replace the GDB \"--annotate=3\" +option with \"--fullname\" either in the minibuffer for the +current Emacs session, or the custom variable +`gud-gdb-command-name' for all future sessions. You need to use +text command mode to debug multiple programs within one Emacs +session." + (interactive (list (gud-query-cmdline 'gdb))) + + (when (and gud-comint-buffer + (buffer-name gud-comint-buffer) + (get-buffer-process gud-comint-buffer) + (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))) + (gdb-restore-windows) + (error + "Multiple debugging requires restarting in text command mode")) + + (gud-common-init command-line nil 'gud-gdba-marker-filter) + (set (make-local-variable 'gud-minor-mode) 'gdba) + + (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") + (gud-def gud-tbreak "tbreak %f:%l" "\C-t" + "Set temporary breakpoint at current line.") + (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") + (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") + (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") + (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") + (gud-def gud-nexti "nexti %p" nil "Step one instruction (skip functions).") + (gud-def gud-cont "cont" "\C-r" "Continue with display.") + (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") + (gud-def gud-jump + (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l")) + "\C-j" "Set execution address to current line.") + + (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") + (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") + (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") + (gud-def gud-pstar "print* %e" nil + "Evaluate C dereferenced pointer expression at point.") + + ;; For debugging Emacs only. + (gud-def gud-pv "pv1 %e" "\C-v" "Print the value of the lisp variable.") + + (gud-def gud-until "until %l" "\C-u" "Continue to current line.") + (gud-def gud-run "run" nil "Run the program.") + + (local-set-key "\C-i" 'gud-gdb-complete-command) + (setq comint-prompt-regexp "^(.*gdb[+]?) *") + (setq paragraph-start comint-prompt-regexp) + (setq gdb-first-prompt t) + (setq gud-running nil) + (setq gdb-ready nil) + (setq gud-filter-pending-text nil) + (run-hooks 'gdb-mode-hook)) + +(defcustom gdb-debug-log-max 128 + "Maximum size of `gdb-debug-log'. If nil, size is unlimited." :group 'gud - :type 'integer + :type '(choice (integer :tag "Number of elements") + (const :tag "Unlimited" nil)) :version "22.1") -(defvar gdb-debug-ring nil - "List of commands, most recent first, sent to and replies received from GDB. -This variable is used to debug GDB-UI.") +(defvar gdb-debug-log nil + "List of commands sent to and replies received from GDB. Most +recent commands are listed first. This list stores only the last +'gdb-debug-log-max' values. This variable is used to debug +GDB-UI.") ;;;###autoload (defcustom gdb-enable-debug nil - "Non-nil means record the process input and output in `gdb-debug-ring'." + "Non-nil means record the process input and output in `gdb-debug-log'." :type 'boolean :group 'gud :version "22.1") @@ -302,27 +367,65 @@ Also display the main routine in the disassembly buffer if present." :group 'gud :version "22.1") +(defcustom gdb-many-windows nil + "If nil, just pop up the GUD buffer unless `gdb-show-main' is t. +In this case start with two windows: one displaying the GUD +buffer and the other with the source file with the main routine +of the debugged program. Non-nil means display the layout shown +for `gdba'." + :type 'boolean + :group 'gud + :version "22.1") + (defcustom gdb-use-separate-io-buffer nil - "Non-nil means display output from the inferior in a separate buffer." + "Non-nil means display output from the debugged program in a separate buffer." :type 'boolean :group 'gud :version "22.1") +(defun gdb-force-mode-line-update (status) + (let ((buffer gud-comint-buffer)) + (if (and buffer (buffer-name buffer)) + (with-current-buffer buffer + (setq mode-line-process + (format ":%s [%s]" + (process-status (get-buffer-process buffer)) status)) + ;; Force mode line redisplay soon. + (force-mode-line-update))))) + +(defun gdb-many-windows (arg) + "Toggle the number of windows in the basic arrangement. +With prefix argument ARG, display additional buffers if ARG is positive, +otherwise use a single window." + (interactive "P") + (setq gdb-many-windows + (if (null arg) + (not gdb-many-windows) + (> (prefix-numeric-value arg) 0))) + (message (format "Display of other windows %sabled" + (if gdb-many-windows "en" "dis"))) + (if (and gud-comint-buffer + (buffer-name gud-comint-buffer)) + (condition-case nil + (gdb-restore-windows) + (error nil)))) + (defun gdb-use-separate-io-buffer (arg) - "Toggle separate IO for inferior. -With arg, use separate IO iff arg is positive." + "Toggle separate IO for debugged program. +With prefix argument ARG, use separate IO if ARG is positive, +otherwise do not." (interactive "P") (setq gdb-use-separate-io-buffer (if (null arg) (not gdb-use-separate-io-buffer) (> (prefix-numeric-value arg) 0))) - (message (format "Separate inferior IO %sabled" + (message (format "Separate IO %sabled" (if gdb-use-separate-io-buffer "en" "dis"))) (if (and gud-comint-buffer (buffer-name gud-comint-buffer)) (condition-case nil (if gdb-use-separate-io-buffer - (gdb-restore-windows) + (if gdb-many-windows (gdb-restore-windows)) (kill-buffer (gdb-inferior-io-name))) (error nil)))) @@ -339,8 +442,7 @@ With arg, use separate IO iff arg is positive." (list t nil) nil "-c" (concat gdb-cpp-define-alist-program " " gdb-cpp-define-alist-flags))))) - (define-list (split-string output "\n" t)) - (name)) + (define-list (split-string output "\n" t)) (name)) (setq gdb-define-alist nil) (dolist (define define-list) (setq name (nth 1 (split-string define "[( ]"))) @@ -377,7 +479,8 @@ With arg, use separate IO iff arg is positive." (goto-char (point-min)) (when (search-forward "read in on demand:" nil t) (while (re-search-forward gdb-source-file-regexp nil t) - (push (or (match-string 1) (match-string 2)) gdb-source-file-list)) + (push (file-name-nondirectory (or (match-string 1) (match-string 2))) + gdb-source-file-list)) (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (and buffer-file-name @@ -388,21 +491,28 @@ With arg, use separate IO iff arg is positive." (when gud-tooltip-mode (make-local-variable 'gdb-define-alist) (gdb-create-define-alist) - (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))) + (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))) + (gdb-force-mode-line-update + (propertize "ready" 'face font-lock-variable-name-face))) (defun gdb-find-watch-expression () (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) - (varno (nth 1 var)) (expr)) - (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varno) - (dolist (var1 gdb-var-list) - (if (string-equal (nth 1 var1) (match-string 1 varno)) - (setq expr (concat (car var1) "." (match-string 2 varno))))) - expr)) + (varnum (car var)) expr array) + (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum) + (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet + (component-list (split-string (match-string 2 varnum) "\\." t))) + (setq expr (nth 1 var1)) + (setq varnumlet (car var1)) + (dolist (component component-list) + (setq var2 (assoc varnumlet gdb-var-list)) + (setq expr (concat expr + (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2)) + (concat "[" component "]") + (concat "." component)))) + (setq varnumlet (concat varnumlet "." component))) + expr))) (defun gdb-init-1 () - (set (make-local-variable 'gud-minor-mode) 'gdba) - (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) - ;; (gud-def gud-break (if (not (string-match "Machine" mode-name)) (gud-call "break %f:%l" arg) (save-excursion @@ -443,31 +553,33 @@ With arg, use separate IO iff arg is positive." 'gdb-mouse-set-clear-breakpoint) (define-key gud-minor-mode-map [left-fringe mouse-1] 'gdb-mouse-set-clear-breakpoint) - (define-key gud-minor-mode-map [left-fringe mouse-2] - 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-margin C-mouse-1] + 'gdb-mouse-toggle-breakpoint-margin) + (define-key gud-minor-mode-map [left-fringe C-mouse-1] + 'gdb-mouse-toggle-breakpoint-fringe) + (define-key gud-minor-mode-map [left-margin drag-mouse-1] 'gdb-mouse-until) (define-key gud-minor-mode-map [left-fringe drag-mouse-1] 'gdb-mouse-until) - (define-key gud-minor-mode-map [left-margin mouse-2] + (define-key gud-minor-mode-map [left-margin mouse-3] + 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-fringe mouse-3] 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-margin C-drag-mouse-1] 'gdb-mouse-jump) (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1] 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-fringe C-mouse-2] + (define-key gud-minor-mode-map [left-fringe C-mouse-3] 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-margin C-mouse-2] + (define-key gud-minor-mode-map [left-margin C-mouse-3] 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-margin mouse-3] - 'gdb-mouse-toggle-breakpoint-margin) - (define-key gud-minor-mode-map [left-fringe mouse-3] - 'gdb-mouse-toggle-breakpoint-fringe) (setq comint-input-sender 'gdb-send) ;; (re-)initialize - (setq gdb-frame-address (if gdb-show-main "main" nil)) + (setq gdb-pc-address (if gdb-show-main "main" nil)) (setq gdb-previous-frame-address nil gdb-memory-address "main" gdb-previous-frame nil @@ -475,7 +587,7 @@ With arg, use separate IO iff arg is positive." gdb-current-language nil gdb-frame-number nil gdb-var-list nil - gdb-force-update t + gdb-main-file nil gdb-first-post-prompt t gdb-prompting nil gdb-input-queue nil @@ -489,9 +601,15 @@ With arg, use separate IO iff arg is positive." gdb-error nil gdb-macro-info nil gdb-buffer-fringe-width (car (window-fringes)) - gdb-debug-ring nil + gdb-debug-log nil gdb-signalled nil - gdb-source-window nil) + gdb-source-window nil + gdb-inferior-status nil + gdb-continuation nil + gdb-look-up-stack nil + gdb-frame-begin nil + gdb-printing t + gud-old-arrow nil) (setq gdb-buffer-type 'gdba) @@ -521,83 +639,68 @@ With arg, use separate IO iff arg is positive." 'gdb-set-gud-minor-mode-existing-buffers-1)) (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)) - ;; find source file and compilation directory here - (gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program - (gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program + ;; Find source file and compilation directory here. + ;; Works for C, C++, Fortran and Ada but not Java (GDB 6.4) + (gdb-enqueue-input (list "server list\n" 'ignore)) (gdb-enqueue-input (list "server info source\n" 'gdb-source-info)) - (run-hooks 'gdba-mode-hook)) + (run-hooks 'gdb-mode-hook)) (defun gdb-get-version () (goto-char (point-min)) - (if (and (re-search-forward gdb-error-regexp nil t) - (string-match ".*(missing implementation)" (match-string 1))) + (if (re-search-forward "Undefined\\( mi\\)* command:" nil t) (setq gdb-version "pre-6.4") (setq gdb-version "6.4+")) (gdb-init-2)) +(defmacro gdb-if-arrow (arrow-position &rest body) + `(if ,arrow-position + (let ((buffer (marker-buffer ,arrow-position)) (line)) + (if (equal buffer (window-buffer (posn-window end))) + (with-current-buffer buffer + (when (or (equal start end) + (equal (posn-point start) + (marker-position ,arrow-position))) + ,@body)))))) + (defun gdb-mouse-until (event) "Continue running until a source line past the current line. -The destination source line can be selected either by clicking with mouse-2 -on the fringe/margin or dragging the arrow with mouse-1 (default bindings)." +The destination source line can be selected either by clicking +with mouse-3 on the fringe/margin or dragging the arrow +with mouse-1 (default bindings)." (interactive "e") - (if gud-overlay-arrow-position - (let ((start (event-start event)) - (end (event-end event)) - (buffer (marker-buffer gud-overlay-arrow-position)) (line)) - (if (not (string-match "Machine" mode-name)) - (if (equal buffer (window-buffer (posn-window end))) - (with-current-buffer buffer - (when (or (equal start end) - (equal (posn-point start) - (marker-position - gud-overlay-arrow-position))) - (setq line (line-number-at-pos (posn-point end))) - (gud-call (concat "until " (number-to-string line)))))) - (if (equal (marker-buffer gdb-overlay-arrow-position) - (window-buffer (posn-window end))) - (when (or (equal start end) - (equal (posn-point start) - (marker-position - gdb-overlay-arrow-position))) - (save-excursion - (goto-line (line-number-at-pos (posn-point end))) - (forward-char 2) - (gud-call (concat "until *%a"))))))))) + (let ((start (event-start event)) + (end (event-end event))) + (gdb-if-arrow gud-overlay-arrow-position + (setq line (line-number-at-pos (posn-point end))) + (gud-call (concat "until " (number-to-string line)))) + (gdb-if-arrow gdb-overlay-arrow-position + (save-excursion + (goto-line (line-number-at-pos (posn-point end))) + (forward-char 2) + (gud-call (concat "until *%a")))))) (defun gdb-mouse-jump (event) "Set execution address/line. -The destination source line can be selected either by clicking with mouse-2 -on the fringe/margin or dragging the arrow with mouse-1 (default bindings). +The destination source line can be selected either by clicking with C-mouse-3 +on the fringe/margin or dragging the arrow with C-mouse-1 (default bindings). Unlike gdb-mouse-until the destination address can be before the current line, and no execution takes place." (interactive "e") - (if gud-overlay-arrow-position - (let ((start (event-start event)) - (end (event-end event)) - (buffer (marker-buffer gud-overlay-arrow-position)) (line)) - (if (not (string-match "Machine" mode-name)) - (if (equal buffer (window-buffer (posn-window end))) - (with-current-buffer buffer - (when (or (equal start end) - (equal (posn-point start) - (marker-position - gud-overlay-arrow-position))) - (setq line (line-number-at-pos (posn-point end))) - (progn (gud-call (concat "tbreak " (number-to-string line))) - (gud-call (concat "jump " (number-to-string line))))))) - (if (equal (marker-buffer gdb-overlay-arrow-position) - (window-buffer (posn-window end))) - (when (or (equal start end) - (equal (posn-point start) - (marker-position - gdb-overlay-arrow-position))) - (save-excursion - (goto-line (line-number-at-pos (posn-point end))) - (forward-char 2) + (let ((start (event-start event)) + (end (event-end event))) + (gdb-if-arrow gud-overlay-arrow-position + (setq line (line-number-at-pos (posn-point end))) (progn - (gud-call (concat "tbreak *%a")) - (gud-call (concat "jump *%a")))))))))) + (gud-call (concat "tbreak " (number-to-string line))) + (gud-call (concat "jump " (number-to-string line))))) + (gdb-if-arrow gdb-overlay-arrow-position + (save-excursion + (goto-line (line-number-at-pos (posn-point end))) + (forward-char 2) + (progn + (gud-call (concat "tbreak *%a")) + (gud-call (concat "jump *%a"))))))) (defcustom gdb-speedbar-auto-raise nil "If non-nil raise speedbar every time display of watch expressions is\ @@ -608,7 +711,8 @@ line, and no execution takes place." (defun gdb-speedbar-auto-raise (arg) "Toggle automatic raising of the speedbar for watch expressions. -With arg, automatically raise speedbar iff arg is positive." +With prefix argument ARG, automatically raise speedbar if ARG is +positive, otherwise don't automatically raise it." (interactive "P") (setq gdb-speedbar-auto-raise (if (null arg) @@ -623,65 +727,94 @@ With arg, automatically raise speedbar iff arg is positive." :group 'gud :version "22.1") -(defun gud-watch (&optional event) - "Watch expression at point." - (interactive (list last-input-event)) - (if event (posn-set-point (event-end event))) - (require 'tooltip) - (save-selected-window - (let ((expr (tooltip-identifier-from-point (point)))) - (catch 'already-watched - (dolist (var gdb-var-list) - (if (string-equal expr (car var)) (throw 'already-watched nil))) - (set-text-properties 0 (length expr) nil expr) - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (concat "server interpreter mi \"-var-create - * " expr "\"\n") - (concat"-var-create - * " expr "\n")) - `(lambda () (gdb-var-create-handler ,expr)))))))) +(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch) +(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch) + +(defun gud-watch (&optional arg event) + "Watch expression at point. +With arg, enter name of variable to be watched in the minibuffer." + (interactive (list current-prefix-arg last-input-event)) + (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer))) + (if (memq minor-mode '(gdbmi gdba)) + (progn + (if event (posn-set-point (event-end event))) + (require 'tooltip) + (save-selected-window + (let ((expr + (if arg + (completing-read "Name of variable: " + 'gud-gdb-complete-command) + (if (and transient-mark-mode mark-active) + (buffer-substring (region-beginning) (region-end)) + (tooltip-identifier-from-point (point)))))) + (speedbar 1) + (set-text-properties 0 (length expr) nil expr) + (gdb-enqueue-input + (list + (if (eq minor-mode 'gdba) + (concat + "server interpreter mi \"-var-create - * " expr "\"\n") + (concat"-var-create - * " expr "\n")) + `(lambda () (gdb-var-create-handler ,expr))))))) + (message "gud-watch is a no-op in this mode.")))) (defconst gdb-var-create-regexp - "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") + "name=\"\\(.*?\\)\",.*numchild=\"\\(.*?\\)\",\\(?:.*value=\\(\".*\"\\),\\)?.*type=\"\\(.*?\\)\"") (defun gdb-var-create-handler (expr) (goto-char (point-min)) (if (re-search-forward gdb-var-create-regexp nil t) (let ((var (list + (match-string 1) (if (and (string-equal gdb-current-language "c") gdb-use-colon-colon-notation gdb-selected-frame) (setq expr (concat gdb-selected-frame "::" expr)) expr) - (match-string 1) (match-string 2) - (match-string 3) - nil nil))) + (match-string 4) + (if (match-string 3) (read (match-string 3))) + nil gdb-frame-address))) (push var gdb-var-list) - (speedbar 1) (unless (string-equal speedbar-initial-expansion-list-name "GUD") (speedbar-change-initial-expansion-list "GUD")) - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (concat "server interpreter mi \"-var-evaluate-expression " - (nth 1 var) "\"\n") - (concat "-var-evaluate-expression " (nth 1 var) "\n")) - `(lambda () (gdb-var-evaluate-expression-handler - ,(nth 1 var) nil))))) + (unless (nth 4 var) + (gdb-enqueue-input + (list + (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdba) + (concat "server interpreter mi \"0-var-evaluate-expression " + (car var) "\"\n") + (concat "0-var-evaluate-expression " (car var) "\n")) + `(lambda () (gdb-var-evaluate-expression-handler + ,(car var) nil)))))) (if (search-forward "Undefined command" nil t) - (message-box "Watching expressions requires gdb 6.0 onwards") + (message-box "Watching expressions requires GDB 6.0 onwards") (message-box "No symbol \"%s\" in current context." expr)))) +(defun gdb-speedbar-update () + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) + (not (member 'gdb-speedbar-timer gdb-pending-triggers))) + ;; Dummy command to update speedbar even when idle. + (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn)) + ;; Keep gdb-pending-triggers non-nil till end. + (push 'gdb-speedbar-timer gdb-pending-triggers))) + +(defun gdb-speedbar-timer-fn () + (setq gdb-pending-triggers + (delq 'gdb-speedbar-timer gdb-pending-triggers)) + (speedbar-timer-fn)) + (defun gdb-var-evaluate-expression-handler (varnum changed) (goto-char (point-min)) - (re-search-forward ".*value=\\(\".*\"\\)" nil t) - (catch 'var-found - (dolist (var gdb-var-list) - (when (string-equal varnum (cadr var)) - (if changed (setcar (nthcdr 5 var) 'changed)) - (setcar (nthcdr 4 var) (read (match-string 1))) - (throw 'var-found nil))))) + (re-search-forward "\\(.+\\)\\^done,value=\\(\".*\"\\)" nil t) + (setq gdb-pending-triggers + (delq (string-to-number (match-string 1)) gdb-pending-triggers)) + (let ((var (assoc varnum gdb-var-list))) + (when var + (if changed (setcar (nthcdr 5 var) 'changed)) + (setcar (nthcdr 4 var) (read (match-string 2))))) + (gdb-speedbar-update)) (defun gdb-var-list-children (varnum) (gdb-enqueue-input @@ -689,34 +822,33 @@ With arg, automatically raise speedbar iff arg is positive." `(lambda () (gdb-var-list-children-handler ,varnum))))) (defconst gdb-var-list-children-regexp - "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",\ -type=\"\\(.*?\\)\"") + "child={.*?name=\"\\(.*?\\)\",.*?exp=\"\\(.*?\\)\",.*?\ +numchild=\"\\(.*?\\)\"\\(}\\|,.*?\\(type=\"\\(.*?\\)\"\\)?.*?}\\)") (defun gdb-var-list-children-handler (varnum) (goto-char (point-min)) (let ((var-list nil)) (catch 'child-already-watched (dolist (var gdb-var-list) - (if (string-equal varnum (cadr var)) + (if (string-equal varnum (car var)) (progn (push var var-list) (while (re-search-forward gdb-var-list-children-regexp nil t) - (let ((varchild (list (match-string 2) - (match-string 1) + (let ((varchild (list (match-string 1) + (match-string 2) (match-string 3) - (match-string 4) + (match-string 6) nil nil))) - (dolist (var1 gdb-var-list) - (if (string-equal (cadr var1) (cadr varchild)) - (throw 'child-already-watched nil))) + (if (assoc (car varchild) gdb-var-list) + (throw 'child-already-watched nil)) (push varchild var-list) (gdb-enqueue-input (list (concat - "server interpreter mi \"-var-evaluate-expression " - (nth 1 varchild) "\"\n") + "server interpreter mi \"0-var-evaluate-expression " + (car varchild) "\"\n") `(lambda () (gdb-var-evaluate-expression-handler - ,(nth 1 varchild) nil))))))) + ,(car varchild) nil))))))) (push var var-list))) (setq gdb-var-list (nreverse var-list))))) @@ -727,68 +859,66 @@ type=\"\\(.*?\\)\"") 'gdb-var-update-handler)) (push 'gdb-var-update gdb-pending-triggers))) -(defconst gdb-var-update-regexp "name=\"\\(.*?\\)\",in_scope=\"\\(.*?\\)\"") +(defconst gdb-var-update-regexp + "{.*?name=\"\\(.*?\\)\",.*?in_scope=\"\\(.*?\\)\",.*?\ +type_changed=\".*?\".*?}") (defun gdb-var-update-handler () (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)) (goto-char (point-min)) - (while (re-search-forward gdb-var-update-regexp nil t) - (let ((varnum (match-string 1))) - (if (string-equal (match-string 2) "false") - (catch 'var-found - (dolist (var gdb-var-list) - (when (string-equal varnum (cadr var)) - (setcar (nthcdr 5 var) 'out-of-scope) - (throw 'var-found nil)))) - (gdb-enqueue-input - (list - (concat "server interpreter mi \"-var-evaluate-expression " - varnum "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))))) + (let ((n 0)) + (while (re-search-forward gdb-var-update-regexp nil t) + (let ((varnum (match-string 1))) + (if (string-equal (match-string 2) "false") + (let ((var (assoc varnum gdb-var-list))) + (if var (setcar (nthcdr 5 var) 'out-of-scope))) + (setq n (1+ n)) + (push n gdb-pending-triggers) + (gdb-enqueue-input + (list + (concat "server interpreter mi \"" (number-to-string n) + "-var-evaluate-expression " varnum "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler ,varnum t)))))))) (setq gdb-pending-triggers - (delq 'gdb-var-update gdb-pending-triggers)) - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - ;; Dummy command to update speedbar at right time. - (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-refresh)) - ;; Keep gdb-pending-triggers non-nil till end. - (push 'gdb-speedbar-refresh gdb-pending-triggers))) + (delq 'gdb-var-update gdb-pending-triggers))) -(defun gdb-speedbar-refresh () - (setq gdb-pending-triggers - (delq 'gdb-speedbar-refresh gdb-pending-triggers)) - (with-current-buffer gud-comint-buffer - (let ((speedbar-verbosity-level 0)) - (save-excursion - (speedbar-refresh))))) +(defun gdb-var-delete-1 (varnum) + (gdb-enqueue-input + (list + (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdba) + (concat "server interpreter mi \"-var-delete " varnum "\"\n") + (concat "-var-delete " varnum "\n")) + 'ignore)) + (setq gdb-var-list (delq var gdb-var-list)) + (dolist (varchild gdb-var-list) + (if (string-match (concat (car var) "\\.") (car varchild)) + (setq gdb-var-list (delq varchild gdb-var-list))))) (defun gdb-var-delete () "Delete watch expression at point from the speedbar." (interactive) (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) '(gdbmi gdba)) - (let ((text (speedbar-line-text))) - (string-match "\\(\\S-+\\)" text) - (let* ((expr (match-string 1 text)) - (var (assoc expr gdb-var-list)) - (varnum (cadr var))) - (unless (string-match "\\." varnum) - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - 'gdba) - (concat "server interpreter mi \"-var-delete " varnum "\"\n") - (concat "-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))))))))) + (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) + (varnum (car var))) + (if (string-match "\\." (car var)) + (message-box "Can only delete a root expression") + (gdb-var-delete-1 varnum))))) + +(defun gdb-var-delete-children (varnum) + "Delete children of variable object at point from the speedbar." + (gdb-enqueue-input + (list + (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) + (concat "server interpreter mi \"-var-delete -c " varnum "\"\n") + (concat "-var-delete -c " varnum "\n")) 'ignore))) (defun gdb-edit-value (text token indent) "Assign a value to a variable displayed in the speedbar." (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) - (varnum (cadr var)) (value)) + (varnum (car var)) (value)) (setq value (read-string "New value: ")) (gdb-enqueue-input (list @@ -796,7 +926,12 @@ type=\"\\(.*?\\)\"") (concat "server interpreter mi \"-var-assign " varnum " " value "\"\n") (concat "-var-assign " varnum " " value "\n")) - 'ignore)))) + `(lambda () (gdb-edit-value-handler ,value)))))) + +(defun gdb-edit-value-handler (value) + (goto-char (point-min)) + (if (re-search-forward gdb-error-regexp nil t) + (message-box "Invalid number or expression (%s)" value))) (defcustom gdb-show-changed-values t "If non-nil change the face of out of scope variables and changed values. @@ -806,25 +941,41 @@ Changed values are highlighted with the face `font-lock-warning-face'." :group 'gud :version "22.1") +(defcustom gdb-max-children 40 + "Maximum number of children before expansion requires confirmation." + :type 'integer + :group 'gud + :version "22.1") + (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 - (if (and - (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (string-equal gdb-version "pre-6.4")) - (gdb-var-list-children token) - (gdb-var-list-children-1 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)))) - (speedbar-change-expand-button-char ?+) - (speedbar-delete-subblock indent)) - (t (error "Ooops... not sure what to do"))) - (speedbar-center-buffer-smartly)) + (if (and gud-comint-buffer (buffer-name gud-comint-buffer)) + (progn + (cond ((string-match "+" text) ;expand this node + (let* ((var (assoc token gdb-var-list)) + (expr (nth 1 var)) (children (nth 2 var))) + (if (or (<= (string-to-number children) gdb-max-children) + (y-or-n-p + (format + "%s has %s children. Continue? " expr children))) + (if (and (eq (buffer-local-value + 'gud-minor-mode gud-comint-buffer) 'gdba) + (string-equal gdb-version "pre-6.4")) + (gdb-var-list-children token) + (gdb-var-list-children-1 token))))) + ((string-match "-" text) ;contract this node + (dolist (var gdb-var-list) + (if (string-match (concat token "\\.") (car var)) + (setq gdb-var-list (delq var gdb-var-list)))) + (gdb-var-delete-children token) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)) + (t (error "Ooops... not sure what to do"))) + (speedbar-center-buffer-smartly)) + (message-box "GUD session has been killed"))) (defun gdb-get-target-string () (with-current-buffer gud-comint-buffer @@ -910,7 +1061,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'." 'gdb-partial-output-name) (defun gdb-partial-output-name () - (concat "*partial-output-" + (concat " *partial-output-" (gdb-get-target-string) "*")) @@ -929,7 +1080,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'." (interactive) (if gdb-use-separate-io-buffer (gdb-display-buffer - (gdb-get-buffer-create 'gdb-inferior-io)))) + (gdb-get-buffer-create 'gdb-inferior-io) t))) (defconst gdb-frame-parameters '((height . 14) (width . 80) @@ -939,7 +1090,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'." (minibuffer . nil))) (defun gdb-frame-separate-io-buffer () - "Display IO of inferior in a new frame." + "Display IO of debugged program in a new frame." (interactive) (if gdb-use-separate-io-buffer (let ((special-display-regexps (append special-display-regexps '(".*"))) @@ -1018,25 +1169,32 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'." (defun gdb-send (proc string) "A comint send filter for gdb. This filter may simply queue input for a later time." - (with-current-buffer gud-comint-buffer - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(face)))) - (let ((item (concat string "\n"))) - (if gud-running - (progn - (if gdb-enable-debug (push (cons 'send item) gdb-debug-ring)) - (process-send-string proc item)) - (gdb-enqueue-input item)))) + (when gdb-ready + (with-current-buffer gud-comint-buffer + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(face)))) + (if gud-running + (progn + (let ((item (concat string "\n"))) + (if gdb-enable-debug (push (cons 'send item) gdb-debug-log)) + (process-send-string proc item))) + (if (string-match "\\\\\\'" string) + (setq gdb-continuation (concat gdb-continuation string "\n")) + (let ((item (concat gdb-continuation string + (if (not comint-input-sender-no-newline) "\n")))) + (gdb-enqueue-input item) + (setq gdb-continuation nil)))))) ;; Note: Stuff enqueued here will be sent to the next prompt, even if it ;; is a query, or other non-top-level prompt. (defun gdb-enqueue-input (item) - (if gdb-prompting - (progn - (gdb-send-item item) - (setq gdb-prompting nil)) - (push item gdb-input-queue))) + (if (not gud-running) + (if gdb-prompting + (progn + (gdb-send-item item) + (setq gdb-prompting nil)) + (push item gdb-input-queue)))) (defun gdb-dequeue-input () (let ((queue gdb-input-queue)) @@ -1047,7 +1205,7 @@ This filter may simply queue input for a later time." (defun gdb-send-item (item) (setq gdb-flush-pending-output nil) - (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-ring)) + (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log)) (setq gdb-current-item item) (let ((process (get-buffer-process gud-comint-buffer))) (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) @@ -1081,8 +1239,8 @@ This filter may simply queue input for a later time." ;; any newlines. ;; -(defcustom gud-gdba-command-name "gdb -annotate=3" - "Default command to execute an executable under the GDB-UI debugger." +(defcustom gud-gdb-command-name "gdb --annotate=3" + "Default command to execute an executable under the GDB debugger." :type 'string :group 'gud :version "22.1") @@ -1101,7 +1259,7 @@ This filter may simply queue input for a later time." ("starting" gdb-starting) ("exited" gdb-exited) ("signalled" gdb-signalled) - ("signal" gdb-stopping) + ("signal" gdb-signal) ("breakpoint" gdb-stopping) ("watchpoint" gdb-stopping) ("frame-begin" gdb-frame-begin) @@ -1113,6 +1271,8 @@ This filter may simply queue input for a later time." (defun gdb-resync() (setq gdb-flush-pending-output t) (setq gud-running nil) + (gdb-force-mode-line-update + (propertize "stopped"'face font-lock-warning-face)) (setq gdb-output-sink 'user) (setq gdb-input-queue nil) (setq gdb-pending-triggers nil) @@ -1129,7 +1289,7 @@ This filter may simply queue input for a later time." (cons (match-string 1 args) (string-to-number (match-string 2 args)))) - (setq gdb-frame-address (match-string 3 args)) + (setq gdb-pc-address (match-string 3 args)) ;; cover for auto-display output which comes *before* ;; stopped annotation (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) @@ -1152,6 +1312,8 @@ happens to be in effect." "An annotation handler for `prompt'. This sends the next command (if any) to gdb." (when gdb-first-prompt + (gdb-force-mode-line-update + (propertize "initializing..." 'face font-lock-variable-name-face)) (gdb-init-1) (setq gdb-first-prompt nil)) (let ((sink gdb-output-sink)) @@ -1182,17 +1344,33 @@ This sends the next command (if any) to gdb." This says that I/O for the subprocess is now the program being debugged, not GDB." (setq gdb-active-process t) + (setq gdb-printing t) (let ((sink gdb-output-sink)) (cond ((eq sink 'user) (progn (setq gud-running t) + (setq gdb-inferior-status "running") + (setq gdb-signalled nil) + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-type-face)) + (gdb-remove-text-properties) + (setq gud-old-arrow gud-overlay-arrow-position) + (setq gud-overlay-arrow-position nil) + (setq gdb-overlay-arrow-position nil) + (setq gdb-stack-position nil) (if gdb-use-separate-io-buffer (setq gdb-output-sink 'inferior)))) (t (gdb-resync) (error "Unexpected `starting' annotation"))))) +(defun gdb-signal (ignored) + (setq gdb-inferior-status "signal") + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-warning-face)) + (gdb-stopping ignored)) + (defun gdb-stopping (ignored) "An annotation handler for `breakpoint' and other annotations. They say that I/O for the subprocess is now GDB, not the program @@ -1215,12 +1393,19 @@ directives." (setq gdb-active-process nil) (setq gud-overlay-arrow-position nil) (setq gdb-overlay-arrow-position nil) + (setq gdb-stack-position nil) + (setq gud-old-arrow nil) + (setq gdb-inferior-status "exited") + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-warning-face)) (gdb-stopping ignored)) (defun gdb-signalled (ignored) (setq gdb-signalled t)) (defun gdb-frame-begin (ignored) + (setq gdb-frame-begin t) + (setq gdb-printing nil) (let ((sink gdb-output-sink)) (cond ((eq sink 'inferior) @@ -1231,11 +1416,57 @@ directives." (gdb-resync) (error "Unexpected frame-begin annotation (%S)" sink))))) +(defcustom gdb-same-frame focus-follows-mouse + "Non-nil means pop up GUD buffer in same frame." + :group 'gud + :type 'boolean + :version "22.1") + +(defcustom gdb-find-source-frame nil + "Non-nil means try to find a source frame further up stack e.g after signal." + :group 'gud + :type 'boolean + :version "22.1") + +(defun gdb-find-source-frame (arg) + "Toggle trying to find a source frame further up stack. +With prefix argument ARG, look for a source frame further up +stack if ARG is positive, otherwise don't look further up." + (interactive "P") + (setq gdb-find-source-frame + (if (null arg) + (not gdb-find-source-frame) + (> (prefix-numeric-value arg) 0))) + (message (format "Looking for source frame %sabled" + (if gdb-find-source-frame "en" "dis")))) + (defun gdb-stopped (ignored) "An annotation handler for `stopped'. It is just like `gdb-stopping', except that if we already set the output sink to `user' in `gdb-stopping', that is fine." (setq gud-running nil) + (unless (or gud-overlay-arrow-position gud-last-frame) + (if (and gdb-frame-begin gdb-printing) + (setq gud-overlay-arrow-position gud-old-arrow) + ;;Pop up GUD buffer to display current frame when it doesn't have source + ;;information i.e if not compiled with -g as with libc routines generally. + (if gdb-same-frame + (gdb-display-gdb-buffer) + (gdb-frame-gdb-buffer)) + (if gdb-find-source-frame + ;;Try to find source further up stack e.g after signal. + (setq gdb-look-up-stack + (if (gdb-get-buffer 'gdb-stack-buffer) + 'keep + (progn + (gdb-get-buffer-create 'gdb-stack-buffer) + (gdb-invalidate-frames) + 'delete)))))) + (unless (member gdb-inferior-status '("exited" "signal")) + (setq gdb-active-process t) ;Just for attaching case. + (setq gdb-inferior-status "stopped") + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-warning-face))) (let ((sink gdb-output-sink)) (cond ((eq sink 'inferior) @@ -1262,7 +1493,7 @@ happens to be appropriate." (gdb-get-buffer-create 'gdb-breakpoints-buffer) (gdb-invalidate-breakpoints) ;; Do this through gdb-get-selected-frame -> gdb-frame-handler - ;; so gdb-frame-address is updated. + ;; so gdb-pc-address is updated. ;; (gdb-invalidate-assembler) (if (string-equal gdb-version "pre-6.4") @@ -1280,7 +1511,6 @@ happens to be appropriate." ;; FIXME: with GDB-6 on Darwin, this might very well work. ;; Only needed/used with speedbar/watch expressions. (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (setq gdb-force-update t) (if (string-equal gdb-version "pre-6.4") (gdb-var-update) (gdb-var-update-1))))) @@ -1294,6 +1524,18 @@ happens to be appropriate." (gdb-resync) (error "Phase error in gdb-post-prompt (got %s)" sink))))) +(defconst gdb-buffer-list +'(gdb-stack-buffer gdb-locals-buffer gdb-registers-buffer gdb-threads-buffer)) + +(defun gdb-remove-text-properties () + (dolist (buffertype gdb-buffer-list) + (let ((buffer (gdb-get-buffer buffertype))) + (if buffer + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (remove-text-properties + (point-min) (point-max) '(mouse-face nil help-echo nil)))))))) + ;; GUD displays the selected GDB frame. This might might not be the current ;; GDB frame (after up, down etc). If no GDB frame is visible but the last ;; visited breakpoint is, use that window. @@ -1310,14 +1552,19 @@ happens to be appropriate." (set-window-buffer source-window buffer)) source-window)) +;; Derived from gud-gdb-marker-regexp +(defvar gdb-fullname-regexp + (concat "\\(.:?[^" ":" "\n]*\\)" ":" "\\([0-9]*\\)" ":" ".*")) + (defun gud-gdba-marker-filter (string) "A gud marker filter for gdb. Handle a burst of output from GDB." (if gdb-flush-pending-output nil (when gdb-enable-debug - (push (cons 'recv string) gdb-debug-ring) - (if (> (length gdb-debug-ring) gdb-debug-ring-max) - (setcdr (nthcdr (1- gdb-debug-ring-max) gdb-debug-ring) nil))) + (push (cons 'recv string) gdb-debug-log) + (if (and gdb-debug-log-max + (> (length gdb-debug-log) gdb-debug-log-max)) + (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil))) ;; Recall the left over gud-marker-acc from last time. (setq gud-marker-acc (concat gud-marker-acc string)) ;; Start accumulating output for the GUD buffer. @@ -1325,34 +1572,50 @@ happens to be appropriate." ;; ;; Process all the complete markers in this chunk. (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) - (let ((annotation (match-string 1 gud-marker-acc))) - ;; - ;; Stuff prior to the match is just ordinary output. - ;; It is either concatenated to OUTPUT or directed - ;; elsewhere. - (setq output - (gdb-concat-output - output - (substring gud-marker-acc 0 (match-beginning 0)))) - ;; - ;; Take that stuff off the gud-marker-acc. - (setq gud-marker-acc (substring gud-marker-acc (match-end 0))) + (let ((annotation (match-string 1 gud-marker-acc)) + (before (substring gud-marker-acc 0 (match-beginning 0))) + (after (substring gud-marker-acc (match-end 0)))) ;; ;; Parse the tag from the annotation, and maybe its arguments. (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) (let* ((annotation-type (match-string 1 annotation)) (annotation-arguments (match-string 2 annotation)) (annotation-rule (assoc annotation-type - gdb-annotation-rules))) + gdb-annotation-rules)) + (fullname (string-match gdb-fullname-regexp annotation-type))) + + ;; Stuff prior to the match is just ordinary output. + ;; It is either concatenated to OUTPUT or directed + ;; elsewhere. + (setq output + (gdb-concat-output output + (concat before (if fullname "\n")))) + + ;; Take that stuff off the gud-marker-acc. + (setq gud-marker-acc after) + ;; Call the handler for this annotation. (if annotation-rule (funcall (car (cdr annotation-rule)) annotation-arguments) - ;; Else the annotation is not recognized. Ignore it silently, - ;; so that GDB can add new annotations without causing - ;; us to blow up. - )))) - ;; + + ;; Switch to gud-gdb-marker-filter if appropriate. + (when fullname + + ;; Extract the frame position from the marker. + (setq gud-last-frame (cons (match-string 1 annotation) + (string-to-number + (match-string 2 annotation)))) + + (set (make-local-variable 'gud-minor-mode) 'gdb) + (set (make-local-variable 'gud-marker-filter) + 'gud-gdb-marker-filter))) + + ;; Else the annotation is not recognized. Ignore it silently, + ;; so that GDB can add new annotations without causing + ;; us to blow up. + ))) + ;; Does the remaining text end in a partial line? ;; If it does, then keep part of the gud-marker-acc until we get more. (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" @@ -1405,7 +1668,7 @@ happens to be appropriate." (goto-char (point-max)) (insert-before-markers string)) (if (not (string-equal string "")) - (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))) + (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t))) (defun gdb-clear-inferior-io () (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) @@ -1562,27 +1825,37 @@ static char *magick[] = { (defvar breakpoint-disabled-icon nil "Icon for disabled breakpoint in display margin.") -;; Bitmap for breakpoint in fringe (and (display-images-p) + ;; Bitmap for breakpoint in fringe (define-fringe-bitmap 'breakpoint - "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")) + "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") + ;; Bitmap for gud-overlay-arrow in fringe + (define-fringe-bitmap 'hollow-right-triangle + "\xe0\x90\x88\x84\x84\x88\x90\xe0")) (defface breakpoint-enabled '((t - :foreground "red" + :foreground "red1" :weight bold)) "Face for enabled breakpoint icon in fringe." :group 'gud) (defface breakpoint-disabled - ;; We use different values of grey for different background types, - ;; so that on low-color displays it will end up as something visible - ;; if it has to be approximated. - '((((background dark)) :foreground "grey60") - (((background light)) :foreground "grey40")) + '((((class color) (min-colors 88)) :foreground "grey70") + ;; Ensure that on low-color displays that we end up something visible. + (((class color) (min-colors 8) (background light)) + :foreground "black") + (((class color) (min-colors 8) (background dark)) + :foreground "white") + (((type tty) (class mono)) + :inverse-video t) + (t :background "gray")) "Face for disabled breakpoint icon in fringe." :group 'gud) +(defconst gdb-breakpoint-regexp + "\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\s-+\\(.\\)\\s-+") + ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). (defun gdb-info-breakpoints-custom () (let ((flag) (bptno)) @@ -1590,56 +1863,73 @@ static char *magick[] = { (dolist (buffer (buffer-list)) (with-current-buffer buffer (if (and (memq gud-minor-mode '(gdba gdbmi)) - (not (string-match "\\`\\*.+\\*\\'" (buffer-name)))) + (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) (gdb-remove-breakpoint-icons (point-min) (point-max))))) (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) (save-excursion + (let ((buffer-read-only nil)) (goto-char (point-min)) (while (< (point) (- (point-max) 1)) (forward-line 1) - (if (looking-at "[^\t].*?breakpoint") + (if (looking-at gdb-breakpoint-regexp) (progn - (looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)") (setq bptno (match-string 1)) (setq flag (char-after (match-beginning 2))) - (beginning-of-line) - (if (re-search-forward " in \\(.*\\) at\\s-+" nil t) - (progn - (let ((buffer-read-only nil)) - (add-text-properties (match-beginning 1) (match-end 1) - '(face font-lock-function-name-face))) - (looking-at "\\(\\S-+\\):\\([0-9]+\\)") - (let ((line (match-string 2)) (buffer-read-only nil) - (file (match-string 1))) - (add-text-properties (line-beginning-position) - (line-end-position) - '(mouse-face highlight - help-echo "mouse-2, RET: visit breakpoint")) - (unless (file-exists-p file) - (setq file (cdr (assoc bptno gdb-location-alist)))) - (if (and file - (not (string-equal file "File not found"))) - (with-current-buffer - (find-file-noselect file 'nowarn) - (set (make-local-variable 'gud-minor-mode) - 'gdba) - (set (make-local-variable 'tool-bar-map) - gud-tool-bar-map) - ;; Only want one breakpoint icon at each - ;; location. - (save-excursion - (goto-line (string-to-number line)) - (gdb-put-breakpoint-icon (eq flag ?y) bptno))) - (gdb-enqueue-input - (list - (concat gdb-server-prefix "list " - (match-string-no-properties 1) ":1\n") - 'ignore)) - (gdb-enqueue-input - (list (concat gdb-server-prefix "info source\n") - `(lambda () (gdb-get-location - ,bptno ,line ,flag)))))))))) - (end-of-line))))) + (add-text-properties + (match-beginning 2) (match-end 2) + (if (eq flag ?y) + '(face font-lock-warning-face) + '(face font-lock-type-face))) + (let ((bl (point)) + (el (line-end-position))) + (if (re-search-forward " in \\(.*\\) at\\s-+" el t) + (progn + (add-text-properties + (match-beginning 1) (match-end 1) + '(face font-lock-function-name-face)) + (looking-at "\\(\\S-+\\):\\([0-9]+\\)") + (let ((line (match-string 2)) + (file (match-string 1))) + (add-text-properties bl el + '(mouse-face highlight + help-echo "mouse-2, RET: visit breakpoint")) + (unless (file-exists-p file) + (setq file (cdr (assoc bptno gdb-location-alist)))) + (if (and file + (not (string-equal file "File not found"))) + (with-current-buffer + (find-file-noselect file 'nowarn) + (set (make-local-variable 'gud-minor-mode) + 'gdba) + (set (make-local-variable 'tool-bar-map) + gud-tool-bar-map) + ;; Only want one breakpoint icon at each + ;; location. + (save-excursion + (goto-line (string-to-number line)) + (gdb-put-breakpoint-icon (eq flag ?y) bptno))) + (gdb-enqueue-input + (list + (concat gdb-server-prefix "list " + (match-string-no-properties 1) ":1\n") + 'ignore)) + (gdb-enqueue-input + (list (concat gdb-server-prefix "info source\n") + `(lambda () (gdb-get-location + ,bptno ,line ,flag))))))) + (if (re-search-forward + "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" + el t) + (add-text-properties + (match-beginning 1) (match-end 1) + '(face font-lock-function-name-face)) + (end-of-line) + (re-search-backward "\\s-\\(\\S-*\\)" + bl t) + (add-text-properties + (match-beginning 1) (match-end 1) + '(face font-lock-variable-name-face))))))) + (end-of-line)))))) (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) (defun gdb-mouse-set-clear-breakpoint (event) @@ -1712,7 +2002,7 @@ static char *magick[] = { "Display status of user-settable breakpoints." (interactive) (gdb-display-buffer - (gdb-get-buffer-create 'gdb-breakpoints-buffer))) + (gdb-get-buffer-create 'gdb-breakpoints-buffer) t)) (defun gdb-frame-breakpoints-buffer () "Display status of user-settable breakpoints in a new frame." @@ -1759,9 +2049,6 @@ static char *magick[] = { 'gdb-invalidate-breakpoints 'gdbmi-invalidate-breakpoints)) -(defconst gdb-breakpoint-regexp - "\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\s-+\\(.\\)\\s-+") - (defun gdb-toggle-breakpoint () "Enable/disable breakpoint at current line." (interactive) @@ -1801,7 +2088,7 @@ static char *magick[] = { (let* ((buffer (find-file-noselect (if (file-exists-p file) file (cdr (assoc bptno gdb-location-alist))))) - (window (unless (gdb-display-source-buffer buffer) + (window (or (gdb-display-source-buffer buffer) (display-buffer buffer)))) (setq gdb-source-window window) (with-current-buffer buffer @@ -1815,49 +2102,99 @@ static char *magick[] = { ;; ;; Alas, if your stack is deep, it is costly. ;; +(defcustom gdb-max-frames 40 + "Maximum number of frames displayed in call stack." + :type 'integer + :group 'gud + :version "22.1") + (gdb-set-buffer-rules 'gdb-stack-buffer 'gdb-stack-buffer-name 'gdb-frames-mode) (def-gdb-auto-updated-buffer gdb-stack-buffer gdb-invalidate-frames - "server where\n" - gdb-info-frames-handler - gdb-info-frames-custom) + (concat "server info stack " (number-to-string gdb-max-frames) "\n") + gdb-info-stack-handler + gdb-info-stack-custom) -(defun gdb-info-frames-custom () +(defun gdb-info-stack-custom () (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) - (save-excursion - (let ((buffer-read-only nil) - bl el) - (goto-char (point-min)) - (while (< (point) (point-max)) - (setq bl (line-beginning-position) - el (line-end-position)) - (when (looking-at "#") - (add-text-properties bl el - '(mouse-face highlight - help-echo "mouse-2, RET: Select frame"))) - (goto-char bl) - (when (looking-at "^#\\([0-9]+\\)") - (when (string-equal (match-string 1) gdb-frame-number) - (put-text-property bl (+ bl 4) - 'face '(:inverse-video t))) - (when (re-search-forward - (concat - (if (string-equal (match-string 1) "0") "" " in ") - "\\([^ ]+\\) (") el t) - (put-text-property (match-beginning 1) (match-end 1) - 'face font-lock-function-name-face) - (setq bl (match-end 0)) - (while (re-search-forward "<\\([^>]+\\)>" el t) - (put-text-property (match-beginning 1) (match-end 1) - 'face font-lock-function-name-face)) + (let (move-to) + (save-excursion + (unless (eq gdb-look-up-stack 'delete) + (let ((buffer-read-only nil) + bl el) + (goto-char (point-min)) + (while (< (point) (point-max)) + (setq bl (line-beginning-position) + el (line-end-position)) + (when (looking-at "#") + (add-text-properties bl el + '(mouse-face highlight + help-echo "mouse-2, RET: Select frame"))) (goto-char bl) - (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t) - (put-text-property (match-beginning 1) (match-end 1) - 'face font-lock-variable-name-face)))) - (forward-line 1)))))) + (when (looking-at "^#\\([0-9]+\\)") + (when (string-equal (match-string 1) gdb-frame-number) + (if (> (car (window-fringes)) 0) + (progn + (or gdb-stack-position + (setq gdb-stack-position (make-marker))) + (set-marker gdb-stack-position (point)) + (setq move-to gdb-stack-position)) + (put-text-property bl (+ bl 4) + 'face '(:inverse-video t)) + (setq move-to bl))) + (when (re-search-forward + (concat + (if (string-equal (match-string 1) "0") "" " in ") + "\\([^ ]+\\) (") el t) + (put-text-property (match-beginning 1) (match-end 1) + 'face font-lock-function-name-face) + (setq bl (match-end 0)) + (while (re-search-forward "<\\([^>]+\\)>" el t) + (put-text-property (match-beginning 1) (match-end 1) + 'face font-lock-function-name-face)) + (goto-char bl) + (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t) + (put-text-property (match-beginning 1) (match-end 1) + 'face font-lock-variable-name-face)))) + (forward-line 1)) + (forward-line -1) + (when (looking-at "(More stack frames follow...)") + (add-text-properties (match-beginning 0) (match-end 0) + '(mouse-face highlight + gdb-max-frames t + help-echo + "mouse-2, RET: customize gdb-max-frames to see more frames"))))) + (when gdb-look-up-stack + (goto-char (point-min)) + (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t) + (let ((start (line-beginning-position)) + (file (match-string 1)) + (line (match-string 2))) + (re-search-backward "^#*\\([0-9]+\\)" start t) + (gdb-enqueue-input + (list (concat gdb-server-prefix "frame " + (match-string 1) "\n") 'gdb-set-hollow)) + (gdb-enqueue-input + (list (concat gdb-server-prefix "frame 0\n") 'ignore)))))) + (when move-to + (let ((window (get-buffer-window (current-buffer) 0))) + (when window + (with-selected-window window + (goto-char move-to) + (unless (pos-visible-in-window-p) + (recenter '(center))))))))) + (if (eq gdb-look-up-stack 'delete) + (kill-buffer (gdb-get-buffer 'gdb-stack-buffer))) + (setq gdb-look-up-stack nil)) + +(defun gdb-set-hollow () + (if gud-last-last-frame + (with-current-buffer (gud-find-file (car gud-last-last-frame)) + (setq fringe-indicator-alist + '((overlay-arrow . hollow-right-triangle)))))) (defun gdb-stack-buffer-name () (with-current-buffer gud-comint-buffer @@ -1867,7 +2204,7 @@ static char *magick[] = { "Display backtrace of current stack." (interactive) (gdb-display-buffer - (gdb-get-buffer-create 'gdb-stack-buffer))) + (gdb-get-buffer-create 'gdb-stack-buffer) t)) (defun gdb-frame-stack-buffer () "Display backtrace of current stack in a new frame." @@ -1886,12 +2223,15 @@ static char *magick[] = { map)) (defun gdb-frames-mode () - "Major mode for gdb frames. + "Major mode for gdb call stack. \\{gdb-frames-mode-map}" (kill-all-local-variables) (setq major-mode 'gdb-frames-mode) (setq mode-name "Frames") + (setq gdb-stack-position nil) + (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) + (setq truncate-lines t) ;; Make it easier to see overlay arrow. (setq buffer-read-only t) (use-local-map gdb-frames-mode-map) (run-mode-hooks 'gdb-frames-mode-hook) @@ -1904,17 +2244,21 @@ static char *magick[] = { (end-of-line) (let* ((start (line-beginning-position)) (pos (re-search-backward "^#*\\([0-9]+\\)" start t)) - (n (or (and pos (match-string-no-properties 1)) "0"))) + (n (or (and pos (match-string 1)) "0"))) n))) (defun gdb-frames-select (&optional event) "Select the frame and display the relevant source." (interactive (list last-input-event)) (if event (posn-set-point (event-end event))) - (gdb-enqueue-input - (list (concat gdb-server-prefix "frame " - (gdb-get-frame-number) "\n") 'ignore)) - (gud-display-frame)) + (if (get-text-property (point) 'gdb-max-frames) + (progn + (message-box "After setting gdb-max-frames, you need to enter\n\ +another GDB command e.g pwd, to see new frames") + (customize-variable-other-window 'gdb-max-frames)) + (gdb-enqueue-input + (list (concat gdb-server-prefix "frame " + (gdb-get-frame-number) "\n") 'ignore)))) ;; Threads buffer. This displays a selectable thread list. @@ -1932,13 +2276,14 @@ static char *magick[] = { (defun gdb-info-threads-custom () (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer) (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (< (point) (point-max)) - (unless (looking-at "No ") - (add-text-properties (line-beginning-position) (line-end-position) - '(mouse-face highlight + (save-excursion + (goto-char (point-min)) + (while (< (point) (point-max)) + (unless (looking-at "No ") + (add-text-properties (line-beginning-position) (line-end-position) + '(mouse-face highlight help-echo "mouse-2, RET: select thread"))) - (forward-line 1))))) + (forward-line 1)))))) (defun gdb-threads-buffer-name () (with-current-buffer gud-comint-buffer @@ -1948,7 +2293,7 @@ static char *magick[] = { "Display IDs of currently known threads." (interactive) (gdb-display-buffer - (gdb-get-buffer-create 'gdb-threads-buffer))) + (gdb-get-buffer-create 'gdb-threads-buffer) t)) (defun gdb-frame-threads-buffer () "Display IDs of currently known threads in a new frame." @@ -1967,15 +2312,13 @@ static char *magick[] = { map)) (defvar gdb-threads-font-lock-keywords - '( - (") +\\([^ ]+\\) (" (1 font-lock-function-name-face)) + '((") +\\([^ ]+\\) (" (1 font-lock-function-name-face)) ("in \\([^ ]+\\) (" (1 font-lock-function-name-face)) - ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face)) - ) + ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face))) "Font lock keywords used in `gdb-threads-mode'.") (defun gdb-threads-mode () - "Major mode for gdb frames. + "Major mode for gdb threads. \\{gdb-threads-mode-map}" (kill-all-local-variables) @@ -2035,7 +2378,7 @@ static char *magick[] = { (unless (string-equal (match-string 0) "The") (put-text-property start (match-end 0) 'face font-lock-variable-name-face) - (add-text-properties start end + (add-text-properties start end '(help-echo "mouse-2: edit value" mouse-face highlight)))) (forward-line 1)))))) @@ -2084,7 +2427,7 @@ static char *magick[] = { "Display integer register contents." (interactive) (gdb-display-buffer - (gdb-get-buffer-create 'gdb-registers-buffer))) + (gdb-get-buffer-create 'gdb-registers-buffer) t)) (defun gdb-frame-registers-buffer () "Display integer register contents in a new frame." @@ -2340,37 +2683,37 @@ corresponding to the mode line clicked." (propertize "-" 'face font-lock-warning-face - 'help-echo "mouse-1: Decrement address" + 'help-echo "mouse-1: decrement address" 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 - #'(lambda () (interactive) - (let ((gdb-memory-address - ;; Let GDB do the arithmetic. - (concat - gdb-memory-address " - " - (number-to-string - (* gdb-memory-repeat-count - (cond ((string= gdb-memory-unit "b") 1) - ((string= gdb-memory-unit "h") 2) - ((string= gdb-memory-unit "w") 4) - ((string= gdb-memory-unit "g") 8))))))) - (gdb-invalidate-memory))))) + (lambda () (interactive) + (let ((gdb-memory-address + ;; Let GDB do the arithmetic. + (concat + gdb-memory-address " - " + (number-to-string + (* gdb-memory-repeat-count + (cond ((string= gdb-memory-unit "b") 1) + ((string= gdb-memory-unit "h") 2) + ((string= gdb-memory-unit "w") 4) + ((string= gdb-memory-unit "g") 8))))))) + (gdb-invalidate-memory))))) "|" (propertize "+" 'face font-lock-warning-face - 'help-echo "mouse-1: Increment address" + 'help-echo "mouse-1: increment address" 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 - #'(lambda () (interactive) - (let ((gdb-memory-address nil)) - (gdb-invalidate-memory))))) + (lambda () (interactive) + (let ((gdb-memory-address nil)) + (gdb-invalidate-memory))))) "]: " (propertize gdb-memory-address 'face font-lock-warning-face - 'help-echo "mouse-1: Set memory address" + 'help-echo "mouse-1: set memory address" 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 @@ -2378,7 +2721,7 @@ corresponding to the mode line clicked." " Repeat Count: " (propertize (number-to-string gdb-memory-repeat-count) 'face font-lock-warning-face - 'help-echo "mouse-1: Set repeat count" + 'help-echo "mouse-1: set repeat count" 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 @@ -2386,13 +2729,13 @@ corresponding to the mode line clicked." " Display Format: " (propertize gdb-memory-format 'face font-lock-warning-face - 'help-echo "mouse-3: Select display format" + 'help-echo "mouse-3: select display format" 'mouse-face 'mode-line-highlight 'local-map gdb-memory-format-map) " Unit Size: " (propertize gdb-memory-unit 'face font-lock-warning-face - 'help-echo "mouse-3: Select unit size" + 'help-echo "mouse-3: select unit size" 'mouse-face 'mode-line-highlight 'local-map gdb-memory-unit-map)))) (set (make-local-variable 'font-lock-defaults) @@ -2408,13 +2751,16 @@ corresponding to the mode line clicked." "Display memory contents." (interactive) (gdb-display-buffer - (gdb-get-buffer-create 'gdb-memory-buffer))) + (gdb-get-buffer-create 'gdb-memory-buffer) t)) (defun gdb-frame-memory-buffer () "Display memory contents in a new frame." (interactive) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) + (let* ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist + (cons '(left-fringe . 0) + (cons '(right-fringe . 0) + (cons '(width . 83) gdb-frame-parameters))))) (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) @@ -2431,13 +2777,14 @@ corresponding to the mode line clicked." (defvar gdb-locals-watch-map (let ((map (make-sparse-keymap))) - (define-key map "\r" '(lambda () (interactive) - (beginning-of-line) - (gud-watch))) - (define-key map [mouse-2] '(lambda (event) (interactive "e") - (mouse-set-point event) - (beginning-of-line) - (gud-watch))) + (suppress-keymap map) + (define-key map "\r" (lambda () (interactive) + (beginning-of-line) + (gud-watch))) + (define-key map [mouse-2] (lambda (event) (interactive "e") + (mouse-set-point event) + (beginning-of-line) + (gud-watch))) map) "Keymap to create watch expression of a complex data type local variable.") @@ -2515,7 +2862,7 @@ corresponding to the mode line clicked." "Display local variables of current stack and their values." (interactive) (gdb-display-buffer - (gdb-get-buffer-create 'gdb-locals-buffer))) + (gdb-get-buffer-create 'gdb-locals-buffer) t)) (defun gdb-frame-locals-buffer () "Display local variables of current stack and their values in a new frame." @@ -2526,16 +2873,17 @@ corresponding to the mode line clicked." ;;;; Window management -(defun gdb-display-buffer (buf &optional size) +(defun gdb-display-buffer (buf dedicated &optional size) (let ((answer (get-buffer-window buf 0)) (must-split nil)) (if answer - (display-buffer buf nil 0) ;Raise the frame if necessary. + (display-buffer buf nil 0) ;Deiconify the frame if necessary. ;; The buffer is not yet displayed. (pop-to-buffer gud-comint-buffer) ;Select the right frame. (let ((window (get-lru-window))) (if (and window - (not (eq window (get-buffer-window gud-comint-buffer)))) + (not (memq window `(,(get-buffer-window gud-comint-buffer) + ,gdb-source-window)))) (progn (set-window-buffer window buf) (setq answer window)) @@ -2546,7 +2894,7 @@ corresponding to the mode line clicked." (new-size (and size (< size cur-size) (- cur-size size)))) (setq answer (split-window largest new-size)) (set-window-buffer answer buf) - (set-window-dedicated-p answer t))) + (set-window-dedicated-p answer dedicated))) answer))) @@ -2559,7 +2907,7 @@ corresponding to the mode line clicked." (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) (define-key menu [inferior] - '(menu-item "Inferior IO" gdb-display-separate-io-buffer + '(menu-item "Separate IO" gdb-display-separate-io-buffer :enable gdb-use-separate-io-buffer)) (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) @@ -2578,10 +2926,10 @@ corresponding to the mode line clicked." (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) (define-key menu [inferior] - '(menu-item "Inferior IO" gdb-frame-separate-io-buffer + '(menu-item "Separate IO" gdb-frame-separate-io-buffer :enable gdb-use-separate-io-buffer)) (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) - (define-key menu [disassembly] '("Disassembiy" . gdb-frame-assembler-buffer)) + (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer)) (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) @@ -2591,10 +2939,15 @@ corresponding to the mode line clicked." (define-key gud-menu-map [ui] `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI") ,menu :visible (memq gud-minor-mode '(gdbmi gdba)))) + (define-key menu [gdb-find-source-frame] + '(menu-item "Look For Source Frame" gdb-find-source-frame + :visible (eq gud-minor-mode 'gdba) + :help "Toggle look for source frame." + :button (:toggle . gdb-find-source-frame))) (define-key menu [gdb-use-separate-io] - '(menu-item "Separate inferior IO" gdb-use-separate-io-buffer + '(menu-item "Separate IO" gdb-use-separate-io-buffer :visible (eq gud-minor-mode 'gdba) - :help "Toggle separate IO for inferior." + :help "Toggle separate IO for debugged program." :button (:toggle . gdb-use-separate-io-buffer))) (define-key menu [gdb-many-windows] '(menu-item "Display Other Windows" gdb-many-windows @@ -2608,7 +2961,9 @@ corresponding to the mode line clicked." "Display GUD buffer in a new frame." (interactive) (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters) + (special-display-frame-alist + (remove '(menu-bar-lines) (remove '(tool-bar-lines) + gdb-frame-parameters))) (same-window-regexps nil)) (display-buffer gud-comint-buffer))) @@ -2640,7 +2995,12 @@ corresponding to the mode line clicked." (switch-to-buffer (if gud-last-last-frame (gud-find-file (car gud-last-last-frame)) - (gud-find-file gdb-main-file))) + (if gdb-main-file + (gud-find-file gdb-main-file) + ;; Put buffer list in window if we + ;; can't find a source file. + (list-buffers-noselect)))) + (setq gdb-source-window (selected-window)) (when gdb-use-separate-io-buffer (split-window-horizontally) (other-window 1) @@ -2653,32 +3013,6 @@ corresponding to the mode line clicked." (gdb-set-window-buffer (gdb-breakpoints-buffer-name)) (other-window 1)) -(defcustom gdb-many-windows nil - "Nil means just pop up the GUD buffer unless `gdb-show-main' is t. -In this case it starts with two windows: one displaying the GUD -buffer and the other with the source file with the main routine -of the inferior. Non-nil means display the layout shown for -`gdba'." - :type 'boolean - :group 'gud - :version "22.1") - -(defun gdb-many-windows (arg) - "Toggle the number of windows in the basic arrangement. -With arg, display additional buffers iff arg is positive." - (interactive "P") - (setq gdb-many-windows - (if (null arg) - (not gdb-many-windows) - (> (prefix-numeric-value arg) 0))) - (message (format "Display of other windows %sabled" - (if gdb-many-windows "en" "dis"))) - (if (and gud-comint-buffer - (buffer-name gud-comint-buffer)) - (condition-case nil - (gdb-restore-windows) - (error nil)))) - (defun gdb-restore-windows () "Restore the basic arrangement of windows used by gdba. This arrangement depends on the value of `gdb-many-windows'." @@ -2694,6 +3028,7 @@ This arrangement depends on the value of `gdb-many-windows'." (if gud-last-last-frame (gud-find-file (car gud-last-last-frame)) (gud-find-file gdb-main-file))) + (setq gdb-source-window (selected-window)) (other-window 1)))) (defun gdb-reset () @@ -2703,19 +3038,20 @@ Kills the gdb buffers, and resets variables and the source buffers." (unless (eq buffer gud-comint-buffer) (with-current-buffer buffer (if (memq gud-minor-mode '(gdbmi gdba)) - (if (string-match "\\`\\*.+\\*\\'" (buffer-name)) + (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name)) (kill-buffer nil) (gdb-remove-breakpoint-icons (point-min) (point-max) t) (setq gud-minor-mode nil) (kill-local-variable 'tool-bar-map) (kill-local-variable 'gdb-define-alist)))))) - (when (markerp gdb-overlay-arrow-position) - (move-marker gdb-overlay-arrow-position nil) - (setq gdb-overlay-arrow-position nil)) + (setq gdb-overlay-arrow-position nil) (setq overlay-arrow-variable-list (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) - (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (speedbar-refresh)) + (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) + (setq gdb-stack-position nil) + (setq overlay-arrow-variable-list + (delq 'gdb-stack-position overlay-arrow-variable-list)) + (if (boundp 'speedbar-frame) (speedbar-timer-fn)) (setq gud-running nil) (setq gdb-active-process nil) (setq gdb-var-list nil) @@ -2736,7 +3072,8 @@ buffers." (gdb-get-buffer-create 'gdb-breakpoints-buffer) (if gdb-show-main (let ((pop-up-windows t)) - (display-buffer (gud-find-file gdb-main-file)))))) + (display-buffer (gud-find-file gdb-main-file))))) + (setq gdb-ready t)) (defun gdb-get-location (bptno line flag) "Find the directory containing the relevant source file. @@ -2773,7 +3110,11 @@ of the current session." gud-comint-buffer (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) '(gdba gdbmi))) - (if (member buffer-file-name gdb-source-file-list) + ;;Pre GDB 6.3 "info sources" doesn't give absolute file name. + (if (member (if (string-equal gdb-version "pre-6.4") + (file-name-nondirectory buffer-file-name) + buffer-file-name) + gdb-source-file-list) (with-current-buffer (find-buffer-visiting buffer-file-name) (set (make-local-variable 'gud-minor-mode) (buffer-local-value 'gud-minor-mode gud-comint-buffer)) @@ -2894,28 +3235,45 @@ BUFFER nil or omitted means use the current buffer." 'gdb-assembler-buffer-name 'gdb-assembler-mode) -(def-gdb-auto-update-handler gdb-assembler-handler - gdb-invalidate-assembler - gdb-assembler-buffer - gdb-assembler-custom) +;; We can't use def-gdb-auto-update-handler because we don't want to use +;; window-start but keep the overlay arrow/current line visible. +(defun gdb-assembler-handler () + (setq gdb-pending-triggers + (delq 'gdb-invalidate-assembler + gdb-pending-triggers)) + (let ((buf (gdb-get-buffer 'gdb-assembler-buffer))) + (and buf + (with-current-buffer buf + (let* ((window (get-buffer-window buf 0)) + (p (window-point window)) + (buffer-read-only nil)) + (erase-buffer) + (insert-buffer-substring (gdb-get-buffer-create + 'gdb-partial-output-buffer)) + (set-window-point window p))))) + ;; put customisation here + (gdb-assembler-custom)) (defun gdb-assembler-custom () (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) (pos 1) (address) (flag) (bptno)) (with-current-buffer buffer (save-excursion - (if (not (equal gdb-frame-address "main")) + (if (not (equal gdb-pc-address "main")) (progn (goto-char (point-min)) - (if (and gdb-frame-address - (search-forward gdb-frame-address nil t)) + (if (and gdb-pc-address + (search-forward gdb-pc-address nil t)) (progn (setq pos (point)) (beginning-of-line) + (setq fringe-indicator-alist + (if (string-equal gdb-frame-number "0") + nil + '((overlay-arrow . hollow-right-triangle)))) (or gdb-overlay-arrow-position (setq gdb-overlay-arrow-position (make-marker))) - (set-marker gdb-overlay-arrow-position - (point) (current-buffer)))))) + (set-marker gdb-overlay-arrow-position (point)))))) ;; remove all breakpoint-icons in assembler buffer before updating. (gdb-remove-breakpoint-icons (point-min) (point-max)))) (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) @@ -2934,7 +3292,7 @@ BUFFER nil or omitted means use the current buffer." (goto-char (point-min)) (if (search-forward address nil t) (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))) - (if (not (equal gdb-frame-address "main")) + (if (not (equal gdb-pc-address "main")) (with-current-buffer buffer (set-window-point (get-buffer-window buffer 0) pos))))) @@ -2986,7 +3344,7 @@ BUFFER nil or omitted means use the current buffer." (interactive) (setq gdb-previous-frame nil) (gdb-display-buffer - (gdb-get-buffer-create 'gdb-assembler-buffer))) + (gdb-get-buffer-create 'gdb-assembler-buffer) t)) (defun gdb-frame-assembler-buffer () "Display disassembly view in a new frame." @@ -2996,7 +3354,7 @@ BUFFER nil or omitted means use the current buffer." (special-display-frame-alist gdb-frame-parameters)) (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer)))) -;; modified because if gdb-frame-address has changed value a new command +;; modified because if gdb-pc-address has changed value a new command ;; must be enqueued to update the buffer with the new output (defun gdb-invalidate-assembler (&optional ignored) (if (gdb-get-buffer 'gdb-assembler-buffer) @@ -3005,7 +3363,7 @@ BUFFER nil or omitted means use the current buffer." (string-equal gdb-selected-frame gdb-previous-frame)) (if (or (not (member 'gdb-invalidate-assembler gdb-pending-triggers)) - (not (string-equal gdb-frame-address + (not (string-equal gdb-pc-address gdb-previous-frame-address))) (progn ;; take previous disassemble command, if any, off the queue @@ -3018,11 +3376,11 @@ BUFFER nil or omitted means use the current buffer." (gdb-enqueue-input (list (concat gdb-server-prefix "disassemble " - (if (member gdb-frame-address '(nil "main")) nil "0x") - gdb-frame-address "\n") + (if (member gdb-pc-address '(nil "main")) nil "0x") + gdb-pc-address "\n") 'gdb-assembler-handler)) (push 'gdb-invalidate-assembler gdb-pending-triggers) - (setq gdb-previous-frame-address gdb-frame-address) + (setq gdb-previous-frame-address gdb-pc-address) (setq gdb-previous-frame gdb-selected-frame))))))) (defun gdb-get-selected-frame () @@ -3037,22 +3395,36 @@ BUFFER nil or omitted means use the current buffer." (setq gdb-pending-triggers (delq 'gdb-get-selected-frame gdb-pending-triggers)) (goto-char (point-min)) - (if (re-search-forward "Stack level \\([0-9]+\\)" nil t) - (setq gdb-frame-number (match-string 1))) + (when (re-search-forward + "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t) + (setq gdb-frame-number (match-string 1)) + (setq gdb-frame-address (match-string 2))) (goto-char (point-min)) - (if (re-search-forward - ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? " nil t) - (progn - (setq gdb-selected-frame (match-string 2)) - (if (gdb-get-buffer 'gdb-locals-buffer) - (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) - (setq mode-name (concat "Locals:" gdb-selected-frame)))) - (if (gdb-get-buffer 'gdb-assembler-buffer) - (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) - (setq mode-name (concat "Machine:" gdb-selected-frame)))) - (setq gdb-frame-address (match-string 1)))) + (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\ +\\(?: (\\(\\S-+?\\):[0-9]+?)\\)*; " + nil t) + (setq gdb-selected-frame (match-string 2)) + (if (gdb-get-buffer 'gdb-locals-buffer) + (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) + (setq mode-name (concat "Locals:" gdb-selected-frame)))) + (if (gdb-get-buffer 'gdb-assembler-buffer) + (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) + (setq mode-name (concat "Machine:" gdb-selected-frame)))) + (setq gdb-pc-address (match-string 1)) + (if (and (match-string 3) gud-overlay-arrow-position) + (let ((buffer (marker-buffer gud-overlay-arrow-position)) + (position (marker-position gud-overlay-arrow-position))) + (when (and buffer + (string-equal (buffer-name buffer) + (file-name-nondirectory (match-string 3)))) + (with-current-buffer buffer + (setq fringe-indicator-alist + (if (string-equal gdb-frame-number "0") + nil + '((overlay-arrow . hollow-right-triangle)))) + (set-marker gud-overlay-arrow-position position)))))) (goto-char (point-min)) - (if (re-search-forward " source language \\(\\S-*\\)\." nil t) + (if (re-search-forward " source language \\(\\S-+\\)\." nil t) (setq gdb-current-language (match-string 1))) (gdb-invalidate-assembler)) @@ -3076,43 +3448,46 @@ is set in them." (when gud-tooltip-mode (make-local-variable 'gdb-define-alist) (gdb-create-define-alist) - (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))) + (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))) + (gdb-force-mode-line-update + (propertize "ready" 'face font-lock-variable-name-face))) ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. (defun gdb-var-list-children-1 (varnum) (gdb-enqueue-input (list (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (concat "server interpreter mi \"-var-list-children --all-values " + (concat "server interpreter mi \"-var-list-children --all-values " varnum "\"\n") (concat "-var-list-children --all-values " varnum "\n")) `(lambda () (gdb-var-list-children-handler-1 ,varnum))))) (defconst gdb-var-list-children-regexp-1 - "name=\"\\(.+?\\)\",exp=\"\\(.+?\\)\",numchild=\"\\(.+?\\)\",\ -value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") + "child={.*?name=\"\\(.+?\\)\",.*?exp=\"\\(.+?\\)\",.*?\ +numchild=\"\\(.+?\\)\",.*?value=\\(\".*?\"\\)\ +\\(}\\|,.*?\\(type=\"\\(.+?\\)\"\\)?.*?}\\)") (defun gdb-var-list-children-handler-1 (varnum) (goto-char (point-min)) (let ((var-list nil)) (catch 'child-already-watched (dolist (var gdb-var-list) - (if (string-equal varnum (cadr var)) + (if (string-equal varnum (car var)) (progn (push var var-list) (while (re-search-forward gdb-var-list-children-regexp-1 nil t) - (let ((varchild (list (match-string 2) - (match-string 1) + (let ((varchild (list (match-string 1) + (match-string 2) (match-string 3) - (match-string 5) + (match-string 7) (read (match-string 4)) nil))) - (dolist (var1 gdb-var-list) - (if (string-equal (cadr var1) (cadr varchild)) - (throw 'child-already-watched nil))) + (if (assoc (car varchild) gdb-var-list) + (throw 'child-already-watched nil)) (push varchild var-list)))) (push var var-list))) - (setq gdb-var-list (nreverse var-list))))) + (setq gdb-var-list (nreverse var-list)))) + (gdb-speedbar-update)) ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. (defun gdb-var-update-1 () @@ -3127,30 +3502,29 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") (push 'gdb-var-update gdb-pending-triggers)))) (defconst gdb-var-update-regexp-1 - "name=\"\\(.*?\\)\",\\(?:value=\\(\".*?\"\\),\\)?in_scope=\"\\(.*?\\)\"") + "{.*?name=\"\\(.*?\\)\",.*?\\(?:value=\\(\".*?\"\\),\\)?.*?\ +in_scope=\"\\(.*?\\)\".*?}") (defun gdb-var-update-handler-1 () (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)) (goto-char (point-min)) (while (re-search-forward gdb-var-update-regexp-1 nil t) - (let ((varnum (match-string 1))) - (catch 'var-found - (dolist (var gdb-var-list) - (when (string-equal varnum (cadr var)) - (if (string-equal (match-string 3) "false") - (setcar (nthcdr 5 var) 'out-of-scope) - (setcar (nthcdr 5 var) 'changed) - (setcar (nthcdr 4 var) - (read (match-string 2)))) - (throw 'var-found nil)))))) - (setq gdb-pending-triggers - (delq 'gdb-var-update gdb-pending-triggers)) - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - ;; dummy command to update speedbar at right time - (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-refresh)) - ;; keep gdb-pending-triggers non-nil till end - (push 'gdb-speedbar-refresh gdb-pending-triggers))) + (let* ((varnum (match-string 1)) + (var (assoc varnum gdb-var-list))) + (when var + (let ((match (match-string 3))) + (cond ((string-equal match "false") + (setcar (nthcdr 5 var) 'out-of-scope)) + ((string-equal match "true") + (setcar (nthcdr 5 var) 'changed) + (setcar (nthcdr 4 var) + (read (match-string 2)))) + ((string-equal match "invalid") + (gdb-var-delete-1 varnum))))))) + (setq gdb-pending-triggers + (delq 'gdb-var-update gdb-pending-triggers)) + (gdb-speedbar-update)) ;; Registers buffer. ;; @@ -3166,18 +3540,20 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") gdb-data-list-register-values-handler) (defconst gdb-data-list-register-values-regexp - "number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"") + "{.*?number=\"\\(.*?\\)\",.*?value=\"\\(.*?\\)\".*?}") (defun gdb-data-list-register-values-handler () (setq gdb-pending-triggers (delq 'gdb-invalidate-registers-1 gdb-pending-triggers)) (goto-char (point-min)) (if (re-search-forward gdb-error-regexp nil t) - (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert (match-string 1)) - (goto-char (point-min)))) + (let ((err (match-string 1))) + (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) + (let ((buffer-read-only nil)) + (erase-buffer) + (put-text-property 0 (length err) 'face font-lock-warning-face err) + (insert err) + (goto-char (point-min))))) (let ((register-list (reverse gdb-register-names)) (register nil) (register-string nil) (register-values nil)) (goto-char (point-min)) @@ -3215,7 +3591,7 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") (unless (string-equal (match-string 0) "No registers.") (put-text-property start (match-end 0) 'face font-lock-variable-name-face) - (add-text-properties start end + (add-text-properties start end '(help-echo "mouse-2: edit value" mouse-face highlight)))) (forward-line 1)))))) @@ -3259,49 +3635,85 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") gdb-stack-list-locals-handler) (defconst gdb-stack-list-locals-regexp - "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") + "{.*?name=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\"") (defvar gdb-locals-watch-map-1 (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gud-watch) (define-key map [mouse-2] 'gud-watch) map) "Keymap to create watch expression of a complex data type local variable.") +(defvar gdb-edit-locals-map-1 + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gdb-edit-locals-value) + (define-key map [mouse-2] 'gdb-edit-locals-value) + map) + "Keymap to edit value of a simple data type local variable.") + +(defun gdb-edit-locals-value (&optional event) + "Assign a value to a variable displayed in the locals buffer." + (interactive (list last-input-event)) + (save-excursion + (if event (posn-set-point (event-end event))) + (beginning-of-line) + (let* ((var (current-word)) + (value (read-string (format "New value (%s): " var)))) + (gdb-enqueue-input + (list (concat gdb-server-prefix"set variable " var " = " value "\n") + 'ignore))))) + ;; Dont display values of arrays or structures. ;; These can be expanded using gud-watch. (defun gdb-stack-list-locals-handler () (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1 gdb-pending-triggers)) - (let (local locals-list) - (goto-char (point-min)) - (while (re-search-forward gdb-stack-list-locals-regexp nil t) - (let ((local (list (match-string 1) - (match-string 2) - nil))) - (if (looking-at ",value=\\(\".*\"\\)}") - (setcar (nthcdr 2 local) (read (match-string 1)))) - (push local locals-list))) - (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) - (and buf (with-current-buffer buf - (let* ((window (get-buffer-window buf 0)) - (start (window-start window)) - (p (window-point window)) - (buffer-read-only nil)) - (erase-buffer) - (dolist (local locals-list) - (setq name (car local)) - (if (or (not (nth 2 local)) - (string-match "\\*$" (nth 1 local))) - (add-text-properties 0 (length name) - `(mouse-face highlight - help-echo "mouse-2: create watch expression" - local-map ,gdb-locals-watch-map-1) - name)) - (insert + (goto-char (point-min)) + (if (re-search-forward gdb-error-regexp nil t) + (let ((err (match-string 1))) + (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert err) + (goto-char (point-min))))) + (let (local locals-list) + (goto-char (point-min)) + (while (re-search-forward gdb-stack-list-locals-regexp nil t) + (let ((local (list (match-string 1) + (match-string 2) + nil))) + (if (looking-at ",value=\\(\".*\"\\).*?}") + (setcar (nthcdr 2 local) (read (match-string 1)))) + (push local locals-list))) + (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) + (and buf (with-current-buffer buf + (let* ((window (get-buffer-window buf 0)) + (start (window-start window)) + (p (window-point window)) + (buffer-read-only nil) (name) (value)) + (erase-buffer) + (dolist (local locals-list) + (setq name (car local)) + (setq value (nth 2 local)) + (if (or (not value) + (string-match "^\\0x" value)) + (add-text-properties 0 (length name) + `(mouse-face highlight + help-echo "mouse-2: create watch expression" + local-map ,gdb-locals-watch-map-1) + name) + (add-text-properties 0 (length value) + `(mouse-face highlight + help-echo "mouse-2: edit value" + local-map ,gdb-edit-locals-map-1) + value)) + (insert (concat name "\t" (nth 1 local) - "\t" (nth 2 local) "\n"))) - (set-window-start window start) - (set-window-point window p))))))) + "\t" value "\n"))) + (set-window-start window start) + (set-window-point window p)))))))) (defun gdb-get-register-names () "Create a list of register names."