diff options
| author | Richard M. Stallman | 1994-09-30 09:11:36 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1994-09-30 09:11:36 +0000 |
| commit | ee97eac30f07c7bdff39aab3ba8a4e4f9579be4b (patch) | |
| tree | 205357129c20d4759477bc1bcd2a6e2612810696 | |
| parent | 39aa8bed39d4864a2ecb47a7b01e906c9e5ff08a (diff) | |
| download | emacs-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.el | 135 |
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) |