;;; gdb-mi.el --- User Interface for running GDB -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;; Author: Nick Roberts <nickrob@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, tools
;; This file is part of GNU Emacs.
(require 'gud)
(require 'json)
(require 'bindat)
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
(defvar gdb-last-command nil)
(defvar gdb-prompt-name nil)
(defvar gdb-token-number 0)
-(defvar gdb-handler-alist '())
-(defvar gdb-handler-number nil)
+(defvar gdb-handler-list '()
+ "List of gdb-handler keeping track of all pending GDB commands.")
(defvar gdb-source-file-list nil
"List of source files for the current executable.")
(defvar gdb-first-done-or-error t)
disposition of output generated by commands that
gdb mode sends to gdb on its own behalf.")
-;; Pending triggers prevent congestion: Emacs won't send two similar
-;; consecutive requests.
-
-(defvar gdb-pending-triggers '()
- "A list of trigger functions which have not yet been handled.
-
-Elements are either function names or pairs (buffer . function)")
-
-(defmacro gdb-add-pending (item)
- `(push ,item gdb-pending-triggers))
-(defmacro gdb-pending-p (item)
- `(member ,item gdb-pending-triggers))
-(defmacro gdb-delete-pending (item)
- `(setq gdb-pending-triggers
- (delete ,item gdb-pending-triggers)))
+(defcustom gdb-discard-unordered-replies t
+ "Non-nil means discard any out-of-order GDB replies.
+This protects against lost GDB replies, assuming that GDB always
+replies in the same order as Emacs sends commands. When receiving a
+reply with a given token-number, assume any pending messages with a
+lower token-number are out-of-order."
+ :type 'boolean
+ :group 'gud
+ :version "24.4")
+
+(cl-defstruct gdb-handler
+ "Data required to handle the reply of a command sent to GDB."
+ ;; Prefix of the command sent to GDB. The GDB reply for this command
+ ;; will be prefixed with this same TOKEN-NUMBER
+ (token-number nil :read-only t)
+ ;; Callback to invoke when the reply is received from GDB
+ (function nil :read-only t)
+ ;; PENDING-TRIGGER is used to prevent congestion: Emacs won't send
+ ;; two requests with the same PENDING-TRIGGER until a reply is received
+ ;; for the first one."
+ (pending-trigger nil))
+
+(defun gdb-add-handler (token-number handler-function &optional pending-trigger)
+ "Insert a new GDB command handler in `gdb-handler-list'.
+Handlers are used to keep track of the commands sent to GDB
+and to handle the replies received.
+Upon reception of a reply prefixed with TOKEN-NUMBER,
+invoke the callback HANDLER-FUNCTION.
+If PENDING-TRIGGER is specified, no new GDB commands will be
+sent with this same PENDING-TRIGGER until a reply is received
+for this handler."
+
+ (push (make-gdb-handler :token-number token-number
+ :function handler-function
+ :pending-trigger pending-trigger)
+ gdb-handler-list))
+
+(defun gdb-delete-handler (token-number)
+ "Remove the handler TOKEN-NUMBER from `gdb-handler-list'.
+Additionally, if `gdb-discard-unordered-replies' is non-nil,
+discard all handlers having a token number less than TOKEN-NUMBER."
+ (if gdb-discard-unordered-replies
+
+ (setq gdb-handler-list
+ (cl-delete-if
+ (lambda (handler)
+ "Discard any HANDLER with a token number `<=' than TOKEN-NUMBER."
+ (when (< (gdb-handler-token-number handler) token-number)
+ (message "WARNING! Discarding GDB handler with token #%d\n"
+ (gdb-handler-token-number handler)))
+ (<= (gdb-handler-token-number handler) token-number))
+ gdb-handler-list))
+
+ (setq gdb-handler-list
+ (cl-delete-if
+ (lambda (handler)
+ "Discard any HANDLER with a token number `eq' to TOKEN-NUMBER."
+ (eq (gdb-handler-token-number handler) token-number))
+ gdb-handler-list))))
+
+(defun gdb-get-handler-function (token-number)
+ "Return the function callback registered with the handler TOKEN-NUMBER."
+ (gdb-handler-function
+ (cl-find-if (lambda (handler) (eq (gdb-handler-token-number handler)
+ token-number))
+ gdb-handler-list)))
+
+
+(defun gdb-pending-handler-p (pending-trigger)
+ "Return non-nil if a command handler is pending with trigger PENDING-TRIGGER."
+ (cl-find-if (lambda (handler) (eq (gdb-handler-pending-trigger handler)
+ pending-trigger))
+ gdb-handler-list))
+
+
+(defun gdb-handle-reply (token-number)
+ "Handle the GDB reply TOKEN-NUMBER.
+This invokes the handler registered with this token number
+in `gdb-handler-list' and clears all pending handlers invalidated
+by the reception of this reply."
+ (let ((handler-function (gdb-get-handler-function token-number)))
+ (when handler-function
+ (funcall handler-function)
+ (gdb-delete-handler token-number))))
+
+(defun gdb-remove-all-pending-triggers ()
+ "Remove all pending triggers from gdb-handler-list.
+The handlers are left in gdb-handler-list so that replies received
+from GDB could still be handled. However, removing the pending triggers
+allows Emacs to send new commands even if replies of previous commands
+were not yet received."
+ (dolist (handler gdb-handler-list)
+ (setf (gdb-handler-pending-trigger handler) nil)))
(defmacro gdb-wait-for-pending (&rest body)
- "Wait until `gdb-pending-triggers' is empty and evaluate FORM.
-
-This function checks `gdb-pending-triggers' value every
-`gdb-wait-for-pending' seconds."
- (run-with-timer
- 0.5 nil
- `(lambda ()
- (if (not gdb-pending-triggers)
- (progn ,@body)
- (gdb-wait-for-pending ,@body)))))
+ "Wait for all pending GDB commands to finish and evaluate BODY.
+
+This function checks every 0.5 seconds if there are any pending
+triggers in `gdb-handler-list'."
+ `(run-with-timer
+ 0.5 nil
+ '(lambda ()
+ (if (not (cl-find-if (lambda (handler)
+ (gdb-handler-pending-trigger handler))
+ gdb-handler-list))
+ (progn ,@body)
+ (gdb-wait-for-pending ,@body)))))
;; Publish-subscribe
(concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
,(when (not noarg) 'arg)))
-(defun gdb--check-interpreter (proc string)
+(defun gdb--check-interpreter (filter 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))))
+ (remove-function (process-filter proc) #'gdb--check-interpreter)
+ (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=))
+ ;; Apparently we're not running with -i=mi.
+ (let ((msg "Error: you did not specify -i=mi on GDB's command line!"))
+ (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)))
(defvar gdb-control-level 0)
;; 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))
+ (add-function :around (process-filter proc) #'gdb--check-interpreter))
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
(set (make-local-variable 'gdb-control-level) 0)
gdb-frame-number nil
gdb-thread-number nil
gdb-var-list nil
- gdb-pending-triggers nil
gdb-output-sink 'user
gdb-location-alist nil
gdb-source-file-list nil
gdb-last-command nil
gdb-token-number 0
- gdb-handler-alist '()
- gdb-handler-number nil
+ gdb-handler-list '()
gdb-prompt-name nil
gdb-first-done-or-error t
gdb-buffer-fringe-width (car (window-fringes))
(eq gud-minor-mode 'gdbmi))
(error "Not in a GDB-MI buffer"))
(let ((proc (get-buffer-process gud-comint-buffer)))
- (if (and (eobp) proc (process-live-p proc)
+ (if (and (eobp)
+ (process-live-p proc)
(not gud-running)
(= (point) (marker-position (process-mark proc))))
;; Sending an EOF does not work with GDB-MI; submit an
(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
+(defconst gdb--string-regexp "\"\\(?:[^\\\"]\\|\\\\.\\)*\"")
+
(defun gdb-tooltip-print (expr)
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-min))
(cond
- ((re-search-forward ".*value=\\(\".*\"\\)" nil t)
+ ((re-search-forward (concat ".*value=\\(" gdb--string-regexp
+ "\\)")
+ nil t)
(tooltip-show
(concat expr " = " (read (match-string 1)))
(or gud-tooltip-echo-area
(message-box "No symbol \"%s\" in current context." expr))))
(defun gdb-speedbar-update ()
- (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
- (not (gdb-pending-p 'gdb-speedbar-timer)))
+ (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
;; Dummy command to update speedbar even when idle.
- (gdb-input "-environment-pwd" 'gdb-speedbar-timer-fn)
- ;; Keep gdb-pending-triggers non-nil till end.
- (gdb-add-pending 'gdb-speedbar-timer)))
+ (gdb-input "-environment-pwd"
+ 'gdb-speedbar-timer-fn
+ 'gdb-speedbar-update)))
(defun gdb-speedbar-timer-fn ()
(if gdb-speedbar-auto-raise
(raise-frame speedbar-frame))
- (gdb-delete-pending 'gdb-speedbar-timer)
(speedbar-timer-fn))
(defun gdb-var-evaluate-expression-handler (varnum changed)
(goto-char (point-min))
- (re-search-forward ".*value=\\(\".*\"\\)" nil t)
+ (re-search-forward (concat ".*value=\\(" gdb--string-regexp "\\)")
+ nil t)
(let ((var (assoc varnum gdb-var-list)))
(when var
(if changed (setcar (nthcdr 5 var) 'changed))
; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
(defun gdb-var-update ()
- (if (not (gdb-pending-p 'gdb-var-update))
- (gdb-input "-var-update --all-values *" 'gdb-var-update-handler))
- (gdb-add-pending 'gdb-var-update))
+ (gdb-input "-var-update --all-values *"
+ 'gdb-var-update-handler
+ 'gdb-var-update))
(defun gdb-var-update-handler ()
(let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist)))
(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)
split-horizontal)
`(defun ,name (&optional thread)
,(when doc doc)
- (message thread)
+ (message "%s" thread)
(gdb-preempt-existing-or-display-buffer
(gdb-get-buffer-create ,buffer thread)
,split-horizontal)))
;; read from the pty, and stops listening to it. If the gdb
;; process is still running, remove the pty, make a new one, and
;; pass it to gdb.
- (let ((gdb-proc (get-buffer-process gud-comint-buffer))
- (io-buffer (process-buffer proc)))
- (when (and gdb-proc (process-live-p gdb-proc)
+ (let ((io-buffer (process-buffer proc)))
+ (when (and (process-live-p (get-buffer-process gud-comint-buffer))
(buffer-live-p io-buffer))
;; `comint-exec' deletes the original process as a side effect.
(comint-exec io-buffer "gdb-inferior" nil nil nil)
As long as GDB is in the recursive reading loop, it does not expect
commands to be prefixed by \"-interpreter-exec console\".")
+(defun gdb-strip-string-backslash (string)
+ (replace-regexp-in-string "\\\\$" "" string))
+
(defun gdb-send (proc string)
"A comint send filter for gdb."
(with-current-buffer gud-comint-buffer
(remove-text-properties (point-min) (point-max) '(face))))
;; mimic <RET> key to repeat previous command in GDB
(if (not (string= "" string))
- (setq gdb-last-command string)
- (if gdb-last-command (setq string gdb-last-command)))
- (if (or (string-match "^-" string)
- (> gdb-control-level 0))
+ (if gdb-continuation
+ (setq gdb-last-command (concat gdb-continuation
+ (gdb-strip-string-backslash string)
+ " "))
+ (setq gdb-last-command (gdb-strip-string-backslash string)))
+ (if gdb-last-command (setq string gdb-last-command))
+ (setq gdb-continuation nil))
+ (if (and (not gdb-continuation) (or (string-match "^-" string)
+ (> gdb-control-level 0)))
;; Either MI command or we are feeding GDB's recursive reading loop.
(progn
(setq gdb-first-done-or-error t)
(setq gdb-control-level (1- gdb-control-level))))
;; CLI command
(if (string-match "\\\\$" string)
- (setq gdb-continuation (concat gdb-continuation string "\n"))
+ (setq gdb-continuation
+ (concat gdb-continuation (gdb-strip-string-backslash
+ string)
+ " "))
(setq gdb-first-done-or-error t)
(let ((to-send (concat "-interpreter-exec console "
- (gdb-mi-quote string)
+ (gdb-mi-quote (concat gdb-continuation string " "))
"\n")))
(if gdb-enable-debug
(push (cons 'mi-send to-send) gdb-debug-log))
(setq string (replace-regexp-in-string "\n" "\\n" string t t))
(concat "\"" string "\""))
-(defun gdb-input (command handler-function)
+(defun gdb-input (command handler-function &optional trigger-name)
"Send COMMAND to GDB via the MI interface.
Run the function HANDLER-FUNCTION, with no arguments, once the command is
-complete."
- (if gdb-enable-debug (push (list 'send-item command handler-function)
- gdb-debug-log))
- (setq gdb-token-number (1+ gdb-token-number))
- (setq command (concat (number-to-string gdb-token-number) command))
- (push (cons gdb-token-number handler-function) gdb-handler-alist)
- (if gdbmi-debug-mode (message "gdb-input: %s" command))
- (process-send-string (get-buffer-process gud-comint-buffer)
- (concat command "\n")))
+complete. Do not send COMMAND to GDB if TRIGGER-NAME is non-nil and
+Emacs is still waiting for a reply from another command previously
+sent with the same TRIGGER-NAME."
+ (when (or (not trigger-name)
+ (not (gdb-pending-handler-p trigger-name)))
+ (setq gdb-token-number (1+ gdb-token-number))
+ (setq command (concat (number-to-string gdb-token-number) command))
+
+ (if gdb-enable-debug (push (list 'send-item command handler-function)
+ gdb-debug-log))
+
+ (gdb-add-handler gdb-token-number handler-function trigger-name)
+
+ (if gdbmi-debug-mode (message "gdb-input: %s" command))
+ (process-send-string (get-buffer-process gud-comint-buffer)
+ (concat command "\n"))))
;; NOFRAME is used for gud execution control commands
(defun gdb-current-context-command (command)
(defun gdb-resync()
(setq gud-running nil)
(setq gdb-output-sink 'user)
- (setq gdb-pending-triggers nil))
+ (gdb-remove-all-pending-triggers))
(defun gdb-update (&optional no-proc)
"Update buffers showing status of debug session.
'&' c-string"
(when (< gdbmi-bnf-offset (length gud-marker-acc))
(if (and (member (aref gud-marker-acc gdbmi-bnf-offset) '(?~ ?@ ?&))
- (string-match "\\([~@&]\\)\\(\".*?\"\\)\n" gud-marker-acc
+ (string-match (concat "\\([~@&]\\)\\(" gdb--string-regexp "\\)\n")
+ gud-marker-acc
gdbmi-bnf-offset))
(let ((prefix (match-string 1 gud-marker-acc))
(c-string (match-string 2 gud-marker-acc)))
;; Search the data stream for the end of the current record:
(let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset))
(is-progressive (equal (cdr class-command) 'progressive))
- (is-complete (not (null newline-pos)))
- result-str)
+ (is-complete (not (null newline-pos)))
+ result-str)
+
+ (when gdbmi-debug-mode
+ (message "gdbmi-bnf-incomplete-record-result: %s"
+ (substring gud-marker-acc gdbmi-bnf-offset newline-pos)))
;; Update the gdbmi-bnf-offset only if the current chunk of data can
;; be processed by the class-command handler:
(when (or is-complete is-progressive)
- (setq result-str
+ (setq result-str
(substring gud-marker-acc gdbmi-bnf-offset newline-pos))
- (setq gdbmi-bnf-offset (+ 1 newline-pos)))
- (if gdbmi-debug-mode
- (message "gdbmi-bnf-incomplete-record-result: %s"
- (substring gud-marker-acc gdbmi-bnf-offset newline-pos)))
+ ;; Move gdbmi-bnf-offset past the end of the chunk.
+ (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length result-str)))
+ (when newline-pos
+ (setq gdbmi-bnf-offset (1+ gdbmi-bnf-offset))))
;; Update the parsing state before invoking the handler in class-command
;; to make sure it's not left in an invalid state if the handler was
(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.
+ ;; the pending triggers in gdb-handler-list 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))))
;; by `=thread-selected` notification. `^done` causes `gdb-update`
;; as usually. Things happen to fast and second call (from
;; gdb-thread-selected handler) gets cut off by our beloved
- ;; gdb-pending-triggers.
- ;; Solution is `gdb-wait-for-pending` macro: it guarantees that its
- ;; body will get executed when `gdb-pending-triggers` is empty.
+ ;; pending triggers.
+ ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its
+ ;; body will get executed when `gdb-handler-list' if free of
+ ;; pending triggers.
(gdb-wait-for-pending
(gdb-update))))
(propertize gdb-inferior-status 'face font-lock-type-face))
(when (not gdb-non-stop)
(setq gud-running t))
- (setq gdb-active-process t)
- (gdb-emit-signal gdb-buf-publisher 'update-threads))
+ (setq gdb-active-process t))
(defun gdb-starting (_output-field _result)
;; CLI commands don't emit ^running at the moment so use gdb-running too.
(gdb-force-mode-line-update
(propertize gdb-inferior-status 'face font-lock-type-face))
(setq gdb-active-process t)
- (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.
- ;; Behavior may change in the future.
- (gdb-emit-signal gdb-buf-publisher 'update-threads))
+ (setq gud-running t))
;; -break-insert -t didn't give a reason before gdb 6.9
(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))
+ (message "Switched to thread %s" thread-id)
(gdb-setq-thread-number thread-id))
- (message (format "Thread %s stopped" thread-id)))))
+ (message "Thread %s stopped" thread-id))))
;; Print "(gdb)" to GUD console
(when gdb-first-done-or-error
;; MI error - send to minibuffer
(when (eq type 'error)
;; Skip "msg=" from `output-field'
- (message (read (substring output-field 4)))
+ (message "%s" (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)))
(when (and token-number is-complete)
(with-current-buffer
(gdb-get-buffer-create 'gdb-partial-output-buffer)
- (funcall
- (cdr (assoc (string-to-number token-number) gdb-handler-alist))))
- (setq gdb-handler-alist
- (assq-delete-all token-number gdb-handler-alist)))
+ (gdb-handle-reply (string-to-number token-number))))
(when is-complete
(gdb-clear-partial-output))))
(insert "]"))))))
(goto-char (point-min))
(insert "{")
- (while (re-search-forward
- "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t)
- (replace-match "\"\\1\":\\2" nil nil))
+ (let ((re (concat "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|"
+ gdb--string-regexp "\\)")))
+ (while (re-search-forward re nil t)
+ (replace-match "\"\\1\":\\2" nil nil)))
(goto-char (point-max))
(insert "}")))
(row-properties nil)
(right-align nil))
-(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
-arguments, and mapping stops as soon as the shortest list runs
-out."
- (let ((shortest (apply #'min (mapcar #'length seqs))))
- (mapcar (lambda (i)
- (apply function
- (mapcar
- (lambda (seq)
- (nth i seq))
- seqs)))
- (number-sequence 0 (1- shortest)))))
-
(defun gdb-table-add-row (table row &optional properties)
"Add ROW of string to TABLE and recalculate column sizes.
(setf (gdb-table-row-properties table)
(append row-properties (list properties)))
(setf (gdb-table-column-sizes table)
- (gdb-mapcar* (lambda (x s)
+ (cl-mapcar (lambda (x s)
(let ((new-x
(max (abs x) (string-width (or s "")))))
(if right-align new-x (- new-x))))
(let ((column-sizes (gdb-table-column-sizes table)))
(mapconcat
'identity
- (gdb-mapcar*
+ (cl-mapcar
(lambda (row properties)
(apply 'propertize
(mapconcat 'identity
- (gdb-mapcar* (lambda (s x) (gdb-pad-string s x))
+ (cl-mapcar (lambda (s x) (gdb-pad-string s x))
row column-sizes)
sep)
properties))
(when
(or (not ,signal-list)
(memq signal ,signal-list))
- (when (not (gdb-pending-p
- (cons (current-buffer) ',trigger-name)))
- (gdb-input ,gdb-command
- (gdb-bind-function-to-buffer ',handler-name (current-buffer)))
- (gdb-add-pending (cons (current-buffer) ',trigger-name))))))
+ (gdb-input ,gdb-command
+ (gdb-bind-function-to-buffer ',handler-name (current-buffer))
+ (cons (current-buffer) ',trigger-name)))))
;; Used by disassembly buffer only, the rest use
;; def-gdb-trigger-and-handler
-(defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun
+(defmacro def-gdb-auto-update-handler (handler-name custom-defun
&optional nopreserve)
- "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN.
+ "Define a handler HANDLER-NAME calling CUSTOM-DEFUN.
Handlers are normally called from the buffers they put output in.
-Delete ((current-buffer) . TRIGGER-NAME) from
-`gdb-pending-triggers', erase current buffer and evaluate
-CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called.
+Erase current buffer and evaluate CUSTOM-DEFUN.
+Then call `gdb-update-buffer-name'.
If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
`(defun ,handler-name ()
- (gdb-delete-pending (cons (current-buffer) ',trigger-name))
(let* ((inhibit-read-only t)
,@(unless nopreserve
'((window (get-buffer-window (current-buffer) 0))
,gdb-command
,handler-name ,signal-list)
(def-gdb-auto-update-handler ,handler-name
- ,trigger-name ,custom-defun)))
+ ,custom-defun)))
\f
(or (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)))
+ (eval-when-compile
+ (propertize "y" 'font-lock-face
+ font-lock-warning-face))
+ (eval-when-compile
+ (propertize "n" 'font-lock-face
+ font-lock-comment-face))))
(bindat-get-field breakpoint 'addr)
(or (bindat-get-field breakpoint 'times) "")
(if (and type (string-match ".*watchpoint" type))
(gdb-put-breakpoint-icon (string-equal flag "y") bptno
(string-to-number line)))))))))
-(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
+(defconst gdb-source-file-regexp
+ (concat "fullname=\\(" gdb--string-regexp "\\)"))
(defun gdb-get-location (bptno line flag)
"Find the directory containing the relevant source file.
(catch 'file-not-found
(if (re-search-forward gdb-source-file-regexp nil t)
(delete (cons bptno "File not found") gdb-location-alist)
+ ;; FIXME: Why/how do we use (match-string 1) when the search failed?
(push (cons bptno (match-string 1)) gdb-location-alist)
(gdb-resync)
(unless (assoc bptno gdb-location-alist)
obj)
(when (numberp pos)
(with-selected-window (posn-window posn)
- (with-current-buffer (window-buffer (selected-window))
+ (with-current-buffer (window-buffer)
(goto-char pos)
(dolist (overlay (overlays-in pos pos))
(when (overlay-get overlay 'put-break)
gud-stop-subjob
"Interrupt thread at current line.")
+;; Defined opaquely in M-x gdb via gud-def.
+(declare-function gud-cont "gdb-mi" (arg) t)
+
(def-gdb-thread-buffer-gud-command
gdb-continue-thread
gud-cont
"Continue thread at current line.")
+(declare-function gud-step "gdb-mi" (arg) t)
+
(def-gdb-thread-buffer-gud-command
gdb-step-thread
gud-step
(def-gdb-auto-update-handler
gdb-disassembly-handler
- gdb-invalidate-disassembly
gdb-disassembly-handler-custom
t)
;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
- (when (and (gdb-get-buffer 'gdb-registers-buffer)
- (not (gdb-pending-p 'gdb-get-changed-registers)))
+ (when (gdb-get-buffer 'gdb-registers-buffer)
(gdb-input "-data-list-changed-registers"
- 'gdb-changed-registers-handler)
- (gdb-add-pending 'gdb-get-changed-registers)))
+ 'gdb-changed-registers-handler
+ 'gdb-get-changed-registers)))
(defun gdb-changed-registers-handler ()
- (gdb-delete-pending 'gdb-get-changed-registers)
(setq gdb-changed-registers nil)
(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
+ ;; Don't use pending triggers because this handler is called
;; only once (in gdb-init-1)
(setq gdb-register-names nil)
(dolist (register-name
is set in them."
(goto-char (point-min))
(while (re-search-forward gdb-source-file-regexp nil t)
- (push (match-string 1) gdb-source-file-list))
+ (push (read (match-string 1)) gdb-source-file-list))
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (member buffer-file-name gdb-source-file-list)
(defun gdb-get-main-selected-frame ()
"Trigger for `gdb-frame-handler' which uses main current thread.
Called from `gdb-update'."
- (if (not (gdb-pending-p 'gdb-get-main-selected-frame))
- (progn
- (gdb-input (gdb-current-context-command "-stack-info-frame")
- 'gdb-frame-handler)
- (gdb-add-pending 'gdb-get-main-selected-frame))))
+ (gdb-input (gdb-current-context-command "-stack-info-frame")
+ 'gdb-frame-handler
+ 'gdb-get-main-selected-frame))
(defun gdb-frame-handler ()
"Set `gdb-selected-frame' and `gdb-selected-file' to show
overlay arrow in source buffer."
- (gdb-delete-pending 'gdb-get-main-selected-frame)
(let ((frame (bindat-get-field (gdb-json-partial-output) 'frame)))
(when frame
(setq gdb-selected-frame (bindat-get-field frame 'func))
(setq gud-overlay-arrow-position (make-marker))
(set-marker gud-overlay-arrow-position position))))))))
-(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
+(defconst gdb-prompt-name-regexp
+ (concat "value=\\(" gdb--string-regexp "\\)"))
(defun gdb-get-prompt ()
"Find prompt for GDB session."
(goto-char (point-min))
(setq gdb-prompt-name nil)
(re-search-forward gdb-prompt-name-regexp nil t)
- (setq gdb-prompt-name (match-string 1))
+ (setq gdb-prompt-name (read (match-string 1)))
;; Insert first prompt.
(setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
buffers, if required."
(goto-char (point-min))
(if (re-search-forward gdb-source-file-regexp nil t)
- (setq gdb-main-file (match-string 1)))
+ (setq gdb-main-file (read (match-string 1))))
(if gdb-many-windows
(gdb-setup-windows)
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
HCoop / bpt / emacs.git / blobdiff