;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998, 2000-2011 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
(require 'comint)
(defvar gdb-active-process)
-(defvar gdb-recording)
(defvar gdb-define-alist)
(defvar gdb-macro-info)
-(defvar gdb-server-prefix)
(defvar gdb-show-changed-values)
(defvar gdb-source-window)
(defvar gdb-var-list)
(display-buffer-reuse-frames t))
(catch 'info-found
(walk-windows
- '(lambda (window)
- (if (eq (window-buffer window) (get-buffer "*info*"))
- (progn
- (setq same-window-regexps nil)
- (throw 'info-found nil))))
+ (lambda (window)
+ (if (eq (window-buffer window) (get-buffer "*info*"))
+ (progn
+ (setq same-window-regexps nil)
+ (throw 'info-found nil))))
nil 0)
(select-frame (make-frame)))
- (if (memq gud-minor-mode '(gdbmi gdba))
+ (if (eq gud-minor-mode 'gdbmi)
(info "(emacs)GDB Graphical Interface")
(info "(emacs)Debuggers"))))
(defun gud-tool-bar-item-visible-no-fringe ()
(not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode)
- (and (memq gud-minor-mode '(gdbmi gdba))
+ (eq (buffer-local-value 'major-mode (window-buffer)) 'gdb-memory-mode)
+ (and (eq gud-minor-mode 'gdbmi)
(> (car (window-fringes)) 0)))))
+(declare-function gdb-gud-context-command "gdb-mi.el")
+
(defun gud-stop-subjob ()
(interactive)
(with-current-buffer gud-comint-buffer
- (if (string-equal gud-target-name "emacs")
- (comint-stop-subjob)
- (if (eq gud-minor-mode 'jdb)
- (gud-call "suspend")
- (comint-interrupt-subjob)))))
+ (cond ((string-equal gud-target-name "emacs")
+ (comint-stop-subjob))
+ ((eq gud-minor-mode 'jdb)
+ (gud-call "suspend"))
+ ((eq gud-minor-mode 'gdbmi)
+ (gud-call (gdb-gud-context-command "-exec-interrupt")))
+ (t
+ (comint-interrupt-subjob)))))
(easy-mmode-defmap gud-menu-map
'(([help] "Info (debugger)" . gud-goto-info)
- ([rfinish] menu-item "Reverse Finish Function" gud-rfinish
- :enable (not gud-running)
- :visible (and gdb-recording
- (eq gud-minor-mode 'gdba)))
- ([rstepi] menu-item "Reverse Step Instruction" gud-rstepi
- :enable (not gud-running)
- :visible (and gdb-recording
- (eq gud-minor-mode 'gdba)))
- ([rnexti] menu-item "Reverse Next Instruction" gud-rnexti
- :enable (not gud-running)
- :visible (and gdb-recording
- (eq gud-minor-mode 'gdba)))
- ([rstep] menu-item "Reverse Step Line" gud-rstep
- :enable (not gud-running)
- :visible (and gdb-recording
- (eq gud-minor-mode 'gdba)))
- ([rnext] menu-item "Reverse Next Line" gud-rnext
- :enable (not gud-running)
- :visible (and gdb-recording
- (eq gud-minor-mode 'gdba)))
- ([rcont] menu-item "Reverse Continue" gud-rcont
- :enable (not gud-running)
- :visible (and gdb-recording
- (eq gud-minor-mode 'gdba)))
- ([recstart] menu-item "Start Recording" gdb-toggle-recording-1
- :visible (and (not gdb-recording)
- (eq gud-minor-mode 'gdba)))
- ([recstop] menu-item "Stop Recording" gdb-toggle-recording
- :visible (and gdb-recording
- (eq gud-minor-mode 'gdba)))
([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode
:enable (and (not emacs-basic-display)
(display-graphic-p)
(fboundp 'x-show-tip))
:visible (memq gud-minor-mode
- '(gdbmi gdba dbx sdb xdb pdb))
+ '(gdbmi dbx sdb xdb pdb))
:button (:toggle . gud-tooltip-mode))
([refresh] "Refresh" . gud-refresh)
([run] menu-item "Run" gud-run
:enable (not gud-running)
:visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
([go] menu-item (if gdb-active-process "Continue" "Run") gud-go
- :visible (and (not gud-running)
- (eq gud-minor-mode 'gdba)))
+ :visible (and (eq gud-minor-mode 'gdbmi)
+ (gdb-show-run-p)))
([stop] menu-item "Stop" gud-stop-subjob
- :visible (or (not (memq gud-minor-mode '(gdba pdb)))
- (and gud-running
- (eq gud-minor-mode 'gdba))))
+ :visible (or (not (memq gud-minor-mode '(gdbmi pdb)))
+ (gdb-show-stop-p)))
([until] menu-item "Continue to selection" gud-until
:enable (not gud-running)
- :visible (and (memq gud-minor-mode '(gdbmi gdba gdb perldb))
+ :visible (and (memq gud-minor-mode '(gdbmi gdb perldb))
(gud-tool-bar-item-visible-no-fringe)))
([remove] menu-item "Remove Breakpoint" gud-remove
:enable (not gud-running)
([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
:enable (not gud-running)
:visible (memq gud-minor-mode
- '(gdbmi gdba gdb sdb xdb)))
+ '(gdbmi gdb sdb xdb)))
([break] menu-item "Set Breakpoint" gud-break
:enable (not gud-running)
:visible (gud-tool-bar-item-visible-no-fringe))
([up] menu-item "Up Stack" gud-up
:enable (not gud-running)
:visible (memq gud-minor-mode
- '(gdbmi gdba gdb dbx xdb jdb pdb)))
+ '(gdbmi gdb dbx xdb jdb pdb)))
([down] menu-item "Down Stack" gud-down
:enable (not gud-running)
:visible (memq gud-minor-mode
- '(gdbmi gdba gdb dbx xdb jdb pdb)))
+ '(gdbmi gdb dbx xdb jdb pdb)))
([pp] menu-item "Print S-expression" gud-pp
:enable (and (not gud-running)
gdb-active-process)
:visible (and (string-equal
(buffer-local-value
'gud-target-name gud-comint-buffer) "emacs")
- (eq gud-minor-mode 'gdba)))
- ([print*] menu-item "Print Dereference" gud-pstar
+ (eq gud-minor-mode 'gdbmi)))
+ ([print*] menu-item (if (eq gud-minor-mode 'jdb)
+ "Dump object"
+ "Print Dereference") gud-pstar
:enable (not gud-running)
- :visible (memq gud-minor-mode '(gdbmi gdba gdb)))
+ :visible (memq gud-minor-mode '(gdbmi gdb jdb)))
([print] menu-item "Print Expression" gud-print
:enable (not gud-running))
([watch] menu-item "Watch Expression" gud-watch
:enable (not gud-running)
- :visible (memq gud-minor-mode '(gdbmi gdba)))
+ :visible (eq gud-minor-mode 'gdbmi))
([finish] menu-item "Finish Function" gud-finish
:enable (not gud-running)
:visible (memq gud-minor-mode
- '(gdbmi gdba gdb xdb jdb pdb)))
+ '(gdbmi gdb xdb jdb pdb)))
([stepi] menu-item "Step Instruction" gud-stepi
:enable (not gud-running)
- :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx)))
+ :visible (memq gud-minor-mode '(gdbmi gdb dbx)))
([nexti] menu-item "Next Instruction" gud-nexti
:enable (not gud-running)
- :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx)))
+ :visible (memq gud-minor-mode '(gdbmi gdb dbx)))
([step] menu-item "Step Line" gud-step
:enable (not gud-running))
([next] menu-item "Next Line" gud-next
:enable (not gud-running))
([cont] menu-item "Continue" gud-cont
:enable (not gud-running)
- :visible (not (eq gud-minor-mode 'gdba))))
+ :visible (not (eq gud-minor-mode 'gdbmi))))
"Menu for `gud-mode'."
:name "Gud")
. (,(propertize "next" 'face 'font-lock-doc-face) . gud-next))
([menu-bar until] menu-item
,(propertize "until" 'face 'font-lock-doc-face) gud-until
- :visible (memq gud-minor-mode '(gdbmi gdba gdb perldb)))
+ :visible (memq gud-minor-mode '(gdbmi gdb perldb)))
([menu-bar cont] menu-item
,(propertize "cont" 'face 'font-lock-doc-face) gud-cont
- :visible (not (eq gud-minor-mode 'gdba)))
+ :visible (not (eq gud-minor-mode 'gdbmi)))
([menu-bar run] menu-item
,(propertize "run" 'face 'font-lock-doc-face) gud-run
:visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
([menu-bar go] menu-item
,(propertize " go " 'face 'font-lock-doc-face) gud-go
- :visible (and (not gud-running)
- (eq gud-minor-mode 'gdba)))
+ :visible (and (eq gud-minor-mode 'gdbmi)
+ (gdb-show-run-p)))
([menu-bar stop] menu-item
,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob
- :visible (and gud-running
- (eq gud-minor-mode 'gdba)))
+ :visible (or (and (eq gud-minor-mode 'gdbmi)
+ (gdb-show-stop-p))
+ (not (eq gud-minor-mode 'gdbmi))))
([menu-bar print]
. (,(propertize "print" 'face 'font-lock-doc-face) . gud-print))
([menu-bar tools] . undefined)
(gud-stepi . "gud/stepi")
(gud-up . "gud/up")
(gud-down . "gud/down")
- (gdb-toggle-recording-1 . "gud/recstart")
- (gdb-toggle-recording . "gud/recstop")
- (gud-rcont . "gud/rcont")
- (gud-rnext . "gud/rnext")
- (gud-rstep . "gud/rstep")
- (gud-rfinish . "gud/rfinish")
- (gud-rnexti . "gud/rnexti")
- (gud-rstepi . "gud/rstepi")
(gud-goto-info . "info"))
map)
(tool-bar-local-item-from-menu
(setq directories (cdr directories)))
result)))
-(declare-function gdb-create-define-alist "gdb-ui" ())
+(declare-function gdb-create-define-alist "gdb-mi" ())
(defun gud-find-file (file)
;; Don't get confused by double slashes in the name that comes from GDB.
(set (make-local-variable 'gud-minor-mode) minor-mode)
(set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
(when (and gud-tooltip-mode
- (memq gud-minor-mode '(gdbmi gdba)))
+ (eq gud-minor-mode 'gdbmi))
(make-local-variable 'gdb-define-alist)
(unless gdb-define-alist (gdb-create-define-alist))
(add-hook 'after-save-hook 'gdb-create-define-alist nil t))
source file) or the source line number at the last break or step (if
we're in the GUD buffer)."
`(progn
- (defun ,func (arg)
+ (defalias ',func (lambda (arg)
,@(if doc (list doc))
(interactive "p")
(if (not gud-running)
,(if (stringp cmd)
`(gud-call ,cmd arg)
- cmd)))
+ cmd))))
,(if key `(local-set-key ,(concat "\C-c" key) ',func))
,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func))))
(defvar gud-speedbar-menu-items
'(["Jump to stack frame" speedbar-edit-line
- :visible (not (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
- '(gdbmi gdba)))]
+ :visible (not (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ 'gdbmi))]
["Edit value" speedbar-edit-line
- :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
- '(gdbmi gdba))]
+ :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ 'gdbmi)]
["Delete expression" gdb-var-delete
- :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
- '(gdbmi gdba))]
+ :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ 'gdbmi)]
["Auto raise frame" gdb-speedbar-auto-raise
:style toggle :selected gdb-speedbar-auto-raise
- :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
- '(gdbmi gdba))]
+ :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ 'gdbmi)]
("Output Format"
- :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
- '(gdbmi gdba))
+ :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ 'gdbmi)
["Binary" (gdb-var-set-format "binary") t]
["Natural" (gdb-var-set-format "natural") t]
["Hexadecimal" (gdb-var-set-format "hexadecimal") t]))
(gud-install-speedbar-variables)
(add-hook 'speedbar-load-hook 'gud-install-speedbar-variables))
-(defun gud-expansion-speedbar-buttons (directory zero)
+(defun gud-expansion-speedbar-buttons (_directory _zero)
"Wrapper for call to `speedbar-add-expansion-list'.
DIRECTORY and ZERO are not used, but are required by the caller."
(gud-speedbar-buttons gud-comint-buffer))
(start (window-start window))
(p (window-point window)))
(cond
- ((memq minor-mode '(gdbmi gdba))
+ ((eq minor-mode 'gdbmi)
(erase-buffer)
(insert "Watch Expressions:\n")
(let ((var-list gdb-var-list) parent)
(car frame)
'speedbar-file-face
'speedbar-highlight-face
- (cond ((memq minor-mode '(gdbmi gdba gdb))
+ (cond ((memq minor-mode '(gdbmi gdb))
'gud-gdb-goto-stackframe)
(t (error "Should never be here")))
frame t))))
;; Set the accumulator to the remaining text.
gud-marker-acc (substring gud-marker-acc (match-end 0))))
- ;; Check for annotations and change gud-minor-mode to 'gdba if
- ;; they are found.
(while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
- (let ((match (match-string 1 gud-marker-acc)))
-
- (setq
- ;; Append any text before the marker to the output we're going
- ;; to return - we don't include the marker in this text.
- output (concat output
- (substring gud-marker-acc 0 (match-beginning 0)))
+ (setq
+ ;; Append any text before the marker to the output we're going
+ ;; to return - we don't include the marker in this text.
+ output (concat output
+ (substring gud-marker-acc 0 (match-beginning 0)))
- ;; Set the accumulator to the remaining text.
+ ;; Set the accumulator to the remaining text.
- gud-marker-acc (substring gud-marker-acc (match-end 0)))))
+ gud-marker-acc (substring gud-marker-acc (match-end 0))))
;; Does the remaining text look like it might end with the
;; beginning of another marker? If it does, then keep it in
(defvar gud-filter-pending-text nil
"Non-nil means this is text that has been saved for later in `gud-filter'.")
-;; If in gdba mode, gdb-ui is loaded.
-(declare-function gdb-restore-windows "gdb-ui" ())
+;; If in gdb mode, gdb-mi is loaded.
+(declare-function gdb-restore-windows "gdb-mi" ())
-;; The old gdb command (text command mode). The new one is in gdb-ui.el.
+;; The old gdb command (text command mode). The new one is in gdb-mi.el.
;;;###autoload
(defun gud-gdb (command-line)
"Run gdb on program FILE in buffer *gud-FILE*.
(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"))
+ (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdbmi)))
+ (gdb-restore-windows)
+ (error
+ "Multiple debugging requires restarting in text command mode"))
(gud-common-init command-line nil 'gud-gdb-marker-filter)
(set (make-local-variable 'gud-minor-mode) 'gdb)
(gud-def gud-until "until %l" "\C-u" "Continue to current line.")
(gud-def gud-run "run" nil "Run the program.")
- (local-set-key "\C-i" 'gud-gdb-complete-command)
+ (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
+ nil 'local)
+ (local-set-key "\C-i" 'completion-at-point)
(setq comint-prompt-regexp "^(.*gdb[+]?) *")
(setq paragraph-start comint-prompt-regexp)
(setq gdb-first-prompt t)
;; The completion list is constructed by the process filter.
(defvar gud-gdb-fetched-lines)
-(defun gud-gdb-complete-command (&optional command a b)
- "Perform completion on the GDB command preceding point.
-This is implemented using the GDB `complete' command which isn't
-available with older versions of GDB."
- (interactive)
- (if command
- ;; Used by gud-watch in mini-buffer.
- (setq command (concat "p " command))
- ;; Used in GUD buffer.
- (let ((end (point)))
- (setq command (buffer-substring (comint-line-beginning-position) end))))
- (let* ((command-word
- ;; Find the word break. This match will always succeed.
- (and (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
- (substring command (match-beginning 2))))
- (complete-list
- (gud-gdb-run-command-fetch-lines (concat "complete " command)
+(defun gud-gdb-completions (context command)
+ "Completion table for GDB commands.
+COMMAND is the prefix for which we seek completion.
+CONTEXT is the text before COMMAND on the line."
+ (let* ((start (- (point) (field-beginning)))
+ (complete-list
+ (gud-gdb-run-command-fetch-lines (concat "complete " context command)
(current-buffer)
;; From string-match above.
- (match-beginning 2))))
+ (length context))))
+ ;; `gud-gdb-run-command-fetch-lines' has some nasty side-effects on the
+ ;; buffer (via `gud-delete-prompt-marker'): it removes the prompt and then
+ ;; re-adds it later, thus messing up markers and overlays along the way.
+ ;; This is a problem for completion-in-region which uses an overlay to
+ ;; create a field.
+ ;; So we restore completion-in-region's field if needed.
+ ;; FIXME: change gud-gdb-run-command-fetch-lines so it doesn't modify the
+ ;; buffer at all.
+ (when (/= start (- (point) (field-beginning)))
+ (dolist (ol (overlays-at (1- (point))))
+ (when (eq (overlay-get ol 'field) 'completion)
+ (move-overlay ol (- (point) start) (overlay-end ol)))))
;; Protect against old versions of GDB.
(and complete-list
(string-match "^Undefined command: \"complete\"" (car complete-list))
pos (match-end 0)))
(and (= (mod count 2) 1)
(setq complete-list (list (concat str "'"))))))
- ;; Let comint handle the rest.
- (comint-dynamic-simple-complete command-word complete-list)))
+ complete-list))
+
+(defun gud-gdb-completion-at-point ()
+ "Return the data to complete the GDB command before point."
+ (let ((end (point))
+ (start
+ (save-excursion
+ (skip-chars-backward "^ " (comint-line-beginning-position))
+ (point))))
+ (list start end
+ (completion-table-dynamic
+ (apply-partially #'gud-gdb-completions
+ (buffer-substring (comint-line-beginning-position)
+ start))))))
+
+;; (defun gud-gdb-complete-command ()
+;; "Perform completion on the GDB command preceding point.
+;; This is implemented using the GDB `complete' command which isn't
+;; available with older versions of GDB."
+;; (interactive)
+;; (apply #'completion-in-region (gud-gdb-completion-at-point)))
;; The completion process filter is installed temporarily to slurp the
;; output of GDB up to the next prompt and build the completion list.
;; gdb speedbar functions
-(defun gud-gdb-goto-stackframe (text token indent)
+(defun gud-gdb-goto-stackframe (_text token _indent)
"Goto the stackframe described by TEXT, TOKEN, and INDENT."
(speedbar-with-attached-buffer
(gud-basic-call (concat "server frame " (nth 1 token)))
directory))
:group 'gud)
-(defun gud-dbx-massage-args (file args)
+(defun gud-dbx-massage-args (_file args)
(nconc (let ((directories gud-dbx-directories)
(result nil))
(while directories
directory))
:group 'gud)
-(defun gud-xdb-massage-args (file args)
+(defun gud-xdb-massage-args (_file args)
(nconc (let ((directories gud-xdb-directories)
(result nil))
(while directories
;; History of argument lists passed to perldb.
(defvar gud-perldb-history nil)
-(defun gud-perldb-massage-args (file args)
+(defun gud-perldb-massage-args (_file args)
"Convert a command line as would be typed normally to run perldb
into one that invokes an Emacs-enabled debugging session.
\"-emacs\" is inserted where it will be $ARGV[0] (see perl5db.pl)."
;; Last group is for return value, e.g. "> test.py(2)foo()->None"
;; Either file or function name may be omitted: "> <string>(0)?()"
(defvar gud-pdb-marker-regexp
- "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n]*\\)?\n")
+ "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]")
+
(defvar gud-pdb-marker-regexp-file-group 1)
(defvar gud-pdb-marker-regexp-line-group 2)
(defvar gud-pdb-marker-regexp-fnname-group 3)
;; Change what was given in the minibuffer to something that can be used to
;; invoke the debugger.
-(defun gud-jdb-massage-args (file args)
+(defun gud-jdb-massage-args (_file args)
;; The jdb executable must have whitespace between "-classpath" and
;; its value while gud-common-init expects all switch values to
;; follow the switch keyword without intervening whitespace. We
(setq cplist (cdr cplist)))
(if found-file (concat (car cplist) "/" filename)))))
-(defun gud-jdb-find-source (string)
+(defun gud-jdb-find-source (_string)
"Alias for function used to locate source files.
Set to `gud-jdb-find-source-using-classpath' or `gud-jdb-find-source-file'
during jdb initialization depending on the value of
(setq w (cdr w)))
(if w
(setcar w
- (if (file-remote-p default-directory)
+ (if (file-remote-p file)
;; Tramp has already been loaded if we are here.
(setq file (tramp-file-name-localname
(tramp-dissect-file-name file)))
(gud-set-buffer))
(defun gud-set-buffer ()
- (when (eq major-mode 'gud-mode)
+ (when (derived-mode-p 'gud-mode)
(setq gud-comint-buffer (current-buffer))))
(defvar gud-filter-defer-flag nil
(defvar gud-overlay-arrow-position nil)
(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position)
-(declare-function gdb-reset "gdb-ui" ())
+(declare-function gdb-reset "gdb-mi" ())
(defun gud-sentinel (proc msg)
(cond ((null (buffer-name (process-buffer proc)))
(string-equal speedbar-initial-expansion-list-name "GUD"))
(speedbar-change-initial-expansion-list
speedbar-previously-used-expansion-list-name))
- (if (memq gud-minor-mode-type '(gdbmi gdba))
+ (if (eq gud-minor-mode-type 'gdbmi)
(gdb-reset)
(gud-reset)))
((memq (process-status proc) '(signal exit))
;; Stop displaying an arrow in a source file.
(setq gud-overlay-arrow-position nil)
- (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
- '(gdba gdbmi))
+ (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ 'gdbmi)
(gdb-reset)
(gud-reset))
(let* ((obuf (current-buffer)))
(defun gud-kill-buffer-hook ()
(setq gud-minor-mode-type gud-minor-mode)
(condition-case nil
- (kill-process (get-buffer-process (current-buffer)))
+ (progn
+ (kill-process (get-buffer-process (current-buffer)))
+ (delete-process (get-process "gdb-inferior")))
(error nil)))
(defun gud-reset ()
(declare-function global-hl-line-highlight "hl-line" ())
(declare-function hl-line-highlight "hl-line" ())
-(declare-function gdb-display-source-buffer "gdb-ui" (buffer))
-(declare-function gdb-display-buffer "gdb-ui" (buf dedicated &optional size))
+(declare-function gdb-display-source-buffer "gdb-mi" (buffer))
+(declare-function gdb-display-buffer "gdb-mi" (buf dedicated &optional size))
;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
;; and that its line LINE is visible.
(gud-find-file true-file)))
(window (and buffer
(or (get-buffer-window buffer)
- (if (memq gud-minor-mode '(gdbmi gdba))
+ (if (eq gud-minor-mode 'gdbmi)
(or (if (get-buffer-window buffer 'visible)
(display-buffer buffer nil 'visible))
(unless (gdb-display-source-buffer buffer)
(goto-char pos))))
(when window
(set-window-point window gud-overlay-arrow-position)
- (if (memq gud-minor-mode '(gdbmi gdba))
+ (if (eq gud-minor-mode 'gdbmi)
(setq gdb-source-window window)))))))
;; The gud-call function must do the right thing whether its invoking
(forward-line 0))
(if (looking-at comint-prompt-regexp)
(set-marker gud-delete-prompt-marker (point)))
- (if (memq gud-minor-mode '(gdbmi gdba))
+ (if (eq gud-minor-mode 'gdbmi)
(apply comint-input-sender (list proc command))
(process-send-string proc (concat command "\n"))))))))
(declare-function c-langelem-sym "cc-defs" (langelem))
(declare-function c-langelem-pos "cc-defs" (langelem))
-(declare-function syntax-symbol "gud" (x))
-(declare-function syntax-point "gud" (x))
-(defun gud-find-class (f line)
+(defun gud-find-class (f _line)
"Find fully qualified class in file F at line LINE.
This function uses the `gud-jdb-classpath' (and optional
`gud-jdb-sourcepath') list(s) to derive a file
(save-match-data
(let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath))
(fbuffer (get-file-buffer f))
- syntax-symbol syntax-point class-found)
+ class-found
+ ;; Syntax-symbol returns the symbol of the *first* element
+ ;; in the syntactical analysis result list, syntax-point
+ ;; returns the buffer position of same
+ (syntax-symbol (lambda (x) (c-langelem-sym (car x))))
+ (syntax-point (lambda (x) (c-langelem-pos (car x)))))
(setq f (file-name-sans-extension (file-truename f)))
- ;; Syntax-symbol returns the symbol of the *first* element
- ;; in the syntactical analysis result list, syntax-point
- ;; returns the buffer position of same
- (fset 'syntax-symbol (lambda (x) (c-langelem-sym (car x))))
- (fset 'syntax-point (lambda (x) (c-langelem-pos (car x))))
;; Search through classpath list for an entry that is
;; contained in f
(while (and cplist (not class-found))
;; syntactic information chain and collect any 'inclass
;; symbols until 'topmost-intro is reached to find out if
;; point is within a nested class
+ ;; FIXME: Yuck!!! cc-mode should provide a function instead.
(if (and fbuffer (equal (symbol-file 'java-mode) "cc-mode"))
(with-current-buffer fbuffer
(let ((nclass) (syntax))
;; with the 'topmost-intro symbol, there may be
;; nested classes...
(while (not (eq 'topmost-intro
- (syntax-symbol (c-guess-basic-syntax))))
+ (funcall syntax-symbol (c-guess-basic-syntax))))
;; Check if the current position c-syntactic
;; analysis has 'inclass
(setq syntax (c-guess-basic-syntax))
(while
- (and (not (eq 'inclass (syntax-symbol syntax)))
+ (and (not (eq 'inclass (funcall syntax-symbol syntax)))
(cdr syntax))
(setq syntax (cdr syntax)))
- (if (eq 'inclass (syntax-symbol syntax))
+ (if (eq 'inclass (funcall syntax-symbol syntax))
(progn
- (goto-char (syntax-point syntax))
+ (goto-char (funcall syntax-point syntax))
;; Now we're at the beginning of a class
;; definition. Find class name
(looking-at
(append (list (match-string-no-properties 1))
nclass)))
(setq syntax (c-guess-basic-syntax))
- (while (and (not (syntax-point syntax)) (cdr syntax))
+ (while (and (not (funcall syntax-point syntax)) (cdr syntax))
(setq syntax (cdr syntax)))
- (goto-char (syntax-point syntax))
+ (goto-char (funcall syntax-point syntax))
))
(string-match (concat (car nclass) "$") class-found)
(setq class-found
("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face))))
-(defvar gdb-script-font-lock-syntactic-keywords
- '(("^document\\s-.*\\(\n\\)" (1 "< b"))
- ("^end\\>"
- (0 (unless (eq (match-beginning 0) (point-min))
+(defconst gdb-script-syntax-propertize-function
+ (syntax-propertize-rules
+ ("^document\\s-.*\\(\n\\)" (1 "< b"))
+ ("^end\\(\\>\\)"
+ (1 (ignore
+ (when (and (> (match-beginning 0) (point-min))
+ (eq 1 (nth 7 (save-excursion
+ (syntax-ppss (1- (match-beginning 0)))))))
;; We change the \n in front, which is more difficult, but results
;; in better highlighting. If the doc is empty, the single \n is
;; both the beginning and the end of the docstring, which can't be
'syntax-table (eval-when-compile
(string-to-syntax "> b")))
;; Make sure that rehighlighting the previous line won't erase our
- ;; syntax-table property.
+ ;; syntax-table property and that modifying `end' will.
(put-text-property (1- (match-beginning 0)) (match-end 0)
- 'font-lock-multiline t)
- nil)))))
+ 'syntax-multiline t)))))))
(defun gdb-script-font-lock-syntactic-face (state)
(cond
(goto-char (point-max)))
t)
-;; Besides .gdbinit, gdb documents other names to be usable for init
-;; files, cross-debuggers can use something like
-;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files
-;; don't interfere with each other.
-;;;###autoload
-(add-to-list 'auto-mode-alist (cons (purecopy "/\\.[a-z0-9-]*gdbinit") 'gdb-script-mode))
-
;;;###autoload
-(define-derived-mode gdb-script-mode nil "GDB-Script"
+(define-derived-mode gdb-script-mode prog-mode "GDB-Script"
"Major mode for editing GDB scripts."
(set (make-local-variable 'comment-start) "#")
(set (make-local-variable 'comment-start-skip) "#+\\s-*")
#'gdb-script-end-of-defun)
(set (make-local-variable 'font-lock-defaults)
'(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
- (font-lock-syntactic-keywords
- . gdb-script-font-lock-syntactic-keywords)
(font-lock-syntactic-face-function
- . gdb-script-font-lock-syntactic-face))))
+ . gdb-script-font-lock-syntactic-face)))
+ ;; Recognize docstrings.
+ (set (make-local-variable 'syntax-propertize-function)
+ gdb-script-syntax-propertize-function)
+ (add-hook 'syntax-propertize-extend-region-functions
+ #'syntax-propertize-multiline 'append 'local))
\f
;;; tooltips for GUD
(gud-tooltip-activate-mouse-motions-if-enabled)
(if (and gud-comint-buffer
(buffer-name gud-comint-buffer); gud-comint-buffer might be killed
- (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
- '(gdbmi gdba)))
+ (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ 'gdbmi))
(if gud-tooltip-mode
(progn
(dolist (buffer (buffer-list))
(unless (eq buffer gud-comint-buffer)
(with-current-buffer buffer
- (when (and (memq gud-minor-mode '(gdbmi gdba))
+ (when (and (eq gud-minor-mode 'gdbmi)
(not (string-match "\\`\\*.+\\*\\'"
(buffer-name))))
(make-local-variable 'gdb-define-alist)
ACTIVATEP non-nil means activate mouse motion events."
(if activatep
(progn
- (make-local-variable 'gud-tooltip-mouse-motions-active)
- (setq gud-tooltip-mouse-motions-active t)
- (make-local-variable 'track-mouse)
- (setq track-mouse t))
+ (set (make-local-variable 'gud-tooltip-mouse-motions-active) t)
+ (set (make-local-variable 'track-mouse) t))
(when gud-tooltip-mouse-motions-active
(kill-local-variable 'gud-tooltip-mouse-motions-active)
(kill-local-variable 'track-mouse))))
; Larger arrays (say 400 elements) are displayed in
; the tooltip incompletely and spill over into the gud buffer.
; Switching the process-filter creates timing problems and
-; it may be difficult to do better. Using annotations as in
-; gdb-ui.el gets round this problem.
+; it may be difficult to do better. Using GDB/MI as in
+; gdb-mi.el gets round this problem.
(defun gud-tooltip-process-output (process output)
"Process debugger output and show it in a tooltip window."
(set-process-filter process gud-tooltip-original-filter)
(defun gud-tooltip-print-command (expr)
"Return a suitable command to print the expression EXPR."
(case gud-minor-mode
- (gdba (concat "server print " expr))
- ((dbx gdbmi) (concat "print " expr))
+ (gdbmi (concat "-data-evaluate-expression " expr))
+ (dbx (concat "print " expr))
((xdb pdb) (concat "p " expr))
(sdb (concat expr "/"))))
-(declare-function gdb-enqueue-input "gdb-ui" (item))
+(declare-function gdb-input "gdb-mi" (item))
(declare-function tooltip-expr-to-print "tooltip" (event))
(declare-function tooltip-event-buffer "tooltip" (event))
(buffer-name gud-comint-buffer); might be killed
(setq process (get-buffer-process gud-comint-buffer))
(posn-point (event-end event))
- (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process))
+ (or (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process))
(progn (setq gud-tooltip-event event)
(eval (cons 'and gud-tooltip-display)))))
(let ((expr (tooltip-expr-to-print event)))
(when expr
- (if (and (eq gud-minor-mode 'gdba)
+ (if (and (eq gud-minor-mode 'gdbmi)
(not gdb-active-process))
(progn
(with-current-buffer (tooltip-event-buffer event)
(message-box "Using GUD tooltips in this mode is unsafe\n\
so they have been disabled."))
(unless (null cmd) ; CMD can be nil if unknown debugger
- (if (memq gud-minor-mode '(gdba gdbmi))
- (if gdb-macro-info
- (gdb-enqueue-input
- (list (concat
- gdb-server-prefix "macro expand " expr "\n")
- `(lambda () (gdb-tooltip-print-1 ,expr))))
- (gdb-enqueue-input
- (list (concat cmd "\n")
- `(lambda () (gdb-tooltip-print ,expr)))))
+ (if (eq gud-minor-mode 'gdbmi)
+ (if gdb-macro-info
+ (gdb-input
+ (list (concat
+ "server macro expand " expr "\n")
+ `(lambda () (gdb-tooltip-print-1 ,expr))))
+ (gdb-input
+ (list (concat cmd "\n")
+ `(lambda () (gdb-tooltip-print ,expr)))))
(setq gud-tooltip-original-filter (process-filter process))
(set-process-filter process 'gud-tooltip-process-output)
(gud-basic-call cmd))
(provide 'gud)
-;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4
;;; gud.el ends here