Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
393 lines (314 sloc) 13.9 KB
;;; rdebug-track.el --- Tracking the Ruby debugger from a shell
;; $Id: rdebug-track.el 909 2009-03-11 18:57:08Z rockyb $
;; Copyright (C) 2006, 2007, 2008 Rocky Bernstein (
;; Copyright (C) 2007, 2008 Anders Lindgren
;; Modified from python-mode in particular the part:
;; pdbtrack support contributed by Ken Manheimer, April 2001.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; See the manual and the file `rdebug.el' for more information.
;; `rdebug-track-mode' allows access to full debugger user interface
;; for Ruby debugger sessions started in a standard shell window.
;; `turn-on-rdebug-track-mode' turns the mode on and
;; `turn-off-rdebug-track-mode' turns it off.
;;; Customization:
;; `rdebug-track' sets whether file tracking is done by the shell prompt.
;; `rdebug-track-minor-mode-string' sets the mode indicator to show that
;; tracking is in effect.
;;; Code:
;; -------------------------------------------------------------------
;; Customizable variables.
(defgroup rdebug-track nil
"Ruby debug and rdebug file tracking by watching the shell prompt."
:prefix "rdebug-track"
:group 'shell)
(defcustom rdebug-track-do-tracking-p nil
"*Controls whether the rdebug-track feature is enabled or not.
When non-nil, rdebug-track is enabled in all comint-based buffers,
e.g. shell buffers and the *Ruby* buffer. When using rdebug to debug a
Ruby program, rdebug-track notices the rdebug prompt and displays the
source file and line that the program is stopped at, much the same way
as gud-mode does for debugging C programs with gdb."
:type 'boolean
:group 'rdebug)
(make-variable-buffer-local 'rdebug-track-do-tracking-p)
(defcustom rdebug-track-minor-mode-string " rdebug"
"*String to use in the minor mode list when rdebug-track is enabled."
:type 'string
:group 'rdebug)
;; -------------------------------------------------------------------
;; Variables.
(defvar gud-rdebug-history nil
"History of argument lists passed to rdebug.")
;; rdebug-track constants
(defconst rdebug-track-stack-entry-regexp
"^(\\([-a-zA-Z0-9_/.]*\\):\\([0-9]+\\)):[ \t]?\\(.*\n\\)"
"Regular expression rdebug-track uses to find a stack trace entry.")
(defconst rdebug-track-track-range 10000
"Max number of characters from end of buffer to search for stack entry.")
;; -------------------------------------------------------------------
;; Dependencies.
(require 'comint)
(require 'custom)
(require 'cl)
(require 'compile)
(require 'gud)
(require 'shell)
(require 'rdebug-breaks)
(require 'rdebug-cmd)
(require 'rdebug-core)
;; -------------------------------------------------------------------
;; Rdebug track -- support for attaching the `rdebug' ruby debugger to
;; a process running in a shell buffer.
(defvar rdebug-track-is-tracking-p t)
(defun rdebug-track-overlay-arrow (activation)
"Activate or de arrow at beginning-of-line in current buffer."
;; This was derived/simplified from edebug-overlay-arrow
(cond (activation
(setq overlay-arrow-position (make-marker))
(setq overlay-arrow-string "=>")
(set-marker overlay-arrow-position (point) (current-buffer))
(setq rdebug-track-is-tracking-p t))
(setq overlay-arrow-position nil)
(setq rdebug-track-is-tracking-p nil))
(defun rdebug-track-track-stack-file (text)
"Show the file indicated by the rdebug stack entry line, in a separate window.
Activity is disabled if the buffer-local variable
`rdebug-track-do-tracking-p' is nil.
We depend on the rdebug input prompt matching `rdebug-input-prompt-regexp'
at the beginning of the line."
;; Instead of trying to piece things together from partial text
;; (which can be almost useless depending on Emacs version), we
;; monitor to the point where we have the next rdebug prompt, and then
;; check all text from comint-last-input-end to process-mark.
;; Also, we're very conservative about clearing the overlay arrow,
;; to minimize residue. This means, for instance, that executing
;; other rdebug commands wipe out the highlight. You can always do a
;; 'where' (aka 'w') command to reveal the overlay arrow.
(rdebug-debug-enter "rdebug-track-track-stack-file"
(let* ((origbuf (current-buffer))
(currproc (get-buffer-process origbuf)))
(if (not (and currproc rdebug-track-do-tracking-p))
(rdebug-track-overlay-arrow nil)
(let* ((procmark (process-mark currproc))
(block-start (max comint-last-input-end
(- procmark rdebug-track-track-range)))
(block-str (buffer-substring block-start procmark))
target target_fname target_lineno target_buffer)
(if (not (string-match rdebug-input-prompt-regexp block-str))
(rdebug-track-overlay-arrow nil)
(setq target (rdebug-track-get-source-buffer block-str))
(if (stringp target)
(rdebug-debug-message "rdebug-track: %s" target)
(gud-rdebug-marker-filter block-str)
(setq target_lineno (car target))
(setq target_buffer (cadr target))
(setq target_fname (buffer-file-name target_buffer))
(setq gud-last-frame (cons target_fname target_lineno))
(switch-to-buffer-other-window target_buffer)
(goto-line target_lineno)
(rdebug-debug-message "rdebug-track: line %s, file %s"
target_lineno target_fname)
(rdebug-track-overlay-arrow t)
(rdebug-set-frame-top-arrow (current-buffer))
(set (make-local-variable 'gud-comint-buffer) origbuf)
(set (make-local-variable 'gud-delete-prompt-marker)
(pop-to-buffer origbuf t)
(rdebug-locring-add gud-last-frame
;; Delete processed annotations from buffer.
(let ((annotate-start)
(annotate-end (point-max)))
(goto-char block-start)
(while (re-search-forward
rdebug-annotation-start-regexp annotate-end t)
(let* ((start (match-beginning 0))
(end (match-end 0))
(name (or (match-string 1) "source")))
(cond ((string= name "prompt\n")
(delete-region (- start 1) end))
((string= name "pre-prompt\n")
(delete-region start end))
((string= name "error-begin\n")
(delete-region start end))
((re-search-forward rdebug-annotation-end-regexp
annotate-end t)
(delete-region start (point)))
(t (forward-line)))))))
(defun rdebug-track-get-source-buffer (block-str)
"Return line and buffer of code indicated by block-str's traceback text.
We look first to visit the file indicated in the trace.
Failing that, we look for the most recently visited ruby-mode buffer
with the same name or having having the named function.
If we're unable find the source code we return a string describing the
problem as best as we can determine."
(if (not (string-match rdebug-position-regexp block-str))
"line number cue not found"
(let* ((filename (match-string rdebug-marker-regexp-file-group block-str))
(lineno (string-to-number
(match-string rdebug-marker-regexp-line-group block-str)))
(cond ((file-exists-p filename)
(list lineno (find-file-noselect filename)))
((= (elt filename 0) ?\<)
(format "(Non-file source: '%s')" filename))
(t (format "Not found: %s" filename))))))
;; -----------------------------------------------
;; Rdebug track mode
(defcustom rdebug-track-mode-text " rdebug"
"*String to display in the mode line when rdebug-track mode is active.
\(When the string is not empty, make sure that it has a leading space.)"
:tag "rdebug mode text" ; To separate it from `global-...'
:group 'rdebug
:type 'string)
(define-minor-mode rdebug-track-mode
"Minor mode for tracking ruby debugging inside a process shell."
:init-value nil
;; The indicator for the mode line.
:lighter rdebug-track-mode-text
;; The minor mode bindings.
:global nil
:group 'rdebug
(rdebug-track-toggle-stack-tracking 1)
(setq rdebug-track-is-tracking-p t)
(local-set-key "\C-cg" 'rdebug-goto-traceback-line)
(local-set-key "\C-cG" 'rdebug-goto-dollarbang-traceback-line)
(add-hook 'comint-output-filter-functions 'rdebug-track-track-stack-file)
(run-mode-hooks 'rdebug-track-mode-hook))
(defun rdebug-track-toggle-stack-tracking (arg)
(interactive "P")
(if (not (get-buffer-process (current-buffer)))
(message "No process associated with buffer '%s'" (current-buffer))
;; missing or 0 is toggle, >0 turn on, <0 turn off
(if (or (not arg)
(zerop (setq arg (prefix-numeric-value arg))))
(setq rdebug-track-do-tracking-p (not rdebug-track-do-tracking-p))
(setq rdebug-track-do-tracking-p (> arg 0)))
(message "%sabled rdebug's rdebug-track"
(if rdebug-track-do-tracking-p "En" "Dis"))))
(defun turn-on-rdebug-track-mode ()
"Turn on rdebug-track mode.
This function is designed to be added to hooks, for example:
(add-hook 'comint-mode-hook 'turn-on-rdebug-track-mode)"
(set (make-local-variable 'gud-last-last-frame) nil)
(set (make-local-variable 'gud-last-frame) nil)
(set (make-local-variable 'gud-comint-buffer) (current-buffer))
(set (make-local-variable 'gud-marker-filter) 'gud-rdebug-marker-filter)
(set (make-local-variable 'gud-minor-mode) 'rdebug)
(set (make-local-variable 'comint-prompt-regexp) (concat "^" rdebug-input-prompt-regexp))
(set (make-local-variable 'gud-find-file) 'gud-rdebug-find-file)
(rdebug-track-mode 1))
(defun turn-off-rdebug-track-mode ()
"Turn off rdebug-track mode."
(setq rdebug-track-is-tracking-p nil)
(rdebug-track-toggle-stack-tracking 0)
(if (local-variable-p 'gud-last-frame)
(setq gud-last-frame nil))
(while (not (ring-empty-p rdebug-source-location-ring))
(ring-remove rdebug-source-location-ring))
(remove-hook 'comint-output-filter-functions
;; -----------------------------------------------
;; The `attach' function.
(defun rdebug-track-attach (&optional name rename-shell)
"Do things to make the current process buffer work like a
rdebug command buffer. In particular, the buffer is renamed,
gud-mode is set, and rdebug-track-mode is turned on, among other
things. When `rdebug-many-windows' is non-nil, the initial debugger
window layout is used."
(interactive "sProgram name: ")
(rdebug-debug-enter "rdebug-set-windows"
(rdebug-set-window-configuration-state 'debugger t)
;; from rdebug-common-init
(set (make-local-variable 'gud-marker-filter) 'gud-rdebug-marker-filter)
(set (make-local-variable 'gud-minor-mode) 'rdebug)
(set (make-local-variable 'gud-last-frame) nil)
(set (make-local-variable 'gud-last-last-frame) nil)
(set (make-local-variable 'gud-find-file) 'gud-rdebug-find-file)
(set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
(rdebug-track-mode 1)
(when name
(if rename-shell
(rename-buffer (format "*rdebug-cmd-%s*" gud-target-name)))
(setq gud-target-name name)
(setq gud-comint-buffer (current-buffer)))
;; Setup exit callback so that the original frame configuration
;; can be restored.
(let ((process (get-buffer-process gud-comint-buffer)))
(when process
(unless (equal rdebug-line-width 120)
(gud-call (format "set width %d" rdebug-line-width)))
(set-process-sentinel process
(when gud-last-frame
(setq gud-last-last-frame gud-last-frame))
;; Add the buffer-displaying commands to the Gud buffer,
;; FIXME: combine with code in rdebug-track.el; make common
;; command buffer mode map.
(let ((prefix-map (make-sparse-keymap))
(map (current-local-map)))
(define-key map [M-down] 'rdebug-locring-newer)
(define-key map [M-up] 'rdebug-locring-older)
(define-key map [M-S-down] 'rdebug-locring-newest)
(define-key map [M-S-up] 'rdebug-locring-oldest)
(define-key map gud-key-prefix prefix-map)
(define-key prefix-map "t" 'rdebug-goto-traceback-line)
(define-key prefix-map "!" 'rdebug-goto-dollarbang-traceback-line)
(rdebug-populate-secondary-buffer-map-plain prefix-map))
(rdebug-populate-common-keys (current-local-map))
(rdebug-populate-debugger-menu (current-local-map))
(set (make-local-variable 'comint-prompt-regexp) (concat "^" rdebug-input-prompt-regexp))
(setq paragraph-start comint-prompt-regexp)
(setcdr (assq 'rdebug-debugger-support-minor-mode minor-mode-map-alist)
(gud-call "set annotate 3")
(gud-call "frame 0")
(when rdebug-many-windows
(run-hooks 'rdebug-mode-hook)))
;; -------------------------------------------------------------------
;; The end.
(provide 'rdebug-track)
;;; Local variables:
;;; eval:(put 'rdebug-debug-enter 'lisp-indent-hook 1)
;;; End:
;;; rdebug-track.el ends here
Something went wrong with that request. Please try again.