(defun gud-find-file (f)
(error "GUD not properly entered."))
-
+\f
;; ======================================================================
;; command definition
;; The job of the find-file method is to visit and return the buffer indicated
;; by the car of gud-tag-frame. This may be a file name, a tag name, or
;; something else.
-
+\f
;; ======================================================================
;; gdb functions
(run-hooks 'gdb-mode-hook)
)
-
+\f
;; ======================================================================
;; sdb functions
(setq comint-prompt-regexp "\\(^\\|\n\\)\\*")
(run-hooks 'sdb-mode-hook)
)
-
+\f
;; ======================================================================
;; dbx functions
(setq comint-prompt-regexp "^[^)]*dbx) *")
(run-hooks 'dbx-mode-hook)
)
-
+\f
;; ======================================================================
;; xdb (HP PARISC debugger) functions
(make-local-variable 'gud-xdb-accumulation)
(setq gud-xdb-accumulation "")
(run-hooks 'xdb-mode-hook))
+\f
+;; ======================================================================
+;; perldb functions
+
+;;; History of argument lists passed to perldb.
+(defvar gud-perldb-history nil)
+
+(defun gud-perldb-massage-args (file args)
+ (cons "-fullname" (cons file args)))
+
+;; There's no guarantee that Emacs will hand the filter the entire
+;; marker at once; it could be broken up across several strings. We
+;; might even receive a big chunk with several markers in it. If we
+;; receive a chunk of text which looks like it might contain the
+;; beginning of a marker, we save it here between calls to the
+;; filter.
+(defvar gud-perldb-marker-acc "")
+
+(defun gud-perldb-marker-filter (string)
+ (save-match-data
+ (setq gud-perldb-marker-acc (concat gud-perldb-marker-acc string))
+ (let ((output ""))
+
+ ;; Process all the complete markers in this chunk.
+ (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
+ gud-perldb-marker-acc)
+ (setq
+
+ ;; Extract the frame position from the marker.
+ gud-last-frame
+ (cons (substring gud-perldb-marker-acc (match-beginning 1) (match-end 1))
+ (string-to-int (substring gud-perldb-marker-acc
+ (match-beginning 2)
+ (match-end 2))))
+
+ ;; Append any text before the marker to the output we're going
+ ;; to return - we don't include the marker in this text.
+ output (concat output
+ (substring gud-perldb-marker-acc 0 (match-beginning 0)))
+
+ ;; Set the accumulator to the remaining text.
+ gud-perldb-marker-acc (substring gud-perldb-marker-acc (match-end 0))))
+
+ ;; Does the remaining text look like it might end with the
+ ;; beginning of another marker? If it does, then keep it in
+ ;; gud-perldb-marker-acc until we receive the rest of it. Since we
+ ;; know the full marker regexp above failed, it's pretty simple to
+ ;; test for marker starts.
+ (if (string-match "^\032.*\\'" gud-perldb-marker-acc)
+ (progn
+ ;; Everything before the potential marker start can be output.
+ (setq output (concat output (substring gud-perldb-marker-acc
+ 0 (match-beginning 0))))
+
+ ;; Everything after, we save, to combine with later input.
+ (setq gud-perldb-marker-acc
+ (substring gud-perldb-marker-acc (match-beginning 0))))
+
+ (setq output (concat output gud-perldb-marker-acc)
+ gud-perldb-marker-acc ""))
+
+ output)))
+
+(defun gud-perldb-find-file (f)
+ (find-file-noselect f))
+
+;;;###autoload
+(defun perldb (command-line)
+ "Run perldb on program FILE in buffer *gud-FILE*.
+The directory containing FILE becomes the initial working directory
+and source-file directory for your debugger."
+ (interactive
+ (list (read-from-minibuffer "Run perldb (like this): "
+ (if (consp gud-perldb-history)
+ (car gud-perldb-history)
+ "perldb ")
+ nil nil
+ '(gud-perldb-history . 1))))
+ (gud-overload-functions '((gud-massage-args . gud-perldb-massage-args)
+ (gud-marker-filter . gud-perldb-marker-filter)
+ (gud-find-file . gud-perldb-find-file)
+ ))
+
+ (gud-common-init command-line)
+
+ (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
+ (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
+ (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line")
+ (gud-def gud-step "step %p" "\C-s" "Step one source line with display.")
+ (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.")
+ (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).")
+ (gud-def gud-cont "cont" "\C-r" "Continue with display.")
+ (gud-def gud-finish "finish" "\C-f" "Finish executing current function.")
+ (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
+ (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
+ (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
+
+ (setq comint-prompt-regexp "^(.*perldb[+]?) *")
+ (run-hooks 'gdb-mode-hook)
+ )
;;
;; End of debugger-specific information
;;
+\f
;;; When we send a command to the debugger via gud-call, it's annoying
;;; to see the command and the new prompt inserted into the debugger's
;;; buffer; we have other ways of knowing the command has completed.