code.delx.au - gnu-emacs-elpa/blob - realgud/debugger/perldb/init.el

   1 ;;; Copyright (C) 2011, 2014-2015 Rocky Bernstein <rocky@gnu.org>
   2 ;;; Stock Perl debugger perldb
   3
   4 (eval-when-compile (require 'cl))
   5
   6 (require 'load-relative)
   7 (require-relative-list '("../../common/regexp" "../../common/loc") "realgud-")
   8 (require-relative-list '("../../lang/perl") "realgud-lang-")
   9
  10 (defvar realgud-pat-hash)
  11 (declare-function make-realgud-loc-pat (realgud-loc))
  12
  13 (defvar realgud:perldb-pat-hash (make-hash-table :test 'equal)
  14   "Hash key is the what kind of pattern we want to match:
  15 lang-backtrace, prompt, etc.  The values of a hash entry is a
  16 realgud-loc-pat struct")
  17
  18 (declare-function make-realgud-loc "realgud-loc" (a b c d e f))
  19
  20 ;; Regular expression that describes a perldb location generally shown
  21 ;; before a command prompt. We include matching the source text so we
  22 ;; can save that.
  23 ;;
  24 ;; Program-location lines look like this:
  25 ;;  File::Basename::dirname(/usr/share/perl/5.16.0/File/Basename.pm:284):
  26 ;;  284:            my $path = shift;
  27 ;;
  28 ;;   main::(/usr/bin/latex2html:102):
  29 ;; or MS Windows:
  30 ;;   ???
  31 (setf (gethash "loc" realgud:perldb-pat-hash)
  32       (make-realgud-loc-pat
  33        :regexp "\\(?:CODE(0x[0-9a-h]+)\\)?(\\(.+\\):\\(\[0-9]+\\)):\\(?:\n[0-9]+:\t\\(.*?\\)\n\\)?"
  34        :file-group 1
  35        :line-group 2
  36        :text-group 3))
  37
  38 ;; perldb debugger prompt.
  39 ;; Examples:
  40 ;;   DB<4>
  41 ;; [pid=6489->6502]  DB<1>
  42 ;;
  43 (setf (gethash "prompt" realgud:perldb-pat-hash)
  44       (make-realgud-loc-pat
  45        :regexp   "\\(?:\\[pid=[0-9]+->[0-9]+\\]\\)?  DB<\\([0-9]+\\)> "
  46        :num 1
  47        ))
  48
  49 ;;  Regular expression that describes a Perl debugger backtrace line.
  50 ;; $ = main::top_navigation_panel called from file `./latex2html' line 7400
  51 ;; $ = main::BEGIN() called from file `(eval 19)[/usr/bin/latex2html:126]' line 2
  52 (setf (gethash "debugger-backtrace" realgud:perldb-pat-hash)
  53       (make-realgud-loc-pat
  54        :regexp   "\s+called from file `\\(.+\\)' line \\([0-9]+\\)"
  55        :file-group 1
  56        :line-group 2))
  57
  58 ;;  Regular expression that describes location in a Perl errmsg
  59 (setf (gethash "perl-errmsg" realgud:perldb-pat-hash)
  60       realgud-perl-errmsg-loc-pat)
  61
  62 ;;  Regular expression that describes a Perl Carp backtrace line.
  63 ;;  at /tmp/foo.pl line 7
  64 ;;      main::__ANON__('Illegal division by zero at /tmp/foo.pl line 4.\x{a}') called at /tmp/foo.pl line 4
  65 ;;      main::foo(3) called at /tmp/foo.pl line 8
  66 (setf (gethash "lang-backtrace" realgud:perldb-pat-hash)
  67       realgud-perl-carp-loc-pat)
  68
  69 (defvar realgud:perldb-command-hash (make-hash-table :test 'equal)
  70   "Hash key is command name like 'quit' and the value is
  71   the perldb command to use, like 'q'")
  72
  73 (setf (gethash "font-lock-keywords" realgud:perldb-pat-hash)
  74       '(
  75         ("\s+called from file `\\(.+\\)' line \\([0-9]+\\)"
  76          (1 realgud-file-name-face)
  77          (2 realgud-line-number-face))
  78         ))
  79
  80
  81 (setf (gethash "perldb"  realgud-pat-hash) realgud:perldb-pat-hash)
  82 (setf (gethash "perl5db" realgud-pat-hash) realgud:perldb-pat-hash)
  83
  84 (setf (gethash "backtrace" realgud:perldb-command-hash) "T")
  85 (setf (gethash "break"     realgud:perldb-command-hash) "b %l")
  86 (setf (gethash "clear"     realgud:perldb-command-hash) "B %l")
  87 (setf (gethash "continue"  realgud:perldb-command-hash) "c")
  88 (setf (gethash "eval"      realgud:perldb-command-hash) "x %s")
  89 (setf (gethash "quit"      realgud:perldb-command-hash) "q")
  90 (setf (gethash "restart"   realgud:perldb-command-hash) "R")
  91 (setf (gethash "run"       realgud:perldb-command-hash) "R")
  92 (setf (gethash "step"      realgud:perldb-command-hash) "s")
  93 (setf (gethash "next"      realgud:perldb-command-hash) "n")
  94 (setf (gethash "until"     realgud:perldb-command-hash) "c %l")
  95 (setf (gethash "perldb" realgud-command-hash) realgud:perldb-command-hash)
  96
  97 (provide-me "realgud:perldb-")