comparison lisp/gud.el @ 2489:b626f5b9a0df

Massive changes, amounting nearly to a rewrite. The new features include auto-configuring support for SVr4, more commands, and a full minor-mode implementation that binds all GUD commands not just in the GUD interaction mode, but in C buffers visited by GUD. The common prefix of GUD commands is now C-x X, like electric-debug mode.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Thu, 08 Apr 1993 16:35:48 +0000
parents 6eb6b48f6bf1
children d567a93d9408
comparison
equal deleted inserted replaced
2488:278580be9b4a 2489:b626f5b9a0df
1 ;;; gud.el --- Grand Unified Debugger mode for gdb, sdb, or dbx under Emacs 1 ;;; gud.el --- Grand Unified Debugger mode for gdb, sdb, or dbx under Emacs
2 2
3 ;; Author: Eric S. Raymond <eric@snark.thyrsus.com> 3 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
4 ;; Version: 1.1
4 ;; Keywords: unix, tools 5 ;; Keywords: unix, tools
5
6 ;; %W%
7 6
8 ;; Copyright (C) 1992 Free Software Foundation, Inc. 7 ;; Copyright (C) 1992 Free Software Foundation, Inc.
9 8
10 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
11 10
29 ;; It was later rewritten by rms. Some ideas were due to Masanobu. 28 ;; It was later rewritten by rms. Some ideas were due to Masanobu.
30 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com> 29 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com>
31 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>, 30 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
32 ;; who also hacked the mode to use comint.el. 31 ;; who also hacked the mode to use comint.el.
33 32
34 ;; Note: use of this package with sdb requires that your tags.el support 33 ;; This code will not work under Emacs 18. It relies on Emacs 19's
35 ;; the find-tag-noselect entry point. Stock distributions up to 18.57 do 34 ;; minor-mode-keymap support and the find-tag-noselect entry point of etags.
36 ;; *not* include this feature; if it's not included with this file, email 35
37 ;; esr@snark.thyrsus.com for it or get 18.58. 36 ;;; Change Log:
38 37
39 ;; Further note: due to lossage in the Emacs-18 byte compiler, compiled 38 ;; Version 1.1: ESR 6 Apr 1993
40 ;; versions of this code will fail with a complaint about gud-step if 39 ;; * Facility to accept and parse command-line switches other than the
41 ;; you invoke the gdb or sdb initializers. This should be fixed in 19. 40 ;; filename added.
41 ;; * System V Release 4 support added.
42 ;; * Can now set temporary breakpoints in sdb.
43 ;; * A GUD minor mode using the 19 minor-mode-keymap facilities is now
44 ;; enabled in visited C buffers.
45 ;; * Command bindings are now automatically the same in gud-minor-mode
46 ;; as they are in the GUD buffer itself, and use ^XX as a common
47 ;; prefix (for compatibility with electric-debug).
48 ;; * There is a new command for printing the C expression around point.
49
50 ;; Version 1.0: ESR
51 ;; * Created.
42 52
43 ;;; Code: 53 ;;; Code:
44 54
45 (require 'comint) 55 (require 'comint)
46 (require 'etags) 56 (require 'etags)
57
58 ;; ======================================================================
59 ;; minor-mode machinery for C buffers visited by GUD
60
61 (defvar gud-key-prefix "\C-xX"
62 "Prefix of all GUD minor-mode commands valid in C buffers.")
63
64 (defvar gud-minor-mode nil)
65 (or (assq 'gud-minor-mode minor-mode-alist)
66 (setq minor-mode-alist
67 (cons '(gud-minor-mode " GUD") minor-mode-alist)))
68
69 (defvar gud-mode-map nil)
70 (if gud-mode-map
71 nil
72 (setq gud-mode-map (make-sparse-keymap))
73 (define-key gud-mode-map gud-key-prefix (make-sparse-keymap))
74 (define-key gud-mode-map (concat gud-key-prefix "\C-l") 'gud-refresh)
75 )
76
77 (or (assq 'gud-minor-mode minor-mode-map-alist)
78 (setq minor-mode-map-alist
79 (cons
80 (cons 'gud-minor-mode gud-mode-map)
81 minor-mode-map-alist)))
82
83 (defun gud-minor-mode (&optional enable)
84 "GUD minor mode is enabled in C buffers visited due to a GUD stop at
85 breakpoint. All GUD-specific commands defined in GUD major mode will work,
86 but they get their current file and current line number from the context of
87 this buffer."
88 (interactive "P")
89 (setq gud-minor-mode
90 (if (null enable) (not gud-minor-mode)
91 (> (prefix-numeric-value enable) 0)))
92 )
47 93
48 ;; ====================================================================== 94 ;; ======================================================================
49 ;; the overloading mechanism 95 ;; the overloading mechanism
50 96
51 (defun gud-overload-functions (gud-overload-alist) 97 (defun gud-overload-functions (gud-overload-alist)
54 (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)" 100 (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)"
55 (mapcar 101 (mapcar
56 (function (lambda (p) (fset (car p) (symbol-function (cdr p))))) 102 (function (lambda (p) (fset (car p) (symbol-function (cdr p)))))
57 gud-overload-alist)) 103 gud-overload-alist))
58 104
59 (defun gud-debugger-startup (f d) 105 (defun gud-debugger-startup (file args)
60 (error "GUD not properly entered.")) 106 (error "GUD not properly entered."))
61 107
62 (defun gud-marker-filter (proc s) 108 (defun gud-marker-filter (str)
63 (error "GUD not properly entered.")) 109 (error "GUD not properly entered."))
64 110
65 (defun gud-visit-file (f) 111 (defun gud-find-file (f)
66 (error "GUD not properly entered.")) 112 (error "GUD not properly entered."))
67 113
68 (defun gud-set-break (proc f n rest) 114 ;; ======================================================================
69 (error "GUD not properly entered.")) 115 ;; command definition
70 116
71 ;; This macro is used below to define some basic debugger interface commands. 117 ;; This macro is used below to define some basic debugger interface commands.
72 ;; Of course you may use `gud-def' with any other debugger command, including 118 ;; Of course you may use `gud-def' with any other debugger command, including
73 ;; user defined ones. 119 ;; user defined ones.
74 120
75 ;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form 121 ;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form
76 ;; which defines FUNC to send the command NAME to the debugger, gives 122 ;; which defines FUNC to send the command NAME to the debugger, gives
77 ;; it the docstring DOC, and binds that function to KEY. NAME should 123 ;; it the docstring DOC, and binds that function to KEY in the GUD
78 ;; be a string. If a numeric prefix argument is given to FUNC, it 124 ;; major mode. The function is also bound in the GUD minor-mode
79 ;; gets sent after NAME. 125 ;; keymap. If a numeric prefix argument is given to FUNC, it gets
80 126 ;; sent after NAME.
81 (defmacro gud-def (func name key &optional doc) 127
82 (let* ((cstr (list 'if '(not (= 1 arg)) 128 (defmacro gud-def (func cmd key &optional doc)
83 (list 'format "%s %s" name 'arg) 129 "Define FUNC to be a command sending STR and bound to KEY, with
84 name))) 130 optional doc string DOC. Certain %-escapes in the string arguments
85 (list 'progn 131 are interpreted specially if present. These are:
86 (list 'defun func '(arg) 132
87 (or doc "") 133 %f name of current source file.
88 '(interactive "p") 134 %l number of current source line
89 (list 'gud-call cstr)) 135 %e text of the C lvalue or function-call expression surrounding point.
90 (if key 136 %a text of the hexadecimal address surrounding point
91 (list 'define-key 'gud-mode-map key (list 'quote func)))))) 137 %p prefix argument to the command (if any) as a number
138
139 The `current' source file is the file of the current buffer (if we're in a
140 C file with gud-minor-mode active) or the source file current at the last
141 break or step (if we're in the GUD buffer).
142 The `current' line is that of the current buffer (if we're in a source
143 file with gud-minor-mode active) or the source line number at the last
144 break or step (if we're in the GUD buffer)."
145 (list 'progn
146 (list 'defun func '(arg)
147 (or doc "")
148 '(interactive "p")
149 (list 'gud-call cmd 'arg))
150 (if key
151 (list 'define-key
152 'gud-mode-map
153 (concat gud-key-prefix key)
154 (list 'quote func)))))
92 155
93 ;; Where gud-display-frame should put the debugging arrow. This is 156 ;; Where gud-display-frame should put the debugging arrow. This is
94 ;; set by the marker-filter, which scans the debugger's output for 157 ;; set by the marker-filter, which scans the debugger's output for
95 ;; indications of the current pc. 158 ;; indications of the current program counter.
96 (defvar gud-last-frame nil) 159 (defvar gud-last-frame nil)
97 160
98 ;; All debugger-specific information is collected here 161 ;; All debugger-specific information is collected here.
99 ;; Here's how it works, in case you ever need to add a debugger to the table. 162 ;; Here's how it works, in case you ever need to add a debugger to the mode.
100 ;; 163 ;;
101 ;; Each entry must define the following at startup: 164 ;; Each entry must define the following at startup:
102 ;; 165 ;;
103 ;;<name> 166 ;;<name>
104 ;; comint-prompt-regexp 167 ;; comint-prompt-regexp
105 ;; gud-<name>-debugger-startup 168 ;; gud-<name>-debugger-startup
106 ;; gud-<name>-marker-filter 169 ;; gud-<name>-marker-filter
107 ;; gud-<name>-visit-file 170 ;; gud-<name>-find-file
108 ;; gud-<name>-set-break
109 ;; 171 ;;
110 ;; The job of the startup-command method is to fire up a copy of the debugger, 172 ;; The job of the startup-command method is to fire up a copy of the debugger,
111 ;; given an object file and source directory. 173 ;; given a list of debugger arguments.
112 ;; 174 ;;
113 ;; The job of the marker-filter method is to detect file/line markers in 175 ;; The job of the marker-filter method is to detect file/line markers in
114 ;; strings and set the global gud-last-frame to indicate what display 176 ;; strings and set the global gud-last-frame to indicate what display
115 ;; action (if any) should be triggered by the marker. Note that only 177 ;; action (if any) should be triggered by the marker. Note that only
116 ;; whetever the method *returns* is displayed in the buffer; thus, you 178 ;; whetever the method *returns* is displayed in the buffer; thus, you
117 ;; can filter the debugger's output, interpreting some and passing on 179 ;; can filter the debugger's output, interpreting some and passing on
118 ;; the rest. 180 ;; the rest.
119 ;; 181 ;;
120 ;; The job of the visit-file method is to visit and return the buffer indicated 182 ;; The job of the find-file method is to visit and return the buffer indicated
121 ;; by the car of gud-tag-frame. This may be a file name, a tag name, or 183 ;; by the car of gud-tag-frame. This may be a file name, a tag name, or
122 ;; something else. 184 ;; something else.
123 ;;
124 ;; The job of the gud-set-break method is to send the commands
125 ;; necessary to set a breakpoint at a given line in a given source
126 ;; file. If its third argument TEMP is non-nil, the breakpoint set
127 ;; should be temporary - it should be deleted when it is reached. If
128 ;; the debugger doesn't support such breakpoints, it should set an
129 ;; ordinary breakpoint.
130 ;;
131 ;; Debugger-specific information begins here:
132 185
133 ;; ====================================================================== 186 ;; ======================================================================
134 ;; gdb functions 187 ;; gdb functions
135 188
136 (defun gud-gdb-debugger-startup (f d) 189 (defun gud-gdb-debugger-startup (file args)
137 (make-comint (concat "gud-" f) "gdb" nil "-fullname" "-cd" d f)) 190 (apply 'make-comint (concat "gud-" file) "gdb" nil "-fullname" args))
138 191
139 (defun gud-gdb-marker-filter (proc string) 192 (defun gud-gdb-marker-filter (string)
140 (if (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" string) 193 (if (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" string)
141 (progn 194 (progn
142 (setq gud-last-frame 195 (setq gud-last-frame
143 (cons 196 (cons
144 (substring string (match-beginning 1) (match-end 1)) 197 (substring string (match-beginning 1) (match-end 1))
150 (substring string 0 (match-beginning 0)) 203 (substring string 0 (match-beginning 0))
151 (substring string (match-end 0)) 204 (substring string (match-end 0))
152 )) 205 ))
153 string)) 206 string))
154 207
155 (defun gud-gdb-visit-file (f) 208 (defun gud-gdb-find-file (f)
156 (find-file-noselect f)) 209 (find-file-noselect f))
157 210
158 (defun gud-gdb-set-break (proc f n temp)
159 (gud-call "%s %s:%d" (if temp "tbreak" "break") f n))
160
161 ;;;###autoload 211 ;;;###autoload
162 (defun gdb (path) 212 (defun gdb (args)
163 "Run gdb on program FILE in buffer *gud-FILE*. 213 "Run gdb on program FILE in buffer *gud-FILE*.
164 The directory containing FILE becomes the initial working directory 214 The directory containing FILE becomes the initial working directory
165 and source-file directory for your debugger." 215 and source-file directory for your debugger."
166 (interactive "fRun gdb on file: ") 216 (interactive "sgdb ")
167 (gud-overload-functions '((gud-debugger-startup . gud-gdb-debugger-startup) 217 (gud-overload-functions '((gud-debugger-startup . gud-gdb-debugger-startup)
168 (gud-marker-filter . gud-gdb-marker-filter) 218 (gud-marker-filter . gud-gdb-marker-filter)
169 (gud-visit-file . gud-gdb-visit-file) 219 (gud-find-file . gud-gdb-find-file)
170 (gud-set-break . gud-gdb-set-break))) 220 ))
171 221
172 (gud-def gud-step "step" "\C-c\C-s" "Step one source line with display") 222 (gud-def gud-break "break %f:%l" "b" "Set breakpoint at current line.")
173 (gud-def gud-stepi "stepi" "\C-c\C-i" "Step one instruction with display") 223 (gud-def gud-tbreak "tbreak %f:%l" "t" "Set breakpoint at current line.")
174 (gud-def gud-next "next" "\C-c\C-n" "Step one line (skip functions)") 224 (gud-def gud-remove "clear %l" "d" "Remove breakpoint at current line")
175 (gud-def gud-cont "cont" "\C-c\C-r" "Continue with display") 225 (gud-def gud-step "step %p" "s" "Step one source line with display.")
176 226 (gud-def gud-stepi "stepi %p" "i" "Step one instruction with display.")
177 (gud-def gud-finish "finish" "\C-c\C-f" "Finish executing current function") 227 (gud-def gud-next "next %p" "n" "Step one line (skip functions).")
178 (gud-def gud-up "up" "\C-c<" "Up N stack frames (numeric arg)") 228 (gud-def gud-cont "cont" "r" "Continue with display.")
179 (gud-def gud-down "down" "\C-c>" "Down N stack frames (numeric arg)") 229 (gud-def gud-finish "finish" "f" "Finish executing current function.")
180 230 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
181 (gud-common-init path) 231 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
232 (gud-def gud-print "print %e" "p" "Evaluate C expression at point.")
233
234 (gud-common-init args)
182 235
183 (setq comint-prompt-regexp "^(.*gdb[+]?) *") 236 (setq comint-prompt-regexp "^(.*gdb[+]?) *")
184 (run-hooks 'gdb-mode-hook) 237 (run-hooks 'gdb-mode-hook)
185 ) 238 )
186 239
187 240
188 ;; ====================================================================== 241 ;; ======================================================================
189 ;; sdb functions 242 ;; sdb functions
190 243
191 (defun gud-sdb-debugger-startup (f d) 244 (defvar gud-sdb-needs-tags (not (file-exists-p "/var"))
192 (make-comint (concat "gud-" f) "sdb" nil f "-" d)) 245 "If nil, we're on a System V Release 4 and don't need the tags hack.")
193 246
194 (defun gud-sdb-marker-filter (proc string) 247 (defvar gud-sdb-lastfile nil)
195 (if (string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" 248
249 (defun gud-sdb-debugger-startup (file args)
250 (apply 'make-comint (concat "gud-" file) "sdb" nil args))
251
252 (defun gud-sdb-marker-filter (string)
253 (cond
254 ;; System V Release 3.2 uses this format
255 ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n"
196 string) 256 string)
197 (setq gud-last-frame 257 (setq gud-last-frame
198 (cons 258 (cons
199 (substring string (match-beginning 2) (match-end 2)) 259 (substring string (match-beginning 2) (match-end 2))
200 (string-to-int 260 (string-to-int
201 (substring string (match-beginning 3) (match-end 3)))))) 261 (substring string (match-beginning 3) (match-end 3))))))
262 ;; System V Release 4.0
263 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
264 string)
265 (setq gud-sdb-lastfile
266 (substring string (match-beginning 2) (match-end 2))))
267 ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" string))
268 (setq gud-last-frame
269 (cons
270 gud-sdb-lastfile
271 (string-to-int
272 (substring string (match-beginning 1) (match-end 1))))))
273 (t
274 (setq gud-sdb-lastfile nil)))
202 string) 275 string)
203 276
204 (defun gud-sdb-visit-file (f) 277 (defun gud-sdb-find-file (f)
205 (find-tag-noselect f)) 278 (if gud-sdb-needs-tags
206 279 (find-tag-noselect f)
207 ;;; We'll just ignore the TEMP argument for now; I don't know how to 280 (find-file-noselect f)))
208 ;;; set temporary breakpoints in sdb. (See the description of the
209 ;;; gud-set-break method for details.)
210 (defun gud-sdb-set-break (proc f n temp)
211 (gud-queue-send (format "e %s" f) (format "%d b" n)))
212 281
213 ;;;###autoload 282 ;;;###autoload
214 (defun sdb (path) 283 (defun sdb (args)
215 "Run sdb on program FILE in buffer *gud-FILE*. 284 "Run sdb on program FILE in buffer *gud-FILE*.
216 The directory containing FILE becomes the initial working directory 285 The directory containing FILE becomes the initial working directory
217 and source-file directory for your debugger." 286 and source-file directory for your debugger."
218 (interactive "fRun sdb on file: ") 287 (interactive "ssdb ")
219 (if (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name))) 288 (if (and gud-sdb-needs-tags
289 (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name))))
220 (error "The sdb support requires a valid tags table to work.")) 290 (error "The sdb support requires a valid tags table to work."))
221 (gud-overload-functions '((gud-debugger-startup . gud-sdb-debugger-startup) 291 (gud-overload-functions '((gud-debugger-startup . gud-sdb-debugger-startup)
222 (gud-marker-filter . gud-sdb-marker-filter) 292 (gud-marker-filter . gud-sdb-marker-filter)
223 (gud-visit-file . gud-sdb-visit-file) 293 (gud-find-file . gud-sdb-find-file)
224 (gud-set-break . gud-sdb-set-break))) 294 ))
225 295
226 (gud-def gud-step "s" "\C-c\C-s" "Step one source line with display") 296 (gud-def gud-break "%l b" "b" "Set breakpoint at current line.")
227 (gud-def gud-stepi "i" "\C-c\C-i" "Step one instruction with display") 297 (gud-def gud-tbreak "%l c" "t" "Set temporary breakpoint at current line.")
228 (gud-def gud-next "S" "\C-c\C-n" "Step one source line (skip functions)") 298 (gud-def gud-remove "%l d" "d" "Remove breakpoint at current line")
229 (gud-def gud-cont "c" "\C-c\C-r" "Continue with display (`resume')") 299 (gud-def gud-step "s %p" "s" "Step one source line with display.")
230 300 (gud-def gud-stepi "i %p" "i" "Step one instruction with display.")
231 (gud-common-init path) 301 (gud-def gud-next "S %p" "n" "Step one line (skip functions).")
302 (gud-def gud-cont "c" "r" "Continue with display.")
303 (gud-def gud-print "%e/" "p" "Evaluate C expression at point.")
304
305 (gud-common-init args)
232 306
233 (setq comint-prompt-regexp "\\(^\\|\n\\)\\*") 307 (setq comint-prompt-regexp "\\(^\\|\n\\)\\*")
234 (run-hooks 'sdb-mode-hook) 308 (run-hooks 'sdb-mode-hook)
235 ) 309 )
236 310
237 ;; ====================================================================== 311 ;; ======================================================================
238 ;; dbx functions 312 ;; dbx functions
239 313
240 (defun gud-dbx-debugger-startup (f d) 314 (defun gud-dbx-debugger-startup (file args)
241 (make-comint (concat "gud-" f) "dbx" nil f)) 315 (apply 'make-comint (concat "gud-" file) "dbx" nil args))
242 316
243 (defun gud-dbx-marker-filter (proc string) 317 (defun gud-dbx-marker-filter (string)
244 (if (string-match 318 (if (string-match
245 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" string) 319 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" string)
246 (setq gud-last-frame 320 (setq gud-last-frame
247 (cons 321 (cons
248 (substring string (match-beginning 2) (match-end 2)) 322 (substring string (match-beginning 2) (match-end 2))
249 (string-to-int 323 (string-to-int
250 (substring string (match-beginning 1) (match-end 1)))))) 324 (substring string (match-beginning 1) (match-end 1))))))
251 string) 325 string)
252 326
253 (defun gud-dbx-visit-file (f) 327 (defun gud-dbx-find-file (f)
254 (find-file-noselect f)) 328 (find-file-noselect f))
255 329
256 ;;; We'll just ignore the TEMP argument for now; I don't know how to
257 ;;; set temporary breakpoints in dbx. (See the description of the
258 ;;; gud-set-break method for details.)
259 (defun gud-dbx-set-break (proc f n temp)
260 (gud-call "stop at \"%s\":%d" f n))
261
262 ;;;###autoload 330 ;;;###autoload
263 (defun dbx (path) 331 (defun dbx (args)
264 "Run dbx on program FILE in buffer *gud-FILE*. 332 "Run dbx on program FILE in buffer *gud-FILE*.
265 The directory containing FILE becomes the initial working directory 333 The directory containing FILE becomes the initial working directory
266 and source-file directory for your debugger." 334 and source-file directory for your debugger."
267 (interactive "fRun dbx on file: ") 335 (interactive "sdbx")
268 (gud-overload-functions '((gud-debugger-startup . gud-dbx-debugger-startup) 336 (gud-overload-functions '((gud-debugger-startup . gud-dbx-debugger-startup)
269 (gud-marker-filter . gud-dbx-marker-filter) 337 (gud-marker-filter . gud-dbx-marker-filter)
270 (gud-visit-file . gud-dbx-visit-file) 338 (gud-find-file . gud-dbx-find-file)
271 (gud-set-break . gud-dbx-set-break))) 339 ))
272 340
273 (gud-def gud-step "step" "\C-c\C-s" "Step one source line with display") 341 (gud-def gud-break "stop at \"%f\":%l"
274 (gud-def gud-stepi "stepi" "\C-c\C-i" "Step one instruction with display") 342 "b" "Set breakpoint at current line.")
275 (gud-def gud-next "next" "\C-c\C-n" "Step one line (skip functions)") 343 (gud-def gud-remove "clear %l" "d" "Remove breakpoint at current line")
276 (gud-def gud-cont "cont" "\C-c\C-r" "Continue with display (`resume')") 344 (gud-def gud-step "step %p" "s" "Step one line with display.")
277 345 (gud-def gud-stepi "stepi %p" "i" "Step one instruction with display.")
278 (gud-def gud-up "up" "\C-c<" "Up N stack frames (numeric arg)") 346 (gud-def gud-next "next %p" "n" "Step one line (skip functions).")
279 (gud-def gud-down "down" "\C-c>" "Down N stack frames (numeric arg)") 347 (gud-def gud-cont "cont" "r" "Continue with display.")
280 348 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.")
281 (gud-common-init path) 349 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.")
350 (gud-def gud-print "print %e" "p" "Evaluate C expression at point.")
351
352 (gud-common-init args)
282 (setq comint-prompt-regexp "^[^)]*dbx) *") 353 (setq comint-prompt-regexp "^[^)]*dbx) *")
283 354
284 (run-hooks 'dbx-mode-hook) 355 (run-hooks 'dbx-mode-hook)
285 ) 356 )
286 357
287 ;; 358 ;;
288 ;; End of debugger-specific information 359 ;; End of debugger-specific information
289 ;; 360 ;;
290
291 (defvar gud-mode-map nil
292 "Keymap for gud-mode.")
293
294 (defvar gud-commands nil
295 "List of strings or functions used by send-gud-command.
296 It is for customization by you.")
297
298 (defvar gud-command-queue nil)
299 361
300 ;;; When we send a command to the debugger via gud-call, it's annoying 362 ;;; When we send a command to the debugger via gud-call, it's annoying
301 ;;; to see the command and the new prompt inserted into the debugger's 363 ;;; to see the command and the new prompt inserted into the debugger's
302 ;;; buffer; we have other ways of knowing the command has completed. 364 ;;; buffer; we have other ways of knowing the command has completed.
303 ;;; 365 ;;;
337 ;;; delete all text between it and the process output marker. If 399 ;;; delete all text between it and the process output marker. If
338 ;;; gud-delete-prompt-marker points nowhere, we leave the current 400 ;;; gud-delete-prompt-marker points nowhere, we leave the current
339 ;;; prompt alone. 401 ;;; prompt alone.
340 (defvar gud-delete-prompt-marker nil) 402 (defvar gud-delete-prompt-marker nil)
341 403
342 (if gud-mode-map
343 nil
344 (setq gud-mode-map (copy-keymap comint-mode-map))
345 (define-key gud-mode-map "\C-c\C-l" 'gud-refresh))
346
347 ;; Global mappings --- we'll invoke these from a source buffer.
348 (define-key ctl-x-map " " 'gud-break)
349 (define-key ctl-x-map "&" 'send-gud-command)
350
351 404
352 (defun gud-mode () 405 (defun gud-mode ()
353 "Major mode for interacting with an inferior debugger process. 406 "Major mode for interacting with an inferior debugger process.
354 407
355 You start it up with one of the commands M-x gdb, M-x sdb, or 408 You start it up with one of the commands M-x gdb, M-x sdb, or
356 M-x dbx. Each entry point finishes by executing a hook; gdb-mode-hook, 409 M-x dbx. Each entry point finishes by executing a hook; gdb-mode-hook,
357 sdb-mode-hook or dbx-mode-hook respectively. 410 sdb-mode-hook or dbx-mode-hook respectively.
358 411
359 After startup, the following commands are available: 412 After startup, the following commands are available in both the GUD
413 interaction buffer and any source buffer GUD visits due to a breakpoint stop
414 or step operation:
360 415
361 \\{gud-mode-map} 416 \\{gud-mode-map}
362 417
363 \\[gud-refresh] displays in the other window the last line referred to 418 \\[gud-break] sets a breakpoint at the current file and line. In the
419 GUD buffer, the current file and line are those of the last breakpoint or
420 step. In a source buffer, they are the buffer's file and current line.
421
422 \\[gud-refresh] displays in the source window the last line referred to
364 in the gud buffer. 423 in the gud buffer.
365 424
366 \\[gud-step], \\[gud-next], and \\[gud-stepi] in the gud window, 425 \\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line,
367 do a step-one-line, step-one-line (not entering function calls), and 426 step-one-line (not entering function calls), and step-one-instruction
368 step-one-instruction and then update the other window 427 and then update the source window with the current file and position.
369 with the current file and position. \\[gud-cont] continues 428 \\[gud-cont] continues execution.
370 execution. 429
371 430 \\[gud-print] tries to find the largest C lvalue or function-call expression
372 The above commands are common to all supported debuggers. If you are 431 around point, and sends it to the debugger for value display.
373 using gdb or dbx, the following additional commands will be available: 432
374 433 The above commands are common to all supported debuggers.
375 \\[gud-up] pops up through an enclosing stack frame. \\[gud-down] drops 434
376 back down through one. 435 Under gdb and sdb, \\[gud-tbreak] behaves exactly like \\[gud-break],
436 except that the breakpoint is temporary; that is, it is removed when
437 execution stops on it.
438
439 Under gdb and dbx, \\[gud-up] pops up through an enclosing stack
440 frame. \\[gud-down] drops back down through one.
377 441
378 If you are using gdb, \\[gdb-finish] runs execution to the return from 442 If you are using gdb, \\[gdb-finish] runs execution to the return from
379 the current function and stops. 443 the current function and stops.
380 444
381 These functions repeat themselves the appropriate number of times if you give a 445 All pre-defined functions for which the concept make sense repeat
382 prefix argument. 446 themselves the appropriate number of times if you give a prefix
383 447 argument.
384 If you are in a source file, you may do the following: 448
385 449 You may use the gud-def macro in the initialization hook to define other
386 Set a breakpoint at the current line by doing \\[gud-break]. This causes 450 commands.
387 an appropriate set-break to be send to the debugger; of course, if the file
388 you're visiting doesn't correspond to any code in the executable this will
389 have no effect or raise an error.
390
391 Execute a user-defined command at point with \\[send-gud-command]; the
392 prefix argument is taken as an index into the list of strings gud-commands.
393 A %s in a gud-commands string is substituted with a number or address picked
394 up from point.
395 451
396 Other commands for interacting with the debugger process are inherited from 452 Other commands for interacting with the debugger process are inherited from
397 comint mode, which see." 453 comint mode, which see."
398 (interactive) 454 (interactive)
399 (comint-mode) 455 (comint-mode)
400 ; (kill-all-local-variables)
401 (setq major-mode 'gud-mode) 456 (setq major-mode 'gud-mode)
402 (setq mode-name "Debugger") 457 (setq mode-name "Debugger")
403 (setq mode-line-process '(": %s")) 458 (setq mode-line-process '(": %s"))
404 (use-local-map gud-mode-map) 459 (use-local-map (copy-keymap comint-mode-map))
460 (define-key (current-local-map)
461 gud-key-prefix (lookup-key gud-mode-map gud-key-prefix))
405 (make-local-variable 'gud-last-frame) 462 (make-local-variable 'gud-last-frame)
406 (setq gud-last-frame nil) 463 (setq gud-last-frame nil)
407 (make-local-variable 'comint-prompt-regexp) 464 (make-local-variable 'comint-prompt-regexp)
408 (make-local-variable 'gud-delete-prompt-marker) 465 (make-local-variable 'gud-delete-prompt-marker)
409 (setq gud-delete-prompt-marker (make-marker)) 466 (setq gud-delete-prompt-marker (make-marker))
410 (run-hooks 'gud-mode-hook) 467 (run-hooks 'gud-mode-hook)
411 ) 468 )
412 469
413 (defvar current-gud-buffer nil) 470 (defvar gud-comint-buffer nil)
414 471
415 (defun gud-common-init (path) 472 (defun gud-common-init (args)
416 ;; perform initializations common to all debuggers 473 ;; Perform initializations common to all debuggers
417 (setq path (expand-file-name path)) 474 ;; There *must* be a cleaner way to lex the arglist...
418 (let ((file (file-name-nondirectory path))) 475 (let (file i)
419 (switch-to-buffer (concat "*gud-" file "*")) 476 (if (string= args "")
420 (setq default-directory (file-name-directory path)) 477 (setq args nil)
421 (or (bolp) (newline)) 478 (set-buffer (get-buffer-create "*gud-scratch*"))
422 (insert "Current directory is " default-directory "\n") 479 (erase-buffer)
423 (gud-debugger-startup file default-directory)) 480 (insert args)
481 (goto-char (point-max))
482 (insert "\")")
483 (goto-char (point-min))
484 (insert "(\"")
485 (while (re-search-forward " +" nil t)
486 (replace-match "\" \"" nil nil))
487 (goto-char (point-min))
488 (while (re-search-forward "\"\"" nil t)
489 (replace-match "" nil nil))
490 (setq args (read (buffer-string)))
491 (kill-buffer (current-buffer)))
492 (setq i (1- (length args)))
493 (while (and (>= i 0) (not (= (aref (nth i args) 0) ?-)))
494 (setq file (nth i args)) (setq i (1- i)))
495 (let* ((path (expand-file-name file))
496 (filepart (file-name-nondirectory path)))
497 (switch-to-buffer (concat "*gud-" filepart "*"))
498 (setq default-directory (file-name-directory path))
499 (or (bolp) (newline))
500 (insert "Current directory is " default-directory "\n")
501 (gud-debugger-startup filepart args)))
424 (gud-mode) 502 (gud-mode)
425 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) 503 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
426 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) 504 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
427 (setq gud-command-queue nil)
428 (gud-set-buffer) 505 (gud-set-buffer)
429 ) 506 )
430 507
431 (defun gud-set-buffer () 508 (defun gud-set-buffer ()
432 (cond ((eq major-mode 'gud-mode) 509 (cond ((eq major-mode 'gud-mode)
433 (setq current-gud-buffer (current-buffer))))) 510 (setq gud-comint-buffer (current-buffer)))))
434 511
512 ;; These functions are responsible for inserting output from your debugger
513 ;; into the buffer. The hard work is done by the method that is
514 ;; the value of gud-marker-filter.
515
435 (defun gud-filter (proc string) 516 (defun gud-filter (proc string)
436 ;; This function is responsible for inserting output from your debugger 517 ;; Here's where the actual buffer insertion is done
437 ;; into the buffer. The hard work is done by the method that is
438 ;; the value of gud-marker-filter.
439 (let ((inhibit-quit t)) 518 (let ((inhibit-quit t))
440 (gud-filter-insert proc (gud-marker-filter proc string)) 519 (save-excursion
441 ;; If we've got queued commands and we see a prompt, pop one and send it. 520 (set-buffer (process-buffer proc))
442 ;; In theory we should check that a prompt has been issued before sending 521 (let ((moving (= (point) (process-mark proc)))
443 ;; queued commands. In practice, command responses from the first through 522 (output-after-point (< (point) (process-mark proc))))
444 ;; penultimate elements of a command sequence are short enough that we 523 (save-excursion
445 ;; don't really have to bother. 524 (goto-char (process-mark proc))
446 (if gud-command-queue 525 ;; If we have been so requested, delete the debugger prompt.
447 (progn 526 (if (marker-buffer gud-delete-prompt-marker)
448 (gud-call (car gud-command-queue)) 527 (progn
449 (setq gud-command-queue (cdr gud-command-queue)) 528 (delete-region (point) gud-delete-prompt-marker)
450 ) 529 (set-marker gud-delete-prompt-marker nil)))
451 ))) 530 (insert-before-markers (gud-marker-filter string))
452 531 ;; Check for a filename-and-line number.
453 (defun gud-filter-insert (proc string) 532 ;; Don't display the specified file
454 ;; Here's where the actual buffer insertion is done 533 ;; unless (1) point is at or after the position where output appears
455 (save-excursion 534 ;; and (2) this buffer is on the screen.
456 (set-buffer (process-buffer proc)) 535 (if (and gud-last-frame
457 (let ((moving (= (point) (process-mark proc))) 536 (not output-after-point)
458 (output-after-point (< (point) (process-mark proc)))) 537 (get-buffer-window (current-buffer)))
459 (save-excursion 538 (gud-display-frame)))
460 (goto-char (process-mark proc)) 539 (if moving (goto-char (process-mark proc)))))))
461 ;; If we have been so requested, delete the debugger prompt.
462 (if (marker-buffer gud-delete-prompt-marker)
463 (progn
464 (delete-region (point) gud-delete-prompt-marker)
465 (set-marker gud-delete-prompt-marker nil)))
466 (insert-before-markers string)
467 ;; Check for a filename-and-line number.
468 ;; Don't display the specified file
469 ;; unless (1) point is at or after the position where output appears
470 ;; and (2) this buffer is on the screen.
471 (if (and gud-last-frame
472 (not output-after-point)
473 (get-buffer-window (current-buffer)))
474 (gud-display-frame)))
475 (if moving (goto-char (process-mark proc))))))
476 540
477 (defun gud-sentinel (proc msg) 541 (defun gud-sentinel (proc msg)
478 (cond ((null (buffer-name (process-buffer proc))) 542 (cond ((null (buffer-name (process-buffer proc)))
479 ;; buffer killed 543 ;; buffer killed
480 ;; Stop displaying an arrow in a source file. 544 ;; Stop displaying an arrow in a source file.
481 (setq overlay-arrow-position nil) 545 (setq overlay-arrow-position nil)
546 (setq gud-minor-mode nil)
482 (set-process-buffer proc nil)) 547 (set-process-buffer proc nil))
483 ((memq (process-status proc) '(signal exit)) 548 ((memq (process-status proc) '(signal exit))
484 ;; Stop displaying an arrow in a source file. 549 ;; Stop displaying an arrow in a source file.
550 (setq gud-minor-mode nil)
485 (setq overlay-arrow-position nil) 551 (setq overlay-arrow-position nil)
486 ;; Fix the mode line. 552 ;; Fix the mode line.
487 (setq mode-line-process 553 (setq mode-line-process
488 (concat ": " 554 (concat ": "
489 (symbol-name (process-status proc)))) 555 (symbol-name (process-status proc))))
507 (delete-process proc)) 573 (delete-process proc))
508 ;; Restore old buffer, but don't restore old point 574 ;; Restore old buffer, but don't restore old point
509 ;; if obuf is the gud buffer. 575 ;; if obuf is the gud buffer.
510 (set-buffer obuf)))))) 576 (set-buffer obuf))))))
511 577
512
513 (defun gud-refresh (&optional arg)
514 "Fix up a possibly garbled display, and redraw the arrow."
515 (interactive "P")
516 (recenter arg)
517 (gud-display-frame))
518
519 (defun gud-display-frame () 578 (defun gud-display-frame ()
520 "Find and obey the last filename-and-line marker from the debugger. 579 "Find and obey the last filename-and-line marker from the debugger.
521 Obeying it means displaying in another window the specified file and line." 580 Obeying it means displaying in another window the specified file and line."
522 (interactive) 581 (interactive)
523 (if gud-last-frame 582 (if gud-last-frame
524 (progn 583 (progn
525 (gud-set-buffer) 584 (gud-set-buffer)
526 (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) 585 (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
527 (setq gud-last-frame nil)))) 586 (setq gud-last-frame nil))))
528 587
529 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen 588 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
530 ;; and that its line LINE is visible. 589 ;; and that its line LINE is visible.
531 ;; Put the overlay-arrow on the line LINE in that buffer. 590 ;; Put the overlay-arrow on the line LINE in that buffer.
591 ;; Most of the trickiness in here comes from wanting to preserve the current
592 ;; region-restriction if that's possible. We use an explicit display-buffer
593 ;; to get around the fact that this is called inside a save-excursion.
532 594
533 (defun gud-display-line (true-file line) 595 (defun gud-display-line (true-file line)
534 (let* ((buffer (gud-visit-file true-file)) 596 (let* ((buffer (gud-find-file true-file))
535 (window (display-buffer buffer t)) 597 (window (display-buffer buffer))
536 (pos)) 598 (pos))
537 (save-excursion 599 (save-excursion
538 (set-buffer buffer) 600 (set-buffer buffer)
601 (make-local-variable 'gud-minor-mode)
602 (setq gud-minor-mode t)
539 (save-restriction 603 (save-restriction
540 (widen) 604 (widen)
541 (goto-line line) 605 (goto-line line)
542 (setq pos (point)) 606 (setq pos (point))
543 (setq overlay-arrow-string "=>") 607 (setq overlay-arrow-string "=>")
546 (set-marker overlay-arrow-position (point) (current-buffer))) 610 (set-marker overlay-arrow-position (point) (current-buffer)))
547 (cond ((or (< pos (point-min)) (> pos (point-max))) 611 (cond ((or (< pos (point-min)) (> pos (point-max)))
548 (widen) 612 (widen)
549 (goto-char pos)))) 613 (goto-char pos))))
550 (set-window-point window overlay-arrow-position))) 614 (set-window-point window overlay-arrow-position)))
551 615
552 (defun gud-call (command &rest args) 616 ;;; The gud-call function must do the right thing whether its invoking
553 "Invoke the debugger COMMAND displaying source in other window." 617 ;;; keystroke is from the GUD buffer itself (via major-mode binding)
554 (interactive) 618 ;;; or a C buffer in GUD minor mode. In the former case, we want to
555 (gud-set-buffer) 619 ;;; supply data from gud-last-frame. Here's how we do it:
556 (let ((command (concat (apply 'format command args) "\n")) 620
557 (proc (get-buffer-process current-gud-buffer))) 621 (defun gud-format-command (str arg)
558 622 (let ((minor (not (eq (current-buffer) gud-comint-buffer))))
559 ;; Arrange for the current prompt to get deleted. 623 (if (string-match "\\(.*\\)%f\\(.*\\)" str)
560 (save-excursion 624 (progn
561 (set-buffer current-gud-buffer) 625 (setq str (concat
562 (goto-char (process-mark proc)) 626 (substring str (match-beginning 1) (match-end 1))
563 (beginning-of-line) 627 (if minor
564 (if (looking-at comint-prompt-regexp) 628 (buffer-file-name)
565 (set-marker gud-delete-prompt-marker (point)))) 629 (car gud-last-frame))
566 630 (substring str (match-beginning 2) (match-end 2))))))
567 (goto-char (point-max)) 631 (if (string-match "\\(.*\\)%l\\(.*\\)" str)
568 (process-send-string proc command))) 632 (progn
569 633 (setq str (concat
570 (defun gud-queue-send (&rest cmdlist) 634 (substring str (match-beginning 1) (match-end 1))
571 ;; Send the first command, queue the rest for send after successive 635 (if minor
572 ;; send on subsequent prompts 636 (save-excursion
573 (interactive) 637 (beginning-of-line)
574 (gud-call (car cmdlist)) 638 (save-restriction (widen)
575 (setq gud-command-queue (append gud-command-queue (cdr cmdlist)))) 639 (1+ (count-lines 1 (point)))))
576 640 (cdr gud-last-frame))
577 (defun gud-apply-from-source (func &rest args) 641 (substring str (match-beginning 2) (match-end 2))))))
578 ;; Apply a method from the gud buffer environment, passing it file 642 (if (string-match "\\(.*\\)%e\\(.*\\)" str)
579 ;; and line, then ARGS. This is intended to be used for gud 643 (progn
580 ;; commands called from a source file. 644 (setq str (concat
581 (if (not buffer-file-name) 645 (substring str (match-beginning 1) (match-end 1))
582 (error "There is no file associated with this buffer")) 646 (find-c-expr)
583 (let ((file (file-name-nondirectory buffer-file-name)) 647 (substring str (match-beginning 2) (match-end 2))))))
584 (line (save-restriction (widen) (1+ (count-lines 1 (point)))))) 648 (if (string-match "\\(.*\\)%a\\(.*\\)" str)
585 (save-excursion 649 (progn
586 (gud-set-buffer) 650 (setq str (concat
587 (apply func 651 (substring str (match-beginning 1) (match-end 1))
588 (get-buffer-process current-gud-buffer) 652 (gud-read-address)
589 file 653 (substring str (match-beginning 2) (match-end 2))))))
590 line 654 (if (string-match "\\(.*\\)%p\\(.*\\)" str)
591 args) 655 (progn
592 ))) 656 (setq str (concat
593 657 (substring str (match-beginning 1) (match-end 1))
594 (defun gud-break (arg) 658 (if arg (int-to-string arg) "")
595 "Set breakpoint at this source line. 659 (substring str (match-beginning 2) (match-end 2))))))
596 With prefix argument, set a temporary breakpoint, if the debugger in 660 )
597 use supports such things. (A temporary breakpoint is one which will 661 str
598 be deleted when it is reached.)" 662 )
599 (interactive "P")
600 (gud-apply-from-source 'gud-set-break arg))
601 663
602 (defun gud-read-address () 664 (defun gud-read-address ()
603 "Return a string containing the core-address found in the buffer at point." 665 "Return a string containing the core-address found in the buffer at point."
604 (save-excursion 666 (save-excursion
605 (let ((pt (point)) found begin) 667 (let ((pt (point)) found begin)
606 (setq found (if (search-backward "0x" (- pt 7) t)(point))) 668 (setq found (if (search-backward "0x" (- pt 7) t) (point)))
607 (cond 669 (cond
608 (found (forward-char 2) 670 (found (forward-char 2)
609 (buffer-substring found 671 (buffer-substring found
610 (progn (re-search-forward "[^0-9a-f]") 672 (progn (re-search-forward "[^0-9a-f]")
611 (forward-char -1) 673 (forward-char -1)
616 (forward-char 1) 678 (forward-char 1)
617 (re-search-forward "[^0-9]") 679 (re-search-forward "[^0-9]")
618 (forward-char -1) 680 (forward-char -1)
619 (buffer-substring begin (point))))))) 681 (buffer-substring begin (point)))))))
620 682
621 683 (defun gud-call (fmt &optional arg)
622 (defun send-gud-command (arg) 684 (let ((msg (gud-format-command fmt arg)))
623 "This command reads the number where the cursor is positioned. A numeric arg 685 (message "Command: %s" msg)
624 selects the ARG'th member COMMAND of the list gud-commands. If COMMAND is a 686 (sit-for 0)
625 string, (format COMMAND ADDR) is inserted at the end of the debugger buffer, 687 (gud-basic-call msg)))
626 otherwise (funcall COMMAND ADDR) is inserted. 688
627 For example, \"p (rtx)%s->fld[0].rtint\" is a possible string to be a 689 (defun gud-basic-call (command)
628 member of gud-commands." 690 "Invoke the debugger COMMAND displaying source in other window."
691 (interactive)
692 (gud-set-buffer)
693 (let ((command (concat command "\n"))
694 (proc (get-buffer-process gud-comint-buffer)))
695
696 ;; Arrange for the current prompt to get deleted.
697 (save-excursion
698 (set-buffer gud-comint-buffer)
699 (goto-char (process-mark proc))
700 (beginning-of-line)
701 (if (looking-at comint-prompt-regexp)
702 (set-marker gud-delete-prompt-marker (point))))
703 (process-send-string proc command)))
704
705 (defun gud-refresh (&optional arg)
706 "Fix up a possibly garbled display, and redraw the arrow."
629 (interactive "P") 707 (interactive "P")
630 (let (comm addr) 708 (recenter arg)
631 (if arg (setq comm (nth arg gud-commands))) 709 (gud-display-frame))
632 (setq addr (gud-read-address)) 710
633 (if (eq (current-buffer) current-gud-buffer) 711 ;;; Code for parsing expressions out of C code. The single entry point is
634 (set-mark (point))) 712 ;;; find-c-expr, which tries to return an lvalue expression from around point.
635 (cond (comm 713 ;;;
636 (setq comm 714 ;;; The rest of this file is a hacked version of gdbsrc.el by
637 (if (stringp comm) (format comm addr) (funcall comm addr)))) 715 ;;; Debby Ayers <ayers@asc.slb.com>,
638 (t (setq comm addr))) 716 ;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx.
639 (switch-to-buffer current-gud-buffer) 717 ;;; ??? We're waiting on papers from these people
640 (goto-char (point-max)) 718
641 (insert-string comm))) 719 (defun find-c-expr ()
720 "Returns the C expr that surrounds point."
721 (interactive)
722 (save-excursion
723 (let ((p) (expr) (test-expr))
724 (setq p (point))
725 (setq expr (expr-cur))
726 (setq test-expr (expr-prev))
727 (while (expr-compound test-expr expr)
728 (setq expr (cons (car test-expr) (cdr expr)))
729 (goto-char (car expr))
730 (setq test-expr (expr-prev))
731 )
732 (goto-char p)
733 (setq test-expr (expr-next))
734 (while (expr-compound expr test-expr)
735 (setq expr (cons (car expr) (cdr test-expr)))
736 (setq test-expr (expr-next))
737 )
738 (buffer-substring (car expr) (cdr expr))
739 )
740 )
741 )
742
743 (defun expr-cur ()
744 "Returns the expr that point is in; point is set to beginning of expr.
745 The expr is represented as a cons cell, where the car specifies the point in
746 the current buffer that marks the beginning of the expr and the cdr specifies
747 the character after the end of the expr"
748 (let ((p (point)) (begin) (end))
749 (back-expr)
750 (setq begin (point))
751 (forw-expr)
752 (setq end (point))
753 (if (>= p end)
754 (progn
755 (setq begin p)
756 (goto-char p)
757 (forw-expr)
758 (setq end (point))
759 )
760 )
761 (goto-char begin)
762 (cons begin end)
763 )
764 )
765
766 (defun back-expr ()
767 "Version of backward-sexp that catches errors"
768 (condition-case nil
769 (backward-sexp)
770 (error t)))
771
772 (defun forw-expr ()
773 "Version of forward-sexp that catches errors"
774 (condition-case nil
775 (forward-sexp)
776 (error t)))
777
778 (defun expr-prev ()
779 "Returns the previous expr, point is set to beginning of that expr.
780 The expr is represented as a cons cell, where the car specifies the point in
781 the current buffer that marks the beginning of the expr and the cdr specifies
782 the character after the end of the expr"
783 (let ((begin) (end))
784 (back-expr)
785 (setq begin (point))
786 (forw-expr)
787 (setq end (point))
788 (goto-char begin)
789 (cons begin end)))
790
791 (defun expr-next ()
792 "Returns the following expr, point is set to beginning of that expr.
793 The expr is represented as a cons cell, where the car specifies the point in
794 the current buffer that marks the beginning of the expr and the cdr specifies
795 the character after the end of the expr"
796 (let ((begin) (end))
797 (forw-expr)
798 (forw-expr)
799 (setq end (point))
800 (back-expr)
801 (setq begin (point))
802 (cons begin end)
803 )
804 )
805
806 (defun expr-compound-sep (span-start span-end)
807 "Returns '.' for '->' & '.', returns ' ' for white space,
808 returns '?' for other puctuation."
809 (let ((result ? )
810 (syntax))
811 (while (< span-start span-end)
812 (setq syntax (char-syntax (char-after span-start)))
813 (cond
814 ((= syntax ? ) t)
815 ((= syntax ?.) (setq syntax (char-after span-start))
816 (cond
817 ((= syntax ?.) (setq result ?.))
818 ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
819 (setq result ?.)
820 (setq span-start (+ span-start 1)))
821 (t (setq span-start span-end)
822 (setq result ??)))))
823 (setq span-start (+ span-start 1)))
824 result
825 )
826 )
827
828 (defun expr-compound (first second)
829 "Returns non-nil if the concatenation of two exprs results in a single C
830 token. The two exprs are represented as a cons cells, where the car
831 specifies the point in the current buffer that marks the beginning of the
832 expr and the cdr specifies the character after the end of the expr
833 Link exprs of the form:
834 Expr -> Expr
835 Expr . Expr
836 Expr (Expr)
837 Expr [Expr]
838 (Expr) Expr
839 [Expr] Expr"
840 (let ((span-start (cdr first))
841 (span-end (car second))
842 (syntax))
843 (setq syntax (expr-compound-sep span-start span-end))
844 (cond
845 ((= (car first) (car second)) nil)
846 ((= (cdr first) (cdr second)) nil)
847 ((= syntax ?.) t)
848 ((= syntax ? )
849 (setq span-start (char-after (- span-start 1)))
850 (setq span-end (char-after span-end))
851 (cond
852 ((= span-start ?) ) t )
853 ((= span-start ?] ) t )
854 ((= span-end ?( ) t )
855 ((= span-end ?[ ) t )
856 (t nil))
857 )
858 (t nil))
859 )
860 )
642 861
643 ;;; gud.el ends here 862 ;;; gud.el ends here