/[emacs]/emacs/lisp/gud.el
ViewVC logotype

Diff of /emacs/lisp/gud.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.157 by eliz, Wed Mar 27 16:32:15 2002 UTC revision 1.157.2.1 by miles, Fri Apr 4 06:20:06 2003 UTC
# Line 47  Line 47 
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    
# Line 71  Supported debuggers include gdb, sdb, db Line 71  Supported debuggers include gdb, sdb, db
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.
# Line 85  If SOFT is non-nil, returns nil if the s Line 87  If SOFT is non-nil, returns nil if the s
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    
# Line 129  If SOFT is non-nil, returns nil if the s Line 144  If SOFT is non-nil, returns nil if the s
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
# Line 162  step (if we're in the GUD buffer). Line 226  step (if we're in the GUD buffer).
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
# Line 214  we're in the GUD buffer)." Line 273  we're in the GUD buffer)."
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.")
# Line 255  off the specialized speedbar mode." Line 314  off the specialized speedbar mode."
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)
# Line 287  off the specialized speedbar mode." Line 344  off the specialized speedbar mode."
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))
# Line 303  off the specialized speedbar mode." Line 360  off the specialized speedbar mode."
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 ":";
# Line 334  off the specialized speedbar mode." Line 393  off the specialized speedbar mode."
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.
# Line 368  off the specialized speedbar mode." Line 424  off the specialized speedbar mode."
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."
# Line 383  off the specialized speedbar mode." Line 436  off the specialized speedbar mode."
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    
# Line 394  The directory containing FILE becomes th Line 456  The directory containing FILE becomes th
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.")
# Line 411  and source-file directory for your debug Line 472  and source-file directory for your debug
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)
# Line 427  and source-file directory for your debug Line 486  and source-file directory for your debug
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    
# Line 447  available with older versions of GDB." Line 506  available with older versions of GDB."
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)))
# Line 480  available with older versions of GDB." Line 531  available with older versions of GDB."
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
# Line 520  available with older versions of GDB." Line 574  available with older versions of GDB."
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.
# Line 537  available with older versions of GDB." Line 588  available with older versions of GDB."
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)))
# Line 566  available with older versions of GDB." Line 616  available with older versions of GDB."
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)
# Line 587  BUFFER is the GUD buffer in which to run Line 635  BUFFER is the GUD buffer in which to run
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"))
# Line 629  BUFFER is the GUD buffer in which to run Line 660  BUFFER is the GUD buffer in which to run
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))
# Line 642  BUFFER is the GUD buffer in which to run Line 671  BUFFER is the GUD buffer in which to run
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)))
# Line 696  and source-file directory for your debug Line 717  and source-file directory for your debug
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.")
# Line 711  and source-file directory for your debug Line 731  and source-file directory for your debug
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
# Line 743  containing the executable being debugged Line 761  containing the executable being debugged
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    
# Line 769  containing the executable being debugged Line 773  containing the executable being debugged
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
# Line 799  containing the executable being debugged Line 801  containing the executable being debugged
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
# Line 818  containing the executable being debugged Line 820  containing the executable being debugged
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.
# Line 925  a better solution in 6.1 upwards.") Line 925  a better solution in 6.1 upwards.")
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    
# Line 982  This was tested using R4.11.") Line 973  This was tested using R4.11.")
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
# Line 1001  This was tested using R4.11.") Line 990  This was tested using R4.11.")
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*.
# Line 1016  and source-file directory for your debug Line 999  and source-file directory for your debug
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    
# Line 1066  and source-file directory for your debug Line 1048  and source-file directory for your debug
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
# Line 1098  containing the executable being debugged Line 1078  containing the executable being debugged
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)
# Line 1123  containing the executable being debugged Line 1089  containing the executable being debugged
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*.
# Line 1150  directories if your program contains sou Line 1108  directories if your program contains sou
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.")
# Line 1167  directories if your program contains sou Line 1125  directories if your program contains sou
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
# Line 1239  directories if your program contains sou Line 1192  directories if your program contains sou
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.
# Line 1272  directories if your program contains sou Line 1223  directories if your program contains sou
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    
# Line 1290  and source-file directory for your debug Line 1238  and source-file directory for your debug
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.")
# Line 1303  and source-file directory for your debug Line 1251  and source-file directory for your debug
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)
# Line 1381  and source-file directory for your debug Line 1326  and source-file directory for your debug
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."
# Line 1398  and source-file directory for your debug Line 1340  and source-file directory for your debug
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.")
# Line 1414  and source-file directory for your debug Line 1355  and source-file directory for your debug
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)
# Line 1431  and source-file directory for your debug Line 1369  and source-file directory for your debug
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  ;;  ;;
# Line 1536  class information on jdb startup (origin Line 1475  class information on jdb startup (origin
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,
# Line 1834  extension EXTN.  Normally EXTN is given Line 1773  extension EXTN.  Normally EXTN is given
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    
# Line 1880  relative to a classpath directory." Line 1813  relative to a classpath directory."
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 "$"
# Line 1935  nil) Line 1868  nil)
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
# Line 1968  nil) Line 1900  nil)
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:
# Line 1990  nil) Line 1929  nil)
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.
# Line 2019  nil) Line 1957  nil)
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)
# Line 2051  gud, see `gud-mode'." Line 1987  gud, see `gud-mode'."
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
# Line 2072  gud, see `gud-mode'." Line 2008  gud, see `gud-mode'."
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)
# Line 2098  gud, see `gud-mode'." Line 2032  gud, see `gud-mode'."
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    
# Line 2205  comint mode, which see." Line 2259  comint mode, which see."
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)
# Line 2220  comint mode, which see." Line 2275  comint mode, which see."
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.
# Line 2251  comint mode, which see." Line 2311  comint mode, which see."
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
# Line 2270  comint mode, which see." Line 2332  comint mode, which see."
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)
# Line 2364  It is saved for when this flag is not se Line 2429  It is saved for when this flag is not se
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
# Line 2393  It is saved for when this flag is not se Line 2465  It is saved for when this flag is not se
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.
# Line 2414  Obeying it means displaying in another w Line 2502  Obeying it means displaying in another w
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)
# Line 2469  Obeying it means displaying in another w Line 2564  Obeying it means displaying in another w
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)
# Line 2477  Obeying it means displaying in another w Line 2572  Obeying it means displaying in another w
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)))
# Line 2489  Obeying it means displaying in another w Line 2592  Obeying it means displaying in another w
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)))
# Line 2516  Obeying it means displaying in another w Line 2620  Obeying it means displaying in another w
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
# Line 2527  Obeying it means displaying in another w Line 2630  Obeying it means displaying in another w
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."
# Line 2537  Obeying it means displaying in another w Line 2642  Obeying it means displaying in another w
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."
# Line 2681  Link exprs of the form: Line 2786  Link exprs of the form:
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

Legend:
Removed from v.1.157  
changed lines
  Added in v.1.157.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26