;;; 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 (rocky@gnu.org) ;; 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 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; 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)) (rdebug-track-is-tracking-p (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) ;;else (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) ;;else (setq target (rdebug-track-get-source-buffer block-str)) (if (stringp target) (rdebug-debug-message "rdebug-track: %s" target) ;;else (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) (make-marker)) (pop-to-buffer origbuf t) (rdebug-locring-add gud-last-frame rdebug-source-location-ring)) ;; Delete processed annotations from buffer. (save-excursion (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" ;;else (let* ((filename (match-string rdebug-marker-regexp-file-group block-str)) (lineno (string-to-number (match-string rdebug-marker-regexp-line-group block-str))) funcbuffer) (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)) ;;else ;; 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")))) ;;;###autoload (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)" (interactive) (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-command-initialization) (rdebug-track-mode 1)) (defun turn-off-rdebug-track-mode () "Turn off rdebug-track mode." (interactive) (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 'rdebug-track-track-stack-file)) ;; ----------------------------------------------- ;; 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 (gud-mode) (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) (gud-set-buffer) ;; (rdebug-track-mode 1) (rdebug-command-initialization) (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 'rdebug-process-sentinel))) (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) rdebug-debugger-support-minor-mode-map-when-active) (gud-call "set annotate 3") (gud-call "frame 0") (when rdebug-many-windows (rdebug-setup-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