aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-09-30 09:11:36 +0000
committerRichard M. Stallman1994-09-30 09:11:36 +0000
commitee97eac30f07c7bdff39aab3ba8a4e4f9579be4b (patch)
tree205357129c20d4759477bc1bcd2a6e2612810696
parent39aa8bed39d4864a2ecb47a7b01e906c9e5ff08a (diff)
downloademacs-ee97eac30f07c7bdff39aab3ba8a4e4f9579be4b.tar.gz
emacs-ee97eac30f07c7bdff39aab3ba8a4e4f9579be4b.zip
(gud-overload-functions): Function deleted.
(gud-massage-args, gud-marker-filter, gud-find-file): New vars. Mark them as permanent locals. (gud-massage-args, gud-marker-filter, gud-find-file): In these functions, use those variables. (gud-common-init): 3 new args give values for those variables. (gdb, sdb, dbx, xdb, perldb): Pass new args to gud-common-init. (gud-gdb-complete-command): Bind gud-marker-filter. (gud-find-file): Condense multiple slashes to single slashes.
-rw-r--r--lisp/gud.el135
1 files changed, 68 insertions, 67 deletions
diff --git a/lisp/gud.el b/lisp/gud.el
index fe47dc525ec..e83d1f3d0ca 100644
--- a/lisp/gud.el
+++ b/lisp/gud.el
@@ -60,14 +60,24 @@ This association list has elements of the form
60 (function (lambda (p) (fset (car p) (symbol-function (cdr p))))) 60 (function (lambda (p) (fset (car p) (symbol-function (cdr p)))))
61 gud-overload-alist)) 61 gud-overload-alist))
62 62
63(defun gud-massage-args (file args) 63(defvar gud-massage-args nil)
64 (error "GUD not properly entered")) 64(put 'gud-massage-args 'permanent-local t)
65 65(defvar gud-marker-filter nil)
66(defun gud-marker-filter (str) 66(put 'gud-marker-filter 'permanent-local t)
67 (error "GUD not properly entered")) 67(defvar gud-find-file nil)
68 68(put 'gud-find-file 'permanent-local t)
69(defun gud-find-file (f) 69
70 (error "GUD not properly entered")) 70(defun gud-massage-args (&rest args)
71 (apply gud-massage-args args))
72
73(defun gud-marker-filter (&rest args)
74 (apply gud-marker-filter args))
75
76(defun gud-find-file (file)
77 ;; Don't get confused by double slashes in the name that comes from GDB.
78 (while (string-match "//+" file)
79 (setq file (replace-match "/" t t file)))
80 (funcall gud-find-file file))
71 81
72;; ====================================================================== 82;; ======================================================================
73;; command definition 83;; command definition
@@ -236,12 +246,9 @@ and source-file directory for your debugger."
236 "gdb ") 246 "gdb ")
237 gdb-minibuffer-local-map nil 247 gdb-minibuffer-local-map nil
238 '(gud-gdb-history . 1)))) 248 '(gud-gdb-history . 1))))
239 (gud-overload-functions '((gud-massage-args . gud-gdb-massage-args)
240 (gud-marker-filter . gud-gdb-marker-filter)
241 (gud-find-file . gud-gdb-find-file)
242 ))
243 249
244 (gud-common-init command-line) 250 (gud-common-init command-line 'gud-gdb-massage-args
251 'gud-gdb-marker-filter 'gud-gdb-find-file)
245 252
246 (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") 253 (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
247 (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.") 254 (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
@@ -295,21 +302,16 @@ available with older versions of GDB."
295 (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) 302 (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
296 (setq gud-gdb-complete-break (match-beginning 2) 303 (setq gud-gdb-complete-break (match-beginning 2)
297 command-word (substring command gud-gdb-complete-break)) 304 command-word (substring command gud-gdb-complete-break))
298 (unwind-protect 305 ;; Temporarily install our filter function.
299 (progn 306 (let ((gud-marker-filter 'gud-gdb-complete-filter))
300 ;; Temporarily install our filter function. 307 ;; Issue the command to GDB.
301 (gud-overload-functions 308 (gud-basic-call (concat "complete " command))
302 '((gud-marker-filter . gud-gdb-complete-filter))) 309 (setq gud-gdb-complete-in-progress t
303 ;; Issue the command to GDB. 310 gud-gdb-complete-string nil
304 (gud-basic-call (concat "complete " command)) 311 gud-gdb-complete-list nil)
305 (setq gud-gdb-complete-in-progress t 312 ;; Slurp the output.
306 gud-gdb-complete-string nil 313 (while gud-gdb-complete-in-progress
307 gud-gdb-complete-list nil) 314 (accept-process-output (get-buffer-process gud-comint-buffer))))
308 ;; Slurp the output.
309 (while gud-gdb-complete-in-progress
310 (accept-process-output (get-buffer-process gud-comint-buffer))))
311 ;; Restore the old filter function.
312 (gud-overload-functions '((gud-marker-filter . gud-gdb-marker-filter))))
313 ;; Protect against old versions of GDB. 315 ;; Protect against old versions of GDB.
314 (and gud-gdb-complete-list 316 (and gud-gdb-complete-list
315 (string-match "^Undefined command: \"complete\"" 317 (string-match "^Undefined command: \"complete\""
@@ -408,12 +410,9 @@ and source-file directory for your debugger."
408 (stringp tags-file-name) 410 (stringp tags-file-name)
409 (file-exists-p tags-file-name)))) 411 (file-exists-p tags-file-name))))
410 (error "The sdb support requires a valid tags table to work.")) 412 (error "The sdb support requires a valid tags table to work."))
411 (gud-overload-functions '((gud-massage-args . gud-sdb-massage-args)
412 (gud-marker-filter . gud-sdb-marker-filter)
413 (gud-find-file . gud-sdb-find-file)
414 ))
415 413
416 (gud-common-init command-line) 414 (gud-common-init command-line 'gud-sdb-massage-args
415 'gud-sdb-marker-filter 'gud-sdb-find-file)
417 416
418 (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") 417 (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.")
419 (gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.") 418 (gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.")
@@ -606,22 +605,18 @@ and source-file directory for your debugger."
606 nil nil 605 nil nil
607 '(gud-dbx-history . 1)))) 606 '(gud-dbx-history . 1))))
608 607
609 (gud-overload-functions 608 (gud-switch-to-buffer command-line)
610 (cond 609
611 (gud-mips-p 610 (cond
612 '((gud-massage-args . gud-mipsdbx-massage-args) 611 (gud-mips-p
613 (gud-marker-filter . gud-mipsdbx-marker-filter) 612 (gud-common-init command-line 'gud-mipsdbx-massage-args
614 (gud-find-file . gud-dbx-find-file))) 613 'gud-mipsdbx-marker-filter 'gud-dbx-find-file))
615 (gud-irix-p 614 (gud-irix-p
616 '((gud-massage-args . gud-dbx-massage-args) 615 (gud-common-init command-line 'gud-dbx-massage-args
617 (gud-marker-filter . gud-irixdbx-marker-filter) 616 'gud-irixdbx-marker-filter 'gud-dbx-find-file))
618 (gud-find-file . gud-dbx-find-file))) 617 (t
619 (t 618 (gud-common-init command-line 'gud-dbx-massage-args
620 '((gud-massage-args . gud-dbx-massage-args) 619 'gud-dbx-marker-filter 'gud-dbx-find-file)))
621 (gud-marker-filter . gud-dbx-marker-filter)
622 (gud-find-file . gud-dbx-find-file)))))
623
624 (gud-common-init command-line)
625 620
626 (cond 621 (cond
627 (gud-mips-p 622 (gud-mips-p
@@ -729,11 +724,9 @@ directories if your program contains sources from more than one directory."
729 "xdb ") 724 "xdb ")
730 nil nil 725 nil nil
731 '(gud-xdb-history . 1)))) 726 '(gud-xdb-history . 1))))
732 (gud-overload-functions '((gud-massage-args . gud-xdb-massage-args)
733 (gud-marker-filter . gud-xdb-marker-filter)
734 (gud-find-file . gud-xdb-find-file)))
735 727
736 (gud-common-init command-line) 728 (gud-common-init command-line 'gud-xdb-massage-args
729 'gud-xdb-marker-filter 'gud-xdb-find-file)
737 730
738 (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") 731 (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.")
739 (gud-def gud-tbreak "b %f:%l\\t" "\C-t" 732 (gud-def gud-tbreak "b %f:%l\\t" "\C-t"
@@ -828,12 +821,9 @@ and source-file directory for your debugger."
828 "perl ") 821 "perl ")
829 nil nil 822 nil nil
830 '(gud-perldb-history . 1)))) 823 '(gud-perldb-history . 1))))
831 (gud-overload-functions '((gud-massage-args . gud-perldb-massage-args)
832 (gud-marker-filter . gud-perldb-marker-filter)
833 (gud-find-file . gud-perldb-find-file)
834 ))
835 824
836 (gud-common-init command-line) 825 (gud-common-init command-line 'gud-perldb-massage-args
826 'gud-perldb-marker-filter 'gud-perldb-find-file)
837 827
838 (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") 828 (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.")
839 (gud-def gud-remove "d %l" "\C-d" "Remove breakpoint at current line") 829 (gud-def gud-remove "d %l" "\C-d" "Remove breakpoint at current line")
@@ -964,8 +954,7 @@ comint mode, which see."
964 (make-local-variable 'paragraph-start) 954 (make-local-variable 'paragraph-start)
965 (make-local-variable 'gud-delete-prompt-marker) 955 (make-local-variable 'gud-delete-prompt-marker)
966 (setq gud-delete-prompt-marker (make-marker)) 956 (setq gud-delete-prompt-marker (make-marker))
967 (run-hooks 'gud-mode-hook) 957 (run-hooks 'gud-mode-hook))
968)
969 958
970;; Chop STRING into words separated by SPC or TAB and return a list of them. 959;; Chop STRING into words separated by SPC or TAB and return a list of them.
971(defun gud-chop-words (string) 960(defun gud-chop-words (string)
@@ -986,7 +975,11 @@ comint mode, which see."
986 (nreverse words))) 975 (nreverse words)))
987 976
988;; Perform initializations common to all debuggers. 977;; Perform initializations common to all debuggers.
989(defun gud-common-init (command-line) 978;; The first arg is the specified command line,
979;; which starts with the program to debug.
980;; The other three args specify the values to use
981;; for local variables in the debugger buffer.
982(defun gud-common-init (command-line massage-args marker-filter find-file)
990 (let* ((words (gud-chop-words command-line)) 983 (let* ((words (gud-chop-words command-line))
991 (program (car words)) 984 (program (car words))
992 (file-word (let ((w (cdr words))) 985 (file-word (let ((w (cdr words)))
@@ -997,13 +990,21 @@ comint mode, which see."
997 (file (and file-word 990 (file (and file-word
998 (expand-file-name (substitute-in-file-name file-word)))) 991 (expand-file-name (substitute-in-file-name file-word))))
999 (filepart (and file-word (file-name-nondirectory file)))) 992 (filepart (and file-word (file-name-nondirectory file))))
1000 (switch-to-buffer (concat "*gud-" filepart "*")) 993 (switch-to-buffer (concat "*gud-" filepart "*"))
1001 (and file-word (setq default-directory (file-name-directory file))) 994 (and file-word (setq default-directory (file-name-directory file)))
1002 (or (bolp) (newline)) 995 (or (bolp) (newline))
1003 (insert "Current directory is " default-directory "\n") 996 (insert "Current directory is " default-directory "\n")
1004 (apply 'make-comint (concat "gud-" filepart) program nil 997 (apply 'make-comint (concat "gud-" filepart) program nil
1005 (if file-word (gud-massage-args file args)))) 998 (if file-word (funcall massage-args file args))))
999 ;; Since comint clobbered the mode, we don't set it until now.
1006 (gud-mode) 1000 (gud-mode)
1001 (make-local-variable 'gud-massage-args)
1002 (setq gud-massage-args massage-args)
1003 (make-local-variable 'gud-marker-filter)
1004 (setq gud-marker-filter marker-filter)
1005 (make-local-variable 'gud-find-file)
1006 (setq gud-find-file find-file)
1007
1007 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) 1008 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
1008 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) 1009 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
1009 (gud-set-buffer) 1010 (gud-set-buffer)