Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
386 lines (347 sloc) 16.1 KB
;;; rdebug-annotate.el --- Ruby debugger output filtering - which
;;; includes annotation handling.
;; Copyright (C) 2008 Rocky Bernstein (
;; Copyright (C) 2008 Anders Lindgren
;; $Id: rdebug-annotate.el 786 2008-04-02 00:50:27Z rockyb $
;; 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:
;; This file contains code dealing with filter of debugger output a large
;; part of which may contain annotations.
;;; Code:
(require 'gud)
(require 'gdb-ui)
(require 'rdebug-dbg)
(require 'rdebug-error)
(require 'rdebug-fns)
(require 'rdebug-info)
(require 'rdebug-layouts)
(require 'rdebug-locring)
(require 'rdebug-regexp)
(require 'rdebug-shortkey)
(require 'rdebug-source)
(require 'rdebug-vars)
(defvar rdebug-non-annotated-text-kind nil
"Represent what non-annotated text is.
This can be:
* nil -- plain shell output
* :output -- output from the command being debugged
* :info -- text for the \"info\" secondary window.
* :message -- message the text to the echo area.
* :cmd -- a command + result, which might go into the \"info\" window.
See the function `rdebug-cmd-process' for details on :cmd.")
(defvar rdebug-annotation-setup-map
(define-hash-table-test 'str-hash 'string= 'sxhash)
(let ((map (make-hash-table :test 'str-hash)))
(puthash "breakpoints" 'rdebug-setup-breakpoints-buffer map)
;;(puthash "error" 'rdebug-setup-error-buffer map)
(puthash "frame" 'rdebug-setup-frame-buffer map)
(puthash "variables" 'rdebug-setup-variables-buffer map)
(puthash "watch" 'rdebug-setup-watch-buffer map)
(puthash "output" 'rdebug-setup-output-buffer map)
(puthash "info" 'rdebug-setup-info-buffer map)
(puthash "help" 'rdebug-setup-secondary-window-help-buffer map)
(defun rdebug-temp-show (text)
"Arrange to show string as in sort of temporary way. Perhaps like a tooltip"
(tooltip-show text))
(defun rdebug-marker-filter-next-item (string)
"The next item for the rdebug marker filter to process.
Return (item . rest) or nil."
(rdebug-debug-message "ACC: %S" string)
;; Empty line, we're done.
((equal (length string) 0)
;; A single ^Z, this could become a new annotation, so lets stop here.
((string= string "\032")
;; A half-baked annotation, lets stop here.
((and (string-match "^\032\032" string)
(not (string-match "\n" string)))
(let ((split-point
(cond ((string-match "\032\032" string)
(let ((beg (match-beginning 0)))
(if (equal beg 0)
(if (string-match "^\032\032" string 2)
(match-beginning 0)
(length string))
((eq (elt string (- (length string) 1)) ?\32)
(length string)))))
(cons (substring string 0 split-point) (substring string split-point))))))
;; There's no guarantee that Emacs will hand the filter the entire
;; marker at once; it could be broken up across several strings. We
;; might even receive a big chunk with several markers in it. If we
;; receive a chunk of text which looks like it might contain the
;; beginning of a marker, we save it here between calls to the
;; filter.
(defun gud-rdebug-marker-filter (string)
"Filter function for process output of the rdebug Ruby debugger."
(rdebug-debug-enter "gud-rdebug-marker-filter:"
(rdebug-debug-message "GOT: %S" string)
(if rdebug-non-annotated-text-kind
(rdebug-debug-message " Text is %S" rdebug-non-annotated-text-kind))
(setq gud-marker-acc (concat gud-marker-acc string))
(rdebug-debug-message "TOT: %S" gud-marker-acc)
(let ((shell-output "") ; Output to debugger shell window.
(done nil)
;; The following loop peels of one "item" at a time. An item is
;; a un-annotated section or an annotation. (This is taken care
;; of by the `rdebug-marker-filter-next-item' function.)
;; An Annotation can be a one-liner (where anything following
;; the annotation is treated as un-annotated text) or a full
;; annotation (which stretches to the next annotation).
;; The concept of one-liners (no phun intended) is to allow
;; continuous output, a "starting" annotation simply sets up the
;; environment for sending lines to the output window, any text
;; following it right now, or in later chunks of data, is
;; redirected to the output window.
(while (and (not done)
(let ((pair (rdebug-marker-filter-next-item gud-marker-acc)))
(rdebug-debug-message "Next item: %S" pair)
(and pair
(setq item (car pair))
(setq gud-marker-acc (cdr pair))
;; Note: Regexp:s are greedy, i.e. the char parts wins over
;; the .* part.
(if (not (string-match "^\032\032\\([-a-z]*\\).*\n" item))
;; Non-annotated text (or the content of one-liners) goes
;; straight into the debugger shell window, or to the
;; output window.
(cond ((and (eq rdebug-non-annotated-text-kind :output)
(rdebug-process-annotation "starting" item))
((eq rdebug-non-annotated-text-kind :info)
(rdebug-process-annotation "info" item))
(if (eq rdebug-non-annotated-text-kind :cmd)
(rdebug-cmd-process item))
(setq shell-output (concat shell-output item))))
;; Handle annotation.
(let* ((line-end (match-end 0))
(name (match-string 1 item))
;; "prompt" is needed to handle "quit" in the shell correctly.
(member name
'("" "exited" "source" "prompt" "starting")))
(next-annotation (string-match "\032\032"
;; For one-liners, shuffle some text back to the accumulator.
(when one-liner
(setq gud-marker-acc (concat (substring item line-end)
(setq item (substring item 0 line-end)))
(if (or next-annotation
;; ok, annotation complete, process it and remove it
(let* ((contents (substring item line-end))
(old-kind rdebug-non-annotated-text-kind))
(rdebug-debug-message "Name: %S Content: %S Kind: %S"
name contents
;; This is a global state flag, this allows us to
;; redirect any further text to the output buffer.
(make-local-variable 'rdebug-non-annotated-text-kind)
(cond ((string= name "starting")
((string= name "prompt")
((string= name "exited")
;; Create a fake command whose output we
;; handle in the cmd system. (We might not
;; receive all of the message at once, we we
;; need some kind of accumukator, which the
;; cmd system provides.)
(setq rdebug-inferior-status "exited")
(setq rdebug-call-queue
(cons '("***exited***" :message)
(t nil)))
(when (and (eq old-kind :cmd)
(not (eq rdebug-non-annotated-text-kind :cmd)))
"New kind: %S" rdebug-non-annotated-text-kind)
;; Process the annotation.
(cond ((string= name "starting")
(setq rdebug-inferior-status "running"))
((string= name "stopped")
(setq rdebug-inferior-status "stopped"))
((string= name "exited")
(setq rdebug-inferior-status "exited"))
((string= name "pre-prompt")
;; Strip of the trailing \n (this is probably
;; a bug in processor.rb).
(if (string= (substring contents -1) "\n")
(setq contents (substring contents 0 -1)))
(if (string-match "post-mortem" contents)
(setq rdebug-inferior-status "crashed"))
(setq shell-output (concat shell-output contents)))
((string= name "source")
(if (string-match gud-rdebug-marker-regexp item)
;; Extract the frame position from the marker.
(setq gud-last-frame
(cons (match-string 1 item)
(match-string 2 item))))))
(t (rdebug-process-annotation name contents))))
;; This is not a one-liner, and we haven't seen the next
;; annotation, so we have to treat this as a partial
;; annotation. Save it and hope that the we can process
;; it the next time we're called.
(setq gud-marker-acc (concat item gud-marker-acc))
(setq done t)))))
(when gud-last-frame
;; Display the source file where we want it, gud will only pick
;; an arbitrary window.
(rdebug-set-frame-arrow (gud-find-file (car gud-last-frame)))
(if (equal 0 rdebug-frames-current-frame-number)
(rdebug-locring-add gud-last-frame
(unless (string= shell-output "")
(rdebug-debug-message "Output: %S" shell-output))
(rdebug-debug-message "REM: %S" gud-marker-acc)
(defun rdebug-process-annotation (name contents)
"Called after `gud-rdebug-marker-filter' found a complete
`name' annotation with string `contents'. Send it to the right
place for processing."
(rdebug-debug-enter (format "rdebug-process-annotation %s" name)
;; Ruby-debug uses the name "starting" for process output (just like
;; GDB). However, it's better to present the buffer as "output" to
;; the user. Ditto for "display" and "watch".
(cond ((string= name "starting")
(setq name "output"))
((string= name "display")
(setq name "watch"))
((string= name "stack")
(setq name "frame"))
((string= name "error-begin")
(setq name "error")))
;; New "info"
(if (string= name "exited")
(setq name "info"))
(if (string= name "error")
(rdebug-errmsg contents))
(let ((setup-func (gethash name rdebug-annotation-setup-map)))
(when setup-func
(let ((buf (rdebug-get-buffer name gud-target-name))
;; Buffer local, doesn't survive the buffer change.
(comint-buffer gud-comint-buffer))
(with-current-buffer buf
(setq buffer-read-only t)
(let ((inhibit-read-only t))
(set (make-local-variable 'rdebug-current-line-number)
(set (make-local-variable 'gud-last-frame) gud-last-frame)
(if rdebug-accumulative-buffer
(goto-char (point-max))
(insert contents)
(funcall setup-func buf comint-buffer))))))
(cond ((and (string= name "info")
(not (string= contents "")))
;; ------------------------------------------------------------
;; Mode line displayer.
;; The variable rdebug-mode-line-process uses this to generate the
;; actual string to display.
(defun rdebug-display-inferior-status ()
"Return a (propertized) string, or nil, to be displayed in the mode line."
(if (and gud-comint-buffer
(buffer-name gud-comint-buffer)
(get-buffer-process gud-comint-buffer)
(let ((s rdebug-inferior-status))
(cond ((string= rdebug-inferior-status "running")
(setq s (propertize s 'face font-lock-type-face)))
(setq s (propertize s 'face font-lock-warning-face))))
(concat ":" s))
;; No process, don't display anything.
;; ------------------------------------------------------------
;; Command output parser.
(defvar rdebug-cmd-acc ""
"The accumulated output of the current command.
Note, on some systems the external process echoes the command,
which is included in the output.")
;; Called when a new command starts.
(defun rdebug-cmd-clear ()
"Called when the Rdebug filter find the start of a new commands."
(rdebug-debug-enter "rdebug-cmd-clear"
(setq rdebug-cmd-acc "")))
;; Called with command output, this can be called any number of times.
(defun rdebug-cmd-process (s)
"Called when the Rdebug filter find the command output.
This may be called any number of times."
(rdebug-debug-enter (format "rdebug-cmd-process %S" s)
(setq rdebug-cmd-acc (concat rdebug-cmd-acc s))))
;; Called when command has finished.
(defun rdebug-cmd-done ()
"Called when the Rdebug filter find the end of a commands."
(rdebug-debug-enter "rdebug-cmd-done"
;; car-safe is used since rdebug-call-queue can be empty.
(let ((entry (car-safe rdebug-call-queue))
(text rdebug-cmd-acc))
(when entry
(rdebug-debug-message "Entry: %S Acc:%S" rdebug-call-queue rdebug-cmd-acc)
(setq rdebug-call-queue (cdr rdebug-call-queue))
(let ((saved-cmd (car entry))
(options (cdr entry)))
;; In cast the external process echoed the actual command,
;; remove it.
(when (and (>= (length text)
(length saved-cmd))
(string= saved-cmd (substring text 0 (length saved-cmd))))
(setq text (substring text (+ 1 (length saved-cmd)))))
(rdebug-debug-message "Text: %S" text)
;; Optionally display the result.
(if (memq :tooltip options)
(rdebug-temp-show text))
(if (memq :info options)
(rdebug-process-annotation "info" text))
(when (memq :message options)
;; Remove trailing newlines (chomp).
(while (and (> (length text) 0)
(eq (elt text (- (length text) 1)) ?\n))
(setq text (substring text 0 -1)))
(message text)))))))
;; -------------------------------------------------------------------
;; The end.
(provide 'rdebug-annotate)
;;; Local variables:
;;; eval:(put 'rdebug-debug-enter 'lisp-indent-hook 1)
;;; End:
;;; rdebug-annotate.el ends here
Something went wrong with that request. Please try again.