47 |
|
|
48 |
(defgroup gud nil |
(defgroup gud nil |
49 |
"Grand Unified Debugger mode for gdb and other debuggers under Emacs. |
"Grand Unified Debugger mode for gdb and other debuggers under Emacs. |
50 |
Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), and jdb." |
Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), jdb, and bash." |
51 |
:group 'unix |
:group 'unix |
52 |
:group 'tools) |
:group 'tools) |
53 |
|
|
71 |
(defvar gud-minor-mode nil) |
(defvar gud-minor-mode nil) |
72 |
(put 'gud-minor-mode 'permanent-local t) |
(put 'gud-minor-mode 'permanent-local t) |
73 |
|
|
74 |
|
(defvar gud-keep-buffer nil) |
75 |
|
|
76 |
(defun gud-symbol (sym &optional soft minor-mode) |
(defun gud-symbol (sym &optional soft minor-mode) |
77 |
"Return the symbol used for SYM in MINOR-MODE. |
"Return the symbol used for SYM in MINOR-MODE. |
78 |
MINOR-MODE defaults to `gud-minor-mode. |
MINOR-MODE defaults to `gud-minor-mode. |
87 |
(let ((sym (gud-symbol sym t minor-mode))) |
(let ((sym (gud-symbol sym t minor-mode))) |
88 |
(if (boundp sym) (symbol-value sym)))) |
(if (boundp sym) (symbol-value sym)))) |
89 |
|
|
90 |
(defun gud-find-file (file) |
(defvar gud-running nil |
91 |
;; Don't get confused by double slashes in the name that comes from GDB. |
"Non-nil if debuggee is running. |
92 |
(while (string-match "//+" file) |
Used to grey out relevant toolbar icons.") |
|
(setq file (replace-match "/" t t file))) |
|
|
(let ((minor-mode gud-minor-mode) |
|
|
(buf (funcall gud-find-file file))) |
|
|
(when buf |
|
|
;; Copy `gud-minor-mode' to the found buffer to turn on the menu. |
|
|
(with-current-buffer buf |
|
|
(set (make-local-variable 'gud-minor-mode) minor-mode)) |
|
|
buf))) |
|
93 |
|
|
94 |
(easy-mmode-defmap gud-menu-map |
(easy-mmode-defmap gud-menu-map |
95 |
'(([refresh] "Refresh" . gud-refresh) |
'(([refresh] "Refresh" . gud-refresh) |
96 |
([remove] "Remove Breakpoint" . gud-remove) |
([run] menu-item "Run" gud-run |
97 |
|
:enable (and (not gud-running) |
98 |
|
(memq gud-minor-mode '(gdba gdb jdb)))) |
99 |
|
([goto] menu-item "Continue to selection" gud-until |
100 |
|
:enable (and (not gud-running) |
101 |
|
(memq gud-minor-mode '(gdba gdb)))) |
102 |
|
([remove] menu-item "Remove Breakpoint" gud-remove |
103 |
|
:enable (not gud-running)) |
104 |
([tbreak] menu-item "Temporary Breakpoint" gud-tbreak |
([tbreak] menu-item "Temporary Breakpoint" gud-tbreak |
105 |
:enable (memq gud-minor-mode '(gdb sdb xdb))) |
:enable (memq gud-minor-mode '(gdba gdb sdb xdb bashdb))) |
106 |
([break] "Set Breakpoint" . gud-break) |
([break] menu-item "Set Breakpoint" gud-break |
107 |
|
:enable (not gud-running)) |
108 |
([up] menu-item "Up Stack" gud-up |
([up] menu-item "Up Stack" gud-up |
109 |
:enable (memq gud-minor-mode '(gdb dbx xdb jdb))) |
:enable (and (not gud-running) |
110 |
|
(memq gud-minor-mode |
111 |
|
'(gdba gdb dbx xdb jdb pdb bashdb)))) |
112 |
([down] menu-item "Down Stack" gud-down |
([down] menu-item "Down Stack" gud-down |
113 |
:enable (memq gud-minor-mode '(gdb dbx xdb jdb))) |
:enable (and (not gud-running) |
114 |
([print] "Print Expression" . gud-print) |
(memq gud-minor-mode |
115 |
|
'(gdba gdb dbx xdb jdb pdb bashdb)))) |
116 |
|
([print] menu-item "Print Expression" gud-print |
117 |
|
:enable (not gud-running)) |
118 |
|
([display] menu-item "Display Expression" gud-display |
119 |
|
:enable (and (not gud-running) |
120 |
|
(eq gud-minor-mode 'gdba))) |
121 |
([finish] menu-item "Finish Function" gud-finish |
([finish] menu-item "Finish Function" gud-finish |
122 |
:enable (memq gud-minor-mode '(gdb xdb jdb))) |
:enable (and (not gud-running) |
123 |
|
(memq gud-minor-mode |
124 |
|
'(gdba gdb xdb jdb pdb bashdb)))) |
125 |
([stepi] "Step Instruction" . gud-stepi) |
([stepi] "Step Instruction" . gud-stepi) |
126 |
([step] "Step Line" . gud-step) |
([step] menu-item "Step Line" gud-step |
127 |
([next] "Next Line" . gud-next) |
:enable (not gud-running)) |
128 |
([cont] "Continue" . gud-cont)) |
([next] menu-item "Next Line" gud-next |
129 |
|
:enable (not gud-running)) |
130 |
|
([cont] menu-item "Continue" gud-cont |
131 |
|
:enable (not gud-running))) |
132 |
"Menu for `gud-mode'." |
"Menu for `gud-mode'." |
133 |
:name "Gud") |
:name "Gud") |
134 |
|
|
144 |
;; Will inherit from comint-mode via define-derived-mode. |
;; Will inherit from comint-mode via define-derived-mode. |
145 |
(make-sparse-keymap) |
(make-sparse-keymap) |
146 |
"`gud-mode' keymap.") |
"`gud-mode' keymap.") |
147 |
|
|
148 |
|
(defvar gud-tool-bar-map |
149 |
|
(if (display-graphic-p) |
150 |
|
(let ((map (make-sparse-keymap))) |
151 |
|
(dolist (x '((gud-break . "gud-break") |
152 |
|
(gud-remove . "gud-remove") |
153 |
|
(gud-print . "gud-print") |
154 |
|
(gud-display . "gud-display") |
155 |
|
(gud-run . "gud-run") |
156 |
|
(gud-until . "gud-until") |
157 |
|
(gud-cont . "gud-cont") |
158 |
|
(gud-step . "gud-step") |
159 |
|
(gud-next . "gud-next") |
160 |
|
(gud-finish . "gud-finish") |
161 |
|
(gud-up . "gud-up") |
162 |
|
(gud-down . "gud-down")) |
163 |
|
map) |
164 |
|
(tool-bar-local-item-from-menu |
165 |
|
(car x) (cdr x) map gud-minor-mode-map))))) |
166 |
|
|
167 |
|
(defun gud-file-name (f) |
168 |
|
"Transform a relative file name to an absolute file name. |
169 |
|
Uses `gud-<MINOR-MODE>-directories' to find the source files." |
170 |
|
(if (file-exists-p f) (expand-file-name f) |
171 |
|
(let ((directories (gud-val 'directories)) |
172 |
|
(result nil)) |
173 |
|
(while directories |
174 |
|
(let ((path (expand-file-name f (car directories)))) |
175 |
|
(if (file-exists-p path) |
176 |
|
(setq result path |
177 |
|
directories nil))) |
178 |
|
(setq directories (cdr directories))) |
179 |
|
result))) |
180 |
|
|
181 |
|
(defun gud-find-file (file) |
182 |
|
;; Don't get confused by double slashes in the name that comes from GDB. |
183 |
|
(while (string-match "//+" file) |
184 |
|
(setq file (replace-match "/" t t file))) |
185 |
|
(let ((minor-mode gud-minor-mode) |
186 |
|
(buf (funcall (or gud-find-file 'gud-file-name) file))) |
187 |
|
(when (stringp buf) |
188 |
|
(setq buf (and (file-readable-p buf) (find-file-noselect buf 'nowarn)))) |
189 |
|
(when buf |
190 |
|
;; Copy `gud-minor-mode' to the found buffer to turn on the menu. |
191 |
|
(with-current-buffer buf |
192 |
|
(set (make-local-variable 'gud-minor-mode) minor-mode) |
193 |
|
(set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
194 |
|
(make-local-variable 'gud-keep-buffer)) |
195 |
|
buf))) |
196 |
|
|
197 |
;; ====================================================================== |
;; ====================================================================== |
198 |
;; command definition |
;; command definition |
226 |
The `current' line is that of the current buffer (if we're in a |
The `current' line is that of the current buffer (if we're in a |
227 |
source file) or the source line number at the last break or step (if |
source file) or the source line number at the last break or step (if |
228 |
we're in the GUD buffer)." |
we're in the GUD buffer)." |
229 |
(list 'progn |
`(progn |
230 |
(list 'defun func '(arg) |
(defun ,func (arg) |
231 |
(or doc "") |
,@(if doc (list doc)) |
232 |
'(interactive "p") |
(interactive "p") |
233 |
(list 'gud-call cmd 'arg)) |
,(if (stringp cmd) |
234 |
(if key |
`(gud-call ,cmd arg) |
235 |
(list 'define-key |
cmd)) |
236 |
'(current-local-map) |
,(if key `(local-set-key ,(concat "\C-c" key) ',func)) |
237 |
(concat "\C-c" key) |
,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func)))) |
|
(list 'quote func))) |
|
|
(if key |
|
|
(list 'global-set-key |
|
|
(list 'concat 'gud-key-prefix key) |
|
|
(list 'quote func))))) |
|
238 |
|
|
239 |
;; Where gud-display-frame should put the debugging arrow; a cons of |
;; Where gud-display-frame should put the debugging arrow; a cons of |
240 |
;; (filename . line-number). This is set by the marker-filter, which scans |
;; (filename . line-number). This is set by the marker-filter, which scans |
273 |
|
|
274 |
;; ====================================================================== |
;; ====================================================================== |
275 |
;; speedbar support functions and variables. |
;; speedbar support functions and variables. |
276 |
(eval-when-compile (require 'speedbar)) |
(eval-when-compile (require 'speedbar)) ;For speedbar-with-attached-buffer. |
277 |
|
|
278 |
(defvar gud-last-speedbar-buffer nil |
(defvar gud-last-speedbar-buffer nil |
279 |
"The last GUD buffer used.") |
"The last GUD buffer used.") |
314 |
(equal gud-last-last-frame gud-last-speedbar-stackframe)) |
(equal gud-last-last-frame gud-last-speedbar-stackframe)) |
315 |
nil |
nil |
316 |
(setq gud-last-speedbar-buffer buffer) |
(setq gud-last-speedbar-buffer buffer) |
317 |
(let* ((ff (save-excursion (set-buffer buffer) gud-find-file)) |
(let* ((minor-mode (with-current-buffer buffer gud-minor-mode)) |
|
;;(lf (save-excursion (set-buffer buffer) gud-last-last-frame)) |
|
318 |
(frames |
(frames |
319 |
(cond ((eq ff 'gud-gdb-find-file) |
(cond ((memq minor-mode '(gdba gdb)) |
320 |
(gud-gdb-get-stackframe buffer) |
(gud-gdb-get-stackframe buffer)) |
|
) |
|
321 |
;; Add more debuggers here! |
;; Add more debuggers here! |
322 |
(t |
(t |
323 |
(speedbar-remove-localized-speedbar-support buffer) |
(speedbar-remove-localized-speedbar-support buffer) |
344 |
(speedbar-insert-button (car (car frames)) |
(speedbar-insert-button (car (car frames)) |
345 |
'speedbar-file-face |
'speedbar-file-face |
346 |
'speedbar-highlight-face |
'speedbar-highlight-face |
347 |
(cond ((eq ff 'gud-gdb-find-file) |
(cond ((memq minor-mode '(gdba gdb)) |
348 |
'gud-gdb-goto-stackframe) |
'gud-gdb-goto-stackframe) |
349 |
(t (error "Should never be here"))) |
(t (error "Should never be here"))) |
350 |
(car frames) t)) |
(car frames) t)) |
360 |
;; ====================================================================== |
;; ====================================================================== |
361 |
;; gdb functions |
;; gdb functions |
362 |
|
|
363 |
;;; History of argument lists passed to gdb. |
;; History of argument lists passed to gdb. |
364 |
(defvar gud-gdb-history nil) |
(defvar gud-gdb-history nil) |
365 |
|
|
366 |
(defun gud-gdb-massage-args (file args) |
(defcustom gud-gdb-command-name "gdb --fullname" |
367 |
(cons "-fullname" args)) |
"Default command to execute an executable under the GDB debugger." |
368 |
|
:type 'string |
369 |
|
:group 'gud) |
370 |
|
|
371 |
(defvar gud-gdb-marker-regexp |
(defvar gud-gdb-marker-regexp |
372 |
;; This used to use path-separator instead of ":"; |
;; This used to use path-separator instead of ":"; |
393 |
(setq |
(setq |
394 |
|
|
395 |
;; Extract the frame position from the marker. |
;; Extract the frame position from the marker. |
396 |
gud-last-frame |
gud-last-frame (cons (match-string 1 gud-marker-acc) |
397 |
(cons (substring gud-marker-acc (match-beginning 1) (match-end 1)) |
(string-to-int (match-string 2 gud-marker-acc))) |
|
(string-to-int (substring gud-marker-acc |
|
|
(match-beginning 2) |
|
|
(match-end 2)))) |
|
398 |
|
|
399 |
;; Append any text before the marker to the output we're going |
;; Append any text before the marker to the output we're going |
400 |
;; to return - we don't include the marker in this text. |
;; to return - we don't include the marker in this text. |
424 |
|
|
425 |
output)) |
output)) |
426 |
|
|
|
(defun gud-gdb-find-file (f) |
|
|
(find-file-noselect f 'nowarn)) |
|
|
|
|
427 |
(easy-mmode-defmap gud-minibuffer-local-map |
(easy-mmode-defmap gud-minibuffer-local-map |
428 |
'(("\C-i" . comint-dynamic-complete-filename)) |
'(("\C-i" . comint-dynamic-complete-filename)) |
429 |
"Keymap for minibuffer prompting of gud startup command." |
"Keymap for minibuffer prompting of gud startup command." |
436 |
(read-from-minibuffer |
(read-from-minibuffer |
437 |
(format "Run %s (like this): " minor-mode) |
(format "Run %s (like this): " minor-mode) |
438 |
(or (car-safe (symbol-value hist-sym)) |
(or (car-safe (symbol-value hist-sym)) |
439 |
(concat (or cmd-name (symbol-name minor-mode)) " " init)) |
(concat (or cmd-name (symbol-name minor-mode)) |
440 |
|
" " |
441 |
|
(or init |
442 |
|
(let ((file nil)) |
443 |
|
(dolist (f (directory-files default-directory) file) |
444 |
|
(if (and (file-executable-p f) |
445 |
|
(not (file-directory-p f)) |
446 |
|
(or (not file) |
447 |
|
(file-newer-than-file-p f file))) |
448 |
|
(setq file f))))))) |
449 |
gud-minibuffer-local-map nil |
gud-minibuffer-local-map nil |
450 |
hist-sym))) |
hist-sym))) |
451 |
|
|
456 |
and source-file directory for your debugger." |
and source-file directory for your debugger." |
457 |
(interactive (list (gud-query-cmdline 'gdb))) |
(interactive (list (gud-query-cmdline 'gdb))) |
458 |
|
|
459 |
(gud-common-init command-line 'gud-gdb-massage-args |
(gud-common-init command-line nil 'gud-gdb-marker-filter) |
|
'gud-gdb-marker-filter 'gud-gdb-find-file) |
|
460 |
(set (make-local-variable 'gud-minor-mode) 'gdb) |
(set (make-local-variable 'gud-minor-mode) 'gdb) |
461 |
|
|
462 |
(gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") |
(gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") |
472 |
(gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") |
(gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") |
473 |
(gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") |
(gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") |
474 |
(gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") |
(gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") |
475 |
|
(gud-def gud-until "until %l" "\C-u" "Continue up to current line.") |
476 |
|
(gud-def gud-run "run" nil "Run the program.") |
477 |
|
|
478 |
(local-set-key "\C-i" 'gud-gdb-complete-command) |
(local-set-key "\C-i" 'gud-gdb-complete-command) |
|
(local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak)) |
|
|
(local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish)) |
|
|
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) |
|
|
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) |
|
479 |
(setq comint-prompt-regexp "^(.*gdb[+]?) *") |
(setq comint-prompt-regexp "^(.*gdb[+]?) *") |
480 |
(setq paragraph-start comint-prompt-regexp) |
(setq paragraph-start comint-prompt-regexp) |
481 |
(run-hooks 'gdb-mode-hook) |
(run-hooks 'gdb-mode-hook) |
486 |
;; in the GUD buffer by using a GDB command designed just for Emacs. |
;; in the GUD buffer by using a GDB command designed just for Emacs. |
487 |
|
|
488 |
;; The completion process filter indicates when it is finished. |
;; The completion process filter indicates when it is finished. |
489 |
(defvar gud-gdb-complete-in-progress) |
(defvar gud-gdb-fetch-lines-in-progress) |
490 |
|
|
491 |
;; Since output may arrive in fragments we accumulate partials strings here. |
;; Since output may arrive in fragments we accumulate partials strings here. |
492 |
(defvar gud-gdb-complete-string) |
(defvar gud-gdb-fetch-lines-string) |
493 |
|
|
494 |
;; We need to know how much of the completion to chop off. |
;; We need to know how much of the completion to chop off. |
495 |
(defvar gud-gdb-complete-break) |
(defvar gud-gdb-fetch-lines-break) |
496 |
|
|
497 |
;; The completion list is constructed by the process filter. |
;; The completion list is constructed by the process filter. |
498 |
(defvar gud-gdb-complete-list) |
(defvar gud-gdb-fetched-lines) |
499 |
|
|
500 |
(defvar gud-comint-buffer nil) |
(defvar gud-comint-buffer nil) |
501 |
|
|
506 |
(interactive) |
(interactive) |
507 |
(let* ((end (point)) |
(let* ((end (point)) |
508 |
(command (buffer-substring (comint-line-beginning-position) end)) |
(command (buffer-substring (comint-line-beginning-position) end)) |
509 |
command-word) |
(command-word |
510 |
;; Find the word break. This match will always succeed. |
;; Find the word break. This match will always succeed. |
511 |
(string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) |
(and (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) |
512 |
(setq gud-gdb-complete-break (match-beginning 2) |
(substring command (match-beginning 2)))) |
513 |
command-word (substring command gud-gdb-complete-break)) |
(complete-list |
514 |
;; Temporarily install our filter function. |
(gud-gdb-run-command-fetch-lines (concat "complete " command) |
515 |
(let ((gud-marker-filter 'gud-gdb-complete-filter)) |
(current-buffer) |
516 |
;; Issue the command to GDB. |
;; From string-match above. |
517 |
(gud-basic-call (concat "complete " command)) |
(match-beginning 2)))) |
|
(setq gud-gdb-complete-in-progress t |
|
|
gud-gdb-complete-string nil |
|
|
gud-gdb-complete-list nil) |
|
|
;; Slurp the output. |
|
|
(while gud-gdb-complete-in-progress |
|
|
(accept-process-output (get-buffer-process gud-comint-buffer)))) |
|
518 |
;; Protect against old versions of GDB. |
;; Protect against old versions of GDB. |
519 |
(and gud-gdb-complete-list |
(and complete-list |
520 |
(string-match "^Undefined command: \"complete\"" |
(string-match "^Undefined command: \"complete\"" (car complete-list)) |
|
(car gud-gdb-complete-list)) |
|
521 |
(error "This version of GDB doesn't support the `complete' command")) |
(error "This version of GDB doesn't support the `complete' command")) |
522 |
;; Sort the list like readline. |
;; Sort the list like readline. |
523 |
(setq gud-gdb-complete-list |
(setq complete-list (sort complete-list (function string-lessp))) |
|
(sort gud-gdb-complete-list (function string-lessp))) |
|
524 |
;; Remove duplicates. |
;; Remove duplicates. |
525 |
(let ((first gud-gdb-complete-list) |
(let ((first complete-list) |
526 |
(second (cdr gud-gdb-complete-list))) |
(second (cdr complete-list))) |
527 |
(while second |
(while second |
528 |
(if (string-equal (car first) (car second)) |
(if (string-equal (car first) (car second)) |
529 |
(setcdr first (setq second (cdr second))) |
(setcdr first (setq second (cdr second))) |
531 |
second (cdr second))))) |
second (cdr second))))) |
532 |
;; Add a trailing single quote if there is a unique completion |
;; Add a trailing single quote if there is a unique completion |
533 |
;; and it contains an odd number of unquoted single quotes. |
;; and it contains an odd number of unquoted single quotes. |
534 |
(and (= (length gud-gdb-complete-list) 1) |
(and (= (length complete-list) 1) |
535 |
(let ((str (car gud-gdb-complete-list)) |
(let ((str (car complete-list)) |
536 |
(pos 0) |
(pos 0) |
537 |
(count 0)) |
(count 0)) |
538 |
(while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos) |
(while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos) |
539 |
(setq count (1+ count) |
(setq count (1+ count) |
540 |
pos (match-end 0))) |
pos (match-end 0))) |
541 |
(and (= (mod count 2) 1) |
(and (= (mod count 2) 1) |
542 |
(setq gud-gdb-complete-list (list (concat str "'")))))) |
(setq complete-list (list (concat str "'")))))) |
543 |
;; Let comint handle the rest. |
;; Let comint handle the rest. |
544 |
(comint-dynamic-simple-complete command-word gud-gdb-complete-list))) |
(comint-dynamic-simple-complete command-word complete-list))) |
545 |
|
|
546 |
;; The completion process filter is installed temporarily to slurp the |
;; The completion process filter is installed temporarily to slurp the |
547 |
;; output of GDB up to the next prompt and build the completion list. |
;; output of GDB up to the next prompt and build the completion list. |
548 |
(defun gud-gdb-complete-filter (string) |
(defun gud-gdb-fetch-lines-filter (string filter) |
549 |
(setq string (concat gud-gdb-complete-string string)) |
"Filter used to read the list of lines output by a command. |
550 |
|
STRING is the output to filter. |
551 |
|
It is passed through FILTER before we look at it." |
552 |
|
(setq string (funcall filter string)) |
553 |
|
(setq string (concat gud-gdb-fetch-lines-string string)) |
554 |
(while (string-match "\n" string) |
(while (string-match "\n" string) |
555 |
(setq gud-gdb-complete-list |
(push (substring string gud-gdb-fetch-lines-break (match-beginning 0)) |
556 |
(cons (substring string gud-gdb-complete-break (match-beginning 0)) |
gud-gdb-fetched-lines) |
|
gud-gdb-complete-list)) |
|
557 |
(setq string (substring string (match-end 0)))) |
(setq string (substring string (match-end 0)))) |
558 |
(if (string-match comint-prompt-regexp string) |
(if (string-match comint-prompt-regexp string) |
559 |
(progn |
(progn |
560 |
(setq gud-gdb-complete-in-progress nil) |
(setq gud-gdb-fetch-lines-in-progress nil) |
561 |
string) |
string) |
562 |
(progn |
(progn |
563 |
(setq gud-gdb-complete-string string) |
(setq gud-gdb-fetch-lines-string string) |
564 |
""))) |
""))) |
565 |
|
|
566 |
;; gdb speedbar functions |
;; gdb speedbar functions |
574 |
(defvar gud-gdb-fetched-stack-frame nil |
(defvar gud-gdb-fetched-stack-frame nil |
575 |
"Stack frames we are fetching from GDB.") |
"Stack frames we are fetching from GDB.") |
576 |
|
|
|
(defvar gud-gdb-fetched-stack-frame-list nil |
|
|
"List of stack frames we are fetching from GDB.") |
|
|
|
|
577 |
;(defun gud-gdb-get-scope-data (text token indent) |
;(defun gud-gdb-get-scope-data (text token indent) |
578 |
; ;; checkdoc-params: (indent) |
; ;; checkdoc-params: (indent) |
579 |
; "Fetch data associated with a stack frame, and expand/contract it. |
; "Fetch data associated with a stack frame, and expand/contract it. |
588 |
(defun gud-gdb-get-stackframe (buffer) |
(defun gud-gdb-get-stackframe (buffer) |
589 |
"Extract the current stack frame out of the GUD GDB BUFFER." |
"Extract the current stack frame out of the GUD GDB BUFFER." |
590 |
(let ((newlst nil) |
(let ((newlst nil) |
591 |
(gud-gdb-fetched-stack-frame-list nil)) |
(fetched-stack-frame-list |
592 |
(gud-gdb-run-command-fetch-lines "backtrace" buffer) |
(gud-gdb-run-command-fetch-lines "backtrace" buffer))) |
593 |
(if (and (car gud-gdb-fetched-stack-frame-list) |
(if (and (car fetched-stack-frame-list) |
594 |
(string-match "No stack" (car gud-gdb-fetched-stack-frame-list))) |
(string-match "No stack" (car fetched-stack-frame-list))) |
595 |
;; Go into some other mode??? |
;; Go into some other mode??? |
596 |
nil |
nil |
597 |
(while gud-gdb-fetched-stack-frame-list |
(dolist (e fetched-stack-frame-list) |
598 |
(let ((e (car gud-gdb-fetched-stack-frame-list)) |
(let ((name nil) (num nil)) |
|
(name nil) (num nil)) |
|
599 |
(if (not (or |
(if (not (or |
600 |
(string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([:0-9a-zA-Z_]+\\) (" e) |
(string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([:0-9a-zA-Z_]+\\) (" e) |
601 |
(string-match "^#\\([0-9]+\\) +\\([:0-9a-zA-Z_]+\\) (" e))) |
(string-match "^#\\([0-9]+\\) +\\([:0-9a-zA-Z_]+\\) (" e))) |
616 |
(list name num (match-string 1 e) |
(list name num (match-string 1 e) |
617 |
(match-string 2 e)) |
(match-string 2 e)) |
618 |
(list name num)) |
(list name num)) |
619 |
newlst)))) |
newlst))))) |
|
(setq gud-gdb-fetched-stack-frame-list |
|
|
(cdr gud-gdb-fetched-stack-frame-list))) |
|
620 |
(nreverse newlst)))) |
(nreverse newlst)))) |
621 |
|
|
622 |
;(defun gud-gdb-selected-frame-info (buffer) |
;(defun gud-gdb-selected-frame-info (buffer) |
623 |
; "Learn GDB information for the currently selected stack frame in BUFFER." |
; "Learn GDB information for the currently selected stack frame in BUFFER." |
624 |
; ) |
; ) |
625 |
|
|
626 |
(defun gud-gdb-run-command-fetch-lines (command buffer) |
(defun gud-gdb-run-command-fetch-lines (command buffer &optional skip) |
627 |
"Run COMMAND, and return when `gud-gdb-fetched-stack-frame-list' is full. |
"Run COMMAND, and return the list of lines it outputs. |
628 |
BUFFER is the GUD buffer in which to run the command." |
BUFFER is the GUD buffer in which to run the command. |
629 |
(save-excursion |
SKIP is the number of chars to skip on each lines, it defaults to 0." |
630 |
(set-buffer buffer) |
(with-current-buffer buffer |
631 |
(if (save-excursion |
(if (save-excursion |
632 |
(goto-char (point-max)) |
(goto-char (point-max)) |
633 |
(forward-line 0) |
(forward-line 0) |
635 |
nil |
nil |
636 |
;; Much of this copied from GDB complete, but I'm grabbing the stack |
;; Much of this copied from GDB complete, but I'm grabbing the stack |
637 |
;; frame instead. |
;; frame instead. |
638 |
(let ((gud-marker-filter 'gud-gdb-speedbar-stack-filter)) |
(let ((gud-gdb-fetch-lines-in-progress t) |
639 |
|
(gud-gdb-fetched-lines nil) |
640 |
|
(gud-gdb-fetch-lines-string nil) |
641 |
|
(gud-gdb-fetch-lines-break (or skip 0)) |
642 |
|
(gud-marker-filter |
643 |
|
`(lambda (string) (gud-gdb-fetch-lines-filter string ',gud-marker-filter)))) |
644 |
;; Issue the command to GDB. |
;; Issue the command to GDB. |
645 |
(gud-basic-call command) |
(gud-basic-call command) |
|
(setq gud-gdb-complete-in-progress t ;; use this flag for our purposes. |
|
|
gud-gdb-complete-string nil |
|
|
gud-gdb-complete-list nil) |
|
646 |
;; Slurp the output. |
;; Slurp the output. |
647 |
(while gud-gdb-complete-in-progress |
(while gud-gdb-fetch-lines-in-progress |
648 |
(accept-process-output (get-buffer-process gud-comint-buffer))) |
(accept-process-output (get-buffer-process buffer))) |
649 |
(setq gud-gdb-fetched-stack-frame nil |
(nreverse gud-gdb-fetched-lines))))) |
|
gud-gdb-fetched-stack-frame-list |
|
|
(nreverse gud-gdb-fetched-stack-frame-list)))))) |
|
|
|
|
|
(defun gud-gdb-speedbar-stack-filter (string) |
|
|
;; checkdoc-params: (string) |
|
|
"Filter used to read in the current GDB stack." |
|
|
(setq string (concat gud-gdb-fetched-stack-frame string)) |
|
|
(while (string-match "\n" string) |
|
|
(setq gud-gdb-fetched-stack-frame-list |
|
|
(cons (substring string 0 (match-beginning 0)) |
|
|
gud-gdb-fetched-stack-frame-list)) |
|
|
(setq string (substring string (match-end 0)))) |
|
|
(if (string-match comint-prompt-regexp string) |
|
|
(progn |
|
|
(setq gud-gdb-complete-in-progress nil) |
|
|
string) |
|
|
(progn |
|
|
(setq gud-gdb-complete-string string) |
|
|
""))) |
|
650 |
|
|
651 |
|
|
652 |
;; ====================================================================== |
;; ====================================================================== |
653 |
;; sdb functions |
;; sdb functions |
654 |
|
|
655 |
;;; History of argument lists passed to sdb. |
;; History of argument lists passed to sdb. |
656 |
(defvar gud-sdb-history nil) |
(defvar gud-sdb-history nil) |
657 |
|
|
658 |
(defvar gud-sdb-needs-tags (not (file-exists-p "/var")) |
(defvar gud-sdb-needs-tags (not (file-exists-p "/var")) |
660 |
|
|
661 |
(defvar gud-sdb-lastfile nil) |
(defvar gud-sdb-lastfile nil) |
662 |
|
|
|
(defun gud-sdb-massage-args (file args) args) |
|
|
|
|
663 |
(defun gud-sdb-marker-filter (string) |
(defun gud-sdb-marker-filter (string) |
664 |
(setq gud-marker-acc |
(setq gud-marker-acc |
665 |
(if gud-marker-acc (concat gud-marker-acc string) string)) |
(if gud-marker-acc (concat gud-marker-acc string) string)) |
671 |
((string-match "\\(^\\|\n\\)\\*?\\(0x\\w* in \\)?\\([^:\n]*\\):\\([0-9]*\\):.*\n" |
((string-match "\\(^\\|\n\\)\\*?\\(0x\\w* in \\)?\\([^:\n]*\\):\\([0-9]*\\):.*\n" |
672 |
gud-marker-acc start) |
gud-marker-acc start) |
673 |
(setq gud-last-frame |
(setq gud-last-frame |
674 |
(cons |
(cons (match-string 3 gud-marker-acc) |
675 |
(substring gud-marker-acc (match-beginning 3) (match-end 3)) |
(string-to-int (match-string 4 gud-marker-acc))))) |
|
(string-to-int |
|
|
(substring gud-marker-acc (match-beginning 4) (match-end 4)))))) |
|
676 |
;; System V Release 4.0 quite often clumps two lines together |
;; System V Release 4.0 quite often clumps two lines together |
677 |
((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):" |
((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):" |
678 |
gud-marker-acc start) |
gud-marker-acc start) |
679 |
(setq gud-sdb-lastfile |
(setq gud-sdb-lastfile (match-string 2 gud-marker-acc)) |
|
(substring gud-marker-acc (match-beginning 2) (match-end 2))) |
|
680 |
(setq gud-last-frame |
(setq gud-last-frame |
681 |
(cons |
(cons gud-sdb-lastfile |
682 |
gud-sdb-lastfile |
(string-to-int (match-string 3 gud-marker-acc))))) |
|
(string-to-int |
|
|
(substring gud-marker-acc (match-beginning 3) (match-end 3)))))) |
|
683 |
;; System V Release 4.0 |
;; System V Release 4.0 |
684 |
((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" |
((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" |
685 |
gud-marker-acc start) |
gud-marker-acc start) |
686 |
(setq gud-sdb-lastfile |
(setq gud-sdb-lastfile (match-string 2 gud-marker-acc))) |
|
(substring gud-marker-acc (match-beginning 2) (match-end 2)))) |
|
687 |
((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" |
((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" |
688 |
gud-marker-acc start)) |
gud-marker-acc start)) |
689 |
(setq gud-last-frame |
(setq gud-last-frame |
690 |
(cons |
(cons gud-sdb-lastfile |
691 |
gud-sdb-lastfile |
(string-to-int (match-string 1 gud-marker-acc))))) |
|
(string-to-int |
|
|
(substring gud-marker-acc (match-beginning 1) (match-end 1)))))) |
|
692 |
(t |
(t |
693 |
(setq gud-sdb-lastfile nil))) |
(setq gud-sdb-lastfile nil))) |
694 |
(setq start (match-end 0))) |
(setq start (match-end 0))) |
717 |
(file-exists-p tags-file-name)))) |
(file-exists-p tags-file-name)))) |
718 |
(error "The sdb support requires a valid tags table to work")) |
(error "The sdb support requires a valid tags table to work")) |
719 |
|
|
720 |
(gud-common-init command-line 'gud-sdb-massage-args |
(gud-common-init command-line nil 'gud-sdb-marker-filter 'gud-sdb-find-file) |
|
'gud-sdb-marker-filter 'gud-sdb-find-file) |
|
721 |
(set (make-local-variable 'gud-minor-mode) 'sdb) |
(set (make-local-variable 'gud-minor-mode) 'sdb) |
722 |
|
|
723 |
(gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") |
(gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") |
731 |
|
|
732 |
(setq comint-prompt-regexp "\\(^\\|\n\\)\\*") |
(setq comint-prompt-regexp "\\(^\\|\n\\)\\*") |
733 |
(setq paragraph-start comint-prompt-regexp) |
(setq paragraph-start comint-prompt-regexp) |
|
(local-set-key [menu-bar debug tbreak] |
|
|
'("Temporary Breakpoint" . gud-tbreak)) |
|
734 |
(run-hooks 'sdb-mode-hook) |
(run-hooks 'sdb-mode-hook) |
735 |
) |
) |
736 |
|
|
737 |
;; ====================================================================== |
;; ====================================================================== |
738 |
;; dbx functions |
;; dbx functions |
739 |
|
|
740 |
;;; History of argument lists passed to dbx. |
;; History of argument lists passed to dbx. |
741 |
(defvar gud-dbx-history nil) |
(defvar gud-dbx-history nil) |
742 |
|
|
743 |
(defcustom gud-dbx-directories nil |
(defcustom gud-dbx-directories nil |
761 |
(nreverse result)) |
(nreverse result)) |
762 |
args)) |
args)) |
763 |
|
|
|
(defun gud-dbx-file-name (f) |
|
|
"Transform a relative file name to an absolute file name, for dbx." |
|
|
(let ((result nil)) |
|
|
(if (file-exists-p f) |
|
|
(setq result (expand-file-name f)) |
|
|
(let ((directories gud-dbx-directories)) |
|
|
(while directories |
|
|
(let ((path (concat (car directories) "/" f))) |
|
|
(if (file-exists-p path) |
|
|
(setq result (expand-file-name path) |
|
|
directories nil))) |
|
|
(setq directories (cdr directories))))) |
|
|
result)) |
|
|
|
|
764 |
(defun gud-dbx-marker-filter (string) |
(defun gud-dbx-marker-filter (string) |
765 |
(setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string)) |
(setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string)) |
766 |
|
|
773 |
"signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" |
"signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" |
774 |
gud-marker-acc start)) |
gud-marker-acc start)) |
775 |
(setq gud-last-frame |
(setq gud-last-frame |
776 |
(cons |
(cons (match-string 2 gud-marker-acc) |
777 |
(substring gud-marker-acc (match-beginning 2) (match-end 2)) |
(string-to-int (match-string 1 gud-marker-acc))) |
|
(string-to-int |
|
|
(substring gud-marker-acc (match-beginning 1) (match-end 1)))) |
|
778 |
start (match-end 0))) |
start (match-end 0))) |
779 |
|
|
780 |
;; Search for the last incomplete line in this chunk |
;; Search for the last incomplete line in this chunk |
801 |
(string-match "^alpha[^-]*-[^-]*-osf" system-configuration)) |
(string-match "^alpha[^-]*-[^-]*-osf" system-configuration)) |
802 |
"Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').") |
"Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').") |
803 |
|
|
804 |
(defun gud-mipsdbx-massage-args (file args) |
(defvar gud-dbx-command-name |
805 |
(cons "-emacs" args)) |
(concat "dbx" (if gud-mips-p " -emacs"))) |
806 |
|
|
807 |
;; This is just like the gdb one except for the regexps since we need to cope |
;; This is just like the gdb one except for the regexps since we need to cope |
808 |
;; with an optional breakpoint number in [] before the ^Z^Z |
;; with an optional breakpoint number in [] before the ^Z^Z |
820 |
|
|
821 |
;; Extract the frame position from the marker. |
;; Extract the frame position from the marker. |
822 |
gud-last-frame |
gud-last-frame |
823 |
(cons (substring gud-marker-acc (match-beginning 1) (match-end 1)) |
(cons (match-string 1 gud-marker-acc) |
824 |
(string-to-int (substring gud-marker-acc |
(string-to-int (match-string 2 gud-marker-acc))) |
|
(match-beginning 2) |
|
|
(match-end 2)))) |
|
825 |
|
|
826 |
;; Append any text before the marker to the output we're going |
;; Append any text before the marker to the output we're going |
827 |
;; to return - we don't include the marker in this text. |
;; to return - we don't include the marker in this text. |
925 |
((string-match |
((string-match |
926 |
"^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n" |
"^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n" |
927 |
result) |
result) |
928 |
(let ((file (substring result (match-beginning 1) |
(let ((file (match-string 1 result))) |
|
(match-end 1)))) |
|
929 |
(if (file-exists-p file) |
(if (file-exists-p file) |
930 |
(setq gud-last-frame |
(setq gud-last-frame |
931 |
(cons |
(cons (match-string 1 result) |
932 |
(substring |
(string-to-int (match-string 2 result)))))) |
|
result (match-beginning 1) (match-end 1)) |
|
|
(string-to-int |
|
|
(substring |
|
|
result (match-beginning 2) (match-end 2))))))) |
|
933 |
result) |
result) |
934 |
((string-match ; kluged-up marker as above |
((string-match ; kluged-up marker as above |
935 |
"\032\032\\([0-9]*\\):\\(.*\\)\n" result) |
"\032\032\\([0-9]*\\):\\(.*\\)\n" result) |
936 |
(let ((file (gud-dbx-file-name |
(let ((file (gud-file-name (match-string 2 result)))) |
|
(substring result (match-beginning 2) (match-end 2))))) |
|
937 |
(if (and file (file-exists-p file)) |
(if (and file (file-exists-p file)) |
938 |
(setq gud-last-frame |
(setq gud-last-frame |
939 |
(cons |
(cons file |
940 |
file |
(string-to-int (match-string 1 result)))))) |
|
(string-to-int |
|
|
(substring |
|
|
result (match-beginning 1) (match-end 1))))))) |
|
941 |
(setq result (substring result 0 (match-beginning 0)))))) |
(setq result (substring result 0 (match-beginning 0)))))) |
942 |
(or result ""))) |
(or result ""))) |
943 |
|
|
973 |
;; Process all complete markers in this chunk. |
;; Process all complete markers in this chunk. |
974 |
(while (string-match re gud-marker-acc start) |
(while (string-match re gud-marker-acc start) |
975 |
(setq gud-last-frame |
(setq gud-last-frame |
976 |
(cons |
(cons (match-string 4 gud-marker-acc) |
977 |
(substring gud-marker-acc (match-beginning 4) (match-end 4)) |
(string-to-int (match-string 3 gud-marker-acc))) |
|
(string-to-int (substring gud-marker-acc |
|
|
(match-beginning 3) (match-end 3)))) |
|
978 |
start (match-end 0))) |
start (match-end 0))) |
979 |
|
|
980 |
;; Search for the last incomplete line in this chunk |
;; Search for the last incomplete line in this chunk |
990 |
nil))) |
nil))) |
991 |
string) |
string) |
992 |
|
|
|
(defun gud-dbx-find-file (f) |
|
|
(save-excursion |
|
|
(let ((realf (gud-dbx-file-name f))) |
|
|
(if realf |
|
|
(find-file-noselect realf))))) |
|
|
|
|
993 |
;;;###autoload |
;;;###autoload |
994 |
(defun dbx (command-line) |
(defun dbx (command-line) |
995 |
"Run dbx on program FILE in buffer *gud-FILE*. |
"Run dbx on program FILE in buffer *gud-FILE*. |
999 |
|
|
1000 |
(cond |
(cond |
1001 |
(gud-mips-p |
(gud-mips-p |
1002 |
(gud-common-init command-line 'gud-mipsdbx-massage-args |
(gud-common-init command-line nil 'gud-mipsdbx-marker-filter)) |
|
'gud-mipsdbx-marker-filter 'gud-dbx-find-file)) |
|
1003 |
(gud-irix-p |
(gud-irix-p |
1004 |
(gud-common-init command-line 'gud-dbx-massage-args |
(gud-common-init command-line 'gud-dbx-massage-args |
1005 |
'gud-irixdbx-marker-filter 'gud-dbx-find-file)) |
'gud-irixdbx-marker-filter)) |
1006 |
(gud-dgux-p |
(gud-dgux-p |
1007 |
(gud-common-init command-line 'gud-dbx-massage-args |
(gud-common-init command-line 'gud-dbx-massage-args |
1008 |
'gud-dguxdbx-marker-filter 'gud-dbx-find-file)) |
'gud-dguxdbx-marker-filter)) |
1009 |
(t |
(t |
1010 |
(gud-common-init command-line 'gud-dbx-massage-args |
(gud-common-init command-line 'gud-dbx-massage-args |
1011 |
'gud-dbx-marker-filter 'gud-dbx-find-file))) |
'gud-dbx-marker-filter))) |
1012 |
|
|
1013 |
(set (make-local-variable 'gud-minor-mode) 'dbx) |
(set (make-local-variable 'gud-minor-mode) 'dbx) |
1014 |
|
|
1048 |
|
|
1049 |
(setq comint-prompt-regexp "^[^)\n]*dbx) *") |
(setq comint-prompt-regexp "^[^)\n]*dbx) *") |
1050 |
(setq paragraph-start comint-prompt-regexp) |
(setq paragraph-start comint-prompt-regexp) |
|
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) |
|
|
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) |
|
1051 |
(run-hooks 'dbx-mode-hook) |
(run-hooks 'dbx-mode-hook) |
1052 |
) |
) |
1053 |
|
|
1054 |
;; ====================================================================== |
;; ====================================================================== |
1055 |
;; xdb (HP PARISC debugger) functions |
;; xdb (HP PARISC debugger) functions |
1056 |
|
|
1057 |
;;; History of argument lists passed to xdb. |
;; History of argument lists passed to xdb. |
1058 |
(defvar gud-xdb-history nil) |
(defvar gud-xdb-history nil) |
1059 |
|
|
1060 |
(defcustom gud-xdb-directories nil |
(defcustom gud-xdb-directories nil |
1078 |
(nreverse result)) |
(nreverse result)) |
1079 |
args)) |
args)) |
1080 |
|
|
|
(defun gud-xdb-file-name (f) |
|
|
"Transform a relative pathname to a full pathname in xdb mode" |
|
|
(let ((result nil)) |
|
|
(if (file-exists-p f) |
|
|
(setq result (expand-file-name f)) |
|
|
(let ((directories gud-xdb-directories)) |
|
|
(while directories |
|
|
(let ((path (concat (car directories) "/" f))) |
|
|
(if (file-exists-p path) |
|
|
(setq result (expand-file-name path) |
|
|
directories nil))) |
|
|
(setq directories (cdr directories))))) |
|
|
result)) |
|
|
|
|
1081 |
;; xdb does not print the lines all at once, so we have to accumulate them |
;; xdb does not print the lines all at once, so we have to accumulate them |
1082 |
(defun gud-xdb-marker-filter (string) |
(defun gud-xdb-marker-filter (string) |
1083 |
(let (result) |
(let (result) |
1089 |
(if result |
(if result |
1090 |
(if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\)[: ]" |
(if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\)[: ]" |
1091 |
result) |
result) |
1092 |
(string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" |
(string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" |
1093 |
result)) |
result)) |
1094 |
(let ((line (string-to-int |
(let ((line (string-to-int (match-string 2 result))) |
1095 |
(substring result (match-beginning 2) (match-end 2)))) |
(file (gud-file-name (match-string 1 result)))) |
1096 |
(file (gud-xdb-file-name |
(if file |
1097 |
(substring result (match-beginning 1) (match-end 1))))) |
(setq gud-last-frame (cons file line)))))) |
|
(if file |
|
|
(setq gud-last-frame (cons file line)))))) |
|
1098 |
(or result ""))) |
(or result ""))) |
1099 |
|
|
|
(defun gud-xdb-find-file (f) |
|
|
(save-excursion |
|
|
(let ((realf (gud-xdb-file-name f))) |
|
|
(if realf |
|
|
(find-file-noselect realf))))) |
|
|
|
|
1100 |
;;;###autoload |
;;;###autoload |
1101 |
(defun xdb (command-line) |
(defun xdb (command-line) |
1102 |
"Run xdb on program FILE in buffer *gud-FILE*. |
"Run xdb on program FILE in buffer *gud-FILE*. |
1108 |
(interactive (list (gud-query-cmdline 'xdb))) |
(interactive (list (gud-query-cmdline 'xdb))) |
1109 |
|
|
1110 |
(gud-common-init command-line 'gud-xdb-massage-args |
(gud-common-init command-line 'gud-xdb-massage-args |
1111 |
'gud-xdb-marker-filter 'gud-xdb-find-file) |
'gud-xdb-marker-filter) |
1112 |
(set (make-local-variable 'gud-minor-mode) 'xdb) |
(set (make-local-variable 'gud-minor-mode) 'xdb) |
1113 |
|
|
1114 |
(gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") |
(gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") |
1125 |
|
|
1126 |
(setq comint-prompt-regexp "^>") |
(setq comint-prompt-regexp "^>") |
1127 |
(setq paragraph-start comint-prompt-regexp) |
(setq paragraph-start comint-prompt-regexp) |
|
(local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak)) |
|
|
(local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish)) |
|
|
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) |
|
|
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) |
|
1128 |
(run-hooks 'xdb-mode-hook)) |
(run-hooks 'xdb-mode-hook)) |
1129 |
|
|
1130 |
;; ====================================================================== |
;; ====================================================================== |
1131 |
;; perldb functions |
;; perldb functions |
1132 |
|
|
1133 |
;;; History of argument lists passed to perldb. |
;; History of argument lists passed to perldb. |
1134 |
(defvar gud-perldb-history nil) |
(defvar gud-perldb-history nil) |
1135 |
|
|
|
;; Convert a command line as would be typed normally to run a script |
|
|
;; into one that invokes an Emacs-enabled debugging session. |
|
|
;; "-d" in inserted as the first switch, and "-emacs" is inserted where |
|
|
;; it will be $ARGV[0] (see perl5db.pl). |
|
1136 |
(defun gud-perldb-massage-args (file args) |
(defun gud-perldb-massage-args (file args) |
1137 |
(let* ((new-args (list "-d")) |
"Convert a command line as would be typed normally to run perldb |
1138 |
|
into one that invokes an Emacs-enabled debugging session. |
1139 |
|
\"-emacs\" is inserted where it will be $ARGV[0] (see perl5db.pl)." |
1140 |
|
;; FIXME: what if the command is `make perldb' and doesn't accept those extra |
1141 |
|
;; arguments ? |
1142 |
|
(let* ((new-args nil) |
1143 |
(seen-e nil) |
(seen-e nil) |
1144 |
(shift (lambda () |
(shift (lambda () (push (pop args) new-args)))) |
|
(setq new-args (cons (car args) new-args)) |
|
|
(setq args (cdr args))))) |
|
1145 |
|
|
1146 |
;; Pass all switches and -e scripts through. |
;; Pass all switches and -e scripts through. |
1147 |
(while (and args |
(while (and args |
1192 |
|
|
1193 |
;; Extract the frame position from the marker. |
;; Extract the frame position from the marker. |
1194 |
gud-last-frame |
gud-last-frame |
1195 |
(cons (substring gud-marker-acc (match-beginning 1) (match-end 1)) |
(cons (match-string 1 gud-marker-acc) |
1196 |
(string-to-int (substring gud-marker-acc |
(string-to-int (match-string 3 gud-marker-acc))) |
|
(match-beginning 3) |
|
|
(match-end 3)))) |
|
1197 |
|
|
1198 |
;; Append any text before the marker to the output we're going |
;; Append any text before the marker to the output we're going |
1199 |
;; to return - we don't include the marker in this text. |
;; to return - we don't include the marker in this text. |
1223 |
|
|
1224 |
output)) |
output)) |
1225 |
|
|
1226 |
(defun gud-perldb-find-file (f) |
(defcustom gud-perldb-command-name "perl -d" |
1227 |
(find-file-noselect f)) |
"Default command to execute a Perl script under debugger." |
|
|
|
|
(defcustom gud-perldb-command-name "perl" |
|
|
"File name for executing Perl." |
|
1228 |
:type 'string |
:type 'string |
1229 |
:group 'gud) |
:group 'gud) |
1230 |
|
|
1238 |
(concat (or (buffer-file-name) "-e 0") " ")))) |
(concat (or (buffer-file-name) "-e 0") " ")))) |
1239 |
|
|
1240 |
(gud-common-init command-line 'gud-perldb-massage-args |
(gud-common-init command-line 'gud-perldb-massage-args |
1241 |
'gud-perldb-marker-filter 'gud-perldb-find-file) |
'gud-perldb-marker-filter) |
1242 |
(set (make-local-variable 'gud-minor-mode) 'perldb) |
(set (make-local-variable 'gud-minor-mode) 'perldb) |
1243 |
|
|
1244 |
(gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") |
(gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") |
1251 |
; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") |
; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") |
1252 |
(gud-def gud-print "%e" "\C-p" "Evaluate perl expression at point.") |
(gud-def gud-print "%e" "\C-p" "Evaluate perl expression at point.") |
1253 |
|
|
1254 |
(setq comint-prompt-regexp "^ DB<+[0-9]+>+ ") |
(setq comint-prompt-regexp "^ DB<+[0-9]+>+ ") |
1255 |
(setq paragraph-start comint-prompt-regexp) |
(setq paragraph-start comint-prompt-regexp) |
1256 |
(run-hooks 'perldb-mode-hook)) |
(run-hooks 'perldb-mode-hook)) |
1257 |
|
|
1258 |
;; ====================================================================== |
;; ====================================================================== |
1259 |
;; pdb (Python debugger) functions |
;; pdb (Python debugger) functions |
1260 |
|
|
1261 |
;;; History of argument lists passed to pdb. |
;; History of argument lists passed to pdb. |
1262 |
(defvar gud-pdb-history nil) |
(defvar gud-pdb-history nil) |
1263 |
|
|
|
(defun gud-pdb-massage-args (file args) |
|
|
args) |
|
|
|
|
1264 |
;; Last group is for return value, e.g. "> test.py(2)foo()->None" |
;; Last group is for return value, e.g. "> test.py(2)foo()->None" |
1265 |
;; Either file or function name may be omitted: "> <string>(0)?()" |
;; Either file or function name may be omitted: "> <string>(0)?()" |
1266 |
(defvar gud-pdb-marker-regexp |
(defvar gud-pdb-marker-regexp |
1267 |
"^> \\([-a-zA-Z0-9_/.]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\)()\\(->[^\n]*\\)?\n") |
"^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\)()\\(->[^\n]*\\)?\n") |
1268 |
(defvar gud-pdb-marker-regexp-file-group 1) |
(defvar gud-pdb-marker-regexp-file-group 1) |
1269 |
(defvar gud-pdb-marker-regexp-line-group 2) |
(defvar gud-pdb-marker-regexp-line-group 2) |
1270 |
(defvar gud-pdb-marker-regexp-fnname-group 3) |
(defvar gud-pdb-marker-regexp-fnname-group 3) |
1326 |
|
|
1327 |
output)) |
output)) |
1328 |
|
|
|
(defun gud-pdb-find-file (f) |
|
|
(find-file-noselect f)) |
|
|
|
|
1329 |
(defcustom gud-pdb-command-name "pdb" |
(defcustom gud-pdb-command-name "pdb" |
1330 |
"File name for executing the Python debugger. |
"File name for executing the Python debugger. |
1331 |
This should be an executable on your path, or an absolute file name." |
This should be an executable on your path, or an absolute file name." |
1340 |
(interactive |
(interactive |
1341 |
(list (gud-query-cmdline 'pdb))) |
(list (gud-query-cmdline 'pdb))) |
1342 |
|
|
1343 |
(gud-common-init command-line 'gud-pdb-massage-args |
(gud-common-init command-line nil 'gud-pdb-marker-filter) |
|
'gud-pdb-marker-filter 'gud-pdb-find-file) |
|
1344 |
(set (make-local-variable 'gud-minor-mode) 'pdb) |
(set (make-local-variable 'gud-minor-mode) 'pdb) |
1345 |
|
|
1346 |
(gud-def gud-break "break %l" "\C-b" "Set breakpoint at current line.") |
(gud-def gud-break "break %l" "\C-b" "Set breakpoint at current line.") |
1347 |
(gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") |
(gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") |
1348 |
(gud-def gud-step "step" "\C-s" "Step one source line with display.") |
(gud-def gud-step "step" "\C-s" "Step one source line with display.") |
1349 |
(gud-def gud-next "next" "\C-n" "Step one line (skip functions).") |
(gud-def gud-next "next" "\C-n" "Step one line (skip functions).") |
1350 |
(gud-def gud-cont "continue" "\C-r" "Continue with display.") |
(gud-def gud-cont "continue" "\C-r" "Continue with display.") |
1355 |
;; Is this right? |
;; Is this right? |
1356 |
(gud-def gud-statement "! %e" "\C-e" "Execute Python statement at point.") |
(gud-def gud-statement "! %e" "\C-e" "Execute Python statement at point.") |
1357 |
|
|
|
(local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish)) |
|
|
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) |
|
|
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) |
|
1358 |
;; (setq comint-prompt-regexp "^(.*pdb[+]?) *") |
;; (setq comint-prompt-regexp "^(.*pdb[+]?) *") |
1359 |
(setq comint-prompt-regexp "^(Pdb) *") |
(setq comint-prompt-regexp "^(Pdb) *") |
1360 |
(setq paragraph-start comint-prompt-regexp) |
(setq paragraph-start comint-prompt-regexp) |
1369 |
;; |
;; |
1370 |
;; CREATED: Sun Feb 22 10:46:38 1998 Derek Davies. |
;; CREATED: Sun Feb 22 10:46:38 1998 Derek Davies. |
1371 |
;; UPDATED: Nov 11, 2001 Zoltan Kemenczy |
;; UPDATED: Nov 11, 2001 Zoltan Kemenczy |
1372 |
|
;; Dec 10, 2002 Zoltan Kemenczy - added nested class support |
1373 |
;; |
;; |
1374 |
;; INVOCATION NOTES: |
;; INVOCATION NOTES: |
1375 |
;; |
;; |
1475 |
"Java/jdb classpath directories list. |
"Java/jdb classpath directories list. |
1476 |
If `gud-jdb-use-classpath' is non-nil, gud-jdb derives the `gud-jdb-classpath' |
If `gud-jdb-use-classpath' is non-nil, gud-jdb derives the `gud-jdb-classpath' |
1477 |
list automatically using the following methods in sequence |
list automatically using the following methods in sequence |
1478 |
(with subsequent successful steps overriding the results of previous |
\(with subsequent successful steps overriding the results of previous |
1479 |
steps): |
steps): |
1480 |
|
|
1481 |
1) Read the CLASSPATH environment variable, |
1) Read the CLASSPATH environment variable, |
1773 |
((string-match "-classpath\\(.+\\)" (car args)) |
((string-match "-classpath\\(.+\\)" (car args)) |
1774 |
(setq massaged-args |
(setq massaged-args |
1775 |
(append massaged-args |
(append massaged-args |
1776 |
(list "-classpath") |
(list "-classpath" |
1777 |
(list |
(setq gud-jdb-classpath-string |
1778 |
(setq gud-jdb-classpath-string |
(match-string 1 (car args))))))) |
|
(substring |
|
|
(car args) |
|
|
(match-beginning 1) (match-end 1))))))) |
|
1779 |
((string-match "-sourcepath\\(.+\\)" (car args)) |
((string-match "-sourcepath\\(.+\\)" (car args)) |
1780 |
(setq massaged-args |
(setq massaged-args |
1781 |
(append massaged-args |
(append massaged-args |
1782 |
(list "-sourcepath") |
(list "-sourcepath" |
1783 |
(list |
(setq gud-jdb-sourcepath |
1784 |
(setq gud-jdb-sourcepath |
(match-string 1 (car args))))))) |
|
(substring |
|
|
(car args) |
|
|
(match-beginning 1) (match-end 1))))))) |
|
1785 |
(t (setq massaged-args (append massaged-args (list (car args)))))) |
(t (setq massaged-args (append massaged-args (list (car args)))))) |
1786 |
(setq args (cdr args))) |
(setq args (cdr args))) |
1787 |
|
|
1813 |
;; name relative to classpath |
;; name relative to classpath |
1814 |
(filename |
(filename |
1815 |
(concat |
(concat |
1816 |
(mapconcat (lambda (x) x) |
(mapconcat 'identity |
1817 |
(split-string |
(split-string |
1818 |
;; Eliminate any subclass references in the class |
;; Eliminate any subclass references in the class |
1819 |
;; name string. These start with a "$" |
;; name string. These start with a "$" |
1868 |
(setq gud-jdb-classpath |
(setq gud-jdb-classpath |
1869 |
(gud-jdb-parse-classpath-string |
(gud-jdb-parse-classpath-string |
1870 |
(setq gud-jdb-classpath-string |
(setq gud-jdb-classpath-string |
1871 |
(substring gud-marker-acc |
(match-string 1 gud-marker-acc))))) |
|
(match-beginning 1) (match-end 1)))))) |
|
1872 |
|
|
1873 |
;; We process STRING from left to right. Each time through the |
;; We process STRING from left to right. Each time through the |
1874 |
;; following loop we process at most one marker. After we've found a |
;; following loop we process at most one marker. After we've found a |
1900 |
;; |
;; |
1901 |
;; FIXME: Java ID's are UNICODE strings, this matches ASCII |
;; FIXME: Java ID's are UNICODE strings, this matches ASCII |
1902 |
;; ID's only. |
;; ID's only. |
1903 |
|
;; |
1904 |
|
;; The "," in the last square-bracket is necessary because of |
1905 |
|
;; Sun's total disrespect for backwards compatibility in |
1906 |
|
;; reported line numbers from jdb - starting in 1.4.0 they |
1907 |
|
;; introduced a comma at the thousands position (how |
1908 |
|
;; ingenious!) |
1909 |
|
|
1910 |
"\\(\[[0-9]+\] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \ |
"\\(\[[0-9]+\] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \ |
1911 |
\\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9]+\\)" |
\\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9,]+\\)" |
1912 |
gud-marker-acc) |
gud-marker-acc) |
1913 |
|
|
1914 |
;; A good marker is one that: |
;; A good marker is one that: |
1929 |
(progn (setq gud-jdb-lowest-stack-level n) t))) |
(progn (setq gud-jdb-lowest-stack-level n) t))) |
1930 |
t) |
t) |
1931 |
(if (setq file-found |
(if (setq file-found |
1932 |
(gud-jdb-find-source |
(gud-jdb-find-source (match-string 2 gud-marker-acc))) |
|
(substring gud-marker-acc |
|
|
(match-beginning 2) |
|
|
(match-end 2)))) |
|
1933 |
(setq gud-last-frame |
(setq gud-last-frame |
1934 |
(cons file-found |
(cons file-found |
1935 |
(string-to-int |
(string-to-int |
1936 |
(substring gud-marker-acc |
(let |
1937 |
(match-beginning 4) |
((numstr (match-string 4 gud-marker-acc))) |
1938 |
(match-end 4))))) |
(if (string-match "," numstr) |
1939 |
|
(replace-match "" nil nil numstr) |
1940 |
|
numstr))))) |
1941 |
(message "Could not find source file."))) |
(message "Could not find source file."))) |
1942 |
|
|
1943 |
;; Set the accumulator to the remaining text. |
;; Set the accumulator to the remaining text. |
1957 |
;; We don't filter any debugger output so just return what we were given. |
;; We don't filter any debugger output so just return what we were given. |
1958 |
string) |
string) |
1959 |
|
|
1960 |
(defun gud-jdb-find-file (f) |
(defvar gud-jdb-command-name "jdb" "Command that executes the Java debugger.") |
|
(and (file-readable-p f) |
|
|
(find-file-noselect f))) |
|
1961 |
|
|
1962 |
;;;###autoload |
;;;###autoload |
1963 |
(defun jdb (command-line) |
(defun jdb (command-line) |
1987 |
(setq gud-jdb-classpath-string nil) ; prepare for next |
(setq gud-jdb-classpath-string nil) ; prepare for next |
1988 |
|
|
1989 |
(gud-common-init command-line 'gud-jdb-massage-args |
(gud-common-init command-line 'gud-jdb-massage-args |
1990 |
'gud-jdb-marker-filter 'gud-jdb-find-file) |
'gud-jdb-marker-filter) |
1991 |
(set (make-local-variable 'gud-minor-mode) 'jdb) |
(set (make-local-variable 'gud-minor-mode) 'jdb) |
1992 |
|
|
1993 |
;; If a -classpath option was provided, set gud-jdb-classpath |
;; If a -classpath option was provided, set gud-jdb-classpath |
2008 |
(gud-def gud-finish "step up" "\C-f" "Continue until current method returns.") |
(gud-def gud-finish "step up" "\C-f" "Continue until current method returns.") |
2009 |
(gud-def gud-up "up\C-Mwhere" "<" "Up one stack frame.") |
(gud-def gud-up "up\C-Mwhere" "<" "Up one stack frame.") |
2010 |
(gud-def gud-down "down\C-Mwhere" ">" "Up one stack frame.") |
(gud-def gud-down "down\C-Mwhere" ">" "Up one stack frame.") |
2011 |
(local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish)) |
(gud-def gud-run "run" nil "Run the program.") ;if VM start using jdb |
|
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) |
|
|
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) |
|
2012 |
|
|
2013 |
(setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ") |
(setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ") |
2014 |
(setq paragraph-start comint-prompt-regexp) |
(setq paragraph-start comint-prompt-regexp) |
2032 |
(fset 'gud-jdb-find-source 'gud-jdb-find-source-file))) |
(fset 'gud-jdb-find-source 'gud-jdb-find-source-file))) |
2033 |
|
|
2034 |
|
|
2035 |
|
;; ====================================================================== |
2036 |
|
;; |
2037 |
|
;; BASHDB support. See http://bashdb.sourceforge.net |
2038 |
|
;; |
2039 |
|
;; AUTHOR: Rocky Bernstein <rocky@panix.com> |
2040 |
|
;; |
2041 |
|
;; CREATED: Sun Nov 10 10:46:38 2002 Rocky Bernstein. |
2042 |
|
;; |
2043 |
|
;; INVOCATION NOTES: |
2044 |
|
;; |
2045 |
|
;; You invoke bashdb-mode with: |
2046 |
|
;; |
2047 |
|
;; M-x bashdb <enter> |
2048 |
|
;; |
2049 |
|
;; It responds with: |
2050 |
|
;; |
2051 |
|
;; Run bashdb (like this): bash |
2052 |
|
;; |
2053 |
|
|
2054 |
|
;; History of argument lists passed to bashdb. |
2055 |
|
(defvar gud-bashdb-history nil) |
2056 |
|
|
2057 |
|
;; Convert a command line as would be typed normally to run a script |
2058 |
|
;; into one that invokes an Emacs-enabled debugging session. |
2059 |
|
;; "--debugger" in inserted as the first switch. |
2060 |
|
|
2061 |
|
;; There's no guarantee that Emacs will hand the filter the entire |
2062 |
|
;; marker at once; it could be broken up across several strings. We |
2063 |
|
;; might even receive a big chunk with several markers in it. If we |
2064 |
|
;; receive a chunk of text which looks like it might contain the |
2065 |
|
;; beginning of a marker, we save it here between calls to the |
2066 |
|
;; filter. |
2067 |
|
(defun gud-bashdb-marker-filter (string) |
2068 |
|
(setq gud-marker-acc (concat gud-marker-acc string)) |
2069 |
|
(let ((output "")) |
2070 |
|
|
2071 |
|
;; Process all the complete markers in this chunk. |
2072 |
|
;; Format of line looks like this: |
2073 |
|
;; (/etc/init.d/ntp.init:16): |
2074 |
|
;; but we also allow DOS drive letters |
2075 |
|
;; (d:/etc/init.d/ntp.init:16): |
2076 |
|
(while (string-match "\\(^\\|\n\\)(\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\)):.*\n" |
2077 |
|
gud-marker-acc) |
2078 |
|
(setq |
2079 |
|
|
2080 |
|
;; Extract the frame position from the marker. |
2081 |
|
gud-last-frame |
2082 |
|
(cons (match-string 2 gud-marker-acc) |
2083 |
|
(string-to-int (match-string 4 gud-marker-acc))) |
2084 |
|
|
2085 |
|
;; Append any text before the marker to the output we're going |
2086 |
|
;; to return - we don't include the marker in this text. |
2087 |
|
output (concat output |
2088 |
|
(substring gud-marker-acc 0 (match-beginning 0))) |
2089 |
|
|
2090 |
|
;; Set the accumulator to the remaining text. |
2091 |
|
gud-marker-acc (substring gud-marker-acc (match-end 0)))) |
2092 |
|
|
2093 |
|
;; Does the remaining text look like it might end with the |
2094 |
|
;; beginning of another marker? If it does, then keep it in |
2095 |
|
;; gud-marker-acc until we receive the rest of it. Since we |
2096 |
|
;; know the full marker regexp above failed, it's pretty simple to |
2097 |
|
;; test for marker starts. |
2098 |
|
(if (string-match "\032.*\\'" gud-marker-acc) |
2099 |
|
(progn |
2100 |
|
;; Everything before the potential marker start can be output. |
2101 |
|
(setq output (concat output (substring gud-marker-acc |
2102 |
|
0 (match-beginning 0)))) |
2103 |
|
|
2104 |
|
;; Everything after, we save, to combine with later input. |
2105 |
|
(setq gud-marker-acc |
2106 |
|
(substring gud-marker-acc (match-beginning 0)))) |
2107 |
|
|
2108 |
|
(setq output (concat output gud-marker-acc) |
2109 |
|
gud-marker-acc "")) |
2110 |
|
|
2111 |
|
output)) |
2112 |
|
|
2113 |
|
(defcustom gud-bashdb-command-name "bash --debugger" |
2114 |
|
"File name for executing bash debugger." |
2115 |
|
:type 'string |
2116 |
|
:group 'gud) |
2117 |
|
|
2118 |
|
;;;###autoload |
2119 |
|
(defun bashdb (command-line) |
2120 |
|
"Run bashdb on program FILE in buffer *gud-FILE*. |
2121 |
|
The directory containing FILE becomes the initial working directory |
2122 |
|
and source-file directory for your debugger." |
2123 |
|
(interactive |
2124 |
|
(list (read-from-minibuffer "Run bashdb (like this): " |
2125 |
|
(if (consp gud-bashdb-history) |
2126 |
|
(car gud-bashdb-history) |
2127 |
|
(concat gud-bashdb-command-name |
2128 |
|
" ")) |
2129 |
|
gud-minibuffer-local-map nil |
2130 |
|
'(gud-bashdb-history . 1)))) |
2131 |
|
|
2132 |
|
(gud-common-init command-line nil 'gud-bashdb-marker-filter) |
2133 |
|
|
2134 |
|
(set (make-local-variable 'gud-minor-mode) 'bashdb) |
2135 |
|
|
2136 |
|
(gud-def gud-break "break %l" "\C-b" "Set breakpoint at current line.") |
2137 |
|
(gud-def gud-tbreak "tbreak %l" "\C-t" "Set temporary breakpoint at current line.") |
2138 |
|
(gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") |
2139 |
|
(gud-def gud-step "step" "\C-s" "Step one source line with display.") |
2140 |
|
(gud-def gud-next "next" "\C-n" "Step one line (skip functions).") |
2141 |
|
(gud-def gud-cont "continue" "\C-r" "Continue with display.") |
2142 |
|
(gud-def gud-finish "finish" "\C-f" "Finish executing current function.") |
2143 |
|
(gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") |
2144 |
|
(gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") |
2145 |
|
(gud-def gud-print "x %e" "\C-p" "Evaluate BASH expression at point.") |
2146 |
|
|
2147 |
|
;; Is this right? |
2148 |
|
(gud-def gud-statement "eval %e" "\C-e" "Execute BASH statement at point.") |
2149 |
|
|
2150 |
|
(setq comint-prompt-regexp "^bashdb<+(*[0-9]+)*>+ ") |
2151 |
|
(setq paragraph-start comint-prompt-regexp) |
2152 |
|
(run-hooks 'bashdb-mode-hook) |
2153 |
|
) |
2154 |
|
|
2155 |
;; |
;; |
2156 |
;; End of debugger-specific information |
;; End of debugger-specific information |
2157 |
;; |
;; |
2158 |
|
|
2159 |
|
|
2160 |
;;; When we send a command to the debugger via gud-call, it's annoying |
;; When we send a command to the debugger via gud-call, it's annoying |
2161 |
;;; to see the command and the new prompt inserted into the debugger's |
;; to see the command and the new prompt inserted into the debugger's |
2162 |
;;; buffer; we have other ways of knowing the command has completed. |
;; buffer; we have other ways of knowing the command has completed. |
2163 |
;;; |
;; |
2164 |
;;; If the buffer looks like this: |
;; If the buffer looks like this: |
2165 |
;;; -------------------- |
;; -------------------- |
2166 |
;;; (gdb) set args foo bar |
;; (gdb) set args foo bar |
2167 |
;;; (gdb) -!- |
;; (gdb) -!- |
2168 |
;;; -------------------- |
;; -------------------- |
2169 |
;;; (the -!- marks the location of point), and we type `C-x SPC' in a |
;; (the -!- marks the location of point), and we type `C-x SPC' in a |
2170 |
;;; source file to set a breakpoint, we want the buffer to end up like |
;; source file to set a breakpoint, we want the buffer to end up like |
2171 |
;;; this: |
;; this: |
2172 |
;;; -------------------- |
;; -------------------- |
2173 |
;;; (gdb) set args foo bar |
;; (gdb) set args foo bar |
2174 |
;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49. |
;; Breakpoint 1 at 0x92: file make-docfile.c, line 49. |
2175 |
;;; (gdb) -!- |
;; (gdb) -!- |
2176 |
;;; -------------------- |
;; -------------------- |
2177 |
;;; Essentially, the old prompt is deleted, and the command's output |
;; Essentially, the old prompt is deleted, and the command's output |
2178 |
;;; and the new prompt take its place. |
;; and the new prompt take its place. |
2179 |
;;; |
;; |
2180 |
;;; Not echoing the command is easy enough; you send it directly using |
;; Not echoing the command is easy enough; you send it directly using |
2181 |
;;; process-send-string, and it never enters the buffer. However, |
;; process-send-string, and it never enters the buffer. However, |
2182 |
;;; getting rid of the old prompt is trickier; you don't want to do it |
;; getting rid of the old prompt is trickier; you don't want to do it |
2183 |
;;; when you send the command, since that will result in an annoying |
;; when you send the command, since that will result in an annoying |
2184 |
;;; flicker as the prompt is deleted, redisplay occurs while Emacs |
;; flicker as the prompt is deleted, redisplay occurs while Emacs |
2185 |
;;; waits for a response from the debugger, and the new prompt is |
;; waits for a response from the debugger, and the new prompt is |
2186 |
;;; inserted. Instead, we'll wait until we actually get some output |
;; inserted. Instead, we'll wait until we actually get some output |
2187 |
;;; from the subprocess before we delete the prompt. If the command |
;; from the subprocess before we delete the prompt. If the command |
2188 |
;;; produced no output other than a new prompt, that prompt will most |
;; produced no output other than a new prompt, that prompt will most |
2189 |
;;; likely be in the first chunk of output received, so we will delete |
;; likely be in the first chunk of output received, so we will delete |
2190 |
;;; the prompt and then replace it with an identical one. If the |
;; the prompt and then replace it with an identical one. If the |
2191 |
;;; command produces output, the prompt is moving anyway, so the |
;; command produces output, the prompt is moving anyway, so the |
2192 |
;;; flicker won't be annoying. |
;; flicker won't be annoying. |
2193 |
;;; |
;; |
2194 |
;;; So - when we want to delete the prompt upon receipt of the next |
;; So - when we want to delete the prompt upon receipt of the next |
2195 |
;;; chunk of debugger output, we position gud-delete-prompt-marker at |
;; chunk of debugger output, we position gud-delete-prompt-marker at |
2196 |
;;; the start of the prompt; the process filter will notice this, and |
;; the start of the prompt; the process filter will notice this, and |
2197 |
;;; delete all text between it and the process output marker. If |
;; delete all text between it and the process output marker. If |
2198 |
;;; gud-delete-prompt-marker points nowhere, we leave the current |
;; gud-delete-prompt-marker points nowhere, we leave the current |
2199 |
;;; prompt alone. |
;; prompt alone. |
2200 |
(defvar gud-delete-prompt-marker nil) |
(defvar gud-delete-prompt-marker nil) |
2201 |
|
|
2202 |
|
|
2259 |
(setq mode-line-process '(":%s")) |
(setq mode-line-process '(":%s")) |
2260 |
(define-key (current-local-map) "\C-c\C-l" 'gud-refresh) |
(define-key (current-local-map) "\C-c\C-l" 'gud-refresh) |
2261 |
(set (make-local-variable 'gud-last-frame) nil) |
(set (make-local-variable 'gud-last-frame) nil) |
2262 |
|
(set (make-local-variable 'tool-bar-map) gud-tool-bar-map) |
2263 |
(make-local-variable 'comint-prompt-regexp) |
(make-local-variable 'comint-prompt-regexp) |
2264 |
;; Don't put repeated commands in command history many times. |
;; Don't put repeated commands in command history many times. |
2265 |
(set (make-local-variable 'comint-input-ignoredups) t) |
(set (make-local-variable 'comint-input-ignoredups) t) |
2275 |
:group 'gud |
:group 'gud |
2276 |
:type 'boolean) |
:type 'boolean) |
2277 |
|
|
2278 |
|
(defvar gud-target-name "--unknown--" |
2279 |
|
"The apparent name of the program being debugged in a gud buffer.") |
2280 |
|
|
2281 |
;; Perform initializations common to all debuggers. |
;; Perform initializations common to all debuggers. |
2282 |
;; The first arg is the specified command line, |
;; The first arg is the specified command line, |
2283 |
;; which starts with the program to debug. |
;; which starts with the program to debug. |
2284 |
;; The other three args specify the values to use |
;; The other three args specify the values to use |
2285 |
;; for local variables in the debugger buffer. |
;; for local variables in the debugger buffer. |
2286 |
(defun gud-common-init (command-line massage-args marker-filter &optional find-file) |
(defun gud-common-init (command-line massage-args marker-filter |
2287 |
|
&optional find-file) |
2288 |
(let* ((words (split-string command-line)) |
(let* ((words (split-string command-line)) |
2289 |
(program (car words)) |
(program (car words)) |
2290 |
|
(dir default-directory) |
2291 |
;; Extract the file name from WORDS |
;; Extract the file name from WORDS |
2292 |
;; and put t in its place. |
;; and put t in its place. |
2293 |
;; Later on we will put the modified file name arg back there. |
;; Later on we will put the modified file name arg back there. |
2311 |
file-subst))) |
file-subst))) |
2312 |
(filepart (and file-word (concat "-" (file-name-nondirectory file))))) |
(filepart (and file-word (concat "-" (file-name-nondirectory file))))) |
2313 |
(pop-to-buffer (concat "*gud" filepart "*")) |
(pop-to-buffer (concat "*gud" filepart "*")) |
2314 |
|
;; Set the dir, in case the buffer already existed with a different dir. |
2315 |
|
(setq default-directory dir) |
2316 |
;; Set default-directory to the file's directory. |
;; Set default-directory to the file's directory. |
2317 |
(and file-word |
(and file-word |
2318 |
gud-chdir-before-run |
gud-chdir-before-run |
2332 |
(if w |
(if w |
2333 |
(setcar w file))) |
(setcar w file))) |
2334 |
(apply 'make-comint (concat "gud" filepart) program nil |
(apply 'make-comint (concat "gud" filepart) program nil |
2335 |
(funcall massage-args file args))) |
(if massage-args (funcall massage-args file args) args)) |
2336 |
;; Since comint clobbered the mode, we don't set it until now. |
;; Since comint clobbered the mode, we don't set it until now. |
2337 |
(gud-mode) |
(gud-mode) |
2338 |
(make-local-variable 'gud-marker-filter) |
(set (make-local-variable 'gud-target-name) |
2339 |
(setq gud-marker-filter marker-filter) |
(and file-word (file-name-nondirectory file)))) |
2340 |
|
(set (make-local-variable 'gud-marker-filter) marker-filter) |
2341 |
(if find-file (set (make-local-variable 'gud-find-file) find-file)) |
(if find-file (set (make-local-variable 'gud-find-file) find-file)) |
2342 |
|
(setq gud-running nil) |
2343 |
|
(setq gud-last-last-frame nil) |
2344 |
|
|
2345 |
(set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) |
(set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) |
2346 |
(set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) |
(set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) |
2429 |
;; buffer killed |
;; buffer killed |
2430 |
;; Stop displaying an arrow in a source file. |
;; Stop displaying an arrow in a source file. |
2431 |
(setq overlay-arrow-position nil) |
(setq overlay-arrow-position nil) |
2432 |
(set-process-buffer proc nil)) |
(set-process-buffer proc nil) |
2433 |
|
(if (eq gud-minor-mode-type 'gdba) |
2434 |
|
(gdb-reset) |
2435 |
|
(gud-reset))) |
2436 |
((memq (process-status proc) '(signal exit)) |
((memq (process-status proc) '(signal exit)) |
2437 |
;; Stop displaying an arrow in a source file. |
;; Stop displaying an arrow in a source file. |
2438 |
(setq overlay-arrow-position nil) |
(setq overlay-arrow-position nil) |
2439 |
|
(with-current-buffer gud-comint-buffer |
2440 |
|
(if (eq gud-minor-mode 'gdba) |
2441 |
|
(gdb-reset) |
2442 |
|
(gud-reset))) |
2443 |
(let* ((obuf (current-buffer))) |
(let* ((obuf (current-buffer))) |
2444 |
;; save-excursion isn't the right thing if |
;; save-excursion isn't the right thing if |
2445 |
;; process-buffer is current-buffer |
;; process-buffer is current-buffer |
2465 |
;; if obuf is the gud buffer. |
;; if obuf is the gud buffer. |
2466 |
(set-buffer obuf)))))) |
(set-buffer obuf)))))) |
2467 |
|
|
2468 |
|
(defvar gud-minor-mode-type nil) |
2469 |
|
|
2470 |
|
(defun gud-kill-buffer-hook () |
2471 |
|
(if gud-minor-mode |
2472 |
|
(setq gud-minor-mode-type gud-minor-mode))) |
2473 |
|
|
2474 |
|
(add-hook 'kill-buffer-hook 'gud-kill-buffer-hook) |
2475 |
|
|
2476 |
|
(defun gud-reset () |
2477 |
|
(dolist (buffer (buffer-list)) |
2478 |
|
(if (not (eq buffer gud-comint-buffer)) |
2479 |
|
(save-excursion |
2480 |
|
(set-buffer buffer) |
2481 |
|
(when gud-minor-mode |
2482 |
|
(setq gud-minor-mode nil) |
2483 |
|
(kill-local-variable 'tool-bar-map)))))) |
2484 |
|
|
2485 |
(defun gud-display-frame () |
(defun gud-display-frame () |
2486 |
"Find and obey the last filename-and-line marker from the debugger. |
"Find and obey the last filename-and-line marker from the debugger. |
2487 |
Obeying it means displaying in another window the specified file and line." |
Obeying it means displaying in another window the specified file and line." |
2488 |
(interactive) |
(interactive) |
2489 |
(if gud-last-frame |
(when gud-last-frame |
2490 |
(progn |
(gud-set-buffer) |
2491 |
(gud-set-buffer) |
(gud-display-line (car gud-last-frame) (cdr gud-last-frame)) |
2492 |
(gud-display-line (car gud-last-frame) (cdr gud-last-frame)) |
(setq gud-last-last-frame gud-last-frame |
2493 |
(setq gud-last-last-frame gud-last-frame |
gud-last-frame nil))) |
|
gud-last-frame nil)))) |
|
2494 |
|
|
2495 |
;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen |
;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen |
2496 |
;; and that its line LINE is visible. |
;; and that its line LINE is visible. |
2502 |
(defun gud-display-line (true-file line) |
(defun gud-display-line (true-file line) |
2503 |
(let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions. |
(let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions. |
2504 |
(buffer |
(buffer |
2505 |
(save-excursion |
(with-current-buffer gud-comint-buffer |
|
(or (eq (current-buffer) gud-comint-buffer) |
|
|
(set-buffer gud-comint-buffer)) |
|
2506 |
(gud-find-file true-file))) |
(gud-find-file true-file))) |
2507 |
(window (and buffer (or (get-buffer-window buffer) |
(window (and buffer (or (get-buffer-window buffer) |
2508 |
(display-buffer buffer)))) |
(if (eq gud-minor-mode 'gdba) |
2509 |
|
(gdb-display-source-buffer buffer) |
2510 |
|
(display-buffer buffer))))) |
2511 |
(pos)) |
(pos)) |
2512 |
(if buffer |
(if buffer |
2513 |
(progn |
(progn |
2514 |
(save-excursion |
(with-current-buffer buffer |
2515 |
(set-buffer buffer) |
(if (not (or (verify-visited-file-modtime buffer) gud-keep-buffer)) |
2516 |
|
(progn |
2517 |
|
(if |
2518 |
|
(yes-or-no-p |
2519 |
|
(format "File %s changed on disk. Reread from disk? " |
2520 |
|
(buffer-name))) |
2521 |
|
(revert-buffer t t) |
2522 |
|
(setq gud-keep-buffer t)))) |
2523 |
(save-restriction |
(save-restriction |
2524 |
(widen) |
(widen) |
2525 |
(goto-line line) |
(goto-line line) |
2526 |
(setq pos (point)) |
(setq pos (point)) |
2527 |
(setq overlay-arrow-string "=>") |
(setq overlay-arrow-string "=>") |
2528 |
(or overlay-arrow-position |
(or overlay-arrow-position |
2529 |
(setq overlay-arrow-position (make-marker))) |
(setq overlay-arrow-position (make-marker))) |
2530 |
(set-marker overlay-arrow-position (point) (current-buffer))) |
(set-marker overlay-arrow-position (point) (current-buffer))) |
2531 |
(cond ((or (< pos (point-min)) (> pos (point-max))) |
(cond ((or (< pos (point-min)) (> pos (point-max))) |
2532 |
(widen) |
(widen) |
2533 |
(goto-char pos)))) |
(goto-char pos)))) |
2534 |
(set-window-point window overlay-arrow-position))))) |
(set-window-point window overlay-arrow-position))))) |
2535 |
|
|
2536 |
;;; The gud-call function must do the right thing whether its invoking |
;; The gud-call function must do the right thing whether its invoking |
2537 |
;;; keystroke is from the GUD buffer itself (via major-mode binding) |
;; keystroke is from the GUD buffer itself (via major-mode binding) |
2538 |
;;; or a C buffer. In the former case, we want to supply data from |
;; or a C buffer. In the former case, we want to supply data from |
2539 |
;;; gud-last-frame. Here's how we do it: |
;; gud-last-frame. Here's how we do it: |
2540 |
|
|
2541 |
(defun gud-format-command (str arg) |
(defun gud-format-command (str arg) |
2542 |
(let ((insource (not (eq (current-buffer) gud-comint-buffer))) |
(let ((insource (not (eq (current-buffer) gud-comint-buffer))) |
2543 |
(frame (or gud-last-frame gud-last-last-frame)) |
(frame (or gud-last-frame gud-last-last-frame)) |
2544 |
result) |
result) |
2545 |
(while (and str (string-match "\\([^%]*\\)%\\([adeflpc]\\)" str)) |
(while (and str (string-match "\\([^%]*\\)%\\([adeflpc]\\)" str)) |
2546 |
(let ((key (string-to-char (substring str (match-beginning 2)))) |
(let ((key (string-to-char (match-string 2 str))) |
2547 |
subst) |
subst) |
2548 |
(cond |
(cond |
2549 |
((eq key ?f) |
((eq key ?f) |
2564 |
(if insource |
(if insource |
2565 |
(save-restriction |
(save-restriction |
2566 |
(widen) |
(widen) |
2567 |
(+ (count-lines 1 (point)) |
(+ (count-lines (point-min) (point)) |
2568 |
(if (bolp) 1 0))) |
(if (bolp) 1 0))) |
2569 |
(cdr frame))))) |
(cdr frame))))) |
2570 |
((eq key ?e) |
((eq key ?e) |
2572 |
((eq key ?a) |
((eq key ?a) |
2573 |
(setq subst (gud-read-address))) |
(setq subst (gud-read-address))) |
2574 |
((eq key ?c) |
((eq key ?c) |
2575 |
(setq subst (gud-find-class (if insource |
(setq subst |
2576 |
(buffer-file-name) |
(gud-find-class |
2577 |
(car frame))))) |
(if insource |
2578 |
|
(buffer-file-name) |
2579 |
|
(car frame)) |
2580 |
|
(if insource |
2581 |
|
(save-restriction |
2582 |
|
(widen) |
2583 |
|
(+ (count-lines (point-min) (point)) |
2584 |
|
(if (bolp) 1 0))) |
2585 |
|
(cdr frame))))) |
2586 |
((eq key ?p) |
((eq key ?p) |
2587 |
(setq subst (if arg (int-to-string arg))))) |
(setq subst (if arg (int-to-string arg))))) |
2588 |
(setq result (concat result (match-string 1 str) subst))) |
(setq result (concat result (match-string 1 str) subst))) |
2592 |
|
|
2593 |
(defun gud-read-address () |
(defun gud-read-address () |
2594 |
"Return a string containing the core-address found in the buffer at point." |
"Return a string containing the core-address found in the buffer at point." |
2595 |
(save-excursion |
(save-match-data |
2596 |
(let ((pt (point)) found begin) |
(save-excursion |
2597 |
(setq found (if (search-backward "0x" (- pt 7) t) (point))) |
(let ((pt (point)) found begin) |
2598 |
(cond |
(setq found (if (search-backward "0x" (- pt 7) t) (point))) |
2599 |
(found (forward-char 2) |
(cond |
2600 |
(buffer-substring found |
(found (forward-char 2) |
2601 |
(progn (re-search-forward "[^0-9a-f]") |
(buffer-substring found |
2602 |
(forward-char -1) |
(progn (re-search-forward "[^0-9a-f]") |
2603 |
(point)))) |
(forward-char -1) |
2604 |
(t (setq begin (progn (re-search-backward "[^0-9]") |
(point)))) |
2605 |
(forward-char 1) |
(t (setq begin (progn (re-search-backward "[^0-9]") |
2606 |
(point))) |
(forward-char 1) |
2607 |
(forward-char 1) |
(point))) |
2608 |
(re-search-forward "[^0-9]") |
(forward-char 1) |
2609 |
(forward-char -1) |
(re-search-forward "[^0-9]") |
2610 |
(buffer-substring begin (point))))))) |
(forward-char -1) |
2611 |
|
(buffer-substring begin (point)))))))) |
2612 |
|
|
2613 |
(defun gud-call (fmt &optional arg) |
(defun gud-call (fmt &optional arg) |
2614 |
(let ((msg (gud-format-command fmt arg))) |
(let ((msg (gud-format-command fmt arg))) |
2620 |
"Invoke the debugger COMMAND displaying source in other window." |
"Invoke the debugger COMMAND displaying source in other window." |
2621 |
(interactive) |
(interactive) |
2622 |
(gud-set-buffer) |
(gud-set-buffer) |
2623 |
(let ((command (concat command "\n")) |
(let ((proc (get-buffer-process gud-comint-buffer))) |
|
(proc (get-buffer-process gud-comint-buffer))) |
|
2624 |
(or proc (error "Current buffer has no process")) |
(or proc (error "Current buffer has no process")) |
2625 |
;; Arrange for the current prompt to get deleted. |
;; Arrange for the current prompt to get deleted. |
2626 |
(save-excursion |
(save-excursion |
2630 |
(goto-char (process-mark proc)) |
(goto-char (process-mark proc)) |
2631 |
(forward-line 0) |
(forward-line 0) |
2632 |
(if (looking-at comint-prompt-regexp) |
(if (looking-at comint-prompt-regexp) |
2633 |
(set-marker gud-delete-prompt-marker (point))))) |
(set-marker gud-delete-prompt-marker (point))) |
2634 |
(process-send-string proc command))) |
(if (eq gud-minor-mode 'gdba) |
2635 |
|
(apply comint-input-sender (list proc command)) |
2636 |
|
(process-send-string proc (concat command "\n"))))))) |
2637 |
|
|
2638 |
(defun gud-refresh (&optional arg) |
(defun gud-refresh (&optional arg) |
2639 |
"Fix up a possibly garbled display, and redraw the arrow." |
"Fix up a possibly garbled display, and redraw the arrow." |
2642 |
(gud-display-frame) |
(gud-display-frame) |
2643 |
(recenter arg)) |
(recenter arg)) |
2644 |
|
|
2645 |
;;; Code for parsing expressions out of C code. The single entry point is |
;; Code for parsing expressions out of C code. The single entry point is |
2646 |
;;; find-c-expr, which tries to return an lvalue expression from around point. |
;; find-c-expr, which tries to return an lvalue expression from around point. |
2647 |
;;; |
;; |
2648 |
;;; The rest of this file is a hacked version of gdbsrc.el by |
;; The rest of this file is a hacked version of gdbsrc.el by |
2649 |
;;; Debby Ayers <ayers@asc.slb.com>, |
;; Debby Ayers <ayers@asc.slb.com>, |
2650 |
;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx. |
;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx. |
2651 |
|
|
2652 |
(defun gud-find-c-expr () |
(defun gud-find-c-expr () |
2653 |
"Returns the C expr that surrounds point." |
"Returns the C expr that surrounds point." |
2786 |
(t nil))) |
(t nil))) |
2787 |
(t nil)))) |
(t nil)))) |
2788 |
|
|
2789 |
(defun gud-find-class (f) |
(defun gud-find-class (f line) |
2790 |
"Find fully qualified class corresponding to file F. |
"Find fully qualified class in file F at line LINE. |
2791 |
This function uses the `gud-jdb-classpath' (and optional |
This function uses the `gud-jdb-classpath' (and optional |
2792 |
`gud-jdb-sourcepath') list(s) to derive a file |
`gud-jdb-sourcepath') list(s) to derive a file |
2793 |
pathname relative to its classpath directory. The values in |
pathname relative to its classpath directory. The values in |
2794 |
`gud-jdb-classpath' are assumed to have been converted to absolute |
`gud-jdb-classpath' are assumed to have been converted to absolute |
2795 |
pathname standards using file-truename." |
pathname standards using file-truename. |
2796 |
|
If F is visited by a buffer and its mode is CC-mode(Java), |
2797 |
|
syntactic information of LINE is used to find the enclosing (nested) |
2798 |
|
class string which is appended to the top level |
2799 |
|
class of the file (using s to separate nested class ids)." |
2800 |
;; Convert f to a standard representation and remove suffix |
;; Convert f to a standard representation and remove suffix |
2801 |
(if (and gud-jdb-use-classpath (or gud-jdb-classpath gud-jdb-sourcepath)) |
(if (and gud-jdb-use-classpath (or gud-jdb-classpath gud-jdb-sourcepath)) |
2802 |
(save-match-data |
(save-match-data |
2803 |
(let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath)) |
(let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath)) |
2804 |
class-found) |
(fbuffer (get-file-buffer f)) |
2805 |
(setq f (file-name-sans-extension (file-truename f))) |
class-found) |
2806 |
;; Search through classpath list for an entry that is |
(setq f (file-name-sans-extension (file-truename f))) |
2807 |
;; contained in f |
;; Search through classpath list for an entry that is |
2808 |
(while (and cplist (not class-found)) |
;; contained in f |
2809 |
(if (string-match (car cplist) f) |
(while (and cplist (not class-found)) |
2810 |
(setq class-found |
(if (string-match (car cplist) f) |
2811 |
(mapconcat (lambda(x) x) |
(setq class-found |
2812 |
(split-string |
(mapconcat 'identity |
2813 |
(substring f (+ (match-end 0) 1)) |
(split-string |
2814 |
"/") "."))) |
(substring f (+ (match-end 0) 1)) |
2815 |
(setq cplist (cdr cplist))) |
"/") "."))) |
2816 |
(if (not class-found) |
(setq cplist (cdr cplist))) |
2817 |
(message "gud-find-class: class for file %s not found!" f)) |
;; if f is visited by a java(cc-mode) buffer, walk up the |
2818 |
class-found)) |
;; syntactic information chain and collect any 'inclass |
2819 |
|
;; symbols until 'topmost-intro is reached to find out if |
2820 |
|
;; point is within a nested class |
2821 |
|
(if (and fbuffer (equal (symbol-file 'java-mode) "cc-mode")) |
2822 |
|
(save-excursion |
2823 |
|
(set-buffer fbuffer) |
2824 |
|
(let ((nclass) (syntax) |
2825 |
|
(pos (point))) |
2826 |
|
;; While the c-syntactic information does not start |
2827 |
|
;; with the 'topmost-intro symbol, there may be |
2828 |
|
;; nested classes... |
2829 |
|
(while (not (eq 'topmost-intro |
2830 |
|
(car (car (c-guess-basic-syntax))))) |
2831 |
|
;; Check if the current position c-syntactic |
2832 |
|
;; analysis has 'inclass |
2833 |
|
(setq syntax (c-guess-basic-syntax)) |
2834 |
|
(while |
2835 |
|
(and (not (eq 'inclass (car (car syntax)))) |
2836 |
|
(cdr syntax)) |
2837 |
|
(setq syntax (cdr syntax))) |
2838 |
|
(if (eq 'inclass (car (car syntax))) |
2839 |
|
(progn |
2840 |
|
(goto-char (cdr (car syntax))) |
2841 |
|
;; Now we're at the beginning of a class |
2842 |
|
;; definition. Find class name |
2843 |
|
(looking-at |
2844 |
|
"[A-Za-z0-9 \t\n]*?class[ \t\n]+\\([^ \t\n]+\\)") |
2845 |
|
(setq nclass |
2846 |
|
(append (list (match-string-no-properties 1)) |
2847 |
|
nclass))) |
2848 |
|
(setq syntax (c-guess-basic-syntax)) |
2849 |
|
(while (and (not (cdr (car syntax))) (cdr syntax)) |
2850 |
|
(setq syntax (cdr syntax))) |
2851 |
|
(goto-char (cdr (car syntax))) |
2852 |
|
)) |
2853 |
|
(string-match (concat (car nclass) "$") class-found) |
2854 |
|
(setq class-found |
2855 |
|
(replace-match (mapconcat 'identity nclass "$") |
2856 |
|
t t class-found))))) |
2857 |
|
(if (not class-found) |
2858 |
|
(message "gud-find-class: class for file %s not found!" f)) |
2859 |
|
class-found)) |
2860 |
;; Not using classpath - try class/source association list |
;; Not using classpath - try class/source association list |
2861 |
(let ((class-found (rassoc f gud-jdb-class-source-alist))) |
(let ((class-found (rassoc f gud-jdb-class-source-alist))) |
2862 |
(if class-found |
(if class-found |