;;; 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.
+
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
;; Keywords: unix, tools
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
(defun gud-tool-bar-item-visible-no-fringe ()
(not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode)
+ (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
((eq gud-minor-mode 'jdb)
(gud-call "suspend"))
((eq gud-minor-mode 'gdbmi)
- (gdb-gud-context-call "-exec-interrupt" nil nil t))
- (t
+ (gud-call (gdb-gud-context-command "-exec-interrupt")))
+ (t
(comint-interrupt-subjob)))))
(easy-mmode-defmap gud-menu-map
:visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
([go] menu-item (if gdb-active-process "Continue" "Run") gud-go
:visible (and (eq gud-minor-mode 'gdbmi)
- (or (and (or
- (not gdb-gud-control-all-threads)
- (not gdb-non-stop))
- (not gud-running))
- (and gdb-gud-control-all-threads
- (> gdb-stopped-threads-count 0)))))
+ (gdb-show-run-p)))
([stop] menu-item "Stop" gud-stop-subjob
:visible (or (not (memq gud-minor-mode '(gdbmi pdb)))
- (and (eq gud-minor-mode 'gdbmi)
- (or (and (or
- (not gdb-gud-control-all-threads)
- (not gdb-non-stop))
- gud-running)
- (and gdb-gud-control-all-threads
- (> gdb-running-threads-count 0))))))
+ (gdb-show-stop-p)))
([until] menu-item "Continue to selection" gud-until
:enable (not gud-running)
:visible (and (memq gud-minor-mode '(gdbmi gdb perldb))
([menu-bar go] menu-item
,(propertize " go " 'face 'font-lock-doc-face) gud-go
:visible (and (eq gud-minor-mode 'gdbmi)
- (or (and (or
- (not gdb-gud-control-all-threads)
- (not gdb-non-stop))
- (not gud-running))
- (and gdb-gud-control-all-threads
- (> gdb-stopped-threads-count 0)))))
+ (gdb-show-run-p)))
([menu-bar stop] menu-item
,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob
:visible (or (and (eq gud-minor-mode 'gdbmi)
- (or (and (or
- (not gdb-gud-control-all-threads)
- (not gdb-non-stop))
- gud-running)
- (and gdb-gud-control-all-threads
- (> gdb-running-threads-count 0))))
+ (gdb-show-stop-p))
(not (eq gud-minor-mode 'gdbmi))))
([menu-bar print]
. (,(propertize "print" 'face 'font-lock-doc-face) . gud-print))
(defun gud-speedbar-item-info ()
"Display the data type of the watch expression element."
(let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)))
- (if (nth 6 var)
- (speedbar-message "%s: %s" (nth 6 var) (nth 3 var))
+ (if (nth 7 var)
+ (speedbar-message "%s: %s" (nth 7 var) (nth 3 var))
(speedbar-message "%s" (nth 3 var)))))
(defun gud-install-speedbar-variables ()
(let* (char (depth 0) (start 0) (var (car var-list))
(varnum (car var)) (expr (nth 1 var))
(type (if (nth 3 var) (nth 3 var) " "))
- (value (nth 4 var)) (status (nth 5 var)))
+ (value (nth 4 var)) (status (nth 5 var))
+ (has-more (nth 6 var)))
(put-text-property
0 (length expr) 'face font-lock-variable-name-face expr)
(put-text-property
(setq depth (1+ depth)
start (1+ (match-beginning 0))))
(if (eq depth 0) (setq parent nil))
- (if (or (equal (nth 2 var) "0")
- (and (equal (nth 2 var) "1")
- (string-match "char \\*$" type)))
+ (if (and (or (not has-more) (string-equal has-more "0"))
+ (or (equal (nth 2 var) "0")
+ (and (equal (nth 2 var) "1")
+ (string-match "char \\*$" type)) ))
(speedbar-make-tag-line
'bracket ?? nil nil
(concat expr "\t" value)
;; Cause our buffers to be displayed, by default,
;; in the selected window.
-;;;###autoload (add-hook 'same-window-regexps "\\*gud-.*\\*\\(\\|<[0-9]+>\\)")
+;;;###autoload (add-hook 'same-window-regexps (purecopy "\\*gud-.*\\*\\(\\|<[0-9]+>\\)"))
(defcustom gud-chdir-before-run t
"Non-nil if GUD should `cd' to the debugged executable."
(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
(setq gud-keep-buffer t)))
(save-restriction
(widen)
- (goto-line line)
+ (goto-char (point-min))
+ (forward-line (1- line))
(setq pos (point))
(or gud-overlay-arrow-position
(setq gud-overlay-arrow-position (make-marker)))
(let ((proc (get-buffer-process gud-comint-buffer)))
(or proc (error "Current buffer has no process"))
;; Arrange for the current prompt to get deleted.
- (save-excursion
- (set-buffer gud-comint-buffer)
- (save-restriction
- (widen)
- (if (marker-position gud-delete-prompt-marker)
- ;; We get here when printing an expression.
- (goto-char gud-delete-prompt-marker)
- (goto-char (process-mark proc))
- (forward-line 0))
- (if (looking-at comint-prompt-regexp)
- (set-marker gud-delete-prompt-marker (point)))
- (if (eq gud-minor-mode 'gdbmi)
- (apply comint-input-sender (list proc command))
- (process-send-string proc (concat command "\n")))))))
+ (with-current-buffer gud-comint-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if (marker-position gud-delete-prompt-marker)
+ ;; We get here when printing an expression.
+ (goto-char gud-delete-prompt-marker)
+ (goto-char (process-mark proc))
+ (forward-line 0))
+ (if (looking-at comint-prompt-regexp)
+ (set-marker gud-delete-prompt-marker (point)))
+ (if (eq gud-minor-mode 'gdbmi)
+ (apply comint-input-sender (list proc command))
+ (process-send-string proc (concat command "\n"))))))))
(defun gud-refresh (&optional arg)
"Fix up a possibly garbled display, and redraw the arrow."
;; symbols until 'topmost-intro is reached to find out if
;; point is within a nested class
(if (and fbuffer (equal (symbol-file 'java-mode) "cc-mode"))
- (save-excursion
- (set-buffer fbuffer)
+ (with-current-buffer fbuffer
(let ((nclass) (syntax))
;; While the c-syntactic information does not start
;; with the 'topmost-intro symbol, there may be
("\\$\\(\\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
+ (unless (eq (match-beginning 0) (point-min))
;; 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 '("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode))
-
;;;###autoload
(define-derived-mode gdb-script-mode nil "GDB-Script"
"Major mode for editing GDB scripts."
#'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
(remove-hook 'post-command-hook
'gud-tooltip-activate-mouse-motions-if-enabled)
(dolist (buffer (buffer-list))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(if (and gud-tooltip-mode
(memq major-mode gud-tooltip-modes))
(gud-tooltip-activate-mouse-motions t)
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))))
(defun gud-tooltip-print-command (expr)
"Return a suitable command to print the expression EXPR."
(case gud-minor-mode
- ((dbx gdbmi) (concat "print " expr))
+ (gdbmi (concat "-data-evaluate-expression " expr))
+ (dbx (concat "print " expr))
((xdb pdb) (concat "p " expr))
(sdb (concat expr "/"))))
(provide 'gud)
-;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4
;;; gud.el ends here
HCoop / bpt / emacs.git / blobdiff