;;; 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.
(lambda (handler)
"Discard any HANDLER with a token number `<=' than TOKEN-NUMBER."
(when (< (gdb-handler-token-number handler) token-number)
- (message (format
- "WARNING! Discarding GDB handler with token #%d\n"
- (gdb-handler-token-number handler))))
+ (message "WARNING! Discarding GDB handler with token #%d\n"
+ (gdb-handler-token-number handler)))
(<= (gdb-handler-token-number handler) token-number))
gdb-handler-list))
(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
(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))
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))
'&' 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)))
(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)))
(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))
(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
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)
(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