diff options
Diffstat (limited to 'lisp/progmodes/gdb-mi.el')
| -rw-r--r-- | lisp/progmodes/gdb-mi.el | 1094 |
1 files changed, 702 insertions, 392 deletions
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index e785acd2840..6e9b6830a01 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -8,7 +8,7 @@ ;; This file is part of GNU Emacs. -;; Homepage: http://www.emacswiki.org/emacs/GDB-MI +;; Homepage: https://www.emacswiki.org/emacs/GDB-MI ;; 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 @@ -89,9 +89,9 @@ ;;; Code: (require 'gud) -(require 'json) -(require 'bindat) (require 'cl-lib) +(require 'cl-seq) +(eval-when-compile (require 'pcase)) (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) @@ -105,13 +105,24 @@ (defvar speedbar-initial-expansion-list-name) (defvar speedbar-frame) -(defvar gdb-memory-address "main") -(defvar gdb-memory-last-address nil +(defvar-local gdb-memory-address-expression "main" + "This expression is passed to gdb. +Possible value: main, $rsp, x+3.") +(defvar-local gdb-memory-address nil + "Address of memory display.") +(defvar-local gdb-memory-last-address nil "Last successfully accessed memory address.") (defvar gdb-memory-next-page nil "Address of next memory page for program memory buffer.") (defvar gdb-memory-prev-page nil "Address of previous memory page for program memory buffer.") +(defvar-local gdb--memory-display-warning nil + "Display warning on memory header if t. + +When error occurs when retrieving memory, gdb-mi displays the +last successful page. In that case the expression might not +match the memory displayed. We want to let the user be aware of +that, so display a warning exclamation mark in the header line.") (defvar gdb-thread-number nil "Main current thread. @@ -154,7 +165,7 @@ May be manually changed by user with `gdb-select-frame'.") "Associative list of threads provided by \"-thread-info\" MI command. Keys are thread numbers (in strings) and values are structures as -returned from -thread-info by `gdb-json-partial-output'. Updated in +returned from -thread-info by `gdb-mi--partial-output'. Updated in `gdb-thread-list-handler-custom'.") (defvar gdb-running-threads-count nil @@ -173,7 +184,7 @@ See also `gdb-running-threads-count'.") "Associative list of breakpoints provided by \"-break-list\" MI command. Keys are breakpoint numbers (in string) and values are structures -as returned from \"-break-list\" by `gdb-json-partial-output' +as returned from \"-break-list\" by `gdb-mi--partial-output' \(\"body\" field is used). Updated in `gdb-breakpoints-list-handler-custom'.") @@ -211,7 +222,9 @@ Only used for files that Emacs can't find.") (defvar gdb-source-file-list nil "List of source files for the current executable.") (defvar gdb-first-done-or-error t) -(defvar gdb-source-window nil) +(defvar gdb-source-window-list nil + "List of windows used for displaying source files. +Sorted in most-recently-visited-first order.") (defvar gdb-inferior-status nil) (defvar gdb-continuation nil) (defvar gdb-supports-non-stop nil) @@ -242,6 +255,27 @@ Possible values are these symbols: disposition of output generated by commands that gdb mode sends to gdb on its own behalf.") +(defvar gdb--window-configuration-before nil + "Stores the window configuration before starting GDB.") + +(defcustom gdb-restore-window-configuration-after-quit nil + "If non-nil, restore window configuration as of before GDB started. + +Possible values are: + t -- Always restore. + nil -- Don't restore. + `if-gdb-show-main' -- Restore only if variable `gdb-show-main' + is non-nil + `if-gdb-many-windows' -- Restore only if variable `gdb-many-windows' + is non-nil." + :type '(choice + (const :tag "Always restore" t) + (const :tag "Don't restore" nil) + (const :tag "Depends on `gdb-show-main'" 'if-gdb-show-main) + (const :tag "Depends on `gdb-many-windows'" 'if-gdb-many-windows)) + :group 'gdb + :version "28.1") + (defcustom gdb-discard-unordered-replies t "Non-nil means discard any out-of-order GDB replies. This protects against lost GDB replies, assuming that GDB always @@ -480,8 +514,6 @@ contains fields of corresponding MI *stopped async record: Note that \"reason\" is only present in non-stop debugging mode. -`bindat-get-field' may be used to access the fields of response. - Each function is called after the new current thread was selected and GDB buffers were updated in `gdb-stopped'." :type '(repeat function) @@ -592,6 +624,41 @@ Also display the main routine in the disassembly buffer if present." :group 'gdb :version "22.1") +(defcustom gdb-window-configuration-directory user-emacs-directory + "Directory where GDB window configuration files are stored. +If nil, use `default-directory'." + :type 'string + :group 'gdb + :version "28.1") + +(defcustom gdb-default-window-configuration-file nil + "If non-nil, load this window configuration (layout) on startup. +This should be the full name of the window configuration file. +If this is not an absolute path, GDB treats it as a relative path +and looks under `gdb-window-configuration-directory'. + +Note that this variable only takes effect when variable +`gdb-many-windows' is t." + :type '(choice (const :tag "None" nil) + string) + :group 'gdb + :version "28.1") + +(defcustom gdb-display-source-buffer-action '(nil . ((inhibit-same-window . t))) + "`display-buffer' action used when GDB displays a source buffer." + :type 'sexp + :group 'gdb + :version "28.1") + +(defcustom gdb-max-source-window-count 1 + "Maximum number of source windows to use. +Until there are such number of source windows on screen, GDB +tries to open a new window when visiting a new source file; after +that GDB starts to reuse existing source windows." + :type 'number + :group 'gdb + :version "28.1") + (defvar gdbmi-debug-mode nil "When non-nil, print the messages sent/received from GDB/MI in *Messages*.") @@ -669,8 +736,10 @@ NOARG must be t when this macro is used outside `gud-def'." (unless (zerop (length string)) (remove-function (process-filter proc) #'gdb--check-interpreter) (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=)) - ;; Apparently we're not running with -i=mi. - (let ((msg "Error: you did not specify -i=mi on GDB's command line!")) + ;; Apparently we're not running with -i=mi (or we're, for + ;; instance, debugging something inside a Docker instance with + ;; Emacs on the outside). + (let ((msg "Error: Either -i=mi wasn't specified on the GDB command line, or the extra socket couldn't be established. Consider using `M-x gud-gdb' instead.")) (message msg) (setq string (concat (propertize msg 'font-lock-face 'error) "\n" string))) @@ -750,6 +819,12 @@ detailed description of this mode. (gdb-restore-windows) (error "Multiple debugging requires restarting in text command mode")) + + ;; Save window configuration before starting gdb so we can restore + ;; it after gdb quits. Save it regardless of the value of + ;; `gdb-restore-window-configuration-after-quit'. + (setq gdb--window-configuration-before (window-state-get)) + ;; (gud-common-init command-line nil 'gud-gdbmi-marker-filter) @@ -925,7 +1000,7 @@ detailed description of this mode. gdb-first-done-or-error t gdb-buffer-fringe-width (car (window-fringes)) gdb-debug-log nil - gdb-source-window nil + gdb-source-window-list nil gdb-inferior-status nil gdb-continuation nil gdb-buf-publisher '() @@ -1035,7 +1110,10 @@ no input, and GDB is waiting for input." (declare-function tooltip-show "tooltip" (text &optional use-echo-area)) -(defconst gdb--string-regexp "\"\\(?:[^\\\"]\\|\\\\.\\)*\"") +(defconst gdb--string-regexp (rx "\"" + (* (or (seq "\\" nonl) + (not (any "\"\\")))) + "\"")) (defun gdb-tooltip-print (expr) (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) @@ -1045,11 +1123,11 @@ no input, and GDB is waiting for input." "\\)") nil t) (tooltip-show - (concat expr " = " (read (match-string 1))) + (concat expr " = " (gdb-mi--c-string-from-string (match-string 1))) (or gud-tooltip-echo-area (not (display-graphic-p))))) ((re-search-forward "msg=\\(\".+\"\\)$" nil t) - (tooltip-show (read (match-string 1)) + (tooltip-show (gdb-mi--c-string-from-string (match-string 1)) (or gud-tooltip-echo-area (not (display-graphic-p)))))))) @@ -1062,7 +1140,7 @@ no input, and GDB is waiting for input." (if (search-forward "expands to: " nil t) (unless (looking-at "\\S-+.*(.*).*") (gdb-input (concat "-data-evaluate-expression \"" expr "\"") - `(lambda () (gdb-tooltip-print ,expr))))))) + (lambda () (gdb-tooltip-print expr))))))) (defun gdb-init-buffer () (set (make-local-variable 'gud-minor-mode) 'gdbmi) @@ -1182,23 +1260,26 @@ With arg, enter name of variable to be watched in the minibuffer." (tooltip-identifier-from-point (point))))))) (set-text-properties 0 (length expr) nil expr) (gdb-input (concat "-var-create - * " expr "") - `(lambda () (gdb-var-create-handler ,expr)))))) + (lambda () (gdb-var-create-handler expr)))))) (message "gud-watch is a no-op in this mode.")))) +(defsubst gdb-mi--field (value field) + (cdr (assq field value))) + (defun gdb-var-create-handler (expr) - (let* ((result (gdb-json-partial-output))) - (if (not (bindat-get-field result 'msg)) + (let* ((result (gdb-mi--partial-output))) + (if (not (gdb-mi--field result 'msg)) (let ((var - (list (bindat-get-field result 'name) + (list (gdb-mi--field result 'name) (if (and (string-equal gdb-current-language "c") gdb-use-colon-colon-notation gdb-selected-frame) (setq expr (concat gdb-selected-frame "::" expr)) expr) - (bindat-get-field result 'numchild) - (bindat-get-field result 'type) - (bindat-get-field result 'value) + (gdb-mi--field result 'numchild) + (gdb-mi--field result 'type) + (gdb-mi--field result 'value) nil - (bindat-get-field result 'has_more) + (gdb-mi--field result 'has_more) gdb-frame-address))) (push var gdb-var-list) (speedbar 1) @@ -1219,41 +1300,31 @@ With arg, enter name of variable to be watched in the minibuffer." (raise-frame speedbar-frame)) (speedbar-timer-fn)) -(defun gdb-var-evaluate-expression-handler (varnum changed) - (goto-char (point-min)) - (re-search-forward (concat ".*value=\\(" gdb--string-regexp "\\)") - nil t) - (let ((var (assoc varnum gdb-var-list))) - (when var - (if changed (setcar (nthcdr 5 var) 'changed)) - (setcar (nthcdr 4 var) (read (match-string 1))))) - (gdb-speedbar-update)) - ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. (defun gdb-var-list-children (varnum) (gdb-input (concat "-var-update " varnum) 'ignore) (gdb-input (concat "-var-list-children --all-values " varnum) - `(lambda () (gdb-var-list-children-handler ,varnum)))) + (lambda () (gdb-var-list-children-handler varnum)))) (defun gdb-var-list-children-handler (varnum) (let* ((var-list nil) - (output (bindat-get-field (gdb-json-partial-output "child"))) - (children (bindat-get-field output 'children))) + (output (gdb-mi--partial-output 'child)) + (children (gdb-mi--field output 'children))) (catch 'child-already-watched (dolist (var gdb-var-list) (if (string-equal varnum (car var)) (progn ;; With dynamic varobjs numchild may have increased. - (setcar (nthcdr 2 var) (bindat-get-field output 'numchild)) + (setcar (nthcdr 2 var) (gdb-mi--field output 'numchild)) (push var var-list) (dolist (child children) - (let ((varchild (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) + (let ((varchild (list (gdb-mi--field child 'name) + (gdb-mi--field child 'exp) + (gdb-mi--field child 'numchild) + (gdb-mi--field child 'type) + (gdb-mi--field child 'value) nil - (bindat-get-field child 'has_more)))) + (gdb-mi--field child 'has_more)))) (if (assoc (car varchild) gdb-var-list) (throw 'child-already-watched nil)) (push varchild var-list)))) @@ -1296,7 +1367,7 @@ With arg, enter name of variable to be watched in the minibuffer." (varnum (car var)) (value (read-string "New value: "))) (gdb-input (concat "-var-assign " varnum " " value) - `(lambda () (gdb-edit-value-handler ,value))))) + (lambda () (gdb-edit-value-handler value))))) (defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)") @@ -1312,17 +1383,17 @@ With arg, enter name of variable to be watched in the minibuffer." 'gdb-var-update)) (defun gdb-var-update-handler () - (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) + (let ((changelist (gdb-mi--field (gdb-mi--partial-output) 'changelist))) (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)) (let ((temp-var-list gdb-var-list)) (dolist (change changelist) - (let* ((varnum (bindat-get-field change 'name)) + (let* ((varnum (gdb-mi--field change 'name)) (var (assoc varnum gdb-var-list)) - (new-num (bindat-get-field change 'new_num_children))) + (new-num (gdb-mi--field change 'new_num_children))) (when var - (let ((scope (bindat-get-field change 'in_scope)) - (has-more (bindat-get-field change 'has_more))) + (let ((scope (gdb-mi--field change 'in_scope)) + (has-more (gdb-mi--field change 'has_more))) (cond ((string-equal scope "false") (if gdb-delete-out-of-scope (gdb-var-delete-1 var varnum) @@ -1334,12 +1405,12 @@ With arg, enter name of variable to be watched in the minibuffer." (not new-num) (string-equal (nth 2 var) "0")) (setcar (nthcdr 4 var) - (bindat-get-field change 'value)) + (gdb-mi--field change 'value)) (setcar (nthcdr 5 var) 'changed))) ((string-equal scope "invalid") (gdb-var-delete-1 var varnum))))) (let ((var-list nil) var1 - (children (bindat-get-field change 'new_children))) + (children (gdb-mi--field change 'new_children))) (when new-num (setq var1 (pop temp-var-list)) (while var1 @@ -1355,13 +1426,13 @@ With arg, enter name of variable to be watched in the minibuffer." (push (pop temp-var-list) var-list)) (dolist (child children) (let ((varchild - (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) + (list (gdb-mi--field child 'name) + (gdb-mi--field child 'exp) + (gdb-mi--field child 'numchild) + (gdb-mi--field child 'type) + (gdb-mi--field child 'value) 'changed - (bindat-get-field child 'has_more)))) + (gdb-mi--field child 'has_more)))) (push varchild var-list)))) ;; Remove deleted children from list. ((< new previous) @@ -1442,7 +1513,7 @@ thread." (defun gdb-current-buffer-frame () "Get current stack frame object for thread of current buffer." - (bindat-get-field (gdb-current-buffer-thread) 'frame)) + (gdb-mi--field (gdb-current-buffer-thread) 'frame)) (defun gdb-buffer-type (buffer) "Get value of `gdb-buffer-type' for BUFFER." @@ -1504,9 +1575,9 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (defun gdb-bind-function-to-buffer (expr buffer) "Return a function which will evaluate EXPR in BUFFER." - `(lambda (&rest args) - (with-current-buffer ,buffer - (apply ',expr args)))) + (lambda (&rest args) + (with-current-buffer buffer + (apply expr args)))) ;; Used to display windows with thread-bound buffers (defmacro def-gdb-preempt-display-buffer (name buffer &optional doc @@ -1667,25 +1738,25 @@ this trigger is subscribed to `gdb-buf-publisher' and called with "Interrupt the program being debugged." (interactive) (interrupt-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) + (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) (defun gdb-io-quit () "Send quit signal to the program being debugged." (interactive) (quit-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) + (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) (defun gdb-io-stop () "Stop the program being debugged." (interactive) (stop-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) + (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) (defun gdb-io-eof () "Send end-of-file to the program being debugged." (interactive) (process-send-eof - (get-buffer-process gud-comint-buffer))) + (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)))) (defun gdb-clear-inferior-io () (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) @@ -1788,7 +1859,8 @@ static char *magick[] = { "\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|" gdb-python-guile-commands-regexp "\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions" - "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)?$") + "\\|expl\\(o\\(re?\\)?\\)?" + "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)*$") "Regexp matching GDB commands that enter a recursive reading loop. As long as GDB is in the recursive reading loop, it does not expect commands to be prefixed by \"-interpreter-exec console\".") @@ -1976,7 +2048,7 @@ For all-stop mode, thread information is unavailable while target is running." (let ((old-value gud-running)) (setq gud-running - (string= (bindat-get-field (gdb-current-buffer-thread) 'state) + (string= (gdb-mi--field (gdb-current-buffer-thread) 'state) "running")) ;; Set frame number to "0" when _current_ threads stops. (when (and (gdb-current-buffer-thread) @@ -2007,17 +2079,36 @@ is running." ;; GDB frame (after up, down etc). If no GDB frame is visible but the last ;; visited breakpoint is, use that window. (defun gdb-display-source-buffer (buffer) - (let* ((last-window (if gud-last-last-frame - (get-buffer-window - (gud-find-file (car gud-last-last-frame))))) - (source-window (or last-window - (if (and gdb-source-window - (window-live-p gdb-source-window)) - gdb-source-window)))) - (when source-window - (setq gdb-source-window source-window) - (set-window-buffer source-window buffer)) - source-window)) + "Find a window to display BUFFER. +Always find a window to display buffer, and return it." + ;; This function doesn't take care of setting up source window(s) at startup, + ;; that's handled by `gdb-setup-windows' (if `gdb-many-windows' is non-nil). + ;; If `buffer' is already shown in a window, use that window. + (or (get-buffer-window buffer) + (progn + ;; First, update the window list. + (setq gdb-source-window-list + (cl-remove-duplicates + (cl-remove-if-not + (lambda (win) + (and (window-live-p win) + (eq (window-frame win) + (selected-frame)))) + gdb-source-window-list))) + ;; Should we create a new window or reuse one? + (if (> gdb-max-source-window-count + (length gdb-source-window-list)) + ;; Create a new window, push it to window list and return it. + (car (push (display-buffer buffer gdb-display-source-buffer-action) + gdb-source-window-list)) + ;; Reuse a window, we use the oldest window and put that to + ;; the front of the window list. + (let ((last-win (car (last gdb-source-window-list))) + (rest (butlast gdb-source-window-list))) + (set-window-buffer last-win buffer) + (setq gdb-source-window-list + (cons last-win rest)) + last-win))))) (defun gdbmi-start-with (str offset match) @@ -2214,7 +2305,8 @@ a GDB/MI reply message." ;; Suppress "No registers." GDB 6.8 and earlier ;; duplicates MI error message on internal stream. ;; Don't print to GUD buffer. - (if (not (string-equal (read c-string) "No registers.\n")) + (if (not (string-equal (gdb-mi--c-string-from-string c-string) + "No registers.\n")) (gdb-internals c-string))) @@ -2336,7 +2428,7 @@ the end of the current result or async record is reached." is-complete))) -; The following grammar rules are not yet implemented by this GDBMI-BNF parser. +; The following grammar rules are not parsed directly by this GDBMI-BNF parser. ; The handling of those rules is currently done by the handlers registered ; in gdbmi-bnf-result-state-configs ; @@ -2358,19 +2450,17 @@ the end of the current result or async record is reached." ; list ==> ; "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]" -(defcustom gdb-mi-decode-strings nil +;; FIXME: This is fragile: it relies on the assumption that all the +;; non-ASCII strings output by GDB, including names of the source +;; files, values of string variables in the inferior, etc., are all +;; encoded in the same encoding. + +(defcustom gdb-mi-decode-strings t "When non-nil, decode octal escapes in GDB output into non-ASCII text. If the value is a coding-system, use that coding-system to decode the bytes reconstructed from octal escapes. Any other non-nil value -means to decode using the coding-system set for the GDB process. - -Warning: setting this non-nil might mangle strings reported by GDB -that have literal substrings which match the \\nnn octal escape -patterns, where nnn is an octal number between 200 and 377. So -we only recommend to set this variable non-nil if the program you -are debugging really reports non-ASCII text, or some of its source -file names include non-ASCII characters." +means to decode using the coding-system set for the GDB process." :type '(choice (const :tag "Don't decode" nil) (const :tag "Decode using default coding-system" t) @@ -2378,47 +2468,9 @@ file names include non-ASCII characters." :group 'gdb :version "25.1") -;; The idea of the following function was suggested -;; by Kenichi Handa <handa@gnu.org>. -;; -;; FIXME: This is fragile: it relies on the assumption that all the -;; non-ASCII strings output by GDB, including names of the source -;; files, values of string variables in the inferior, etc., are all -;; encoded in the same encoding. It also assumes that the \nnn -;; sequences are not split between chunks of output of the GDB process -;; due to buffering, and arrive together. Finally, if some string -;; included literal \nnn strings (as opposed to non-ASCII characters -;; converted by GDB/MI to octal escapes), this decoding will mangle -;; those strings. When/if GDB acquires the ability to not -;; escape-protect non-ASCII characters in its MI output, this kludge -;; should be removed. -(defun gdb-mi-decode (string) - "Decode octal escapes in MI output STRING into multibyte text." - (let ((coding - (if (coding-system-p gdb-mi-decode-strings) - gdb-mi-decode-strings - (with-current-buffer - (gdb-get-buffer-create 'gdb-partial-output-buffer) - buffer-file-coding-system)))) - (with-temp-buffer - (set-buffer-multibyte nil) - (prin1 string (current-buffer)) - (goto-char (point-min)) - ;; prin1 quotes the octal escapes as well, which interferes with - ;; their interpretation by 'read' below. Remove the extra - ;; backslashes to countermand that. - (while (re-search-forward "\\\\\\(\\\\[2-3][0-7][0-7]\\)" nil t) - (replace-match "\\1" nil nil)) - (goto-char (point-min)) - (decode-coding-string (read (current-buffer)) coding)))) - (defun gud-gdbmi-marker-filter (string) "Filter GDB/MI output." - ;; If required, decode non-ASCII text encoded with octal escapes. - (or (null gdb-mi-decode-strings) - (setq string (gdb-mi-decode string))) - ;; Record transactions if logging is enabled. (when gdb-enable-debug (push (cons 'recv string) gdb-debug-log) @@ -2446,7 +2498,13 @@ file names include non-ASCII characters." gdb-filter-output) -(defun gdb-gdb (_output-field)) +(defun gdb-gdb (_output-field) + ;; This is needed because the "explore" command is not ended by the + ;; likes of "end" or "quit", but instead by a RET at the appropriate + ;; place, and we know we have exited "explore" when we get the + ;; "(gdb)" prompt. + (and (> gdb-control-level 0) + (setq gdb-control-level (1- gdb-control-level)))) (defun gdb-shell (output-field) (setq gdb-filter-output @@ -2459,7 +2517,7 @@ file names include non-ASCII characters." (defun gdb-thread-exited (_token output-field) "Handle =thread-exited async record. Unset `gdb-thread-number' if current thread exited and update threads list." - (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id))) + (let* ((thread-id (gdb-mi--field (gdb-mi--from-string output-field) 'id))) (if (string= gdb-thread-number thread-id) (gdb-setq-thread-number nil)) ;; When we continue current thread and it quickly exits, @@ -2473,8 +2531,8 @@ Unset `gdb-thread-number' if current thread exited and update threads list." "Handler for =thread-selected MI output record. Sets `gdb-thread-number' to new id." - (let* ((result (gdb-json-string output-field)) - (thread-id (bindat-get-field result 'id))) + (let* ((result (gdb-mi--from-string output-field)) + (thread-id (gdb-mi--field result 'id))) (gdb-setq-thread-number thread-id) ;; Typing `thread N' in GUD buffer makes GDB emit `^done' followed ;; by `=thread-selected' notification. `^done' causes `gdb-update' @@ -2489,7 +2547,7 @@ Sets `gdb-thread-number' to new id." (defun gdb-running (_token output-field) (let* ((thread-id - (bindat-get-field (gdb-json-string output-field) 'thread-id))) + (gdb-mi--field (gdb-mi--from-string output-field) 'thread-id))) ;; We reset gdb-frame-number to nil if current thread has gone ;; running. This can't be done in gdb-thread-list-handler-custom ;; because we need correct gdb-frame-number by the time @@ -2518,11 +2576,11 @@ Sets `gdb-thread-number' to new id." "Given the contents of *stopped MI async record, select new current thread and update GDB buffers." ;; Reason is available with target-async only - (let* ((result (gdb-json-string output-field)) - (reason (bindat-get-field result 'reason)) - (thread-id (bindat-get-field result 'thread-id)) - (retval (bindat-get-field result 'return-value)) - (varnum (bindat-get-field result 'gdb-result-var))) + (let* ((result (gdb-mi--from-string output-field)) + (reason (gdb-mi--field result 'reason)) + (thread-id (gdb-mi--field result 'thread-id)) + (retval (gdb-mi--field result 'return-value)) + (varnum (gdb-mi--field result 'gdb-result-var))) ;; -data-list-register-names needs to be issued for any stopped ;; thread @@ -2565,7 +2623,7 @@ current thread and update GDB buffers." ;; gdb-switch-when-another-stopped: (when (or gdb-switch-when-another-stopped (not (string= "stopped" - (bindat-get-field (gdb-current-buffer-thread) 'state)))) + (gdb-mi--field (gdb-current-buffer-thread) 'state)))) ;; Switch if current reason has been selected or we have no ;; reasons (if (or (eq gdb-switch-reasons t) @@ -2598,7 +2656,7 @@ current thread and update GDB buffers." (if (string= output-field "\"\\n\"") "" (let ((error-message - (read output-field))) + (gdb-mi--c-string-from-string output-field))) (put-text-property 0 (length error-message) 'face font-lock-warning-face @@ -2609,7 +2667,8 @@ current thread and update GDB buffers." ;; (frontend MI commands should not print to this stream) (defun gdb-console (output-field) (setq gdb-filter-output - (gdb-concat-output gdb-filter-output (read output-field)))) + (gdb-concat-output gdb-filter-output + (gdb-mi--c-string-from-string output-field)))) (defun gdb-done (token-number output-field is-complete) (gdb-done-or-error token-number 'done output-field is-complete)) @@ -2626,7 +2685,8 @@ current thread and update GDB buffers." ;; MI error - send to minibuffer (when (eq type 'error) ;; Skip "msg=" from `output-field' - (message "%s" (read (substring output-field 4))) + (message "%s" (gdb-mi--c-string-from-string + (substring output-field 4))) ;; Don't send to the console twice. (If it is a console error ;; it is also in the console stream.) (setq output-field nil))) @@ -2674,83 +2734,154 @@ current thread and update GDB buffers." (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) (erase-buffer))) -(defun gdb-jsonify-buffer (&optional fix-key fix-list) - "Prepare GDB/MI output in current buffer for parsing with `json-read'. - -Field names are wrapped in double quotes and equal signs are -replaced with semicolons. - -If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from -partial output. This is used to get rid of useless keys in lists -in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and --break-info are examples of MI commands which issue such -responses. - -If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with -\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken --break-info output when it contains breakpoint script field -incompatible with GDB/MI output syntax. +;; Parse GDB/MI result records: this process converts +;; list [...] -> list +;; tuple {...} -> list +;; result KEY=VALUE -> (KEY . VALUE) where KEY is a symbol +;; c-string "..." -> string + +(defun gdb-mi--parse-tuple-or-list (end-char) + "Parse a tuple or list, either returned as a Lisp list. +END-CHAR is the ending delimiter; will stop at end-of-buffer otherwise." + (let ((items nil)) + (while (not (or (eobp) + (eq (following-char) end-char))) + (let ((item (gdb-mi--parse-result-or-value))) + (push item items) + (when (eq (following-char) ?,) + (forward-char)))) + (when (eq (following-char) end-char) + (forward-char)) + (nreverse items))) + +(defun gdb-mi--parse-c-string () + "Parse a c-string." + (let ((start (point)) + (pieces nil) + (octals-used nil)) + (while (and (re-search-forward (rx (or ?\\ ?\"))) + (not (eq (preceding-char) ?\"))) + (push (buffer-substring start (1- (point))) pieces) + (cond + ((looking-at (rx (any "0-7") (? (any "0-7") (? (any "0-7"))))) + (push (unibyte-string (string-to-number (match-string 0) 8)) pieces) + (setq octals-used t) + (goto-char (match-end 0))) + ((looking-at (rx (any "ntrvfab\"\\"))) + (push (cdr (assq (following-char) + '((?n . "\n") + (?t . "\t") + (?r . "\r") + (?v . "\v") + (?f . "\f") + (?a . "\a") + (?b . "\b") + (?\" . "\"") + (?\\ . "\\")))) + pieces) + (forward-char)) + (t + (warn "Unrecognised escape char: %c" (following-char)))) + (setq start (point))) + (push (buffer-substring start (1- (point))) pieces) + (let ((s (apply #'concat (nreverse pieces)))) + (if (and octals-used gdb-mi-decode-strings) + (let ((coding + (if (coding-system-p gdb-mi-decode-strings) + gdb-mi-decode-strings + (buffer-local-value + 'buffer-file-coding-system + ;; FIXME: This is somewhat expensive. + (gdb-get-buffer-create 'gdb-partial-output-buffer))))) + (decode-coding-string s coding)) + s)))) + +;; FIXME: Ideally this function should not be needed. +(defun gdb-mi--c-string-from-string (string) + "Parse a c-string from (the beginning of) STRING." + (with-temp-buffer + (insert string) + (goto-char (1+ (point-min))) ; Skip leading double quote. + (gdb-mi--parse-c-string))) -If `default-directory' is remote, full file names are adapted accordingly." - (save-excursion +(defun gdb-mi--parse-value () + "Parse a value." + (cond + ((eq (following-char) ?\{) + (forward-char) + (gdb-mi--parse-tuple-or-list ?\})) + ((eq (following-char) ?\[) + (forward-char) + (gdb-mi--parse-tuple-or-list ?\])) + ((eq (following-char) ?\") + (forward-char) + (gdb-mi--parse-c-string)) + (t (error "Bad start of result or value: %c" (following-char))))) + +(defun gdb-mi--parse-result-or-value () + "Parse a result (key=value) or value." + (if (looking-at (rx (group (+ (any "a-zA-Z" ?_ ?-))) "=")) + (progn + (goto-char (match-end 0)) + (let* ((variable (intern (match-string 1))) + (value (gdb-mi--parse-value))) + (cons variable value))) + (gdb-mi--parse-value))) + +(defun gdb-mi--parse-results () + "Parse zero or more result productions as a list." + (gdb-mi--parse-tuple-or-list nil)) + +(defun gdb-mi--fix-key (key value) + "Convert any result (key-value pair) in VALUE whose key is KEY to its value." + (cond + ((atom value) value) + ((symbolp (car value)) + (if (eq (car value) key) + (cdr value) + (cons (car value) (gdb-mi--fix-key key (cdr value))))) + (t (mapcar (lambda (x) (gdb-mi--fix-key key x)) value)))) + +(defun gdb-mi--extend-fullname (remote value) + "Prepend REMOTE to any result string with `fullname' as the key in VALUE." + (cond + ((atom value) value) + ((symbolp (car value)) + (if (and (eq (car value) 'fullname) + (stringp (cdr value))) + (cons 'fullname (concat remote (cdr value))) + (cons (car value) (gdb-mi--extend-fullname remote (cdr value))))) + (t (mapcar (lambda (x) (gdb-mi--extend-fullname remote x)) value)))) + +(defun gdb-mi--read-buffer (fix-key) + "Parse the current buffer as a list of result productions. +If FIX-KEY is a non-nil symbol, convert all FIX-KEY=VALUE results into VALUE. +This is used to get rid of useless keys in lists in MI messages; +eg, [key=.., key=..]. -stack-list-frames and -break-info are +examples of MI commands which issue such responses." + (goto-char (point-min)) + (let ((results (gdb-mi--parse-results))) (let ((remote (file-remote-p default-directory))) (when remote - (goto-char (point-min)) - (while (re-search-forward "[\\[,]fullname=\"\\(.+\\)\"" nil t) - (replace-match (concat remote "\\1") nil nil nil 1)))) - (goto-char (point-min)) + (setq results (gdb-mi--extend-fullname remote results)))) (when fix-key - (save-excursion - (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t) - (replace-match "" nil nil nil 1)))) - (when fix-list - (save-excursion - ;; Find positions of braces which enclose broken list - (while (re-search-forward (concat fix-list "={\"") nil t) - (let ((p1 (goto-char (- (point) 2))) - (p2 (progn (forward-sexp) - (1- (point))))) - ;; Replace braces with brackets - (save-excursion - (goto-char p1) - (delete-char 1) - (insert "[") - (goto-char p2) - (delete-char 1) - (insert "]")))))) - (goto-char (point-min)) - (insert "{") - (let ((re (concat "\\([[:alnum:]_-]+\\)="))) - (while (re-search-forward re nil t) - (replace-match "\"\\1\":" nil nil) - (if (eq (char-after) ?\") (forward-sexp) (forward-char)))) - (goto-char (point-max)) - (insert "}"))) + (setq results (gdb-mi--fix-key fix-key results))) + results)) -(defun gdb-json-read-buffer (&optional fix-key fix-list) - "Prepare and parse GDB/MI output in current buffer with `json-read'. +(defun gdb-mi--from-string (string &optional fix-key) + "Prepare and parse STRING containing GDB/MI output. -FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." - (gdb-jsonify-buffer fix-key fix-list) - (save-excursion - (goto-char (point-min)) - (let ((json-array-type 'list)) - (json-read)))) - -(defun gdb-json-string (string &optional fix-key fix-list) - "Prepare and parse STRING containing GDB/MI output with `json-read'. - -FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." +FIX-KEY works as in `gdb-mi--read-buffer'." (with-temp-buffer (insert string) - (gdb-json-read-buffer fix-key fix-list))) + (gdb-mi--read-buffer fix-key))) -(defun gdb-json-partial-output (&optional fix-key fix-list) - "Prepare and parse gdb-partial-output-buffer with `json-read'. +(defun gdb-mi--partial-output (&optional fix-key) + "Prepare and parse gdb-partial-output-buffer. -FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'." +FIX-KEY works as in `gdb-mi--read-buffer'." (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (gdb-json-read-buffer fix-key fix-list))) + (gdb-mi--read-buffer fix-key))) (defun gdb-line-posns (line) "Return a pair of LINE beginning and end positions." @@ -2831,14 +2962,6 @@ calling `gdb-table-string'." (gdb-table-row-properties table)) "\n"))) -;; bindat-get-field goes deep, gdb-get-many-fields goes wide -(defun gdb-get-many-fields (struct &rest fields) - "Return a list of FIELDS values from STRUCT." - (let ((values)) - (dolist (field fields) - (push (bindat-get-field struct field) values)) - (nreverse values))) - (defmacro def-gdb-auto-update-trigger (trigger-name gdb-command handler-name &optional signal-list) @@ -2926,26 +3049,27 @@ See `def-gdb-auto-update-handler'." 'gdb-invalidate-breakpoints) (defun gdb-breakpoints-list-handler-custom () - (let ((breakpoints-list (bindat-get-field - (gdb-json-partial-output "bkpt" "script") - 'BreakpointTable 'body)) + (let ((breakpoints-list (gdb-mi--field + (gdb-mi--field (gdb-mi--partial-output 'bkpt) + 'BreakpointTable) + 'body)) (table (make-gdb-table))) (setq gdb-breakpoints-list nil) (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Addr" "Hits" "What")) (dolist (breakpoint breakpoints-list) (add-to-list 'gdb-breakpoints-list - (cons (bindat-get-field breakpoint 'number) + (cons (gdb-mi--field breakpoint 'number) breakpoint)) - (let ((at (bindat-get-field breakpoint 'at)) - (pending (bindat-get-field breakpoint 'pending)) - (func (bindat-get-field breakpoint 'func)) - (type (bindat-get-field breakpoint 'type))) + (let ((at (gdb-mi--field breakpoint 'at)) + (pending (gdb-mi--field breakpoint 'pending)) + (func (gdb-mi--field breakpoint 'func)) + (type (gdb-mi--field breakpoint 'type))) (gdb-table-add-row table (list - (bindat-get-field breakpoint 'number) + (gdb-mi--field breakpoint 'number) (or type "") - (or (bindat-get-field breakpoint 'disp) "") - (let ((flag (bindat-get-field breakpoint 'enabled))) + (or (gdb-mi--field breakpoint 'disp) "") + (let ((flag (gdb-mi--field breakpoint 'enabled))) (if (string-equal flag "y") (eval-when-compile (propertize "y" 'font-lock-face @@ -2953,10 +3077,10 @@ See `def-gdb-auto-update-handler'." (eval-when-compile (propertize "n" 'font-lock-face font-lock-comment-face)))) - (bindat-get-field breakpoint 'addr) - (or (bindat-get-field breakpoint 'times) "") + (gdb-mi--field breakpoint 'addr) + (or (gdb-mi--field breakpoint 'times) "") (if (and type (string-match ".*watchpoint" type)) - (bindat-get-field breakpoint 'what) + (gdb-mi--field breakpoint 'what) (or pending at (concat "in " (propertize (or func "unknown") @@ -2981,11 +3105,11 @@ See `def-gdb-auto-update-handler'." (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is ; an associative list - (line (bindat-get-field breakpoint 'line))) + (line (gdb-mi--field breakpoint 'line))) (when line - (let ((file (bindat-get-field breakpoint 'fullname)) - (flag (bindat-get-field breakpoint 'enabled)) - (bptno (bindat-get-field breakpoint 'number))) + (let ((file (gdb-mi--field breakpoint 'fullname)) + (flag (gdb-mi--field breakpoint 'enabled)) + (bptno (gdb-mi--field breakpoint 'number))) (unless (and file (file-exists-p file)) (setq file (cdr (assoc bptno gdb-location-alist)))) (if (or (null file) @@ -2993,11 +3117,11 @@ See `def-gdb-auto-update-handler'." ;; If the full filename is not recorded in the ;; breakpoint structure or in `gdb-location-alist', use ;; -file-list-exec-source-file to extract it. - (when (setq file (bindat-get-field breakpoint 'file)) + (when (setq file (gdb-mi--field breakpoint 'file)) (gdb-input (concat "list " file ":1") 'ignore) (gdb-input "-file-list-exec-source-file" - `(lambda () (gdb-get-location - ,bptno ,line ,flag)))) + (lambda () (gdb-get-location + bptno line flag)))) (with-current-buffer (find-file-noselect file 'nowarn) (gdb-init-buffer) ;; Only want one breakpoint icon at each location. @@ -3249,7 +3373,7 @@ corresponding to the mode line clicked." 'gdb-invalidate-threads) (defun gdb-thread-list-handler-custom () - (let ((threads-list (bindat-get-field (gdb-json-partial-output) 'threads)) + (let ((threads-list (gdb-mi--field (gdb-mi--partial-output) 'threads)) (table (make-gdb-table)) (marked-line nil)) (setq gdb-threads-list nil) @@ -3258,9 +3382,9 @@ corresponding to the mode line clicked." (set-marker gdb-thread-position nil) (dolist (thread (reverse threads-list)) - (let ((running (equal (bindat-get-field thread 'state) "running"))) + (let ((running (equal (gdb-mi--field thread 'state) "running"))) (add-to-list 'gdb-threads-list - (cons (bindat-get-field thread 'id) + (cons (gdb-mi--field thread 'id) thread)) (cl-incf (if running gdb-running-threads-count @@ -3269,37 +3393,41 @@ corresponding to the mode line clicked." (gdb-table-add-row table (list - (bindat-get-field thread 'id) + (gdb-mi--field thread 'id) (concat (if gdb-thread-buffer-verbose-names - (concat (bindat-get-field thread 'target-id) " ") "") - (bindat-get-field thread 'state) + (concat (gdb-mi--field thread 'target-id) " ") "") + (gdb-mi--field thread 'state) ;; Include frame information for stopped threads (if (not running) (concat - " in " (bindat-get-field thread 'frame 'func) + " in " (gdb-mi--field (gdb-mi--field thread 'frame) 'func) (if gdb-thread-buffer-arguments (concat " (" - (let ((args (bindat-get-field thread 'frame 'args))) + (let ((args (gdb-mi--field (gdb-mi--field thread 'frame) + 'args))) (mapconcat (lambda (arg) - (apply #'format "%s=%s" - (gdb-get-many-fields arg 'name 'value))) + (format "%s=%s" + (gdb-mi--field arg 'name) + (gdb-mi--field arg 'value))) args ",")) ")") "") (if gdb-thread-buffer-locations - (gdb-frame-location (bindat-get-field thread 'frame)) "") + (gdb-frame-location (gdb-mi--field thread 'frame)) "") (if gdb-thread-buffer-addresses - (concat " at " (bindat-get-field thread 'frame 'addr)) "")) + (concat " at " (gdb-mi--field (gdb-mi--field thread 'frame) + 'addr)) + "")) ""))) (list 'gdb-thread thread 'mouse-face 'highlight 'help-echo "mouse-2, RET: select thread"))) (when (string-equal gdb-thread-number - (bindat-get-field thread 'id)) + (gdb-mi--field thread 'id)) (setq marked-line (length gdb-threads-list)))) (insert (gdb-table-string table " ")) (when marked-line @@ -3331,11 +3459,11 @@ If `gdb-thread' is nil, error is signaled." "Define a NAME which will call BUFFER-COMMAND with id of thread on the current line." `(def-gdb-thread-buffer-command ,name - (,buffer-command (bindat-get-field thread 'id)) + (,buffer-command (gdb-mi--field thread 'id)) ,doc)) (def-gdb-thread-buffer-command gdb-select-thread - (let ((new-id (bindat-get-field thread 'id))) + (let ((new-id (gdb-mi--field thread 'id))) (gdb-setq-thread-number new-id) (gdb-input (concat "-thread-select " new-id) 'ignore) (gdb-update)) @@ -3387,7 +3515,7 @@ on the current line." line." `(def-gdb-thread-buffer-command ,name (if gdb-non-stop - (let ((gdb-thread-number (bindat-get-field thread 'id)) + (let ((gdb-thread-number (gdb-mi--field thread 'id)) (gdb-gud-control-all-threads nil)) (call-interactively #',gud-command)) (error "Available in non-stop mode only, customize `gdb-non-stop-setting'")) @@ -3450,7 +3578,7 @@ line." (def-gdb-trigger-and-handler gdb-invalidate-memory (format "-data-read-memory %s %s %d %d %d" - gdb-memory-address + (gdb-mi-quote gdb-memory-address-expression) gdb-memory-format gdb-memory-unit gdb-memory-rows @@ -3486,27 +3614,35 @@ in `gdb-memory-format'." (error "Unknown format")))) (defun gdb-read-memory-custom () - (let* ((res (gdb-json-partial-output)) - (err-msg (bindat-get-field res 'msg))) + (let* ((res (gdb-mi--partial-output)) + (err-msg (gdb-mi--field res 'msg))) (if (not err-msg) - (let ((memory (bindat-get-field res 'memory))) - (setq gdb-memory-address (bindat-get-field res 'addr)) - (setq gdb-memory-next-page (bindat-get-field res 'next-page)) - (setq gdb-memory-prev-page (bindat-get-field res 'prev-page)) + (let ((memory (gdb-mi--field res 'memory))) + (when gdb-memory-last-address + ;; Nil means last retrieve emits error or just started the session. + (setq gdb--memory-display-warning nil)) + (setq gdb-memory-address (gdb-mi--field res 'addr)) + (setq gdb-memory-next-page (gdb-mi--field res 'next-page)) + (setq gdb-memory-prev-page (gdb-mi--field res 'prev-page)) (setq gdb-memory-last-address gdb-memory-address) (dolist (row memory) - (insert (concat (bindat-get-field row 'addr) ":")) - (dolist (column (bindat-get-field row 'data)) + (insert (concat (gdb-mi--field row 'addr) ":")) + (dolist (column (gdb-mi--field row 'data)) (insert (gdb-pad-string column (+ 2 (gdb-memory-column-width gdb-memory-unit gdb-memory-format))))) (newline))) ;; Show last page instead of empty buffer when out of bounds - (progn - (let ((gdb-memory-address gdb-memory-last-address)) + (when gdb-memory-last-address + (let ((gdb-memory-address-expression gdb-memory-last-address)) + ;; If we don't set `gdb-memory-last-address' to nil, + ;; `gdb-invalidate-memory' eventually calls + ;; `gdb-read-memory-custom', making an infinite loop. + (setq gdb-memory-last-address nil + gdb--memory-display-warning t) (gdb-invalidate-memory 'update) - (error err-msg)))))) + (user-error "Error when retrieving memory: %s Displaying last successful page" err-msg)))))) (defvar gdb-memory-mode-map (let ((map (make-sparse-keymap))) @@ -3540,7 +3676,7 @@ in `gdb-memory-format'." "Set the start memory address." (interactive) (let ((arg (read-from-minibuffer "Memory address: "))) - (setq gdb-memory-address arg)) + (setq gdb-memory-address-expression arg)) (gdb-invalidate-memory 'update)) (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) @@ -3723,7 +3859,19 @@ DOC is an optional documentation string." (defvar gdb-memory-header '(:eval (concat - "Start address[" + "Start address " + ;; If `gdb-memory-address-expression' is nil, `propertize' would error. + (propertize (or gdb-memory-address-expression "N/A") + 'face font-lock-warning-face + 'help-echo "mouse-1: set start address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-address-event)) + (if gdb--memory-display-warning + (propertize " !" 'face '(:inherit error :weight bold)) + "") + " [" (propertize "-" 'face font-lock-warning-face 'help-echo "mouse-1: decrement address" @@ -3740,13 +3888,9 @@ DOC is an optional documentation string." 'mouse-1 #'gdb-memory-show-next-page)) "]: " - (propertize gdb-memory-address - 'face font-lock-warning-face - 'help-echo "mouse-1: set start address" - 'mouse-face 'mode-line-highlight - 'local-map (gdb-make-header-line-mouse-map - 'mouse-1 - #'gdb-memory-set-address-event)) + ;; If `gdb-memory-address' is nil, `propertize' would error. + (propertize (or gdb-memory-address "N/A") + 'face font-lock-warning-face) " Rows: " (propertize (number-to-string gdb-memory-rows) 'face font-lock-warning-face @@ -3822,8 +3966,8 @@ DOC is an optional documentation string." (def-gdb-auto-update-trigger gdb-invalidate-disassembly (let* ((frame (gdb-current-buffer-frame)) - (file (bindat-get-field frame 'fullname)) - (line (bindat-get-field frame 'line))) + (file (gdb-mi--field frame 'fullname)) + (line (gdb-mi--field frame 'line))) (if file (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line) ;; If we're unable to get a file name / line for $PC, simply @@ -3879,22 +4023,22 @@ DOC is an optional documentation string." 'gdb-invalidate-disassembly) (defun gdb-disassembly-handler-custom () - (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns)) - (address (bindat-get-field (gdb-current-buffer-frame) 'addr)) + (let* ((instructions (gdb-mi--field (gdb-mi--partial-output) 'asm_insns)) + (address (gdb-mi--field (gdb-current-buffer-frame) 'addr)) (table (make-gdb-table)) (marked-line nil)) (dolist (instr instructions) (gdb-table-add-row table (list - (bindat-get-field instr 'address) + (gdb-mi--field instr 'address) (let - ((func-name (bindat-get-field instr 'func-name)) - (offset (bindat-get-field instr 'offset))) + ((func-name (gdb-mi--field instr 'func-name)) + (offset (gdb-mi--field instr 'offset))) (if func-name (format "<%s+%s>:" func-name offset) "")) - (bindat-get-field instr 'inst))) - (when (string-equal (bindat-get-field instr 'address) + (gdb-mi--field instr 'inst))) + (when (string-equal (gdb-mi--field instr 'address) address) (progn (setq marked-line (length (gdb-table-rows table))) @@ -3913,15 +4057,15 @@ DOC is an optional documentation string." (setq mode-name (gdb-current-context-mode-name (concat "Disassembly: " - (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + (gdb-mi--field (gdb-current-buffer-frame) 'func)))))) (defun gdb-disassembly-place-breakpoints () (gdb-remove-breakpoint-icons (point-min) (point-max)) (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) - (bptno (bindat-get-field breakpoint 'number)) - (flag (bindat-get-field breakpoint 'enabled)) - (address (bindat-get-field breakpoint 'addr))) + (bptno (gdb-mi--field breakpoint 'number)) + (flag (gdb-mi--field breakpoint 'enabled)) + (address (gdb-mi--field breakpoint 'addr))) (save-excursion (goto-char (point-min)) (if (re-search-forward (concat "^" address) nil t) @@ -3951,10 +4095,10 @@ DOC is an optional documentation string." (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint (gud-basic-call - (concat (if (equal "y" (bindat-get-field breakpoint 'enabled)) + (concat (if (equal "y" (gdb-mi--field breakpoint 'enabled)) "-break-disable " "-break-enable ") - (bindat-get-field breakpoint 'number))) + (gdb-mi--field breakpoint 'number))) (error "Not recognized as break/watchpoint line"))))) (defun gdb-delete-breakpoint () @@ -3965,7 +4109,7 @@ DOC is an optional documentation string." (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint (gud-basic-call (concat "-break-delete " - (bindat-get-field breakpoint 'number))) + (gdb-mi--field breakpoint 'number))) (error "Not recognized as break/watchpoint line"))))) (defun gdb-goto-breakpoint (&optional event) @@ -3979,16 +4123,14 @@ DOC is an optional documentation string." (beginning-of-line) (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint - (let ((bptno (bindat-get-field breakpoint 'number)) - (file (bindat-get-field breakpoint 'fullname)) - (line (bindat-get-field breakpoint 'line))) + (let ((bptno (gdb-mi--field breakpoint 'number)) + (file (gdb-mi--field breakpoint 'fullname)) + (line (gdb-mi--field breakpoint 'line))) (save-selected-window (let* ((buffer (find-file-noselect (if (file-exists-p file) file (cdr (assoc bptno gdb-location-alist))))) - (window (or (gdb-display-source-buffer buffer) - (display-buffer buffer)))) - (setq gdb-source-window window) + (window (gdb-display-source-buffer buffer))) (with-current-buffer buffer (goto-char (point-min)) (forward-line (1- (string-to-number line))) @@ -4014,28 +4156,28 @@ DOC is an optional documentation string." FRAME must have either \"file\" and \"line\" members or \"from\" member." - (let ((file (bindat-get-field frame 'file)) - (line (bindat-get-field frame 'line)) - (from (bindat-get-field frame 'from))) + (let ((file (gdb-mi--field frame 'file)) + (line (gdb-mi--field frame 'line)) + (from (gdb-mi--field frame 'from))) (let ((res (or (and file line (concat file ":" line)) from))) (if res (concat " of " res) "")))) (defun gdb-stack-list-frames-custom () - (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack)) + (let ((stack (gdb-mi--field (gdb-mi--partial-output 'frame) 'stack)) (table (make-gdb-table))) (set-marker gdb-stack-position nil) (dolist (frame stack) (gdb-table-add-row table (list - (bindat-get-field frame 'level) + (gdb-mi--field frame 'level) "in" (concat - (bindat-get-field frame 'func) + (gdb-mi--field frame 'func) (if gdb-stack-buffer-locations (gdb-frame-location frame) "") (if gdb-stack-buffer-addresses - (concat " at " (bindat-get-field frame 'addr)) ""))) + (concat " at " (gdb-mi--field frame 'addr)) ""))) `(mouse-face highlight help-echo "mouse-2, RET: Select frame" gdb-frame ,frame))) @@ -4095,7 +4237,7 @@ member." (let ((frame (get-text-property (point) 'gdb-frame))) (if frame (if (gdb-buffer-shows-main-thread-p) - (let ((new-level (bindat-get-field frame 'level))) + (let ((new-level (gdb-mi--field frame 'level))) (setq gdb-frame-number new-level) (gdb-input (concat "-stack-select-frame " new-level) 'ignore) @@ -4141,7 +4283,7 @@ member." (save-excursion (if event (posn-set-point (event-end event))) (beginning-of-line) - (let* ((var (bindat-get-field + (let* ((var (gdb-mi--field (get-text-property (point) 'gdb-local-variable) 'name)) (value (read-string (format "New value (%s): " var)))) (gud-basic-call @@ -4150,12 +4292,12 @@ member." ;; Don't display values of arrays or structures. ;; These can be expanded using gud-watch. (defun gdb-locals-handler-custom () - (let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals)) + (let ((locals-list (gdb-mi--field (gdb-mi--partial-output) 'locals)) (table (make-gdb-table))) (dolist (local locals-list) - (let ((name (bindat-get-field local 'name)) - (value (bindat-get-field local 'value)) - (type (bindat-get-field local 'type))) + (let ((name (gdb-mi--field local 'name)) + (value (gdb-mi--field local 'value)) + (type (gdb-mi--field local 'type))) (when (not value) (setq value "<complex data type>")) (if (or (not value) @@ -4181,7 +4323,7 @@ member." (setq mode-name (gdb-current-context-mode-name (concat "Locals: " - (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + (gdb-mi--field (gdb-current-buffer-frame) 'func)))))) (defvar gdb-locals-header (list @@ -4247,11 +4389,11 @@ member." (defun gdb-registers-handler-custom () (when gdb-register-names (let ((register-values - (bindat-get-field (gdb-json-partial-output) 'register-values)) + (gdb-mi--field (gdb-mi--partial-output) 'register-values)) (table (make-gdb-table))) (dolist (register register-values) - (let* ((register-number (bindat-get-field register 'number)) - (value (bindat-get-field register 'value)) + (let* ((register-number (gdb-mi--field register 'number)) + (value (gdb-mi--field register 'value)) (register-name (nth (string-to-number register-number) gdb-register-names))) (gdb-table-add-row @@ -4275,8 +4417,7 @@ member." (save-excursion (if event (posn-set-point (event-end event))) (beginning-of-line) - (let* ((var (bindat-get-field - (get-text-property (point) 'gdb-register-name))) + (let* ((var (get-text-property (point) 'gdb-register-name)) (value (read-string (format "New value (%s): " var)))) (gud-basic-call (concat "-gdb-set variable $" var " = " value))))) @@ -4338,7 +4479,7 @@ member." (defun gdb-changed-registers-handler () (setq gdb-changed-registers nil) (dolist (register-number - (bindat-get-field (gdb-json-partial-output) 'changed-registers)) + (gdb-mi--field (gdb-mi--partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () @@ -4346,7 +4487,7 @@ member." ;; only once (in gdb-init-1) (setq gdb-register-names nil) (dolist (register-name - (bindat-get-field (gdb-json-partial-output) 'register-names)) + (gdb-mi--field (gdb-mi--partial-output) 'register-names)) (push register-name gdb-register-names)) (setq gdb-register-names (reverse gdb-register-names))) @@ -4357,7 +4498,8 @@ If buffers already exist for any of these files, `gud-minor-mode' is set in them." (goto-char (point-min)) (while (re-search-forward gdb-source-file-regexp nil t) - (push (read (match-string 1)) gdb-source-file-list)) + (push (gdb-mi--c-string-from-string (match-string 1)) + gdb-source-file-list)) (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (member buffer-file-name gdb-source-file-list) @@ -4373,13 +4515,13 @@ Called from `gdb-update'." (defun gdb-frame-handler () "Set `gdb-selected-frame' and `gdb-selected-file' to show overlay arrow in source buffer." - (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) + (let ((frame (gdb-mi--field (gdb-mi--partial-output) 'frame))) (when frame - (setq gdb-selected-frame (bindat-get-field frame 'func)) - (setq gdb-selected-file (bindat-get-field frame 'fullname)) - (setq gdb-frame-number (bindat-get-field frame 'level)) - (setq gdb-frame-address (bindat-get-field frame 'addr)) - (let ((line (bindat-get-field frame 'line))) + (setq gdb-selected-frame (gdb-mi--field frame 'func)) + (setq gdb-selected-file (gdb-mi--field frame 'fullname)) + (setq gdb-frame-number (gdb-mi--field frame 'level)) + (setq gdb-frame-address (gdb-mi--field frame 'addr)) + (let ((line (gdb-mi--field frame 'line))) (setq gdb-selected-line (and line (string-to-number line))) (when (and gdb-selected-file gdb-selected-line) (setq gud-last-frame (cons gdb-selected-file gdb-selected-line)) @@ -4404,7 +4546,7 @@ overlay arrow in source buffer." (goto-char (point-min)) (setq gdb-prompt-name nil) (re-search-forward gdb-prompt-name-regexp nil t) - (setq gdb-prompt-name (read (match-string 1))) + (setq gdb-prompt-name (gdb-mi--c-string-from-string (match-string 1))) ;; Insert first prompt. (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) @@ -4441,17 +4583,17 @@ SPLIT-HORIZONTAL and show BUF in the new window." (let* ((buf-type (gdb-buffer-type buf)) (existing-window (get-window-with-predicate - #'(lambda (w) - (and (eq buf-type - (gdb-buffer-type (window-buffer w))) - (not (window-dedicated-p w))))))) + (lambda (w) + (and (eq buf-type + (gdb-buffer-type (window-buffer w))) + (not (window-dedicated-p w))))))) (if existing-window (set-window-buffer existing-window buf) (let ((dedicated-window (get-window-with-predicate - #'(lambda (w) - (eq buf-type - (gdb-buffer-type (window-buffer w))))))) + (lambda (w) + (eq buf-type + (gdb-buffer-type (window-buffer w))))))) (if dedicated-window (set-window-buffer (split-window dedicated-window nil split-horizontal) buf) @@ -4464,6 +4606,26 @@ SPLIT-HORIZONTAL and show BUF in the new window." (define-key gud-menu-map [displays] `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdbmi))) + (define-key menu [gdb-restore-windows] + '(menu-item "Restore Initial Layout" gdb-restore-windows + :help "Restore the initial GDB window layout.")) + ;; Window layout vs window configuration: We use "window layout" in + ;; GDB UI. Internally we refer to "window configuration" because + ;; that's the data structure used to store window layouts. Though + ;; bare in mind that there is a small difference between what we + ;; store and what normal window configuration functions + ;; output. Because GDB buffers (source, local, breakpoint, etc) are + ;; different between each debugging sessions, simply save/load + ;; window configurations doesn't + ;; work. `gdb-save-window-configuration' and + ;; `gdb-load-window-configuration' do some tricks to store and + ;; recreate each buffer in the layout. + (define-key menu [load-layout] '("Load Layout" "Load GDB window configuration (layout) from a file" . gdb-load-window-configuration)) + (define-key menu [save-layout] '("Save Layout" "Save current GDB window configuration (layout) to a file" . gdb-save-window-configuration)) + (define-key menu [restore-layout-after-quit] + '(menu-item "Restore Layout After Quit" gdb-toggle-restore-window-configuration + :button (:toggle . gdb-restore-window-configuration-after-quit) + :help "Toggle between always restore the window configuration (layout) after GDB quits and never restore.\n You can also change this setting in Customize to conditionally restore.")) (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) @@ -4496,44 +4658,41 @@ SPLIT-HORIZONTAL and show BUF in the new window." (let ((menu (make-sparse-keymap "GDB-MI"))) (define-key menu [gdb-customize] - '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb)) + `(menu-item "Customize" ,(lambda () (interactive) (customize-group 'gdb)) :help "Customize Gdb Graphical Mode options.")) (define-key menu [gdb-many-windows] '(menu-item "Display Other Windows" gdb-many-windows :help "Toggle display of locals, stack and breakpoint information" :button (:toggle . gdb-many-windows))) - (define-key menu [gdb-restore-windows] - '(menu-item "Restore Window Layout" gdb-restore-windows - :help "Restore standard layout for debug session.")) (define-key menu [sep1] '(menu-item "--")) (define-key menu [all-threads] - '(menu-item "GUD controls all threads" - (lambda () - (interactive) - (setq gdb-gud-control-all-threads t)) + `(menu-item "GUD controls all threads" + ,(lambda () + (interactive) + (setq gdb-gud-control-all-threads t)) :help "GUD start/stop commands apply to all threads" :button (:radio . gdb-gud-control-all-threads))) (define-key menu [current-thread] - '(menu-item "GUD controls current thread" - (lambda () - (interactive) - (setq gdb-gud-control-all-threads nil)) + `(menu-item "GUD controls current thread" + ,(lambda () + (interactive) + (setq gdb-gud-control-all-threads nil)) :help "GUD start/stop commands apply to current thread only" :button (:radio . (not gdb-gud-control-all-threads)))) (define-key menu [sep2] '(menu-item "--")) (define-key menu [gdb-customize-reasons] - '(menu-item "Customize switching..." - (lambda () - (interactive) - (customize-option 'gdb-switch-reasons)))) + `(menu-item "Customize switching..." + ,(lambda () + (interactive) + (customize-option 'gdb-switch-reasons)))) (define-key menu [gdb-switch-when-another-stopped] - (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped - gdb-switch-when-another-stopped - "Automatically switch to stopped thread" - "GDB thread switching %s" - "Switch to stopped thread")) + (menu-bar-make-toggle-command + gdb-toggle-switch-when-another-stopped + gdb-switch-when-another-stopped + "Automatically switch to stopped thread" + "GDB thread switching %s" "Switch to stopped thread")) (define-key gud-menu-map [mi] `(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi)))) @@ -4579,41 +4738,173 @@ window is dedicated." (set-window-buffer window (get-buffer name)) (set-window-dedicated-p window t)) +(defun gdb-toggle-restore-window-configuration () + "Toggle whether to restore window configuration when GDB quits." + (interactive) + (setq gdb-restore-window-configuration-after-quit + (not gdb-restore-window-configuration-after-quit))) + +(defun gdb-get-source-buffer () + "Return a buffer displaying source file or nil if we can't find one. +The source file is the file that contains the source location +where GDB stops. There could be multiple source files during a +debugging session, we get the most recently showed one. If +program hasn't started running yet, the source file is the \"main +file\" where the GDB session starts (see `gdb-main-file')." + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (when gdb-main-file + (gud-find-file gdb-main-file)))) + (defun gdb-setup-windows () - "Layout the window pattern for option `gdb-many-windows'." - (gdb-get-buffer-create 'gdb-locals-buffer) - (gdb-get-buffer-create 'gdb-stack-buffer) - (gdb-get-buffer-create 'gdb-breakpoints-buffer) - (set-window-dedicated-p (selected-window) nil) - (switch-to-buffer gud-comint-buffer) - (delete-other-windows) - (let ((win0 (selected-window)) - (win1 (split-window nil ( / ( * (window-height) 3) 4))) - (win2 (split-window nil ( / (window-height) 3))) - (win3 (split-window-right))) - (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3) - (select-window win2) - (set-window-buffer - win2 - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (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)) - (let ((win4 (split-window-right))) - (gdb-set-window-buffer - (gdb-get-buffer-create 'gdb-inferior-io) nil win4)) - (select-window win1) - (gdb-set-window-buffer (gdb-stack-buffer-name)) - (let ((win5 (split-window-right))) - (gdb-set-window-buffer (if gdb-show-threads-by-default - (gdb-threads-buffer-name) - (gdb-breakpoints-buffer-name)) - nil win5)) - (select-window win0))) + "Lay out the window pattern for option `gdb-many-windows'." + (if gdb-default-window-configuration-file + (gdb-load-window-configuration + (if (file-name-absolute-p gdb-default-window-configuration-file) + gdb-default-window-configuration-file + (expand-file-name gdb-default-window-configuration-file + gdb-window-configuration-directory))) + ;; Create default layout as before. + (gdb-get-buffer-create 'gdb-locals-buffer) + (gdb-get-buffer-create 'gdb-stack-buffer) + (gdb-get-buffer-create 'gdb-breakpoints-buffer) + (set-window-dedicated-p (selected-window) nil) + (switch-to-buffer gud-comint-buffer) + (delete-other-windows) + (let ((win0 (selected-window)) + (win1 (split-window nil ( / ( * (window-height) 3) 4))) + (win2 (split-window nil ( / (window-height) 3))) + (win3 (split-window-right))) + (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3) + (select-window win2) + (set-window-buffer win2 (or (gdb-get-source-buffer) + (list-buffers-noselect))) + (setq gdb-source-window-list (list (selected-window))) + (let ((win4 (split-window-right))) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-inferior-io) nil win4)) + (select-window win1) + (gdb-set-window-buffer (gdb-stack-buffer-name)) + (let ((win5 (split-window-right))) + (gdb-set-window-buffer (if gdb-show-threads-by-default + (gdb-threads-buffer-name) + (gdb-breakpoints-buffer-name)) + nil win5)) + (select-window win0)))) + +(defun gdb-buffer-p (buffer) + "Return t if BUFFER is GDB-related." + (with-current-buffer buffer + (eq gud-minor-mode 'gdbmi))) + +(defun gdb-function-buffer-p (buffer) + "Return t if BUFFER is a GDB function buffer. + +Function buffers are locals buffer, registers buffer, etc, but +not including main command buffer (the one where you type GDB +commands) or source buffers (that display program source code)." + (with-current-buffer buffer + (derived-mode-p 'gdb-parent-mode 'gdb-inferior-io-mode))) + +(defun gdb--buffer-type (buffer) + "Return the type of BUFFER if it is a function buffer. +Buffer type is like `gdb-registers-type', `gdb-stack-buffer'. +These symbols are used by `gdb-get-buffer-create'. + +Return nil if BUFFER is not a GDB function buffer." + (with-current-buffer buffer + (cl-loop for rule in gdb-buffer-rules + for mode-name = (gdb-rules-buffer-mode rule) + for type = (car rule) + if (eq mode-name major-mode) + return type + finally return nil))) + +(defun gdb-save-window-configuration (file) + "Save current window configuration (layout) to FILE. +You can later restore this configuration from that file by +`gdb-load-window-configuration'." + (interactive (list (read-file-name + "Save window configuration to file: " + (or gdb-window-configuration-directory + default-directory)))) + ;; We replace the buffer in each window with a placeholder, store + ;; the buffer type (register, breakpoint, etc) in window parameters, + ;; and write the window configuration to the file. + (save-window-excursion + (let ((placeholder (get-buffer-create " *gdb-placeholder*")) + (window-persistent-parameters + (cons '(gdb-buffer-type . writable) window-persistent-parameters))) + (unwind-protect + (dolist (win (window-list nil 'no-minibuffer)) + (select-window win) + (when (gdb-buffer-p (current-buffer)) + (set-window-parameter + nil 'gdb-buffer-type + (cond ((gdb-function-buffer-p (current-buffer)) + ;; 1) If a user arranged the window + ;; configuration herself and saves it, windows + ;; are probably not dedicated. 2) We use the + ;; same dedication flag as in + ;; `gdb-display-buffer'. + (set-window-dedicated-p nil t) + ;; We save this gdb-buffer-type symbol so + ;; we can later pass it to `gdb-get-buffer-create'; + ;; one example: `gdb-registers-buffer'. + (or (gdb--buffer-type (current-buffer)) + (error "Unrecognized gdb buffer mode: %s" major-mode))) + ;; Command buffer. + ((derived-mode-p 'gud-mode) 'command) + ;; Consider everything else as source buffer. + (t 'source))) + (with-window-non-dedicated nil + (set-window-buffer nil placeholder) + (set-window-prev-buffers (selected-window) nil) + (set-window-next-buffers (selected-window) nil)))) + ;; Save the window configuration to FILE. + (let ((window-config (window-state-get nil t))) + (with-temp-buffer + (prin1 window-config (current-buffer)) + (write-file file t))) + (kill-buffer placeholder))))) + +(defun gdb-load-window-configuration (file) + "Restore window configuration (layout) from FILE. +FILE should be a window configuration file saved by +`gdb-save-window-configuration'." + (interactive (list (read-file-name + "Restore window configuration from file: " + (or gdb-window-configuration-directory + default-directory)))) + ;; Basically, we restore window configuration and go through each + ;; window and restore the function buffers. + (let* ((placeholder (get-buffer-create " *gdb-placeholder*"))) + (unwind-protect ; Don't leak buffer. + (let ((window-config (with-temp-buffer + (insert-file-contents file) + ;; We need to go to point-min because + ;; `read' reads from point + (goto-char (point-min)) + (read (current-buffer)))) + (source-buffer (or (gdb-get-source-buffer) + ;; Do the same thing as in + ;; `gdb-setup-windows' if no source + ;; buffer is found. + (list-buffers-noselect))) + buffer-type) + (window-state-put window-config (frame-root-window)) + (dolist (window (window-list nil 'no-minibuffer)) + (with-selected-window window + (setq buffer-type (window-parameter nil 'gdb-buffer-type)) + (pcase buffer-type + ('source (when source-buffer + (set-window-buffer nil source-buffer) + (push (selected-window) gdb-source-window-list))) + ('command (switch-to-buffer gud-comint-buffer)) + (_ (let ((buffer (gdb-get-buffer-create buffer-type))) + (with-window-non-dedicated nil + (set-window-buffer nil buffer)))))))) + (kill-buffer placeholder)))) (define-minor-mode gdb-many-windows "If nil just pop up the GUD buffer unless `gdb-show-main' is t. @@ -4631,7 +4922,12 @@ of the debugged program. Non-nil means display the layout shown for (defun gdb-restore-windows () "Restore the basic arrangement of windows used by gdb. -This arrangement depends on the value of option `gdb-many-windows'." +This arrangement depends on the values of variable +`gdb-many-windows' and `gdb-default-window-configuration-file'." + ;; This function is used when the user messed up window + ;; configuration and wants to "reset to default". The function that + ;; sets up window configuration on start up is + ;; `gdb-get-source-file'. (interactive) (switch-to-buffer gud-comint-buffer) ;Select the right window and frame. (delete-other-windows) @@ -4644,7 +4940,7 @@ This arrangement depends on the value of option `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 win))))) + (setq gdb-source-window-list (list win)))))) ;; Called from `gud-sentinel' in gud.el: (defun gdb-reset () @@ -4678,14 +4974,28 @@ Kills the gdb buffers, and resets variables and the source buffers." (if (boundp 'speedbar-frame) (speedbar-timer-fn)) (setq gud-running nil) (setq gdb-active-process nil) - (remove-hook 'after-save-hook 'gdb-create-define-alist t)) + (remove-hook 'after-save-hook 'gdb-create-define-alist t) + ;; Recover window configuration. + (when (or (eq gdb-restore-window-configuration-after-quit t) + (and (eq gdb-restore-window-configuration-after-quit + 'if-gdb-show-main) + gdb-show-main) + (and (eq gdb-restore-window-configuration-after-quit + 'if-gdb-many-windows) + gdb-many-windows)) + (when gdb--window-configuration-before + (window-state-put gdb--window-configuration-before) + ;; This way we don't accidentally restore an outdated window + ;; configuration. + (setq gdb--window-configuration-before nil)))) (defun gdb-get-source-file () "Find the source file where the program starts and display it with related buffers, if required." + ;; This function is called only once on startup. (goto-char (point-min)) (if (re-search-forward gdb-source-file-regexp nil t) - (setq gdb-main-file (read (match-string 1)))) + (setq gdb-main-file (gdb-mi--c-string-from-string (match-string 1)))) (if gdb-many-windows (gdb-setup-windows) (gdb-get-buffer-create 'gdb-breakpoints-buffer) |