needy_debugger 1.4.0

data/emacs/rdebug-core.el

@@ -0,0 +1,502 @@
+;;; rdebug-core.el --- Core parts of the Ruby debugger user
+;;; interface. It pulls in other parts of the debugger.
+
+;; Copyright (C) 2006, 2007, 2008 Rocky Bernstein (rocky@gnu.org)
+;; Copyright (C) 2007, 2008 Anders Lindgren
+
+;; $Id: rdebug-core.el 909 2009-03-11 18:57:08Z 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
+;; 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.
+
+;; This file implements the core of the debugger.
+
+;;; Code:
+
+;; -------------------------------------------------------------------
+;; Consistency checks.
+;;
+
+(if (< emacs-major-version 22)
+    (error
+     "This version of rdebug.el needs at least Emacs 22 or greater - you have version %d"
+     emacs-major-version))
+
+
+;; -------------------------------------------------------------------
+;; Dependencies.
+;;
+
+(require 'gud)
+(require 'cl)
+
+(require 'rdebug)
+(require 'rdebug-annotate)
+(require 'rdebug-dbg)
+(require 'rdebug-cmd)
+(require 'rdebug-layouts)
+(require 'rdebug-source)
+(require 'rdebug-regexp)
+(require 'rdebug-vars)
+
+(defun rdebug-get-script-name (args)
+  "Parse command line ARGS.
+
+A list containing the script name, and whether the annotate
+option was set is returned.
+
+Initially annotate should be set to nil.  Argument ARGS contains
+a tokenized list of the command line."
+  ;; Parse the following:
+  ;;
+  ;;  [ruby ruby-options] rdebug rdebug-options script-name script-options
+  (and args
+       (let ((name nil)
+             (annotate-p nil))
+         ;; Strip of optional "ruby" or "ruby182" etc.
+         (when (string-match "^ruby[0-9]*$"
+                             (file-name-sans-extension
+                              (file-name-nondirectory (car args))))
+           (pop args)
+           (while (and args
+                       (string-match "^-" (car args)))
+             (if (member (car args) '("-e" "-r" "-I" "-C" "-F" "-K"))
+                 (pop args))
+             (pop args)))
+         ;; Remove "rdebug" from "rdebug --rdebug-options script
+         ;; --script-options"
+         (pop args)
+         ;; Skip to the first non-option argument.
+         (while (and args
+                     (not name))
+           (let ((arg (pop args)))
+             (cond
+              ;; Annotation or emacs option with level number.
+              ((or (member arg '("--annotate" "-A"))
+		   (equal arg "--emacs"))
+               (setq annotate-p t)
+               (pop args))
+              ;; Combined annotation and level option.
+              ((string-match "^--annotate=[0-9]" arg)
+               (setq annotate-p t))
+              ;; Options with arguments.
+              ((member arg '("-h" "--host" "-p" "--port"
+                             "-I" "--include" "-r" "--require"))
+               (pop args))
+              ((string-match "^-" arg)
+               nil)
+              (t
+               (setq name arg)))))
+         (and name
+              (list name annotate-p)))))
+
+;; -------------------------------------------------------------------
+;; Window configuration state support.
+;;
+
+(defun rdebug-set-window-configuration-state (state &optional dont-restore)
+  "Change window configuration state.
+
+Two states are supported, `original' and `debugger'.
+
+When `dont-restore' is non-nil, the old window layout is not
+restored. This is used when a new layout is being drawn, for
+example when the debugger starts."
+  (rdebug-debug-message "Setting state to %s (was %s)"
+                        state rdebug-window-configuration-state)
+  (when (not (eq state rdebug-window-configuration-state))
+    ;; Save the previous state.
+    (cond ((not (eq rdebug-window-configuration-state 'original))
+           (setq rdebug-debugger-window-configuration
+                 (current-window-configuration)))
+          ((eq rdebug-window-configuration-state 'original)
+           (setq rdebug-original-window-configuration
+                 (current-window-configuration))))
+    (unless dont-restore
+      ;; Switch to the saved state,
+      (cond
+       ((not (eq state 'original))
+        (if rdebug-debugger-window-configuration
+            (set-window-configuration rdebug-debugger-window-configuration)))
+       ((eq state 'original)
+        (if rdebug-original-window-configuration
+            (set-window-configuration rdebug-original-window-configuration)))))
+    (setq rdebug-window-configuration-state state)))
+
+
+;; have to bind rdebug-file-queue before installing the kill-emacs-hook
+(defvar rdebug-file-queue nil
+  "Queue of Makefile temp files awaiting execution.
+Currently-active file is at the head of the list.")
+
+(defun rdebug-goto-traceback-line (pt)
+  "Display the location PT in a source file of the Ruby traceback line."
+  (interactive "d")
+  (save-excursion
+    (goto-char pt)
+    (let ((s (buffer-substring (line-beginning-position) (line-end-position)))
+	  (gud-comint-buffer (current-buffer)))
+      (when (string-match rdebug-traceback-line-re s)
+        (rdebug-display-line
+         (substring s (match-beginning 1) (match-end 1))
+         (string-to-number (substring s (match-beginning 2) (match-end 2))))
+        ))))
+
+(defun rdebug-goto-dollarbang-traceback-line (pt)
+  "Display the location PT in a source file of the Ruby $! traceback line."
+  (interactive "d")
+  (save-excursion
+    (goto-char pt)
+    (let ((s (buffer-substring (line-beginning-position) (line-end-position)))
+	  (gud-comint-buffer (current-buffer)))
+      (when (string-match rdebug-dollarbang-traceback-line-re s)
+        (rdebug-display-line
+         (substring s (match-beginning 1) (match-end 1))
+         (string-to-number (substring s (match-beginning 2) (match-end 2))))
+        ))))
+
+;; -------------------------------------------------------------------
+;; Secondary buffers.
+;;
+
+(require 'rdebug-secondary)
+(require 'rdebug-breaks)
+(require 'rdebug-frames)
+(require 'rdebug-help)
+(require 'rdebug-output)
+(require 'rdebug-varbuf)
+(require 'rdebug-watch)
+
+
+;; -------------------------------------------------------------------
+;; Windows.
+;;
+
+(defun rdebug-setup-windows (&optional erase)
+  "Create the debugger user interface window layout.
+
+If ERASE is non-nil, the content of the windows are erased
+\(this does not apply to accumulative windows).
+
+This function displays the source file (or, in some cases, a
+buffer list) and creates the window layout.  The variable
+`rdebug-window-layout-function' controls the function that is
+used to perform the actual layout.
+
+This is only used when `rdebug-many-windows' is non-nil."
+  (rdebug-debug-enter "rdebug-setup-windows"
+    (rdebug-set-window-configuration-state 'debugger t)
+    (pop-to-buffer gud-comint-buffer)
+    (maphash
+     (lambda (name func)
+       (if erase
+           (let ((buf (rdebug-get-existing-buffer name gud-target-name)))
+             (if buf
+                 (with-current-buffer buf
+                   (let ((inhibit-read-only t))
+                     (erase-buffer))))))
+       (rdebug-process-annotation name ""))
+     rdebug-annotation-setup-map)
+    (let ((buf
+           (cond (gud-last-last-frame
+		  (gud-find-file (car gud-last-last-frame)))
+		 (gud-target-name
+		  (gud-find-file gud-target-name)))))
+      ;; Put a buffer in window if we can't find a source file.
+      (unless buf (setq buf (get-buffer-create "*scratch*")))
+      (funcall rdebug-window-layout-function buf gud-target-name))))
+
+
+(defun rdebug-setup-windows-initially ()
+  "Like `rdebug-setup-windows', but erase the content of accumulative windows.
+This is called when the debugger starts."
+  (rdebug-setup-windows t))
+
+
+(defun rdebug-restore-debugger-window-layout ()
+  "Restore the initial ruby debugger window layout."
+  (interactive)
+  (when rdebug-many-windows
+    (rdebug-setup-windows)))
+
+(defun rdebug-display-debugger-window-configuration ()
+  "Switch from the \"original\" to the \"debugger\" window layout.
+
+The rdebug debugger remembers, and can switch between, two window layouts:
+ * original -- the window layout when the debugger was started.
+ * debugger -- the window layout of the debugger, plus all changes made
+               since the debugger started.
+
+The check-marks in the \"Window Layout\" menu indicates the
+active window layout.
+
+The function `rdebug-display-original-window-configuration'
+switch to the \"original\" window configuration.
+
+The function `rdebug-restore-debugger-window-layout' restores the
+window layout to the state it was when the debugger started."
+  (interactive)
+  (rdebug-set-window-configuration-state 'debugger)
+  (message
+   "Type `M-x rdebug-display-original-window-configuration RET' to restore."))
+
+
+;;This function is called upon quitting the debugger and
+;;`rdebug-many-windows' is not nil. See also
+;;`rdebug-display-debugger-window-configuration'."
+
+(defun rdebug-display-original-window-configuration ()
+  "Switch from the \"debugger\" to the \"original\" window layout.
+
+The rdebug debugger remembers, and can switch between, two window layouts:
+ * original -- the window layout when the debugger was started.
+ * debugger -- the window layout of the debugger, plus all changes made
+               since the debugger started.
+
+The check-marks in the \"Window Layout\" menu indicates the
+active window layout.
+
+The function `rdebug-display-debugger-window-configuration'
+switch to the \"debugger\" window configuration."
+  (interactive)
+  (rdebug-set-window-configuration-state 'original)
+  (message
+   "Type `M-x rdebug-display-debugger-window-configuration RET' to restore."))
+
+
+;; -------------------------------------------------------------------
+;; The `rdebug' command and support functions.
+;;
+
+(defun rdebug-process-sentinel (process event)
+  "Restore the original window configuration when the debugger process exits."
+  (rdebug-debug-enter "rdebug-process-sentinel"
+    (rdebug-debug-message "status=%S event=%S state=%S"
+                          (process-status process)
+                          event
+                          rdebug-window-configuration-state)
+    (gud-sentinel process event)
+    ;; This will "flush" the last annotation. Especially "output"
+    ;; (a.k.a. "starting") annotations don't have an end markers, if
+    ;; the last command printed something.
+    (if (string= event "finished\n")
+        (gud-rdebug-marker-filter "\032\032\n"))
+    ;; When the debugger process exited, when the comint buffer has no
+    ;; buffer process (nil). When the debugger processes is replaced
+    ;; with another process we should not restore the window
+    ;; configuration.
+    (when (and (or (eq rdebug-restore-original-window-configuration t)
+                   (and (eq rdebug-restore-original-window-configuration :many)
+                        rdebug-many-windows))
+               (or (rdebug-dead-process-p)
+                   (eq process (get-buffer-process gud-comint-buffer)))
+               (eq rdebug-window-configuration-state 'debugger)
+               (not (eq (process-status process) 'run)))
+      (rdebug-internal-short-key-mode-off)
+      (rdebug-set-window-configuration-state 'original)
+      (rdebug-reset-keymaps))))
+
+
+;; Perform initializations common to all debuggers.
+;; The first arg is the specified command line,
+;; which starts with the program to debug.
+;; The other three args specify the values to use
+;; for local variables in the debugger buffer.
+(defun rdebug-common-init (rdebug-buffer-name rdebug-cmd-buffer target-name
+					      program args
+					      marker-filter
+					      &optional find-file)
+  "Perform initializations common to all debuggers.
+
+RDEBUG-BUFFER-NAME is the specified command line, which starts
+with the program to debug. PROGRAM, ARGS and MARKER-FILTER
+specify the values to use for local variables in the debugger
+buffer."
+  (if rdebug-cmd-buffer
+      (progn
+	(pop-to-buffer rdebug-cmd-buffer)
+	(when (and rdebug-cmd-buffer (get-buffer-process rdebug-cmd-buffer))
+	  (error "This program is already being debugged"))
+	(apply 'make-comint rdebug-buffer-name program nil args)
+	(or (bolp) (newline)))
+    (pop-to-buffer (setq rdebug-cmd-buffer
+			 (apply 'make-comint rdebug-buffer-name program nil
+				args))))
+  
+  ;; Since comint clobbered the mode, we don't set it until now.
+  (gud-mode)
+  (set (make-local-variable 'gud-target-name) target-name)
+  (set (make-local-variable 'gud-marker-filter) 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)
+
+  (let ((buffer-process (get-buffer-process (current-buffer))))
+    (if buffer-process
+	(progn 
+	  (set-process-filter buffer-process 'gud-filter)
+	  (set-process-sentinel buffer-process 'gud-sentinel))))
+  (gud-set-buffer))
+
+;;;###autoload
+(defun rdebug (command-line)
+  "Invoke the rdebug Ruby debugger and start the Emacs user interface.
+
+String COMMAND-LINE specifies how to run rdebug.
+
+By default, the \"standard\" user window layout looks like the following:
+
++----------------------------------------------------------------------+
+|                                Toolbar                               |
++-----------------------------------+----------------------------------+
+| Debugger shell                    | Variables buffer                 |
++-----------------------------------+----------------------------------+
+|                                   |                                  |
+| Source buffer                     | Output buffer                    |
+|                                   |                                  |
++-----------------------------------+----------------------------------+
+| Stack Frame buffer                | Breakpoints buffer               |
++-----------------------------------+----------------------------------+
+
+The variable `rdebug-window-layout-function' can be
+customized so that another layout is used. In addition to a
+number of predefined layouts it's possible to define a function
+to perform a custom layout.
+
+If `rdebug-many-windows' is nil, only a traditional debugger
+shell and source window is opened.
+
+The directory containing the debugged script becomes the initial
+working directory and source-file directory for your debugger.
+
+The custom variable `gud-rdebug-command-name' sets the command
+and options used to invoke rdebug."
+  (interactive
+   (let ((init (buffer-file-name)))
+     (setq init (and init
+                     (file-name-nondirectory init)))
+     (list (gud-query-cmdline 'rdebug init))))
+  (rdebug-debug-enter "rdebug"
+    (rdebug-set-window-configuration-state 'debugger t)
+    ;; Parse the command line and pick out the script name and whether
+    ;; --annotate has been set.
+    (let* ((words (with-no-warnings
+                    (split-string-and-unquote command-line)))
+           (script-name-annotate-p (rdebug-get-script-name
+                                    (gud-rdebug-massage-args "1" words)))
+           (target-name (file-name-nondirectory (car script-name-annotate-p)))
+           (annotate-p (cadr script-name-annotate-p))
+           (cmd-buffer-name (format "rdebug-cmd-%s" target-name))
+           (rdebug-cmd-buffer-name (format "*%s*" cmd-buffer-name))
+           (rdebug-cmd-buffer (get-buffer rdebug-cmd-buffer-name))
+	   (program (car words))
+	   (args (cdr words))
+           (gud-chdir-before-run nil))
+
+      ;; `gud-rdebug-massage-args' needs whole `command-line'.
+      ;; command-line is refered through dynamic scope.
+      (rdebug-common-init cmd-buffer-name rdebug-cmd-buffer target-name
+			  program args
+			  'gud-rdebug-marker-filter
+			  'gud-rdebug-find-file)
+      (setq comint-process-echoes t)
+
+      (setq rdebug-inferior-status "running")
+
+      (rdebug-command-initialization)
+
+      ;; 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)))
+
+
+      ;; 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)))
+        (define-key (current-local-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))
+
+      (setq 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)
+      (when rdebug-many-windows
+        (rdebug-setup-windows-initially))
+
+      (run-hooks 'rdebug-mode-hook))))
+
+
+(defadvice gud-reset (before rdebug-reset)
+  "Rdebug cleanup - remove debugger's internal buffers (frame, breakpoints, etc.)."
+  (rdebug-breakpoint-remove-all-icons)
+  (dolist (buffer (buffer-list))
+    (when (string-match "\\*rdebug-[a-z]+\\*" (buffer-name buffer))
+      (let ((w (get-buffer-window buffer)))
+        (when w
+          (delete-window w)))
+      (kill-buffer buffer))))
+(ad-activate 'gud-reset)
+
+(defun rdebug-reset ()
+  "Rdebug cleanup - remove debugger's internal buffers (frame, breakpoints, etc.)."
+  (interactive)
+  (rdebug-breakpoint-remove-all-icons)
+  (dolist (buffer (buffer-list))
+    (when (string-match "\\*rdebug-[a-z]+\\*" (buffer-name buffer))
+      (let ((w (get-buffer-window buffer)))
+        (when w
+          (delete-window w)))
+      (kill-buffer buffer))))
+
+(defun rdebug-reset-keymaps()
+  "This unbinds the special debugger keys of the source buffers."
+  (interactive)
+  (setcdr (assq 'rdebug-debugger-support-minor-mode minor-mode-map-alist)
+	  rdebug-debugger-support-minor-mode-map-when-deactive))
+
+
+(defun rdebug-customize ()
+  "Use `customize' to edit the settings of the `rdebug' debugger."
+  (interactive)
+  (customize-group 'rdebug))
+
+
+;; -------------------------------------------------------------------
+;; The end.
+;;
+
+(provide 'rdebug-core)
+
+;;; Local variables:
+;;; eval:(put 'rdebug-debug-enter 'lisp-indent-hook 1)
+;;; End:
+
+;;; rdebug-core.el ends here