code.delx.au - gnu-emacs-elpa/blob - packages/realgud/realgud/debugger/trepan.pl/init.el

   1 ;;; Copyright (C) 2011-2012, 2014-2015 Rocky Bernstein <rocky@gnu.org>
   2 ;;; Trepanning Perl debugger
   3 (eval-when-compile (require 'cl))
   4
   5 (require 'load-relative)
   6 (require-relative-list '("../../common/regexp"
   7                          "../../common/loc"
   8                          "../../common/init")
   9                        "realgud-")
  10 (require-relative-list '("../../lang/perl") "realgud-lang-")
  11
  12 (defvar realgud-pat-hash)
  13 (declare-function make-realgud-loc-pat (realgud-loc))
  14
  15 (defvar realgud:trepanpl-pat-hash (make-hash-table :test 'equal)
  16   "Hash key is the what kind of pattern we want to match:
  17 backtrace, prompt, etc.  The values of a hash entry is a
  18 realgud-loc-pat struct")
  19
  20 ;; Regular expression that describes a trepan.pl 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::(/usr/share/perl/5.14/File/Basename.pm:284 @0x8918b70)
  26 ;; my $dirname = dirname(__FILE__);
  27 ;;
  28 ;; or for an eval'd expression:
  29 ;; -- main::((eval 1189)[/tmp/test.pl:2] remapped /tmp/JLlH.pl:1 @0xadcbda0)
  30 ;; $x = 1 + 2;
  31 ;;
  32 ;; or at a function call without the Perl OpCode position or source text:
  33 ;; -> main::(example/gcd.pl:8)
  34
  35 (setf (gethash "loc" realgud:trepanpl-pat-hash)
  36       (make-realgud-loc-pat
  37        :regexp ".. \\(?:.+::\\)?(\\(?:.+ \\(?:via\\|remapped\\) \\)?\\(.+\\):\\([0-9]+\\)\\(?: @0x[0-9a-f]+\\)?)\\(?:\n\\(.*?\\)\n\\)?"
  38        :file-group 1
  39        :line-group 2
  40        :text-group 3
  41        :ignore-file-re  realgud-perl-ignore-file-re)
  42       )
  43
  44 ;; Regular expression that describes a trepanpl command prompt
  45 ;; For example:
  46 ;;   (trepanpl):
  47 ;;   ((trepanpl)):
  48 ;;   (trepanpl@main):
  49 ;;   (trepanpl@55):
  50 (setf (gethash "prompt" realgud:trepanpl-pat-hash)
  51       (make-realgud-loc-pat
  52        :regexp "^(+trepanpl\\(@[0-9]+\\|@main\\)?)+: "
  53        ))
  54
  55 (defconst realgud:trepanpl-frame-start-regexp
  56   "\\(^\\|\n\\)\\(?:-->\\|   \\) #")
  57
  58 (defconst realgud:trepanpl-frame-num-regexp
  59   "\\([0-9]+\\)")
  60
  61 ;; Regular expression that describes a Perl backtrace line.
  62 ;; For example:
  63 ;; --> #0 @ = File::Basename::fileparse('/usr/local/bin/trepan.pl') in
  64 ;;      file `/usr/share/perl/5.18.2/File/Basename.pm' at line 107
  65 ;;     #1 @ = File::Basename::dirname('/usr/local/bin/trepan.pl') in
  66 ;;      file `/usr/share/perl/5.18.2/File/Basename.pm' at line 294
  67 ;;     #2 file `/usr/local/bin/trepan.pl' at line 11
  68 (setf (gethash "debugger-backtrace" realgud:trepanpl-pat-hash)
  69   (make-realgud-loc-pat
  70    :regexp (concat
  71             realgud:trepanpl-frame-start-regexp
  72             realgud:trepanpl-frame-num-regexp
  73             "\\(?: [$@] = .* in\\)?"
  74             "[\n\t ]+?file `"
  75             "\\(.*\\)' at line \\([0-9]+\\)")
  76    :num 2
  77    :file-group 3
  78    :line-group 4
  79    :ignore-file-re  realgud-perl-ignore-file-re)
  80   )
  81
  82 ;;  Regular expression that describes location in a Perl errmsg
  83 (setf (gethash "perl-errmsg" realgud:trepanpl-pat-hash)
  84       realgud-perl-errmsg-loc-pat)
  85
  86 ;;  Regular expression that describes a Perl Carp backtrace line.
  87 ;;  at /tmp/foo.pl line 7
  88 ;;      main::__ANON__('Illegal division by zero at /tmp/foo.pl line 4.\x{a}') called at /tmp/foo.pl line 4
  89 ;;      main::foo(3) called at /tmp/foo.pl line 8
  90 (setf (gethash "lang-backtrace" realgud:trepanpl-pat-hash)
  91       realgud-perl-carp-loc-pat)
  92
  93 ;; Regular expression that describes a "breakpoint set" line.
  94 ;; For example:
  95 ;;   Breakpoint 1 set in (eval 1177)[/Eval.pm:94] at line 5"
  96 ;;   Breakpoint 2 set in /tmp/File/Basename.pm at line 215
  97 (setf (gethash "brkpt-set" realgud:trepanpl-pat-hash)
  98       (make-realgud-loc-pat
  99        :regexp "^Breakpoint \\([0-9]+\\) set in[\n\t ]+\\(.+\\)[ \t\n]+at line \\([0-9]+\\)"
 100        :num 1
 101        :file-group 2
 102        :line-group 3
 103        :ignore-file-re  realgud-perl-ignore-file-re)
 104       )
 105
 106 ;; Regular expression that describes a debugger "delete" (breakpoint) response.
 107 ;; For example:
 108 ;;   Deleted breakpoint 1.
 109 (setf (gethash "brkpt-del" realgud:trepanpl-pat-hash)
 110       (make-realgud-loc-pat
 111        :regexp "^Deleted breakpoint \\([0-9]+\\)\n"
 112        :num 1))
 113
 114 (defconst realgud:trepanpl-selected-frame-indicator "-->"
 115 "String that describes which frame is selected in a debugger
 116 backtrace listing.")
 117
 118 (defconst realgud:trepanpl-frame-file-regexp
 119   "[ \t\n]+in file \\([^ \n]+\\)")
 120
 121 (defconst realgud:trepanpl-debugger-name "trepan.pl" "Name of debugger")
 122
 123 ;; Top frame number
 124 (setf (gethash "top-frame-num" realgud:trepanpl-pat-hash) 0)
 125
 126 ;; Regular expression that describes a debugger "selected" frame in in
 127 ;; a frame-motion command.
 128 ;; For example:
 129 ;; --> #1 TOP Object#<top /usr/local/bin/irb> in file /usr/local/bin/ipl at line 9
 130 (setf (gethash "selected-frame" realgud:trepanpl-pat-hash)
 131       (make-realgud-loc-pat
 132        :regexp
 133        (format "^%s #\\([0-9]+\\) .*%s"
 134                realgud:trepanpl-selected-frame-indicator
 135                realgud:trepanpl-frame-file-regexp)
 136        :num 1))
 137
 138 ;; Regular expression that for a termination message.
 139 (setf (gethash "termination" realgud:trepanpl-pat-hash)
 140        "^trepan.pl: That's all, folks...\n")
 141
 142 (setf (gethash "font-lock-keywords" realgud:trepanpl-pat-hash)
 143       '(
 144         ;; The frame number and first type name, if present.
 145         ("^\\(-->\\|   \\)? #\\([0-9]+\\) \\([A-Z]+\\) *\\([A-Z_][a-zA-Z0-9_]*\\)[#]\\([a-zA-Z_][a-zA-Z_[0-9]]*\\)?"
 146          (2 realgud-backtrace-number-face)
 147          (3 font-lock-keyword-face)         ; e.g. METHOD, TOP
 148          (4 font-lock-constant-face)        ; e.g. Object
 149          (5 font-lock-function-name-face nil t))   ; t means optional
 150         ;; Instruction sequence
 151         ("<\\(.+\\)>"
 152          (1 font-lock-variable-name-face))
 153         ;; "::Type", which occurs in class name of function and in parameter list.
 154         ;; Parameter sequence
 155         ("(\\(.+\\))"
 156          (1 font-lock-variable-name-face))
 157         ;; "::Type", which occurs in class name of function and in parameter list.
 158         ("::\\([a-zA-Z_][a-zA-Z0-9_]*\\)"
 159          (1 font-lock-type-face))
 160         ;; File name.
 161         ("[ \t]+in file \\([^ ]+*\\)"
 162          (1 realgud-file-name-face))
 163         ;; Line number.
 164         ("[ \t]+at line \\([0-9]+\\)$"
 165          (1 realgud-line-number-face))
 166         ;; Function name.
 167         ("\\<\\([a-zA-Z_][a-zA-Z0-9_]*\\)\\.\\([a-zA-Z_][a-zA-Z0-9_]*\\)"
 168          (1 font-lock-type-face)
 169          (2 font-lock-function-name-face))
 170         ;; (trepanpl-frames-match-current-line
 171         ;;  (0 trepanpl-frames-current-frame-face append))
 172         ))
 173
 174 ;; (setf (gethash "font-lock-keywords" realgud:trepanpl-pat-hash)
 175 ;;       '(
 176 ;;      ;; The frame number and first type name, if present.
 177 ;;      ((concat realgud:trepanpl-frame-start-regexp " "
 178 ;;                      realgud:trepanpl-frame-num-regexp " "
 179 ;;                      "\\([A-Z]+\\) *\\([A-Z_][a-zA-Z0-9_]*\\)[#]\\([a-zA-Z_][a-zA-Z_[0-9]]*\\)?")
 180 ;;       (2 realgud-backtrace-number-face)
 181 ;;       (3 font-lock-keyword-face)         ; e.g. METHOD, TOP
 182 ;;       (4 font-lock-constant-face)        ; e.g. Object
 183 ;;       (5 font-lock-function-name-face nil t))   ; t means optional
 184 ;;      ;; Instruction sequence
 185 ;;      ("<\\(.+\\)>"
 186 ;;       (1 font-lock-variable-name-face))
 187 ;;      ;; "::Type", which occurs in class name of function and in
 188 ;;      ;; parameter list.  Parameter sequence
 189 ;;      ("(\\(.+\\))"
 190 ;;       (1 font-lock-variable-name-face))
 191 ;;      ;; "::Type", which occurs in class name of function and in
 192 ;;      ;; parameter list.
 193 ;;      ("::\\([a-zA-Z_][a-zA-Z0-9_]*\\)"
 194 ;;       (1 font-lock-type-face))
 195 ;;      ;; File name.
 196 ;;      (realgud:trepanpl-frame-file-regexp (1 realgud-file-name-face))
 197 ;;      ;; Line number.
 198 ;;      (realgud:trepanpl-frame-line-regexp (1 realgud-line-number-face))
 199 ;;      ;; Function name.
 200 ;;      ("\\<\\([a-zA-Z_][a-zA-Z0-9_]*\\)\\.\\([a-zA-Z_][a-zA-Z0-9_]*\\)"
 201 ;;       (1 font-lock-type-face)
 202 ;;       (2 font-lock-function-name-face))
 203 ;;      ;; (trepanpl-frames-match-current-line
 204 ;;      ;;  (0 trepanpl-frames-current-frame-face append))
 205 ;;      ))
 206
 207 (setf (gethash realgud:trepanpl-debugger-name realgud-pat-hash) realgud:trepanpl-pat-hash)
 208
 209 (defvar realgud:trepanpl-command-hash (make-hash-table :test 'equal)
 210   "Hash key is command name like 'quit' and the value is
 211   the trepanpl command to use, like 'quit!'")
 212
 213 (setf (gethash "break"  realgud:trepanpl-command-hash) "break %x %l")
 214 (setf (gethash "quit"   realgud:trepanpl-command-hash) "quit!")
 215 (setf (gethash "until"   realgud:trepanpl-command-hash) "continue %l")
 216 (setf (gethash realgud:trepanpl-debugger-name
 217                realgud-command-hash) realgud:trepanpl-command-hash)
 218
 219 (provide-me "realgud:trepanpl-")