home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.2J (Developer) / os42jdev.iso / NextDeveloper / Source / GNU / perl / Perl / emacs / emacs19 / emacs19-perldb.el next >
Encoding:
Text File  |  1994-10-18  |  4.6 KB  |  120 lines
  1. ;; Author : Stephane Boucher
  2. ;; Note : This is an add on for gud (Part of GNU Emacs 19). It is
  3. ;;        derived from the gdb section that is part of gud.
  4.  
  5. ;; Copyright (C) 1993 Stephane Boucher.
  6.  
  7. ;; Perldb 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. ;; Perldb Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
  19. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. (require 'gud)
  22.  
  23. ;; ======================================================================
  24. ;; perldb functions
  25.  
  26. ;;; History of argument lists passed to perldb.
  27. (defvar gud-perldb-history nil)
  28.  
  29. (defun gud-perldb-massage-args (file args)
  30.   (cons "-d" (cons file (cons "-emacs" args))))
  31.  
  32. ;; There's no guarantee that Emacs will hand the filter the entire
  33. ;; marker at once; it could be broken up across several strings.  We
  34. ;; might even receive a big chunk with several markers in it.  If we
  35. ;; receive a chunk of text which looks like it might contain the
  36. ;; beginning of a marker, we save it here between calls to the
  37. ;; filter.
  38. (defvar gud-perldb-marker-acc "")
  39.  
  40. (defun gud-perldb-marker-filter (string)
  41.   (save-match-data
  42.     (setq gud-perldb-marker-acc (concat gud-perldb-marker-acc string))
  43.     (let ((output ""))
  44.  
  45.       ;; Process all the complete markers in this chunk.
  46.       (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
  47.                gud-perldb-marker-acc)
  48.     (setq
  49.  
  50.      ;; Extract the frame position from the marker.
  51.      gud-last-frame
  52.      (cons (substring gud-perldb-marker-acc (match-beginning 1) (match-end 1))
  53.            (string-to-int (substring gud-perldb-marker-acc
  54.                      (match-beginning 2)
  55.                      (match-end 2))))
  56.  
  57.      ;; Append any text before the marker to the output we're going
  58.      ;; to return - we don't include the marker in this text.
  59.      output (concat output
  60.             (substring gud-perldb-marker-acc 0 (match-beginning 0)))
  61.  
  62.      ;; Set the accumulator to the remaining text.
  63.      gud-perldb-marker-acc (substring gud-perldb-marker-acc (match-end 0))))
  64.  
  65.       ;; Does the remaining text look like it might end with the
  66.       ;; beginning of another marker?  If it does, then keep it in
  67.       ;; gud-perldb-marker-acc until we receive the rest of it.  Since we
  68.       ;; know the full marker regexp above failed, it's pretty simple to
  69.       ;; test for marker starts.
  70.       (if (string-match "^\032.*\\'" gud-perldb-marker-acc)
  71.       (progn
  72.         ;; Everything before the potential marker start can be output.
  73.         (setq output (concat output (substring gud-perldb-marker-acc
  74.                            0 (match-beginning 0))))
  75.  
  76.         ;; Everything after, we save, to combine with later input.
  77.         (setq gud-perldb-marker-acc
  78.           (substring gud-perldb-marker-acc (match-beginning 0))))
  79.  
  80.     (setq output (concat output gud-perldb-marker-acc)
  81.           gud-perldb-marker-acc ""))
  82.  
  83.       output)))
  84.  
  85. (defun gud-perldb-find-file (f)
  86.   (find-file-noselect f))
  87.  
  88. ;;;###autoload
  89. (defun perldb (command-line)
  90.   "Run perldb on program FILE in buffer *gud-FILE*.
  91. The directory containing FILE becomes the initial working directory
  92. and source-file directory for your debugger."
  93.   (interactive
  94.    (list (read-from-minibuffer "Run perldb (like this): "
  95.                    (if (consp gud-perldb-history)
  96.                    (car gud-perldb-history)
  97.                  "perl ")
  98.                    nil nil
  99.                    '(gud-perldb-history . 1))))
  100.   (gud-overload-functions '((gud-massage-args . gud-perldb-massage-args)
  101.                 (gud-marker-filter . gud-perldb-marker-filter)
  102.                 (gud-find-file . gud-perldb-find-file)
  103.                 ))
  104.  
  105.   (gud-common-init command-line)
  106.  
  107.   (gud-def gud-break  "b %l"         "\C-b" "Set breakpoint at current line.")
  108.   (gud-def gud-remove "d %l"         "\C-d" "Remove breakpoint at current line")
  109.   (gud-def gud-step   "s"            "\C-s" "Step one source line with display.")
  110.   (gud-def gud-next   "n"            "\C-n" "Step one line (skip functions).")
  111.   (gud-def gud-cont   "c"            "\C-r" "Continue with display.")
  112. ;  (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
  113. ;  (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
  114. ;  (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
  115.   (gud-def gud-print  "%e"           "\C-p" "Evaluate perl expression at point.")
  116.  
  117.   (setq comint-prompt-regexp "^  DB<[0-9]+> ")
  118.   (run-hooks 'perldb-mode-hook)
  119.   )
  120.