;;; gdb-mi.el --- User Interface for running GDB
-;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: FSF
;; M-x gdb will start the debugger.
-;; This file uses GDB/MI as the primary interface to GDB. It is still under
-;; development and is part of a process to migrate Emacs from annotations (as
-;; used in gdb-ui.el) to GDB/MI. It runs gdb with GDB/MI (-interp=mi) and
-;; access CLI using "-interpreter-exec console cli-command". This code works
-;; without gdb-ui.el and uses MI tokens instead of queues. Eventually MI
-;; should be asynchronous.
-
-;; This mode will PARTLY WORK WITH RECENT GDB RELEASES (status in modeline
-;; doesn't update properly when execution commands are issued from GUD buffer)
-;; and WORKS BEST when GDB runs asynchronously: maint set linux-async on.
-;;
-;; You need development version of GDB 7.0 for the thread buffer to work.
-
-;; This file replaces gdb-ui.el and is for development with GDB. Use the
-;; release branch of Emacs 22 for the latest version of gdb-ui.el.
+;; This file uses GDB/MI as the primary interface to GDB. It runs gdb with
+;; GDB/MI (-interp=mi) and access CLI using "-interpreter-exec console
+;; cli-command". This code works without gdb-ui.el and uses MI tokens instead
+;; of queues. Eventually MI should be asynchronous.
;; Windows Platforms:
(require 'gud)
(require 'json)
(require 'bindat)
-(require 'speedbar)
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl))
+
+(declare-function speedbar-change-initial-expansion-list
+ "speedbar" (new-default))
+(declare-function speedbar-timer-fn "speedbar" ())
+(declare-function speedbar-line-text "speedbar" (&optional p))
+(declare-function speedbar-change-expand-button-char "speedbar" (char))
+(declare-function speedbar-delete-subblock "speedbar" (indent))
+(declare-function speedbar-center-buffer-smartly "speedbar" ())
(defvar tool-bar-map)
(defvar speedbar-initial-expansion-list-name)
May be manually changed by user with `gdb-select-frame'.")
+(defvar gdb-frame-address nil "Identity of frame for watch expression.")
+
;; Used to show overlay arrow in source buffer. All set in
;; gdb-get-main-selected-frame. Disassembly buffer should not use
;; these but rely on buffer-local thread information instead.
(defvar gdb-running-threads-count nil
"Number of currently running threads.
-Nil means that no information is available.
+If nil, no information is available.
Updated in `gdb-thread-list-handler-custom'.")
(defvar gdb-current-language nil)
(defvar gdb-var-list nil
"List of variables in watch window.
-Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where
-STATUS is nil (unchanged), `changed' or `out-of-scope'.")
+Each element has the form
+ (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE 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.")
;; Overlay arrow markers
(defvar gdb-source-window nil)
(defvar gdb-inferior-status nil)
(defvar gdb-continuation nil)
+(defvar gdb-version nil)
(defvar gdb-filter-output nil
"Message to be shown in GUD console.
"Maximum size of `gdb-debug-log'. If nil, size is unlimited."
:group 'gdb
:type '(choice (integer :tag "Number of elements")
- (const :tag "Unlimited" nil))
+ (const :tag "Unlimited" nil))
:version "22.1")
(defcustom gdb-non-stop-setting t
This setting is used in non-stop mode only. In all-stop mode,
Emacs always switches to the thread which caused the stop."
- ;; exited, exited-normally and exited-signalled are not
+ ;; exited, exited-normally and exited-signaled are not
;; thread-specific stop reasons and therefore are not included in
;; this list
:type '(choice
(set :tag "Selection of reasons..."
(const :tag "A breakpoint was reached." "breakpoint-hit")
(const :tag "A watchpoint was triggered." "watchpoint-trigger")
- (const :tag "A read watchpoint was triggered." "read-watchpoint-trigger")
- (const :tag "An access watchpoint was triggered." "access-watchpoint-trigger")
+ (const :tag "A read watchpoint was triggered."
+ "read-watchpoint-trigger")
+ (const :tag "An access watchpoint was triggered."
+ "access-watchpoint-trigger")
(const :tag "Function finished execution." "function-finished")
(const :tag "Location reached." "location-reached")
- (const :tag "Watchpoint has gone out of scope" "watchpoint-scope")
- (const :tag "End of stepping range reached." "end-stepping-range")
- (const :tag "Signal received (like interruption)." "signal-received"))
+ (const :tag "Watchpoint has gone out of scope"
+ "watchpoint-scope")
+ (const :tag "End of stepping range reached."
+ "end-stepping-range")
+ (const :tag "Signal received (like interruption)."
+ "signal-received"))
(const :tag "None" nil))
:group 'gdb-non-stop
:version "23.2"
Note that \"reason\" is only present in non-stop debugging mode.
-`gdb-get-field' may be used to access the fields of response.
+`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'."
:group 'gdb
:version "22.1")
- (defcustom gdb-create-source-file-list t
- "Non-nil means create a list of files from which the executable was built.
+(defcustom gdb-create-source-file-list t
+ "Non-nil means create a list of files from which the executable was built.
Set this to nil if the GUD buffer displays \"initializing...\" in the mode
line for a long time when starting, possibly because your executable was
built from a large number of files. This allows quicker initialization
but means that these files are not automatically enabled for debugging,
e.g., you won't be able to click in the fringe to set a breakpoint until
execution has already stopped there."
- :type 'boolean
- :group 'gdb
- :version "23.1")
+ :type 'boolean
+ :group 'gdb
+ :version "23.1")
(defcustom gdb-show-main nil
"Non-nil means display source file containing the main routine at startup.
(defun gdb-find-watch-expression ()
(let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
- (varnum (car var)) expr array)
+ (varnum (car var)) expr)
(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)))
When `gdb-non-stop' is nil, return COMMAND unchanged."
(if gdb-non-stop
(if (and gdb-gud-control-all-threads
- (not noall))
+ (not noall)
+ (string-equal gdb-version "7.0+"))
(concat command " --all ")
- (gdb-current-context-command command t))
+ (gdb-current-context-command command))
command))
(defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg)
(concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
,(when (not noarg) 'arg)))
+(defun gdb--check-interpreter (proc string)
+ (unless (zerop (length string))
+ (let ((filter (process-get proc 'gud-normal-filter)))
+ (set-process-filter proc filter)
+ (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!"))
+ (message msg)
+ (setq string (concat (propertize msg 'font-lock-face 'error)
+ "\n" string)))
+ ;; Use the old gud-gbd filter, not because it works, but because it
+ ;; will properly display GDB's answers rather than hanging waiting for
+ ;; answers that aren't coming.
+ (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
+ (funcall filter proc string))))
+
;;;###autoload
(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.
+COMMAND-LINE is the shell command for starting the gdb session.
+It should be a string consisting of the name of the gdb
+executable followed by command-line options. The command-line
+options should include \"-i=mi\" to use gdb's MI text interface.
+Note that the old \"--annotate\" option is no longer supported.
+
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
it starts with two windows: one displaying the GUD buffer and the
(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"))
+ (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-gdbmi-marker-filter)
+
+ ;; Setup a temporary process filter to warn when GDB was not started
+ ;; with -i=mi.
+ (let ((proc (get-buffer-process gud-comint-buffer)))
+ (process-put proc 'gud-normal-filter (process-filter proc))
+ (set-process-filter proc #'gdb--check-interpreter))
+
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
(setq comint-input-sender 'gdb-send)
-
+ (when (ring-empty-p comint-input-ring) ; cf shell-mode
+ (let ((hfile (expand-file-name (or (getenv "GDBHISTFILE")
+ (if (eq system-type 'ms-dos)
+ "_gdb_history"
+ ".gdb_history"))))
+ ;; gdb defaults to 256, but we'll default to comint-input-ring-size.
+ (hsize (getenv "HISTSIZE")))
+ (dolist (file (append '("~/.gdbinit")
+ (unless (string-equal (expand-file-name ".")
+ (expand-file-name "~"))
+ '(".gdbinit"))))
+ (if (file-readable-p (setq file (expand-file-name file)))
+ (with-temp-buffer
+ (insert-file-contents file)
+ ;; TODO? check for "set history save\\( *on\\)?" and do
+ ;; not use history otherwise?
+ (while (re-search-forward
+ "^ *set history \\(filename\\|size\\) *\\(.*\\)" nil t)
+ (cond ((string-equal (match-string 1) "filename")
+ (setq hfile (expand-file-name
+ (match-string 2)
+ (file-name-directory file))))
+ ((string-equal (match-string 1) "size")
+ (setq hsize (match-string 2))))))))
+ (and (stringp hsize)
+ (integerp (setq hsize (string-to-number hsize)))
+ (> hsize 0)
+ (set (make-local-variable 'comint-input-ring-size) hsize))
+ (if (stringp hfile)
+ (set (make-local-variable 'comint-input-ring-file-name) hfile))
+ (comint-read-input-ring t)))
(gud-def gud-tbreak "tbreak %f:%l" "\C-t"
"Set temporary breakpoint at current line.")
(gud-def gud-jump
'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-margin C-mouse-1]
+ (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 C-mouse-3]
'gdb-mouse-jump)
- (local-set-key "\C-i" 'gud-gdb-complete-command)
+ (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
+ nil 'local)
+ (local-set-key "\C-i" 'completion-at-point)
+
(setq gdb-first-prompt t)
(setq gud-running nil)
(gdb-update)
- (add-hook
- 'kill-buffer-hook
- (function
- (lambda ()
- (gdb-input (list "-target-detach" 'ignore))))
- nil t)
-
(run-hooks 'gdb-mode-hook))
(defun gdb-init-1 ()
(gdb-input
;; Needs GDB 6.4 onwards
(list (concat "-inferior-tty-set "
- (process-tty-name (get-process "gdb-inferior")))
+ (or
+ ;; The process can run on a remote host.
+ (process-get (get-process "gdb-inferior") 'remote-tty)
+ (process-tty-name (get-process "gdb-inferior"))))
'ignore))
(if (eq window-system 'w32)
(gdb-input (list "-gdb-set new-console off" 'ignore)))
;; find source file and compilation directory here
(gdb-input
- ; Needs GDB 6.2 onwards.
+ ; Needs GDB 6.2 onwards.
(list "-file-list-exec-source-files" 'gdb-get-source-file-list))
(if gdb-create-source-file-list
(gdb-input
- ; Needs GDB 6.0 onwards.
+ ; Needs GDB 6.0 onwards.
(list "-file-list-exec-source-file" 'gdb-get-source-file)))
(gdb-input
(list "-gdb-show prompt" 'gdb-get-prompt)))
(goto-char (point-min))
(if (re-search-forward "No symbol" nil t)
(progn
- (message "This version of GDB doesn't support non-stop mode. Turning it off.")
- (setq gdb-non-stop nil))
- (gdb-input (list "-gdb-set target-async 1" 'ignore))))
+ (message
+ "This version of GDB doesn't support non-stop mode. Turning it off.")
+ (setq gdb-non-stop nil)
+ (setq gdb-version "pre-7.0"))
+ (setq gdb-version "7.0+")
+ (gdb-input (list "-gdb-set target-async 1" 'ignore))
+ (gdb-input (list "-enable-pretty-printing" 'ignore))))
(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")
(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 "[( ]")))
(defvar tooltip-use-echo-area)
(defun gdb-tooltip-print (expr)
- (tooltip-show
- (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
- (goto-char (point-min))
- (let ((string
- (if (search-forward "=" nil t)
- (concat expr (buffer-substring (- (point) 2) (point-max)))
- (buffer-string))))
- ;; remove newline for gud-tooltip-echo-area
- (substring string 0 (- (length string) 1))))
- (or gud-tooltip-echo-area tooltip-use-echo-area
- (not (display-graphic-p)))))
+ (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
+ (goto-char (point-min))
+ (if (re-search-forward ".*value=\\(\".*\"\\)" nil t)
+ (tooltip-show
+ (concat expr " = " (read (match-string 1)))
+ (or gud-tooltip-echo-area tooltip-use-echo-area
+ (not (display-graphic-p)))))))
;; If expr is a macro for a function don't print because of possible dangerous
;; side-effects. Also printing a function within a tooltip generates an
(if (search-forward "expands to: " nil t)
(unless (looking-at "\\S-+.*(.*).*")
(gdb-input
- (list (concat "print " expr)
+ (list (concat "-data-evaluate-expression " expr)
`(lambda () (gdb-tooltip-print ,expr))))))))
(defun gdb-init-buffer ()
(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))))))
+ (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.
'gud-gdb-complete-command)
(if (and transient-mark-mode mark-active)
(buffer-substring (region-beginning) (region-end))
- (concat (if (eq major-mode 'gdb-registers-mode) "$")
+ (concat (if (derived-mode-p 'gdb-registers-mode) "$")
(tooltip-identifier-from-point (point)))))))
(set-text-properties 0 (length expr) nil expr)
(gdb-input
(defun gdb-var-create-handler (expr)
(let* ((result (gdb-json-partial-output)))
- (if (not (gdb-get-field result 'msg))
- (let
- ((var
- (list
- (gdb-get-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)
- (gdb-get-field result 'numchild)
- (gdb-get-field result 'type)
- (gdb-get-field result 'value)
- nil)))
- (push var gdb-var-list)
- (speedbar 1)
- (unless (string-equal
- speedbar-initial-expansion-list-name "GUD")
- (speedbar-change-initial-expansion-list "GUD")))
- (message-box "No symbol \"%s\" in current context." expr))))
+ (if (not (bindat-get-field result 'msg))
+ (let ((var
+ (list (bindat-get-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)
+ nil
+ (bindat-get-field result 'has_more)
+ 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")))
+ (message-box "No symbol \"%s\" in current context." expr))))
(defun gdb-speedbar-update ()
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
(setcar (nthcdr 4 var) (read (match-string 1)))))
(gdb-speedbar-update))
-; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
+ ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
(defun gdb-var-list-children (varnum)
(gdb-input
(list (concat "-var-update " varnum) 'ignore))
(gdb-input
(list (concat "-var-list-children --all-values "
- varnum)
- `(lambda () (gdb-var-list-children-handler ,varnum)))))
-
-(defconst gdb-var-list-children-regexp
- "child={.*?name=\"\\(.+?\\)\".*?,exp=\"\\(.+?\\)\".*?,\
-numchild=\"\\(.+?\\)\".*?,value=\\(\"\"\\|\".*?[^\\]\"\\)\
-\\(}\\|.*?,\\(type=\"\\(.+?\\)\"\\)?.*?}\\)")
+ varnum)
+ `(lambda () (gdb-var-list-children-handler ,varnum)))))
(defun gdb-var-list-children-handler (varnum)
- (goto-char (point-min))
- (let ((var-list nil))
+ (let* ((var-list nil)
+ (output (bindat-get-field (gdb-json-partial-output "child")))
+ (children (bindat-get-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))
(push var var-list)
- (while (re-search-forward gdb-var-list-children-regexp nil t)
- (let ((varchild (list (match-string 1)
- (match-string 2)
- (match-string 3)
- (match-string 7)
- (read (match-string 4))
- nil)))
+ (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)
+ nil
+ (bindat-get-field child 'has_more))))
(if (assoc (car varchild) gdb-var-list)
(throw 'child-already-watched nil))
(push varchild var-list))))
(list (concat "-var-set-format " varnum " " format) 'ignore))
(gdb-var-update)))
-(defun gdb-var-delete-1 (varnum)
+(defun gdb-var-delete-1 (var varnum)
(gdb-input
(list (concat "-var-delete " varnum) 'ignore))
(setq gdb-var-list (delq var gdb-var-list))
(interactive)
(let ((text (speedbar-line-text)))
(string-match "\\(\\S-+\\)" text)
- (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)))))
+ (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 var varnum)))))
(defun gdb-var-delete-children (varnum)
"Delete children of variable object at point from the speedbar."
(gdb-input
(list (concat "-var-delete -c " varnum) 'ignore)))
-(defun gdb-edit-value (text token indent)
+(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 (car var)) (value))
(if (re-search-forward gdb-error-regexp nil t)
(message-box "Invalid number or expression (%s)" value)))
-; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
+ ; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
(defun gdb-var-update ()
(if (not (gdb-pending-p 'gdb-var-update))
(gdb-input
(list "-var-update --all-values *" 'gdb-var-update-handler)))
(gdb-add-pending 'gdb-var-update))
-(defconst gdb-var-update-regexp
- "{.*?name=\"\\(.*?\\)\".*?,\\(?:value=\\(\".*?\"\\),\\)?.*?\
-in_scope=\"\\(.*?\\)\".*?}")
-
(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))
- (var (assoc varnum gdb-var-list)))
- (when var
- (let ((match (match-string 3)))
- (cond ((string-equal match "false")
- (if gdb-delete-out-of-scope
- (gdb-var-delete-1 varnum)
- (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)))))))
- (gdb-delete-pending 'gdb-var-update)
+ (let ((changelist (bindat-get-field (gdb-json-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))
+ (var (assoc varnum gdb-var-list))
+ (new-num (bindat-get-field change 'new_num_children)))
+ (when var
+ (let ((scope (bindat-get-field change 'in_scope))
+ (has-more (bindat-get-field change 'has_more)))
+ (cond ((string-equal scope "false")
+ (if gdb-delete-out-of-scope
+ (gdb-var-delete-1 var varnum)
+ (setcar (nthcdr 5 var) 'out-of-scope)))
+ ((string-equal scope "true")
+ (setcar (nthcdr 6 var) has-more)
+ (when (and (or (not has-more)
+ (string-equal has-more "0"))
+ (not new-num)
+ (string-equal (nth 2 var) "0"))
+ (setcar (nthcdr 4 var)
+ (bindat-get-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)))
+ (when new-num
+ (setq var1 (pop temp-var-list))
+ (while var1
+ (if (string-equal varnum (car var1))
+ (let ((new (string-to-number new-num))
+ (previous (string-to-number (nth 2 var1))))
+ (setcar (nthcdr 2 var1) new-num)
+ (push var1 var-list)
+ (cond
+ ((> new previous)
+ ;; Add new children to list.
+ (dotimes (dummy previous)
+ (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)
+ 'changed
+ (bindat-get-field child 'has_more))))
+ (push varchild var-list))))
+ ;; Remove deleted children from list.
+ ((< new previous)
+ (dotimes (dummy new)
+ (push (pop temp-var-list) var-list))
+ (dotimes (dummy (- previous new))
+ (pop temp-var-list)))))
+ (push var1 var-list))
+ (setq var1 (pop temp-var-list)))
+ (setq gdb-var-list (nreverse var-list))))))))
+ (setq gdb-pending-triggers
+ (delq 'gdb-var-update gdb-pending-triggers))
(gdb-speedbar-update))
(defun gdb-speedbar-expand-node (text token indent)
(defun gdb-current-buffer-frame ()
"Get current stack frame object for thread of current buffer."
- (gdb-get-field (gdb-current-buffer-thread) 'frame))
+ (bindat-get-field (gdb-current-buffer-thread) 'frame))
(defun gdb-buffer-type (buffer)
"Get value of `gdb-buffer-type' for BUFFER."
(when trigger
(gdb-add-subscriber gdb-buf-publisher
(cons (current-buffer)
- (gdb-bind-function-to-buffer trigger (current-buffer))))
+ (gdb-bind-function-to-buffer
+ trigger (current-buffer))))
(funcall trigger 'start))
(current-buffer))))))
(apply ',expr args))))
;; Used to define all gdb-frame-*-buffer functions except
-;; `gdb-frame-separate-io-buffer'
+;; `gdb-frame-io-buffer'
(defmacro def-gdb-frame-for-buffer (name buffer &optional doc)
"Define a function NAME which shows gdb BUFFER in a separate frame.
(gdb-get-target-string)
"*"))
-(defun gdb-display-separate-io-buffer ()
+(defun gdb-display-io-buffer ()
"Display IO of debugged program in a separate window."
(interactive)
(gdb-display-buffer
(menu-bar-lines . nil)
(minibuffer . nil)))
-(defun gdb-frame-separate-io-buffer ()
+(defun gdb-frame-io-buffer ()
"Display IO of debugged program in a new frame."
(interactive)
(let ((special-display-regexps (append special-display-regexps '(".*")))
(defvar gdb-inferior-io-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'gdb-separate-io-interrupt)
- (define-key map "\C-c\C-z" 'gdb-separate-io-stop)
- (define-key map "\C-c\C-\\" 'gdb-separate-io-quit)
- (define-key map "\C-c\C-d" 'gdb-separate-io-eof)
- (define-key map "\C-d" 'gdb-separate-io-eof)
+ (define-key map "\C-c\C-c" 'gdb-io-interrupt)
+ (define-key map "\C-c\C-z" 'gdb-io-stop)
+ (define-key map "\C-c\C-\\" 'gdb-io-quit)
+ (define-key map "\C-c\C-d" 'gdb-io-eof)
+ (define-key map "\C-d" 'gdb-io-eof)
map))
;; We want to use comint because it has various nifty and familiar features.
(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
- "Major mode for gdb inferior-io.
-
-The following commands are available:
-\\{gdb-inferior-io-mode-map}"
-
+ "Major mode for gdb inferior-io."
:syntax-table nil :abbrev-table nil
-
-(make-comint-in-buffer "gdb-inferior" (current-buffer) nil))
+ (make-comint-in-buffer "gdb-inferior" (current-buffer) nil))
(defun gdb-inferior-filter (proc string)
(unless (string-equal string "")
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
(comint-output-filter proc string)))
-(defun gdb-separate-io-interrupt ()
+(defun gdb-io-interrupt ()
"Interrupt the program being debugged."
(interactive)
(interrupt-process
(get-buffer-process gud-comint-buffer) comint-ptyp))
-(defun gdb-separate-io-quit ()
+(defun gdb-io-quit ()
"Send quit signal to the program being debugged."
(interactive)
(quit-process
(get-buffer-process gud-comint-buffer) comint-ptyp))
-(defun gdb-separate-io-stop ()
+(defun gdb-io-stop ()
"Stop the program being debugged."
(interactive)
(stop-process
(get-buffer-process gud-comint-buffer) comint-ptyp))
-(defun gdb-separate-io-eof ()
+(defun gdb-io-eof ()
"Send end-of-file to the program being debugged."
(interactive)
(process-send-eof
(concat (car item) "\n")))
;; NOFRAME is used for gud execution control commands
-(defun gdb-current-context-command (command &optional noframe)
- "Add --thread and --frame options to gdb COMMAND.
-
-Option values are taken from `gdb-thread-number' and
-`gdb-frame-number'. If `gdb-thread-number' is nil, COMMAND is
-returned unchanged. If `gdb-frame-number' is nil of NOFRAME is t,
-then no --frame option is added."
- ;; gdb-frame-number may be nil while gdb-thread-number is non-nil
- ;; (when current thread is running)
- (if gdb-thread-number
+(defun gdb-current-context-command (command)
+ "Add --thread to gdb COMMAND when needed."
+ (if (and gdb-thread-number
+ (string-equal gdb-version "7.0+"))
(concat command " --thread " gdb-thread-number)
command))
is running."
(let ((old-value gud-running))
(setq gud-running
- (string= (gdb-get-field (gdb-current-buffer-thread) 'state)
+ (string= (bindat-get-field (gdb-current-buffer-thread) 'state)
"running"))
;; Set frame number to "0" when _current_ threads stops
(when (and (gdb-current-buffer-thread)
;; 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)))))
+ (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))
;; Start accumulating output for the GUD buffer
(setq gdb-filter-output "")
- (let ((output-record) (output-record-list))
+ (let (output-record-list)
;; Process all the complete markers in this chunk.
(dolist (gdbmi-record gdbmi-record-list)
;; Suppress "No registers." since GDB 6.8 and earlier duplicates MI
;; error message on internal stream. Don't print to GUD buffer.
(unless (and (eq record-type 'gdb-internals)
- (string-equal (read arg1) "No registers.\n"))
+ (string-equal (read arg1) "No registers.\n"))
(funcall record-type arg1))))))
(setq gdb-output-sink 'user)
gdb-filter-output))
-(defun gdb-gdb (output-field))
+(defun gdb-gdb (_output-field))
(defun gdb-shell (output-field)
(let ((gdb-output-sink gdb-output-sink))
(setq gdb-filter-output
(concat output-field gdb-filter-output))))
-(defun gdb-ignored-notification (output-field))
+(defun gdb-ignored-notification (_output-field))
;; gdb-invalidate-threads is defined to accept 'update-threads signal
-(defun gdb-thread-created (output-field))
+(defun gdb-thread-created (_output-field))
(defun gdb-thread-exited (output-field)
"Handle =thread-exited async record: unset `gdb-thread-number'
if current thread exited and update threads list."
- (let* ((thread-id (gdb-get-field (gdb-json-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,
- ;; gdb-pending-triggers left after gdb-running disallow us to
- ;; properly call -thread-info without --thread option. Thus we
- ;; need to use gdb-wait-for-pending.
- (gdb-wait-for-pending
- (gdb-emit-signal gdb-buf-publisher 'update-threads))))
+ (let* ((thread-id (bindat-get-field (gdb-json-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,
+ ;; gdb-pending-triggers left after gdb-running disallow us to
+ ;; properly call -thread-info without --thread option. Thus we
+ ;; need to use gdb-wait-for-pending.
+ (gdb-wait-for-pending
+ (gdb-emit-signal gdb-buf-publisher 'update-threads))))
(defun gdb-thread-selected (output-field)
"Handler for =thread-selected MI output record.
Sets `gdb-thread-number' to new id."
(let* ((result (gdb-json-string output-field))
- (thread-id (gdb-get-field result 'id)))
+ (thread-id (bindat-get-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`
(gdb-update))))
(defun gdb-running (output-field)
- (let* ((thread-id (gdb-get-field (gdb-json-string output-field) 'thread-id)))
+ (let* ((thread-id
+ (bindat-get-field (gdb-json-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
(setq gdb-active-process t)
(gdb-emit-signal gdb-buf-publisher 'update-threads))
-(defun gdb-starting (output-field)
+(defun gdb-starting (_output-field)
;; CLI commands don't emit ^running at the moment so use gdb-running too.
(setq gdb-inferior-status "running")
(gdb-force-mode-line-update
(setq gud-running t)
;; GDB doesn't seem to respond to -thread-info before first stop or
;; thread exit (even in non-stop mode), so this is useless.
- ;; Behaviour may change in the future.
+ ;; Behavior may change in the future.
(gdb-emit-signal gdb-buf-publisher 'update-threads))
;; -break-insert -t didn't give a reason before gdb 6.9
current thread and update GDB buffers."
;; Reason is available with target-async only
(let* ((result (gdb-json-string output-field))
- (reason (gdb-get-field result 'reason))
- (thread-id (gdb-get-field result 'thread-id)))
+ (reason (bindat-get-field result 'reason))
+ (thread-id (bindat-get-field result 'thread-id)))
;; -data-list-register-names needs to be issued for any stopped
;; thread
(when (not gdb-register-names)
(gdb-input
- (list (concat "-data-list-register-names --thread " thread-id)
+ (list (concat "-data-list-register-names"
+ (if (string-equal gdb-version "7.0+")
+ (concat" --thread " thread-id)))
'gdb-register-names-handler)))
;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler
;; gdb-switch-when-another-stopped:
(when (or gdb-switch-when-another-stopped
(not (string= "stopped"
- (gdb-get-field (gdb-current-buffer-thread) 'state))))
+ (bindat-get-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)
(member reason gdb-switch-reasons))
- (when (not (string-equal gdb-thread-number thread-id))
- (message (concat "Switched to thread " thread-id))
- (gdb-setq-thread-number thread-id))
+ (when (not (string-equal gdb-thread-number thread-id))
+ (message (concat "Switched to thread " thread-id))
+ (gdb-setq-thread-number thread-id))
(message (format "Thread %s stopped" thread-id)))))
- ;; Print "(gdb)" to GUD console
- (when gdb-first-done-or-error
- (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
+ ;; Print "(gdb)" to GUD console
+ (when gdb-first-done-or-error
+ (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
- ;; In non-stop, we update information as soon as another thread gets
- ;; stopped
- (when (or gdb-first-done-or-error
- gdb-non-stop)
- ;; In all-stop this updates gud-running properly as well.
- (gdb-update)
- (setq gdb-first-done-or-error nil))
- (run-hook-with-args 'gdb-stopped-hooks result)))
+ ;; In non-stop, we update information as soon as another thread gets
+ ;; stopped
+ (when (or gdb-first-done-or-error
+ gdb-non-stop)
+ ;; In all-stop this updates gud-running properly as well.
+ (gdb-update)
+ (setq gdb-first-done-or-error nil))
+ (run-hook-with-args 'gdb-stopped-hooks result)))
;; Remove the trimmings from log stream containing debugging messages
;; being produced by GDB's internals, use warning face and send to GUD
;; Remove the trimmings from the console stream and send to GUD buffer
;; (frontend MI commands should not print to this stream)
(defun gdb-console (output-field)
- (setq gdb-filter-output
+ (setq gdb-filter-output
(gdb-concat-output
gdb-filter-output
(read output-field))))
(setq token-number nil)
;; MI error - send to minibuffer
(when (eq type 'error)
- ;; Skip "msg=" from `output-field'
- (message (read (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)))
+ ;; Skip "msg=" from `output-field'
+ (message (read (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)))
;; Output from command from frontend.
(setq gdb-output-sink 'emacs))
Field names are wrapped in double quotes and equal signs are
replaced with semicolons.
-If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from
+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
(save-excursion
(while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t)
(replace-match "" nil nil nil 1))))
- ;; Emacs bug #3794
(when fix-list
(save-excursion
;; Find positions of braces which enclose broken list
(insert "]"))))))
(goto-char (point-min))
(insert "{")
- ;; TODO: This breaks badly with foo= inside constants
- (while (re-search-forward "\\([[:alpha:]-_]+\\)=" nil t)
- (replace-match "\"\\1\":" nil nil))
+ (while (re-search-forward
+ "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t)
+ (replace-match "\"\\1\":\\2" nil nil))
(goto-char (point-max))
(insert "}")))
(defun gdb-mapcar* (function &rest seqs)
"Apply FUNCTION to each element of SEQS, and make a list of the results.
If there are several SEQS, FUNCTION is called with that many
-arugments, and mapping stops as sson as the shortest list runs
+arguments, and mapping stops as soon as the shortest list runs
out."
(let ((shortest (apply #'min (mapcar #'length seqs))))
(mapcar (lambda (i)
(append row-properties (list properties)))
(setf (gdb-table-column-sizes table)
(gdb-mapcar* (lambda (x s)
- (let ((new-x
- (max (abs x) (string-width (or s "")))))
- (if right-align new-x (- new-x))))
- (gdb-table-column-sizes table)
- row))
+ (let ((new-x
+ (max (abs x) (string-width (or s "")))))
+ (if right-align new-x (- new-x))))
+ (gdb-table-column-sizes table)
+ row))
;; Avoid trailing whitespace at eol
(if (not (gdb-table-right-align table))
(setcar (last (gdb-table-column-sizes table)) 0))))
(defun gdb-table-string (table &optional sep)
"Return TABLE as a string with columns separated with SEP."
- (let ((column-sizes (gdb-table-column-sizes table))
- (res ""))
+ (let ((column-sizes (gdb-table-column-sizes table)))
(mapconcat
'identity
(gdb-mapcar*
(gdb-table-row-properties table))
"\n")))
-;; gdb-get-field goes deep, gdb-get-many-fields goes wide
-(defalias 'gdb-get-field 'bindat-get-field)
-
+;; 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 values)
- (setq values (append values (list (gdb-get-field struct field)))))))
+ (setq values (append values (list (bindat-get-field struct field)))))))
(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
handler-name
'(set-window-point window p)))))
(defmacro def-gdb-trigger-and-handler (trigger-name gdb-command
- handler-name custom-defun
- &optional signal-list)
+ handler-name custom-defun
+ &optional signal-list)
"Define trigger and handler.
TRIGGER-NAME trigger is defined to send GDB-COMMAND. See
'gdb-invalidate-breakpoints)
(defun gdb-breakpoints-list-handler-custom ()
- (let ((breakpoints-list (gdb-get-field
+ (let ((breakpoints-list (bindat-get-field
(gdb-json-partial-output "bkpt" "script")
'BreakpointTable 'body))
(table (make-gdb-table)))
(gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Addr" "Hits" "What"))
(dolist (breakpoint breakpoints-list)
(add-to-list 'gdb-breakpoints-list
- (cons (gdb-get-field breakpoint 'number)
+ (cons (bindat-get-field breakpoint 'number)
breakpoint))
- (let ((at (gdb-get-field breakpoint 'at))
- (pending (gdb-get-field breakpoint 'pending))
- (func (gdb-get-field breakpoint 'func))
- (type (gdb-get-field breakpoint 'type)))
- (gdb-table-add-row table
- (list
- (gdb-get-field breakpoint 'number)
- type
- (gdb-get-field breakpoint 'disp)
- (let ((flag (gdb-get-field breakpoint 'enabled)))
- (if (string-equal flag "y")
- (propertize "y" 'font-lock-face font-lock-warning-face)
- (propertize "n" 'font-lock-face font-lock-comment-face)))
- (gdb-get-field breakpoint 'addr)
- (gdb-get-field breakpoint 'times)
- (if (string-match ".*watchpoint" type)
- (gdb-get-field breakpoint 'what)
- (or pending at
- (concat "in "
- (propertize func 'font-lock-face font-lock-function-name-face)
- (gdb-frame-location breakpoint)))))
- ;; Add clickable properties only for breakpoints with file:line
- ;; information
- (append (list 'gdb-breakpoint breakpoint)
- (when func '(help-echo "mouse-2, RET: visit breakpoint"
- mouse-face highlight))))))
+ (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)))
+ (gdb-table-add-row table
+ (list
+ (bindat-get-field breakpoint 'number)
+ type
+ (bindat-get-field breakpoint 'disp)
+ (let ((flag (bindat-get-field breakpoint 'enabled)))
+ (if (string-equal flag "y")
+ (propertize "y" 'font-lock-face font-lock-warning-face)
+ (propertize "n" 'font-lock-face font-lock-comment-face)))
+ (bindat-get-field breakpoint 'addr)
+ (bindat-get-field breakpoint 'times)
+ (if (string-match ".*watchpoint" type)
+ (bindat-get-field breakpoint 'what)
+ (or pending at
+ (concat "in "
+ (propertize (or func "unknown")
+ 'font-lock-face font-lock-function-name-face)
+ (gdb-frame-location breakpoint)))))
+ ;; Add clickable properties only for breakpoints with file:line
+ ;; information
+ (append (list 'gdb-breakpoint breakpoint)
+ (when func '(help-echo "mouse-2, RET: visit breakpoint"
+ mouse-face highlight))))))
(insert (gdb-table-string table " "))
(gdb-place-breakpoints)))
;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
(defun gdb-place-breakpoints ()
- (let ((flag) (bptno))
- ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (if (and (eq gud-minor-mode 'gdbmi)
- (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name))))
- (gdb-remove-breakpoint-icons (point-min) (point-max)))))
- (dolist (breakpoint gdb-breakpoints-list)
- (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is
- ; an associative list
- (line (gdb-get-field breakpoint 'line)))
- (when line
- (let ((file (gdb-get-field breakpoint 'fullname))
- (flag (gdb-get-field breakpoint 'enabled))
- (bptno (gdb-get-field breakpoint 'number)))
- (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)
- (gdb-init-buffer)
- ;; Only want one breakpoint icon at each location.
- (gdb-put-breakpoint-icon (string-equal flag "y") bptno
- (string-to-number line)))
- (gdb-input
- (list (concat "list " file ":1")
- 'ignore))
- (gdb-input
- (list "-file-list-exec-source-file"
- `(lambda () (gdb-get-location
- ,bptno ,line ,flag)))))))))))
+ ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (if (and (eq gud-minor-mode 'gdbmi)
+ (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name))))
+ (gdb-remove-breakpoint-icons (point-min) (point-max)))))
+ (dolist (breakpoint gdb-breakpoints-list)
+ (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is
+ ; an associative list
+ (line (bindat-get-field breakpoint 'line)))
+ (when line
+ (let ((file (bindat-get-field breakpoint 'fullname))
+ (flag (bindat-get-field breakpoint 'enabled))
+ (bptno (bindat-get-field breakpoint 'number)))
+ (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)
+ (gdb-init-buffer)
+ ;; Only want one breakpoint icon at each location.
+ (gdb-put-breakpoint-icon (string-equal flag "y") bptno
+ (string-to-number line)))
+ (gdb-input
+ (list (concat "list " file ":1")
+ 'ignore))
+ (gdb-input
+ (list "-file-list-exec-source-file"
+ `(lambda () (gdb-get-location
+ ,bptno ,line ,flag))))))))))
(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
(catch 'file-not-found
(if (re-search-forward gdb-source-file-regexp nil t)
(delete (cons bptno "File not found") gdb-location-alist)
- (push (cons bptno (match-string 1)) gdb-location-alist)
+ (push (cons bptno (match-string 1)) gdb-location-alist)
(gdb-resync)
(unless (assoc bptno gdb-location-alist)
(push (cons bptno "File not found") gdb-location-alist)
(mouse-minibuffer-check event)
(let ((posn (event-end event)))
(with-selected-window (posn-window posn)
- (if (or (buffer-file-name) (eq major-mode 'gdb-disassembly-mode))
+ (if (or (buffer-file-name) (derived-mode-p 'gdb-disassembly-mode))
(if (numberp (posn-point posn))
(save-excursion
(goto-char (posn-point posn))
obj)
(when (numberp pos)
(with-selected-window (posn-window posn)
- (save-excursion
- (set-buffer (window-buffer (selected-window)))
+ (with-current-buffer (window-buffer (selected-window))
(goto-char pos)
(dolist (overlay (overlays-in pos pos))
(when (overlay-get overlay 'put-break)
(if (get-text-property 0 'gdb-enabled obj)
"-break-disable "
"-break-enable ")
- (get-text-property 0 'gdb-bptno obj)))))))))
+ (get-text-property 0 'gdb-bptno obj)))))))))
(defun gdb-breakpoints-buffer-name ()
(concat "*breakpoints of " (gdb-get-target-string) "*"))
(def-gdb-display-buffer
- gdb-display-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints.")
+ gdb-display-breakpoints-buffer
+ 'gdb-breakpoints-buffer
+ "Display status of user-settable breakpoints.")
(def-gdb-frame-for-buffer
- gdb-frame-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints in a new frame.")
+ gdb-frame-breakpoints-buffer
+ 'gdb-breakpoints-buffer
+ "Display status of user-settable breakpoints in a new frame.")
(defvar gdb-breakpoints-mode-map
(let ((map (make-sparse-keymap))
;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons.
(define-key map "q" 'gdb-delete-frame-or-window)
(define-key map "\r" 'gdb-goto-breakpoint)
- (define-key map "\t" '(lambda ()
- (interactive)
- (gdb-set-window-buffer
- (gdb-get-buffer-create 'gdb-threads-buffer) t)))
+ (define-key map "\t" (lambda ()
+ (interactive)
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create 'gdb-threads-buffer) t)))
(define-key map [mouse-2] 'gdb-goto-breakpoint)
(define-key map [follow-link] 'mouse-face)
map))
(concat "*threads of " (gdb-get-target-string) "*"))
(def-gdb-display-buffer
- gdb-display-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads.")
+ gdb-display-threads-buffer
+ 'gdb-threads-buffer
+ "Display GDB threads.")
(def-gdb-frame-for-buffer
- gdb-frame-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads in a new frame.")
+ gdb-frame-threads-buffer
+ 'gdb-threads-buffer
+ "Display GDB threads in a new frame.")
(def-gdb-trigger-and-handler
- gdb-invalidate-threads (gdb-current-context-command "-thread-info" gud-running)
+ gdb-invalidate-threads (gdb-current-context-command "-thread-info")
gdb-thread-list-handler gdb-thread-list-handler-custom
'(start update update-threads))
(define-key map "i" 'gdb-interrupt-thread)
(define-key map "c" 'gdb-continue-thread)
(define-key map "s" 'gdb-step-thread)
- (define-key map "\t" '(lambda ()
- (interactive)
- (gdb-set-window-buffer
- (gdb-get-buffer-create 'gdb-breakpoints-buffer) t)))
+ (define-key map "\t"
+ (lambda ()
+ (interactive)
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer) t)))
(define-key map [mouse-2] 'gdb-select-thread)
(define-key map [follow-link] 'mouse-face)
map))
(defvar gdb-threads-header
(list
- (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
- "mouse-1: select" mode-line-highlight mode-line-inactive)
+ (gdb-propertize-header
+ "Breakpoints" gdb-breakpoints-buffer
+ "mouse-1: select" mode-line-highlight mode-line-inactive)
" "
(gdb-propertize-header "Threads" gdb-threads-buffer
nil nil mode-line)))
(define-derived-mode gdb-threads-mode gdb-parent-mode "Threads"
- "Major mode for GDB threads.
-
-\\{gdb-threads-mode-map}"
+ "Major mode for GDB threads."
(setq gdb-thread-position (make-marker))
(add-to-list 'overlay-arrow-variable-list 'gdb-thread-position)
(setq header-line-format gdb-threads-header)
(set (make-local-variable 'font-lock-defaults)
'(gdb-threads-font-lock-keywords))
- (run-mode-hooks 'gdb-threads-mode-hook)
'gdb-invalidate-threads)
(defun gdb-thread-list-handler-custom ()
- (let ((threads-list (gdb-get-field (gdb-json-partial-output) 'threads))
+ (let ((threads-list (bindat-get-field (gdb-json-partial-output) 'threads))
(table (make-gdb-table))
(marked-line nil))
(setq gdb-threads-list nil)
(set-marker gdb-thread-position nil)
(dolist (thread (reverse threads-list))
- (let ((running (string-equal (gdb-get-field thread 'state) "running")))
- (add-to-list 'gdb-threads-list
- (cons (gdb-get-field thread 'id)
- thread))
- (if running
- (incf gdb-running-threads-count)
- (incf gdb-stopped-threads-count))
-
- (gdb-table-add-row table
- (list
- (gdb-get-field thread 'id)
- (concat
- (if gdb-thread-buffer-verbose-names
- (concat (gdb-get-field thread 'target-id) " ") "")
- (gdb-get-field thread 'state)
- ;; Include frame information for stopped threads
- (if (not running)
- (concat
- " in " (gdb-get-field thread 'frame 'func)
- (if gdb-thread-buffer-arguments
- (concat
- " ("
- (let ((args (gdb-get-field thread 'frame 'args)))
- (mapconcat
- (lambda (arg)
- (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value))))
- args ","))
- ")")
- "")
- (if gdb-thread-buffer-locations
- (gdb-frame-location (gdb-get-field thread 'frame)) "")
- (if gdb-thread-buffer-addresses
- (concat " at " (gdb-get-field thread 'frame 'addr)) ""))
- "")))
- (list
- 'gdb-thread thread
- 'mouse-face 'highlight
- 'help-echo "mouse-2, RET: select thread")))
+ (let ((running (equal (bindat-get-field thread 'state) "running")))
+ (add-to-list 'gdb-threads-list
+ (cons (bindat-get-field thread 'id)
+ thread))
+ (if running
+ (incf gdb-running-threads-count)
+ (incf gdb-stopped-threads-count))
+
+ (gdb-table-add-row table
+ (list
+ (bindat-get-field thread 'id)
+ (concat
+ (if gdb-thread-buffer-verbose-names
+ (concat (bindat-get-field thread 'target-id) " ") "")
+ (bindat-get-field thread 'state)
+ ;; Include frame information for stopped threads
+ (if (not running)
+ (concat
+ " in " (bindat-get-field thread 'frame 'func)
+ (if gdb-thread-buffer-arguments
+ (concat
+ " ("
+ (let ((args (bindat-get-field thread 'frame 'args)))
+ (mapconcat
+ (lambda (arg)
+ (apply #'format "%s=%s"
+ (gdb-get-many-fields arg 'name 'value)))
+ args ","))
+ ")")
+ "")
+ (if gdb-thread-buffer-locations
+ (gdb-frame-location (bindat-get-field thread 'frame)) "")
+ (if gdb-thread-buffer-addresses
+ (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
+ "")))
+ (list
+ 'gdb-thread thread
+ 'mouse-face 'highlight
+ 'help-echo "mouse-2, RET: select thread")))
(when (string-equal gdb-thread-number
- (gdb-get-field thread 'id))
+ (bindat-get-field thread 'id))
(setq marked-line (length gdb-threads-list))))
(insert (gdb-table-string table " "))
(when marked-line
,custom-defun
(error "Not recognized as thread line"))))))
-(defmacro def-gdb-thread-buffer-simple-command (name buffer-command &optional doc)
+(defmacro def-gdb-thread-buffer-simple-command (name buffer-command
+ &optional doc)
"Define a NAME which will call BUFFER-COMMAND with id of thread
on the current line."
`(def-gdb-thread-buffer-command ,name
- (,buffer-command (gdb-get-field thread 'id))
+ (,buffer-command (bindat-get-field thread 'id))
,doc))
(def-gdb-thread-buffer-command gdb-select-thread
- (let ((new-id (gdb-get-field thread 'id)))
+ (let ((new-id (bindat-get-field thread 'id)))
(gdb-setq-thread-number new-id)
(gdb-input (list (concat "-thread-select " new-id) 'ignore))
(gdb-update))
line."
`(def-gdb-thread-buffer-command ,name
(if gdb-non-stop
- (let ((gdb-thread-number (gdb-get-field thread 'id))
+ (let ((gdb-thread-number (bindat-get-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."))
+ (error "Available in non-stop mode only, customize `gdb-non-stop-setting'"))
,doc))
(def-gdb-thread-buffer-gud-command
(defcustom gdb-memory-format "x"
"Display format of data items in memory window."
:type '(choice (const :tag "Hexadecimal" "x")
- (const :tag "Signed decimal" "d")
- (const :tag "Unsigned decimal" "u")
- (const :tag "Octal" "o")
- (const :tag "Binary" "t"))
+ (const :tag "Signed decimal" "d")
+ (const :tag "Unsigned decimal" "u")
+ (const :tag "Octal" "o")
+ (const :tag "Binary" "t"))
:group 'gud
:version "22.1")
(defcustom gdb-memory-unit 4
"Unit size of data items in memory window."
:type '(choice (const :tag "Byte" 1)
- (const :tag "Halfword" 2)
- (const :tag "Word" 4)
- (const :tag "Giant word" 8))
+ (const :tag "Halfword" 2)
+ (const :tag "Word" 4)
+ (const :tag "Giant word" 8))
:group 'gud
:version "23.2")
(defun gdb-read-memory-custom ()
(let* ((res (gdb-json-partial-output))
- (err-msg (gdb-get-field res 'msg)))
+ (err-msg (bindat-get-field res 'msg)))
(if (not err-msg)
- (let ((memory (gdb-get-field res 'memory)))
- (setq gdb-memory-address (gdb-get-field res 'addr))
- (setq gdb-memory-next-page (gdb-get-field res 'next-page))
- (setq gdb-memory-prev-page (gdb-get-field res 'prev-page))
+ (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))
(setq gdb-memory-last-address gdb-memory-address)
- (dolist (row memory)
- (insert (concat (gdb-get-field row 'addr) ":"))
- (dolist (column (gdb-get-field row 'data))
- (insert (gdb-pad-string column
- (+ 2 (gdb-memory-column-width
- gdb-memory-unit
- gdb-memory-format)))))
- (newline)))
+ (dolist (row memory)
+ (insert (concat (bindat-get-field row 'addr) ":"))
+ (dolist (column (bindat-get-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))
(define-key map "g" 'gdb-memory-unit-giant)
(define-key map "R" 'gdb-memory-set-rows)
(define-key map "C" 'gdb-memory-set-columns)
- map))
+ map))
(defun gdb-memory-set-address-event (event)
"Handle a click on address field in memory buffer header."
map)
"Keymap to select format in the header line.")
-(defvar gdb-memory-format-menu (make-sparse-keymap "Format")
+(defvar gdb-memory-format-menu
+ (let ((map (make-sparse-keymap "Format")))
+
+ (define-key map [binary]
+ '(menu-item "Binary" gdb-memory-format-binary
+ :button (:radio . (equal gdb-memory-format "t"))))
+ (define-key map [octal]
+ '(menu-item "Octal" gdb-memory-format-octal
+ :button (:radio . (equal gdb-memory-format "o"))))
+ (define-key map [unsigned]
+ '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
+ :button (:radio . (equal gdb-memory-format "u"))))
+ (define-key map [signed]
+ '(menu-item "Signed Decimal" gdb-memory-format-signed
+ :button (:radio . (equal gdb-memory-format "d"))))
+ (define-key map [hexadecimal]
+ '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
+ :button (:radio . (equal gdb-memory-format "x"))))
+ map)
"Menu of display formats in the header line.")
-(define-key gdb-memory-format-menu [binary]
- '(menu-item "Binary" gdb-memory-format-binary
- :button (:radio . (equal gdb-memory-format "t"))))
-(define-key gdb-memory-format-menu [octal]
- '(menu-item "Octal" gdb-memory-format-octal
- :button (:radio . (equal gdb-memory-format "o"))))
-(define-key gdb-memory-format-menu [unsigned]
- '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
- :button (:radio . (equal gdb-memory-format "u"))))
-(define-key gdb-memory-format-menu [signed]
- '(menu-item "Signed Decimal" gdb-memory-format-signed
- :button (:radio . (equal gdb-memory-format "d"))))
-(define-key gdb-memory-format-menu [hexadecimal]
- '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
- :button (:radio . (equal gdb-memory-format "x"))))
-
(defun gdb-memory-format-menu (event)
(interactive "@e")
(x-popup-menu event gdb-memory-format-menu))
map)
"Keymap to select units in the header line.")
-(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit")
+(defvar gdb-memory-unit-menu
+ (let ((map (make-sparse-keymap "Unit")))
+ (define-key map [giantwords]
+ '(menu-item "Giant words" gdb-memory-unit-giant
+ :button (:radio . (equal gdb-memory-unit 8))))
+ (define-key map [words]
+ '(menu-item "Words" gdb-memory-unit-word
+ :button (:radio . (equal gdb-memory-unit 4))))
+ (define-key map [halfwords]
+ '(menu-item "Halfwords" gdb-memory-unit-halfword
+ :button (:radio . (equal gdb-memory-unit 2))))
+ (define-key map [bytes]
+ '(menu-item "Bytes" gdb-memory-unit-byte
+ :button (:radio . (equal gdb-memory-unit 1))))
+ map)
"Menu of units in the header line.")
-(define-key gdb-memory-unit-menu [giantwords]
- '(menu-item "Giant words" gdb-memory-unit-giant
- :button (:radio . (equal gdb-memory-unit 8))))
-(define-key gdb-memory-unit-menu [words]
- '(menu-item "Words" gdb-memory-unit-word
- :button (:radio . (equal gdb-memory-unit 4))))
-(define-key gdb-memory-unit-menu [halfwords]
- '(menu-item "Halfwords" gdb-memory-unit-halfword
- :button (:radio . (equal gdb-memory-unit 2))))
-(define-key gdb-memory-unit-menu [bytes]
- '(menu-item "Bytes" gdb-memory-unit-byte
- :button (:radio . (equal gdb-memory-unit 1))))
-
(defun gdb-memory-unit-menu (event)
(interactive "@e")
(x-popup-menu event gdb-memory-unit-menu))
(defvar gdb-memory-font-lock-keywords
'(;; <__function.name+n>
- ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face))
- )
+ ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
+ (1 font-lock-function-name-face)))
"Font lock keywords used in `gdb-memory-mode'.")
(defvar gdb-memory-header
(concat
"Start address["
(propertize "-"
- 'face font-lock-warning-face
- 'help-echo "mouse-1: decrement address"
- 'mouse-face 'mode-line-highlight
- 'local-map (gdb-make-header-line-mouse-map
- 'mouse-1
- #'gdb-memory-show-previous-page))
+ 'face font-lock-warning-face
+ 'help-echo "mouse-1: decrement address"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1
+ #'gdb-memory-show-previous-page))
"|"
(propertize "+"
- 'face font-lock-warning-face
- 'help-echo "mouse-1: increment address"
+ 'face font-lock-warning-face
+ 'help-echo "mouse-1: increment address"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-show-next-page))
- "]: "
- (propertize gdb-memory-address
+ "]: "
+ (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))
- " Rows: "
- (propertize (number-to-string gdb-memory-rows)
+ " Rows: "
+ (propertize (number-to-string gdb-memory-rows)
'face font-lock-warning-face
'help-echo "mouse-1: set number of columns"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-set-rows))
- " Columns: "
- (propertize (number-to-string gdb-memory-columns)
+ " Columns: "
+ (propertize (number-to-string gdb-memory-columns)
'face font-lock-warning-face
'help-echo "mouse-1: set number of columns"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-set-columns))
- " Display Format: "
- (propertize gdb-memory-format
+ " Display Format: "
+ (propertize gdb-memory-format
'face font-lock-warning-face
'help-echo "mouse-3: select display format"
'mouse-face 'mode-line-highlight
'local-map gdb-memory-format-map)
- " Unit Size: "
- (propertize (number-to-string gdb-memory-unit)
+ " Unit Size: "
+ (propertize (number-to-string gdb-memory-unit)
'face font-lock-warning-face
'help-echo "mouse-3: select unit size"
'mouse-face 'mode-line-highlight
"Header line used in `gdb-memory-mode'.")
(define-derived-mode gdb-memory-mode gdb-parent-mode "Memory"
- "Major mode for examining memory.
-
-\\{gdb-memory-mode-map}"
+ "Major mode for examining memory."
(setq header-line-format gdb-memory-header)
(set (make-local-variable 'font-lock-defaults)
'(gdb-memory-font-lock-keywords))
- (run-mode-hooks 'gdb-memory-mode-hook)
'gdb-invalidate-memory)
(defun gdb-memory-buffer-name ()
(concat "disassembly of " (gdb-get-target-string))))
(def-gdb-display-buffer
- gdb-display-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly for current stack frame.")
+ gdb-display-disassembly-buffer
+ 'gdb-disassembly-buffer
+ "Display disassembly for current stack frame.")
(def-gdb-preempt-display-buffer
gdb-preemptively-display-disassembly-buffer
'gdb-disassembly-buffer)
(def-gdb-frame-for-buffer
- gdb-frame-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly in a new frame.")
+ gdb-frame-disassembly-buffer
+ 'gdb-disassembly-buffer
+ "Display disassembly in a new frame.")
(def-gdb-auto-update-trigger gdb-invalidate-disassembly
(let* ((frame (gdb-current-buffer-frame))
- (file (gdb-get-field frame 'fullname))
- (line (gdb-get-field frame 'line)))
+ (file (bindat-get-field frame 'fullname))
+ (line (bindat-get-field frame 'line)))
(when file
(format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)))
gdb-disassembly-handler
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(define-key map "q" 'kill-this-buffer)
- map))
+ map))
(define-derived-mode gdb-disassembly-mode gdb-parent-mode "Disassembly"
- "Major mode for GDB disassembly information.
-
-\\{gdb-disassembly-mode-map}"
+ "Major mode for GDB disassembly information."
;; TODO Rename overlay variable for disassembly mode
(add-to-list 'overlay-arrow-variable-list 'gdb-disassembly-position)
(setq fringes-outside-margins t)
(set (make-local-variable 'gdb-disassembly-position) (make-marker))
(set (make-local-variable 'font-lock-defaults)
'(gdb-disassembly-font-lock-keywords))
- (run-mode-hooks 'gdb-disassembly-mode-hook)
'gdb-invalidate-disassembly)
(defun gdb-disassembly-handler-custom ()
- (let* ((instructions (gdb-get-field (gdb-json-partial-output) 'asm_insns))
- (address (gdb-get-field (gdb-current-buffer-frame) 'addr))
- (pos 1)
+ (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns))
+ (address (bindat-get-field (gdb-current-buffer-frame) 'addr))
(table (make-gdb-table))
(marked-line nil))
- (dolist (instr instructions)
+ (dolist (instr instructions)
(gdb-table-add-row table
- (list
- (gdb-get-field instr 'address)
- (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset)))
- (gdb-get-field instr 'inst)))
- (when (string-equal (gdb-get-field instr 'address)
+ (list
+ (bindat-get-field instr 'address)
+ (apply #'format "<%s+%s>:"
+ (gdb-get-many-fields instr 'func-name 'offset))
+ (bindat-get-field instr 'inst)))
+ (when (string-equal (bindat-get-field instr 'address)
address)
(progn
(setq marked-line (length (gdb-table-rows table)))
(if (string-equal gdb-frame-number "0")
nil
'((overlay-arrow . hollow-right-triangle)))))))
- (insert (gdb-table-string table " "))
- (gdb-disassembly-place-breakpoints)
- ;; Mark current position with overlay arrow and scroll window to
- ;; that point
- (when marked-line
- (let ((window (get-buffer-window (current-buffer) 0)))
- (set-window-point window (gdb-mark-line marked-line gdb-disassembly-position))))
- (setq mode-name
- (gdb-current-context-mode-name
- (concat "Disassembly: "
- (gdb-get-field (gdb-current-buffer-frame) 'func))))))
+ (insert (gdb-table-string table " "))
+ (gdb-disassembly-place-breakpoints)
+ ;; Mark current position with overlay arrow and scroll window to
+ ;; that point
+ (when marked-line
+ (let ((window (get-buffer-window (current-buffer) 0)))
+ (set-window-point window (gdb-mark-line marked-line
+ gdb-disassembly-position))))
+ (setq mode-name
+ (gdb-current-context-mode-name
+ (concat "Disassembly: "
+ (bindat-get-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 (gdb-get-field breakpoint 'number))
- (flag (gdb-get-field breakpoint 'enabled))
- (address (gdb-get-field breakpoint 'addr)))
+ (bptno (bindat-get-field breakpoint 'number))
+ (flag (bindat-get-field breakpoint 'enabled))
+ (address (bindat-get-field breakpoint 'addr)))
(save-excursion
(goto-char (point-min))
(if (re-search-forward (concat "^" address) nil t)
nil nil mode-line)
" "
(gdb-propertize-header "Threads" gdb-threads-buffer
- "mouse-1: select" mode-line-highlight mode-line-inactive)))
+ "mouse-1: select" mode-line-highlight
+ mode-line-inactive)))
;;; Breakpoints view
(define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints"
- "Major mode for gdb breakpoints.
-
-\\{gdb-breakpoints-mode-map}"
+ "Major mode for gdb breakpoints."
(setq header-line-format gdb-breakpoints-header)
- (run-mode-hooks 'gdb-breakpoints-mode-hook)
'gdb-invalidate-breakpoints)
(defun gdb-toggle-breakpoint ()
(let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
(if breakpoint
(gud-basic-call
- (concat (if (string-equal "y" (gdb-get-field breakpoint 'enabled))
+ (concat (if (equal "y" (bindat-get-field breakpoint 'enabled))
"-break-disable "
"-break-enable ")
- (gdb-get-field breakpoint 'number)))
+ (bindat-get-field breakpoint 'number)))
(error "Not recognized as break/watchpoint line")))))
(defun gdb-delete-breakpoint ()
"Delete the breakpoint at current line of breakpoints buffer."
(interactive)
(save-excursion
- (beginning-of-line)
- (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
- (if breakpoint
- (gud-basic-call (concat "-break-delete " (gdb-get-field breakpoint 'number)))
- (error "Not recognized as break/watchpoint line")))))
+ (beginning-of-line)
+ (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
+ (if breakpoint
+ (gud-basic-call (concat "-break-delete "
+ (bindat-get-field breakpoint 'number)))
+ (error "Not recognized as break/watchpoint line")))))
(defun gdb-goto-breakpoint (&optional event)
"Go to the location of breakpoint at current line of
(let ((window (get-buffer-window gud-comint-buffer)))
(if window (save-selected-window (select-window window))))
(save-excursion
- (beginning-of-line)
- (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
- (if breakpoint
- (let ((bptno (gdb-get-field breakpoint 'number))
- (file (gdb-get-field breakpoint 'fullname))
- (line (gdb-get-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)
- (with-current-buffer buffer
- (goto-char (point-min))
- (forward-line (1- (string-to-number line)))
- (set-window-point window (point))))))
- (error "Not recognized as break/watchpoint line")))))
+ (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)))
+ (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)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (forward-line (1- (string-to-number line)))
+ (set-window-point window (point))))))
+ (error "Not recognized as break/watchpoint line")))))
\f
-;; Frames buffer. This displays a perpetually correct bactrack trace.
+;; Frames buffer. This displays a perpetually correct backtrack trace.
;;
(def-gdb-trigger-and-handler
gdb-invalidate-frames (gdb-current-context-command "-stack-list-frames")
FRAME must have either \"file\" and \"line\" members or \"from\"
member."
- (let ((file (gdb-get-field frame 'file))
- (line (gdb-get-field frame 'line))
- (from (gdb-get-field frame 'from)))
+ (let ((file (bindat-get-field frame 'file))
+ (line (bindat-get-field frame 'line))
+ (from (bindat-get-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 (gdb-get-field (gdb-json-partial-output "frame") 'stack))
+ (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack))
(table (make-gdb-table)))
(set-marker gdb-stack-position nil)
- (dolist (frame stack)
- (gdb-table-add-row table
- (list
- (gdb-get-field frame 'level)
- "in"
- (concat
- (gdb-get-field frame 'func)
- (if gdb-stack-buffer-locations
- (gdb-frame-location frame) "")
- (if gdb-stack-buffer-addresses
- (concat " at " (gdb-get-field frame 'addr)) "")))
- `(mouse-face highlight
- help-echo "mouse-2, RET: Select frame"
- gdb-frame ,frame)))
- (insert (gdb-table-string table " ")))
+ (dolist (frame stack)
+ (gdb-table-add-row table
+ (list
+ (bindat-get-field frame 'level)
+ "in"
+ (concat
+ (bindat-get-field frame 'func)
+ (if gdb-stack-buffer-locations
+ (gdb-frame-location frame) "")
+ (if gdb-stack-buffer-addresses
+ (concat " at " (bindat-get-field frame 'addr)) "")))
+ `(mouse-face highlight
+ help-echo "mouse-2, RET: Select frame"
+ gdb-frame ,frame)))
+ (insert (gdb-table-string table " ")))
(when (and gdb-frame-number
(gdb-buffer-shows-main-thread-p))
(gdb-mark-line (1+ (string-to-number gdb-frame-number))
(concat "stack frames of " (gdb-get-target-string))))
(def-gdb-display-buffer
- gdb-display-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack.")
+ gdb-display-stack-buffer
+ 'gdb-stack-buffer
+ "Display backtrace of current stack.")
(def-gdb-preempt-display-buffer
gdb-preemptively-display-stack-buffer
'gdb-stack-buffer nil t)
(def-gdb-frame-for-buffer
- gdb-frame-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack in a new frame.")
+ gdb-frame-stack-buffer
+ 'gdb-stack-buffer
+ "Display backtrace of current stack in a new frame.")
(defvar gdb-frames-mode-map
(let ((map (make-sparse-keymap)))
"Font lock keywords used in `gdb-frames-mode'.")
(define-derived-mode gdb-frames-mode gdb-parent-mode "Frames"
- "Major mode for gdb call stack.
-
-\\{gdb-frames-mode-map}"
+ "Major mode for gdb call stack."
(setq gdb-stack-position (make-marker))
(add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
(setq truncate-lines t) ;; Make it easier to see overlay arrow.
(set (make-local-variable 'font-lock-defaults)
'(gdb-frames-font-lock-keywords))
- (run-mode-hooks 'gdb-frames-mode-hook)
'gdb-invalidate-frames)
(defun gdb-select-frame (&optional event)
(let ((frame (get-text-property (point) 'gdb-frame)))
(if frame
(if (gdb-buffer-shows-main-thread-p)
- (let ((new-level (gdb-get-field frame 'level)))
+ (let ((new-level (bindat-get-field frame 'level)))
(setq gdb-frame-number new-level)
- (gdb-input (list (concat "-stack-select-frame " new-level) 'ignore))
+ (gdb-input (list (concat "-stack-select-frame " new-level)
+ 'ignore))
(gdb-update))
- (error "Could not select frame for non-current thread."))
+ (error "Could not select frame for non-current thread"))
(error "Not recognized as frame line"))))
\f
;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
(def-gdb-trigger-and-handler
gdb-invalidate-locals
- (concat (gdb-current-context-command "-stack-list-locals") " --simple-values")
+ (concat (gdb-current-context-command "-stack-list-locals")
+ " --simple-values")
gdb-locals-handler gdb-locals-handler-custom
'(start update))
(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.")
+ "Keymap to create watch expression of a complex data type local variable.")
(defvar gdb-edit-locals-map-1
(let ((map (make-sparse-keymap)))
(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.")
+ "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."
(save-excursion
(if event (posn-set-point (event-end event)))
(beginning-of-line)
- (let* ((var (gdb-get-field
+ (let* ((var (bindat-get-field
(get-text-property (point) 'gdb-local-variable) 'name))
(value (read-string (format "New value (%s): " var))))
(gud-basic-call
;; Dont display values of arrays or structures.
;; These can be expanded using gud-watch.
(defun gdb-locals-handler-custom ()
- (let ((locals-list (gdb-get-field (gdb-json-partial-output) 'locals))
+ (let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals))
(table (make-gdb-table)))
(dolist (local locals-list)
- (let ((name (gdb-get-field local 'name))
- (value (gdb-get-field local 'value))
- (type (gdb-get-field local 'type)))
+ (let ((name (bindat-get-field local 'name))
+ (value (bindat-get-field local 'value))
+ (type (bindat-get-field local 'type)))
(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)
- name)
+ `(mouse-face highlight
+ help-echo "mouse-2: create watch expression"
+ local-map ,gdb-locals-watch-map)
+ name)
(add-text-properties 0 (length value)
`(mouse-face highlight
- help-echo "mouse-2: edit value"
- local-map ,gdb-edit-locals-map-1)
+ help-echo "mouse-2: edit value"
+ local-map ,gdb-edit-locals-map-1)
value))
(gdb-table-add-row
table
(insert (gdb-table-string table " "))
(setq mode-name
(gdb-current-context-mode-name
- (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func))))))
+ (concat "Locals: "
+ (bindat-get-field (gdb-current-buffer-frame) 'func))))))
(defvar gdb-locals-header
(list
nil nil mode-line)
" "
(gdb-propertize-header "Registers" gdb-registers-buffer
- "mouse-1: select" mode-line-highlight mode-line-inactive)))
+ "mouse-1: select" mode-line-highlight
+ mode-line-inactive)))
(defvar gdb-locals-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(define-key map "q" 'kill-this-buffer)
- (define-key map "\t" '(lambda ()
- (interactive)
- (gdb-set-window-buffer
- (gdb-get-buffer-create
- 'gdb-registers-buffer
- gdb-thread-number) t)))
- map))
+ (define-key map "\t" (lambda ()
+ (interactive)
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create
+ 'gdb-registers-buffer
+ gdb-thread-number) t)))
+ map))
(define-derived-mode gdb-locals-mode gdb-parent-mode "Locals"
- "Major mode for gdb locals.
-
-\\{gdb-locals-mode-map}"
+ "Major mode for gdb locals."
(setq header-line-format gdb-locals-header)
- (run-mode-hooks 'gdb-locals-mode-hook)
'gdb-invalidate-locals)
(defun gdb-locals-buffer-name ()
(concat "locals of " (gdb-get-target-string))))
(def-gdb-display-buffer
- gdb-display-locals-buffer
- 'gdb-locals-buffer
- "Display local variables of current stack and their values.")
+ gdb-display-locals-buffer
+ 'gdb-locals-buffer
+ "Display local variables of current stack and their values.")
(def-gdb-preempt-display-buffer
- gdb-preemptively-display-locals-buffer
- 'gdb-locals-buffer nil t)
+ gdb-preemptively-display-locals-buffer
+ 'gdb-locals-buffer nil t)
(def-gdb-frame-for-buffer
- gdb-frame-locals-buffer
- 'gdb-locals-buffer
- "Display local variables of current stack and their values in a new frame.")
+ gdb-frame-locals-buffer
+ 'gdb-locals-buffer
+ "Display local variables of current stack and their values in a new frame.")
\f
;; Registers buffer.
(defun gdb-registers-handler-custom ()
(when gdb-register-names
- (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values))
+ (let ((register-values
+ (bindat-get-field (gdb-json-partial-output) 'register-values))
(table (make-gdb-table)))
(dolist (register register-values)
- (let* ((register-number (gdb-get-field register 'number))
- (value (gdb-get-field register 'value))
+ (let* ((register-number (bindat-get-field register 'number))
+ (value (bindat-get-field register 'value))
(register-name (nth (string-to-number register-number)
gdb-register-names)))
(gdb-table-add-row
table
(list
- (propertize register-name 'font-lock-face font-lock-variable-name-face)
+ (propertize register-name
+ 'font-lock-face font-lock-variable-name-face)
(if (member register-number gdb-changed-registers)
(propertize value 'font-lock-face font-lock-warning-face)
value))
(save-excursion
(if event (posn-set-point (event-end event)))
(beginning-of-line)
- (let* ((var (gdb-get-field
+ (let* ((var (bindat-get-field
(get-text-property (point) 'gdb-register-name)))
(value (read-string (format "New value (%s): " var))))
(gud-basic-call
(define-key map "\r" 'gdb-edit-register-value)
(define-key map [mouse-2] 'gdb-edit-register-value)
(define-key map "q" 'kill-this-buffer)
- (define-key map "\t" '(lambda ()
- (interactive)
- (gdb-set-window-buffer
- (gdb-get-buffer-create
- 'gdb-locals-buffer
- gdb-thread-number) t)))
+ (define-key map "\t" (lambda ()
+ (interactive)
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create
+ 'gdb-locals-buffer
+ gdb-thread-number) t)))
map))
(defvar gdb-registers-header
(list
(gdb-propertize-header "Locals" gdb-locals-buffer
- "mouse-1: select" mode-line-highlight mode-line-inactive)
+ "mouse-1: select" mode-line-highlight
+ mode-line-inactive)
" "
(gdb-propertize-header "Registers" gdb-registers-buffer
nil nil mode-line)))
(define-derived-mode gdb-registers-mode gdb-parent-mode "Registers"
- "Major mode for gdb registers.
-
-\\{gdb-registers-mode-map}"
+ "Major mode for gdb registers."
(setq header-line-format gdb-registers-header)
- (run-mode-hooks 'gdb-registers-mode-hook)
'gdb-invalidate-registers)
(defun gdb-registers-buffer-name ()
(concat "registers of " (gdb-get-target-string))))
(def-gdb-display-buffer
- gdb-display-registers-buffer
- 'gdb-registers-buffer
- "Display integer register contents.")
+ gdb-display-registers-buffer
+ 'gdb-registers-buffer
+ "Display integer register contents.")
(def-gdb-preempt-display-buffer
gdb-preemptively-display-registers-buffer
- 'gdb-registers-buffer nil t)
+ 'gdb-registers-buffer nil t)
(def-gdb-frame-for-buffer
- gdb-frame-registers-buffer
- 'gdb-registers-buffer
+ gdb-frame-registers-buffer
+ 'gdb-registers-buffer
"Display integer register contents in a new frame.")
;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-changed-registers-handler ()
(gdb-delete-pending 'gdb-get-changed-registers)
(setq gdb-changed-registers nil)
- (dolist (register-number (gdb-get-field (gdb-json-partial-output) 'changed-registers))
+ (dolist (register-number
+ (bindat-get-field (gdb-json-partial-output) 'changed-registers))
(push register-number gdb-changed-registers)))
(defun gdb-register-names-handler ()
;; Don't use gdb-pending-triggers because this handler is called
;; only once (in gdb-init-1)
(setq gdb-register-names nil)
- (dolist (register-name (gdb-get-field (gdb-json-partial-output) 'register-names))
+ (dolist (register-name
+ (bindat-get-field (gdb-json-partial-output) 'register-names))
(push register-name gdb-register-names))
(setq gdb-register-names (reverse gdb-register-names)))
\f
(if (not (gdb-pending-p 'gdb-get-main-selected-frame))
(progn
(gdb-input
- (list (gdb-current-context-command "-stack-info-frame") 'gdb-frame-handler))
+ (list (gdb-current-context-command "-stack-info-frame")
+ 'gdb-frame-handler))
(gdb-add-pending 'gdb-get-main-selected-frame))))
(defun gdb-frame-handler ()
"Sets `gdb-selected-frame' and `gdb-selected-file' to show
overlay arrow in source buffer."
(gdb-delete-pending 'gdb-get-main-selected-frame)
- (let ((frame (gdb-get-field (gdb-json-partial-output) 'frame)))
+ (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame)))
(when frame
- (setq gdb-selected-frame (gdb-get-field frame 'func))
- (setq gdb-selected-file (gdb-get-field frame 'fullname))
- (setq gdb-frame-number (gdb-get-field frame 'level))
- (let ((line (gdb-get-field frame 'line)))
- (setq gdb-selected-line (or (and line (string-to-number line))
- nil)) ; don't fail if line is nil
- (when line ; obey the current file only if we have line info
+ (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-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))
(gud-display-frame)))
(if gud-overlay-arrow-position
already, in which case that window is splitted first."
(let ((answer (get-buffer-window buf (or frame 0))))
(if answer
- (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary.
+ (display-buffer buf nil (or frame 0)) ;Deiconify frame if necessary.
(let ((window (get-lru-window)))
(if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
- 'gdbmi)
- (let* ((largest (get-largest-window))
- (cur-size (window-height largest)))
+ 'gdbmi)
+ (let ((largest (get-largest-window)))
(setq answer (split-window largest))
(set-window-buffer answer buf)
(set-window-dedicated-p answer dedicated)
'("Disassembly" . gdb-display-disassembly-buffer))
(define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
(define-key menu [inferior]
- '("Separate IO" . gdb-display-separate-io-buffer))
+ '("IO" . gdb-display-io-buffer))
(define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
(define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
(define-key menu [breakpoints]
(define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
(define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
(define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
- (define-key menu [disassembly] '("Disassembly" . gdb-frame-disassembly-buffer))
+ (define-key menu [disassembly]
+ '("Disassembly" . gdb-frame-disassembly-buffer))
(define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
(define-key menu [inferior]
- '("Separate IO" . gdb-frame-separate-io-buffer))
+ '("IO" . gdb-frame-io-buffer))
(define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
(define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
(define-key menu [breakpoints]
(let ((menu (make-sparse-keymap "GDB-MI")))
(define-key menu [gdb-customize]
- '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
- :help "Customize Gdb Graphical Mode options."))
+ '(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)))
+ '(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."))
+ '(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))
- :help "GUD start/stop commands apply to all threads"
- :button (:radio . gdb-gud-control-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))
- :help "GUD start/stop commands apply to current thread only"
- :button (:radio . (not gdb-gud-control-all-threads))))
+ (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))))
+ (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
+ (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"))
;; show up right before Run button.
(define-key-after gud-tool-bar-map [all-threads]
'(menu-item "Switch to non-stop/A mode" gdb-control-all-threads
- :image (find-image '((:type xpm :file "gud/thread.xpm")))
- :visible (and (eq gud-minor-mode 'gdbmi)
- gdb-non-stop
- (not gdb-gud-control-all-threads)))
+ :image (find-image '((:type xpm :file "gud/thread.xpm")))
+ :visible (and (eq gud-minor-mode 'gdbmi)
+ gdb-non-stop
+ (not gdb-gud-control-all-threads)))
'run)
(define-key-after gud-tool-bar-map [current-thread]
'(menu-item "Switch to non-stop/T mode" gdb-control-current-thread
- :image (find-image '((:type xpm :file "gud/all.xpm")))
- :visible (and (eq gud-minor-mode 'gdbmi)
- gdb-non-stop
- gdb-gud-control-all-threads))
+ :image (find-image '((:type xpm :file "gud/all.xpm")))
+ :visible (and (eq gud-minor-mode 'gdbmi)
+ gdb-non-stop
+ gdb-gud-control-all-threads))
'all-threads)
(defun gdb-frame-gdb-buffer ()
"Display GUD buffer in a new frame."
(interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist
- (remove '(menu-bar-lines) (remove '(tool-bar-lines)
- gdb-frame-parameters)))
- (same-window-regexps nil))
- (display-buffer gud-comint-buffer)))
+ (display-buffer-other-frame gud-comint-buffer))
(defun gdb-display-gdb-buffer ()
"Display GUD buffer."
(interactive)
- (let ((same-window-regexps nil))
- (select-window (display-buffer gud-comint-buffer nil 0))))
+ (pop-to-buffer gud-comint-buffer nil 0))
-(defun gdb-set-window-buffer (name &optional ignore-dedicated)
+(defun gdb-set-window-buffer (name &optional ignore-dedicated window)
"Set buffer of selected window to NAME and dedicate window.
When IGNORE-DEDICATED is non-nil, buffer is set even if selected
window is dedicated."
+ (unless window (setq window (selected-window)))
(when ignore-dedicated
- (set-window-dedicated-p (selected-window) nil))
- (set-window-buffer (selected-window) (get-buffer name))
- (set-window-dedicated-p (selected-window) t))
+ (set-window-dedicated-p window nil))
+ (set-window-buffer window (get-buffer name))
+ (set-window-dedicated-p window t))
(defun gdb-setup-windows ()
"Layout the window pattern for `gdb-many-windows'."
(delete-other-windows)
(gdb-display-breakpoints-buffer)
(delete-other-windows)
- ; Don't dedicate.
- (pop-to-buffer gud-comint-buffer)
- (split-window nil ( / ( * (window-height) 3) 4))
- (split-window nil ( / (window-height) 3))
- (split-window-horizontally)
- (other-window 1)
- (gdb-set-window-buffer (gdb-locals-buffer-name))
- (other-window 1)
- (switch-to-buffer
- (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))
- (split-window-horizontally)
- (other-window 1)
- (gdb-set-window-buffer
- (gdb-get-buffer-create 'gdb-inferior-io))
- (other-window 1)
- (gdb-set-window-buffer (gdb-stack-buffer-name))
- (split-window-horizontally)
- (other-window 1)
- (gdb-set-window-buffer (if gdb-show-threads-by-default
- (gdb-threads-buffer-name)
- (gdb-breakpoints-buffer-name)))
- (other-window 1))
+ ;; Don't dedicate.
+ (switch-to-buffer gud-comint-buffer)
+ (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)))
(defcustom gdb-many-windows nil
"If nil just pop up the GUD buffer unless `gdb-show-main' is t.
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)))
+ (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 gdb-many-windows "en" "dis")))
(if (and gud-comint-buffer
- (buffer-name gud-comint-buffer))
+ (buffer-name gud-comint-buffer))
(condition-case nil
- (gdb-restore-windows)
- (error nil))))
+ (gdb-restore-windows)
+ (error nil))))
(defun gdb-restore-windows ()
"Restore the basic arrangement of windows used by gdb.
This arrangement depends on the value of `gdb-many-windows'."
(interactive)
- (pop-to-buffer gud-comint-buffer) ;Select the right window and frame.
- (delete-other-windows)
+ (switch-to-buffer gud-comint-buffer) ;Select the right window and frame.
+ (delete-other-windows)
(if gdb-many-windows
(gdb-setup-windows)
(when (or gud-last-last-frame gdb-show-main)
- (split-window)
- (other-window 1)
- (switch-to-buffer
- (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))))
+ (let ((win (split-window)))
+ (set-window-buffer
+ win
+ (if gud-last-last-frame
+ (gud-find-file (car gud-last-last-frame))
+ (gud-find-file gdb-main-file)))
+ (setq gdb-source-window win)))))
(defun gdb-reset ()
"Exit a debugging session cleanly.
(dolist (buffer (buffer-list))
(unless (eq buffer gud-comint-buffer)
(with-current-buffer buffer
- (if (eq gud-minor-mode 'gdbmi)
- (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))))))
+ (if (eq gud-minor-mode 'gdbmi)
+ (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))))))
(setq gdb-disassembly-position nil)
(setq overlay-arrow-variable-list
- (delq 'gdb-disassembly-position overlay-arrow-variable-list))
+ (delq 'gdb-disassembly-position overlay-arrow-variable-list))
(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))
+ (delq 'gdb-stack-position overlay-arrow-variable-list))
(setq gdb-thread-position nil)
(setq overlay-arrow-variable-list
- (delq 'gdb-thread-position overlay-arrow-variable-list))
+ (delq 'gdb-thread-position overlay-arrow-variable-list))
(if (boundp 'speedbar-frame) (speedbar-timer-fn))
(setq gud-running nil)
(setq gdb-active-process nil)
(goto-char (point-min))
(if (re-search-forward gdb-source-file-regexp nil t)
(setq gdb-main-file (match-string 1)))
- (if gdb-many-windows
+ (if gdb-many-windows
(gdb-setup-windows)
- (gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (if gdb-show-main
- (let ((pop-up-windows t))
- (display-buffer (gud-find-file gdb-main-file))))))
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer)
+ (if gdb-show-main
+ (let ((pop-up-windows t))
+ (display-buffer (gud-find-file gdb-main-file))))))
;;from put-image
(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
`before-string' string that has a `display' property whose value is
PUTSTRING."
(let ((string (make-string 1 ?x))
- (buffer (current-buffer)))
+ (buffer (current-buffer)))
(setq putstring (copy-sequence putstring))
(let ((overlay (make-overlay pos pos buffer))
- (prop (or dprop
- (list (list 'margin 'left-margin) putstring))))
+ (prop (or dprop
+ (list (list 'margin 'left-margin) putstring))))
(put-text-property 0 1 'display prop string)
(if sprops
- (add-text-properties 0 1 sprops string))
+ (add-text-properties 0 1 sprops string))
(overlay-put overlay 'put-break t)
(overlay-put overlay 'before-string string))))
(setq buffer (current-buffer)))
(dolist (overlay (overlays-in start end))
(when (overlay-get overlay 'put-break)
- (delete-overlay overlay))))
+ (delete-overlay overlay))))
(defun gdb-put-breakpoint-icon (enabled bptno &optional line)
(let* ((posns (gdb-line-posns (or line (line-number-at-pos))))
0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt")
putstring)
(if enabled
- (add-text-properties
- 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
+ (add-text-properties
+ 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
(add-text-properties
0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring))
(gdb-remove-breakpoint-icons start end)
(if (display-images-p)
- (if (>= (or left-fringe-width
- (if source-window (car (window-fringes source-window)))
- gdb-buffer-fringe-width) 8)
- (gdb-put-string
- nil (1+ start)
- `(left-fringe breakpoint
- ,(if enabled
- 'breakpoint-enabled
- 'breakpoint-disabled))
- 'gdb-bptno bptno
- 'gdb-enabled enabled)
- (when (< left-margin-width 2)
- (save-current-buffer
- (setq left-margin-width 2)
- (if source-window
- (set-window-margins
- source-window
- left-margin-width right-margin-width))))
- (put-image
- (if enabled
- (or breakpoint-enabled-icon
- (setq breakpoint-enabled-icon
- (find-image `((:type xpm :data
- ,breakpoint-xpm-data
- :ascent 100 :pointer hand)
- (:type pbm :data
- ,breakpoint-enabled-pbm-data
- :ascent 100 :pointer hand)))))
- (or breakpoint-disabled-icon
- (setq breakpoint-disabled-icon
- (find-image `((:type xpm :data
- ,breakpoint-xpm-data
- :conversion disabled
- :ascent 100 :pointer hand)
- (:type pbm :data
- ,breakpoint-disabled-pbm-data
- :ascent 100 :pointer hand))))))
- (+ start 1)
- putstring
- 'left-margin))
+ (if (>= (or left-fringe-width
+ (if source-window (car (window-fringes source-window)))
+ gdb-buffer-fringe-width) 8)
+ (gdb-put-string
+ nil (1+ start)
+ `(left-fringe breakpoint
+ ,(if enabled
+ 'breakpoint-enabled
+ 'breakpoint-disabled))
+ 'gdb-bptno bptno
+ 'gdb-enabled enabled)
+ (when (< left-margin-width 2)
+ (save-current-buffer
+ (setq left-margin-width 2)
+ (if source-window
+ (set-window-margins
+ source-window
+ left-margin-width right-margin-width))))
+ (put-image
+ (if enabled
+ (or breakpoint-enabled-icon
+ (setq breakpoint-enabled-icon
+ (find-image `((:type xpm :data
+ ,breakpoint-xpm-data
+ :ascent 100 :pointer hand)
+ (:type pbm :data
+ ,breakpoint-enabled-pbm-data
+ :ascent 100 :pointer hand)))))
+ (or breakpoint-disabled-icon
+ (setq breakpoint-disabled-icon
+ (find-image `((:type xpm :data
+ ,breakpoint-xpm-data
+ :conversion disabled
+ :ascent 100 :pointer hand)
+ (:type pbm :data
+ ,breakpoint-disabled-pbm-data
+ :ascent 100 :pointer hand))))))
+ (+ start 1)
+ putstring
+ 'left-margin))
(when (< left-margin-width 2)
- (save-current-buffer
- (setq left-margin-width 2)
- (let ((window (get-buffer-window (current-buffer) 0)))
- (if window
- (set-window-margins
- window left-margin-width right-margin-width)))))
+ (save-current-buffer
+ (setq left-margin-width 2)
+ (let ((window (get-buffer-window (current-buffer) 0)))
+ (if window
+ (set-window-margins
+ window left-margin-width right-margin-width)))))
(gdb-put-string
(propertize putstring
- 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled))
+ 'face (if enabled
+ 'breakpoint-enabled 'breakpoint-disabled))
(1+ start)))))
(defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
(setq left-margin-width 0)
(let ((window (get-buffer-window (current-buffer) 0)))
(if window
- (set-window-margins
- window left-margin-width right-margin-width)))))
+ (set-window-margins
+ window left-margin-width right-margin-width)))))
(provide 'gdb-mi)
-;; arch-tag: 1b41ea2b-f364-4cec-8f35-e02e4fe01912
;;; gdb-mi.el ends here