site-lisp/bashdb.el

   1 ;;; bashdb.el --- BASH Debugger mode via GUD and bashdb
   2 ;;; $Id: bashdb.el,v 1.22 2007/07/12 06:06:05 myamato Exp $
   3
   4 ;; Copyright (C) 2002, 2006, 2007 Rocky Bernstein (rockyb@users.sf.net)
   5 ;;                    and Masatake YAMATO (jet@gyve.org)
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 ;; Boston, MA 02111-1307, USA.
  21
  22 ;; Commentary:
  23 ;; 1. Add
  24 ;;
  25 ;;      (autoload 'bashdb "bashdb" "BASH Debugger mode via GUD and bashdb" t)
  26 ;;
  27 ;;    to your .emacs file.
  28 ;;
  29 ;; 2. Do M-x bashdb
  30 ;;
  31 ;; 3. Give a target script for debugging and arguments for it
  32 ;;    See `bashdb' of describe-function for more details.
  33 ;;
  34 ;;
  35 ;; Codes:
  36 (require 'gud)
  37 ;; ======================================================================
  38 ;; bashdb functions
  39
  40 ;;; History of argument lists passed to bashdb.
  41 (defvar gud-bashdb-history nil)
  42
  43 ;; The debugger outputs program-location lines that look like this:
  44 ;;   (/etc/init.d/network:14):
  45 (defconst gud-bashdb-marker-regexp
  46   "^(\\(\\(?:[a-zA-Z]:\\)?[-a-zA-Z0-9_/.\\\\ ]+\\):[ \t]?\\(.*\n\\)"
  47   "Regular expression used to find a file location given by bashdb.
  48
  49 Program-location lines look like this:
  50    (/etc/init.d/network:39):
  51 or MS Windows:
  52    (c:\\mydirectory\\gcd.sh:10):
  53 ")
  54 (defconst gud-bashdb-marker-regexp-file-group 1
  55   "Group position in `gud-bashdb-marker-regexp' that matches the file name.")
  56 (defconst gud-bashdb-marker-regexp-line-group 2
  57   "Group position in `gud-bashdb-marker-regexp' that matches the line number.")
  58
  59 ;; Convert a command line as would be typed normally to run a script
  60 ;; into one that invokes an Emacs-enabled debugging session.
  61 ;; "--debugger" in inserted as the first switch, unless the
  62 ;; command is bashdb which doesn't need and can't parse --debugger.
  63 ;; Note: bashdb will be fixed up so that it *does* bass --debugger
  64 ;; eventually.
  65
  66 (defun gud-bashdb-massage-args (file args &optional command-line)
  67   (let* ((new-args (list "--debugger"))
  68          (seen-e nil)
  69          (shift (lambda ()
  70                   (setq new-args (cons (car args) new-args))
  71                   (setq args (cdr args)))))
  72
  73     ; If we are invoking using the bashdb command, no need to add
  74     ; --debugger. '^\S ' means non-whitespace at the beginning of a
  75     ; line and '\s ' means "whitespace"
  76     (if (and command-line (string-match "^\\S *bashdb\\s " command-line))
  77         args
  78
  79       ;; Pass all switches and -e scripts through.
  80       (while (and args
  81                   (string-match "^-" (car args))
  82                   (not (equal "-" (car args)))
  83                   (not (equal "--" (car args))))
  84         (funcall shift))
  85
  86       (when (or (not args)
  87                 (string-match "^-" (car args)))
  88           (error "Can't use stdin as the script to debug"))
  89       ;; This is the program name.
  90       (funcall shift)
  91
  92       (while args
  93         (funcall shift))
  94
  95       (nreverse new-args))))
  96
  97 ;; There's no guarantee that Emacs will hand the filter the entire
  98 ;; marker at once; it could be broken up across several strings.  We
  99 ;; might even receive a big chunk with several markers in it.  If we
 100 ;; receive a chunk of text which looks like it might contain the
 101 ;; beginning of a marker, we save it here between calls to the
 102 ;; filter.
 103 (defun gud-bashdb-marker-filter (string)
 104   (setq gud-marker-acc (concat gud-marker-acc string))
 105   (let ((output ""))
 106
 107     ;; Process all the complete markers in this chunk.
 108     (while (string-match gud-bashdb-marker-regexp gud-marker-acc)
 109       (setq
 110
 111        ;; Extract the frame position from the marker.
 112        gud-last-frame
 113        (cons (substring gud-marker-acc
 114                         (match-beginning gud-bashdb-marker-regexp-file-group)
 115                         (match-end gud-bashdb-marker-regexp-file-group))
 116              (string-to-number
 117               (substring gud-marker-acc
 118                          (match-beginning gud-bashdb-marker-regexp-line-group)
 119                          (match-end gud-bashdb-marker-regexp-line-group))))
 120
 121        ;; Append any text before the marker to the output we're going
 122        ;; to return - we don't include the marker in this text.
 123        output (concat output
 124                       (substring gud-marker-acc 0 (match-beginning 0)))
 125
 126        ;; Set the accumulator to the remaining text.
 127        gud-marker-acc (substring gud-marker-acc (match-end 0))))
 128
 129     ;; Does the remaining text look like it might end with the
 130     ;; beginning of another marker?  If it does, then keep it in
 131     ;; gud-marker-acc until we receive the rest of it.  Since we
 132     ;; know the full marker regexp above failed, it's pretty simple to
 133     ;; test for marker starts.
 134     (if (string-match "\032.*\\'" gud-marker-acc)
 135         (progn
 136           ;; Everything before the potential marker start can be output.
 137           (setq output (concat output (substring gud-marker-acc
 138                                                  0 (match-beginning 0))))
 139
 140           ;; Everything after, we save, to combine with later input.
 141           (setq gud-marker-acc
 142                 (substring gud-marker-acc (match-beginning 0))))
 143
 144       (setq output (concat output gud-marker-acc)
 145             gud-marker-acc ""))
 146
 147     output))
 148
 149 (defun gud-bashdb-find-file (f)
 150   (save-excursion
 151     (let ((buf (find-file-noselect f 'nowarn)))
 152       (set-buffer buf)
 153       buf)))
 154
 155 (defcustom gud-bashdb-command-name "bash"
 156   "File name for executing bash debugger."
 157   :type 'string
 158   :group 'gud)
 159
 160 ;;;###autoload
 161 (defun bashdb (command-line)
 162   "Run bashdb on program FILE in buffer *gud-FILE*.
 163 The directory containing FILE becomes the initial working directory
 164 and source-file directory for your debugger.
 165
 166 You can specify a target script and its arguments like:
 167
 168   bash YOUR-SCRIPT ARGUMENT...
 169
 170 or
 171
 172   bashdb YOUR-SCRIPT ARGUMENT...
 173
 174 Generally the former one works fine. The later one may be useful if
 175 you have not installed bashdb yet or you have installed Bashdb to the
 176 place where Bash doesn't expect."
 177
 178   (interactive
 179    (list (read-from-minibuffer "Run bashdb (like this): "
 180                                (if (consp gud-bashdb-history)
 181                                    (car gud-bashdb-history)
 182                                  (concat gud-bashdb-command-name
 183                                          " "))
 184                                gud-minibuffer-local-map nil
 185                                '(gud-bashdb-history . 1))))
 186
 187   ;; `gud-bashdb-massage-args' needs whole `command-line'.
 188   ;; command-line is refered through dyanmic scope.
 189   (gud-common-init command-line (lambda (file args)
 190                                   (gud-bashdb-massage-args file args command-line))
 191            'gud-bashdb-marker-filter 'gud-bashdb-find-file)
 192
 193   (set (make-local-variable 'gud-minor-mode) 'bashdb)
 194
 195   (gud-def gud-args   "info args"     "a"
 196            "Show arguments of the current stack frame.")
 197   (gud-def gud-break  "break %d%f:%l" "\C-b"
 198            "Set breakpoint at the current line.")
 199   (gud-def gud-cont   "continue"   "\C-r"
 200            "Continue with display.")
 201   (gud-def gud-down   "down %p"     ">"
 202            "Down N stack frames (numeric arg).")
 203   (gud-def gud-finish "finish"      "f\C-f"
 204            "Finish executing current function.")
 205   (gud-def gud-linetrace "toggle"    "t"
 206            "Toggle line tracing.")
 207   (gud-def gud-next   "next %p"     "\C-n"
 208            "Step one line (skip functions).")
 209   (gud-def gud-print  "p %e"        "\C-p"
 210            "Evaluate bash expression at point.")
 211   (gud-def gud-remove "clear %d%f:%l" "\C-d"
 212            "Remove breakpoint at current line")
 213   (gud-def gud-run    "run"       "R"
 214            "Restart the Bash script.")
 215   (gud-def gud-statement "eval %e" "\C-e"
 216            "Execute Bash statement at point.")
 217   (gud-def gud-step   "step %p"       "\C-s"
 218            "Step one source line with display.")
 219   (gud-def gud-tbreak "tbreak %d%f:%l"  "\C-t"
 220            "Set temporary breakpoint at current line.")
 221   (gud-def gud-up     "up %p"
 222            "<" "Up N stack frames (numeric arg).")
 223   (gud-def gud-where   "where"
 224            "T" "Show stack trace.")
 225
 226   ;; Update GUD menu bar
 227   (define-key gud-menu-map [args]      '("Show arguments of current stack" .
 228                                          gud-args))
 229   (define-key gud-menu-map [down]      '("Down Stack" . gud-down))
 230   (define-key gud-menu-map [eval]      '("Execute Bash statement at point"
 231                                          . gud-statement))
 232   (define-key gud-menu-map [finish]    '("Finish Function" . gud-finish))
 233   (define-key gud-menu-map [linetrace] '("Toggle line tracing" .
 234                                          gud-linetrace))
 235   (define-key gud-menu-map [run]       '("Restart the Bash Script" .
 236                                          gud-run))
 237   (define-key gud-menu-map [stepi]     nil)
 238   (define-key gud-menu-map [tbreak]    nil)
 239   (define-key gud-menu-map [up]        '("Up Stack" . gud-up))
 240   (define-key gud-menu-map [where]     '("Show stack trace" . gud-where))
 241
 242   (local-set-key "\C-i" 'gud-bash-complete-command)
 243
 244   (local-set-key [menu-bar debug tbreak]
 245                  '("Temporary Breakpoint" . gud-tbreak))
 246   (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
 247   (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
 248   (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
 249
 250   (setq comint-prompt-regexp "^bashdb<+(*[0-9]*)*>+ ")
 251   (setq paragraph-start comint-prompt-regexp)
 252   (run-hooks 'bashdb-mode-hook)
 253   )
 254
 255 (defun gud-bashdb-complete-command (&optional command a b)
 256   "A wrapper for `gud-gdb-complete-command'"
 257   (gud-gdb-complete-command command a b))
 258
 259 (provide 'bashdb)
 260 \f
 261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 262 ;;; bashdbtrack --- tracking bashdb debugger in an Emacs shell window
 263 ;;; Modified from  python-mode in particular the part:
 264 ;; pdbtrack support contributed by Ken Manheimer, April 2001.
 265
 266 ;;; Code:
 267
 268 (require 'comint)
 269 (require 'custom)
 270 (require 'cl)
 271 (require 'compile)
 272 (require 'shell)
 273
 274 (defgroup bashdbtrack nil
 275   "Bashdb file tracking by watching the prompt."
 276   :prefix "bashdb-bashdbtrack-"
 277   :group 'shell)
 278
 279 \f
 280 ;; user definable variables
 281 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
 282
 283 (defcustom bashdb-bashdbtrack-do-tracking-p t
 284   "*Controls whether the bashdbtrack feature is enabled or not.
 285 When non-nil, bashdbtrack is enabled in all comint-based buffers,
 286 e.g. shell buffers and the *Python* buffer.  When using bashdb to debug a
 287 Python program, bashdbtrack notices the bashdb prompt and displays the
 288 source file and line that the program is stopped at, much the same way
 289 as gud-mode does for debugging C programs with gdb."
 290   :type 'boolean
 291   :group 'bashdb)
 292 (make-variable-buffer-local 'bashdb-bashdbtrack-do-tracking-p)
 293
 294 (defcustom bashdb-bashdbtrack-minor-mode-string " BASHDB"
 295   "*String to use in the minor mode list when bashdbtrack is enabled."
 296   :type 'string
 297   :group 'bashdb)
 298
 299 (defcustom bashdb-temp-directory
 300   (let ((ok '(lambda (x)
 301                (and x
 302                     (setq x (expand-file-name x)) ; always true
 303                     (file-directory-p x)
 304                     (file-writable-p x)
 305                     x))))
 306     (or (funcall ok (getenv "TMPDIR"))
 307         (funcall ok "/usr/tmp")
 308         (funcall ok "/tmp")
 309         (funcall ok "/var/tmp")
 310         (funcall ok  ".")
 311         (error
 312          "Couldn't find a usable temp directory -- set `bashdb-temp-directory'")))
 313   "*Directory used for temporary files created by a *Python* process.
 314 By default, the first directory from this list that exists and that you
 315 can write into: the value (if any) of the environment variable TMPDIR,
 316 /usr/tmp, /tmp, /var/tmp, or the current directory."
 317   :type 'string
 318   :group 'bashdb)
 319
 320 \f
 321 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 322 ;; NO USER DEFINABLE VARIABLES BEYOND THIS POINT
 323
 324 ;; have to bind bashdb-file-queue before installing the kill-emacs-hook
 325 (defvar bashdb-file-queue nil
 326   "Queue of Makefile temp files awaiting execution.
 327 Currently-active file is at the head of the list.")
 328
 329 (defvar bashdb-bashdbtrack-is-tracking-p nil)
 330
 331 \f
 332 ;; Constants
 333
 334 (defconst bashdb-position-re
 335   "\\(^\\|\n\\)(\\([^:]+\\):\\([0-9]*\\)).*\n"
 336   "Regular expression for a bashdb position")
 337
 338 (defconst bashdb-marker-regexp-file-group 2
 339   "Group position in bashdb-postiion-re that matches the file name.")
 340
 341 (defconst bashdb-marker-regexp-line-group 3
 342   "Group position in bashdb-position-re that matches the line number.")
 343
 344
 345
 346 (defconst bashdb-traceback-line-re
 347   "^#[0-9]+[ \t]+\\((\\([a-zA-Z-.]+\\) at (\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\)).*\n"
 348   "Regular expression that describes tracebacks.")
 349
 350 ;; bashdbtrack contants
 351 (defconst bashdb-bashdbtrack-stack-entry-regexp
 352   "^=>#[0-9]+[ \t]+\\((\\([a-zA-Z-.]+\\) at (\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\)).*\n"
 353   "Regular expression bashdbtrack uses to find a stack trace entry.")
 354
 355 (defconst bashdb-bashdbtrack-input-prompt "\nbashdb<+.*>+ "
 356   "Regular expression bashdbtrack uses to recognize a bashdb prompt.")
 357
 358 (defconst bashdb-bashdbtrack-track-range 10000
 359   "Max number of characters from end of buffer to search for stack entry.")
 360
 361 \f
 362 ;; Utilities
 363 (defmacro bashdb-safe (&rest body)
 364   "Safely execute BODY, return nil if an error occurred."
 365   (` (condition-case nil
 366          (progn (,@ body))
 367        (error nil))))
 368
 369 \f
 370 ;;;###autoload
 371
 372 (defun bashdb-bashdbtrack-overlay-arrow (activation)
 373   "Activate or de arrow at beginning-of-line in current buffer."
 374   ;; This was derived/simplified from edebug-overlay-arrow
 375   (cond (activation
 376          (setq overlay-arrow-position (make-marker))
 377          (setq overlay-arrow-string "=>")
 378          (set-marker overlay-arrow-position (point) (current-buffer))
 379          (setq bashdb-bashdbtrack-is-tracking-p t))
 380         (bashdb-bashdbtrack-is-tracking-p
 381          (setq overlay-arrow-position nil)
 382          (setq bashdb-bashdbtrack-is-tracking-p nil))
 383         ))
 384
 385 (defun bashdb-bashdbtrack-track-stack-file (text)
 386   "Show the file indicated by the bashdb stack entry line, in a separate window.
 387 Activity is disabled if the buffer-local variable
 388 `bashdb-bashdbtrack-do-tracking-p' is nil.
 389
 390 We depend on the bashdb input prompt matching `bashdb-bashdbtrack-input-prompt'
 391 at the beginning of the line.
 392 "
 393   ;; Instead of trying to piece things together from partial text
 394   ;; (which can be almost useless depending on Emacs version), we
 395   ;; monitor to the point where we have the next bashdb prompt, and then
 396   ;; check all text from comint-last-input-end to process-mark.
 397   ;;
 398   ;; Also, we're very conservative about clearing the overlay arrow,
 399   ;; to minimize residue.  This means, for instance, that executing
 400   ;; other bashdb commands wipe out the highlight.  You can always do a
 401   ;; 'where' (aka 'w') command to reveal the overlay arrow.
 402   (let* ((origbuf (current-buffer))
 403          (currproc (get-buffer-process origbuf)))
 404
 405     (if (not (and currproc bashdb-bashdbtrack-do-tracking-p))
 406         (bashdb-bashdbtrack-overlay-arrow nil)
 407
 408       (let* ((procmark (process-mark currproc))
 409              (block (buffer-substring (max comint-last-input-end
 410                                            (- procmark
 411                                               bashdb-bashdbtrack-track-range))
 412                                       procmark))
 413              target target_fname target_lineno target_buffer)
 414
 415         (if (not (string-match (concat bashdb-bashdbtrack-input-prompt "$") block))
 416             (bashdb-bashdbtrack-overlay-arrow nil)
 417
 418           (setq target (bashdb-bashdbtrack-get-source-buffer block))
 419
 420           (if (stringp target)
 421               (message "bashdbtrack: %s" target)
 422
 423             (setq target_lineno (car target))
 424             (setq target_buffer (cadr target))
 425             (setq target_fname (buffer-file-name target_buffer))
 426             (switch-to-buffer-other-window target_buffer)
 427             (goto-line target_lineno)
 428             (message "bashdbtrack: line %s, file %s" target_lineno target_fname)
 429             (bashdb-bashdbtrack-overlay-arrow t)
 430             (pop-to-buffer origbuf t)
 431
 432             )))))
 433   )
 434
 435 (defun bashdb-bashdbtrack-get-source-buffer (block)
 436   "Return line number and buffer of code indicated by block's traceback text.
 437
 438 We look first to visit the file indicated in the trace.
 439
 440 Failing that, we look for the most recently visited python-mode buffer
 441 with the same name or having
 442 having the named function.
 443
 444 If we're unable find the source code we return a string describing the
 445 problem as best as we can determine."
 446
 447   (if (not (string-match bashdb-position-re block))
 448
 449       "line number cue not found"
 450
 451     (let* ((filename (match-string bashdb-marker-regexp-file-group block))
 452            (lineno (string-to-number
 453                     (match-string bashdb-marker-regexp-line-group block)))
 454            funcbuffer)
 455
 456       (cond ((file-exists-p filename)
 457              (list lineno (find-file-noselect filename)))
 458
 459             ((= (elt filename 0) ?\<)
 460              (format "(Non-file source: '%s')" filename))
 461
 462             (t (format "Not found: %s" filename)))
 463       )
 464     )
 465   )
 466
 467 \f
 468 ;;; Subprocess commands
 469
 470
 471 \f
 472 ;; bashdbtrack functions
 473 (defun bashdb-bashdbtrack-toggle-stack-tracking (arg)
 474   (interactive "P")
 475   (if (not (get-buffer-process (current-buffer)))
 476       (error "No process associated with buffer '%s'" (current-buffer)))
 477   ;; missing or 0 is toggle, >0 turn on, <0 turn off
 478   (if (or (not arg)
 479           (zerop (setq arg (prefix-numeric-value arg))))
 480       (setq bashdb-bashdbtrack-do-tracking-p (not bashdb-bashdbtrack-do-tracking-p))
 481     (setq bashdb-bashdbtrack-do-tracking-p (> arg 0)))
 482   (message "%sabled bashdb's bashdbtrack"
 483            (if bashdb-bashdbtrack-do-tracking-p "En" "Dis")))
 484
 485 (defun turn-on-bashdbtrack ()
 486   (interactive)
 487   (add-hook 'comint-output-filter-functions
 488             'bashdb-bashdbtrack-track-stack-file)
 489   (setq bashdb-bashdbtrack-is-tracking-p t)
 490   (bashdb-bashdbtrack-toggle-stack-tracking 1))
 491
 492 (defun turn-off-bashdbtrack ()
 493   (interactive)
 494   (remove-hook 'comint-output-filter-functions
 495                'bashdb-bashdbtrack-track-stack-file)
 496   (setq bashdb-bashdbtrack-is-tracking-p nil)
 497   (bashdb-bashdbtrack-toggle-stack-tracking 0))
 498
 499 ;; Add a designator to the minor mode strings
 500 (or (assq 'bashdb-bashdbtrack-is-tracking-p minor-mode-alist)
 501     (push '(bashdb-bashdbtrack-is-tracking-p
 502             bashdb-bashdbtrack-minor-mode-string)
 503           minor-mode-alist))
 504
 505
 506 \f
 507 ;;; bashdbtrack.el ends here
 508
 509 ;;; bashdb.el ends here