home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edebug.el < prev    next >
Encoding:
Text File  |  1992-07-23  |  95.8 KB  |  2,954 lines

  1. ;; edebug.el  A source level debugger for Emacs Lisp.
  2. ;; Copyright (C) 1988-1992, Free Software Foundation, Inc
  3.  
  4. ;; LCD Archive Entry:
  5. ;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu
  6. ;; |A source level debugger for Emacs Lisp.
  7. ;; |$Date: 92/03/23 18:29:26 $|$Revision: 2.7 $|~/modes/edebug.el|
  8.  
  9. ;; This file will be part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  13. ;; accepts responsibility to anyone for the consequences of using it
  14. ;; or for whether it serves any particular purpose or works at all,
  15. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  16. ;; License for full details.
  17.  
  18. ;; Everyone is granted permission to copy, modify and redistribute
  19. ;; GNU Emacs, but only under the conditions described in the
  20. ;; GNU Emacs General Public License.   A copy of this license is
  21. ;; supposed to have been given to you along with GNU Emacs so you
  22. ;; can know your rights and responsibilities.  It should be in a
  23. ;; file named COPYING.  Among other things, the copyright notice
  24. ;; and this notice must be preserved on all copies.
  25.  
  26. ;;;================================================================
  27. ;;; Contents of this file:
  28. ;;; =========
  29. ;;; Introduction
  30. ;;; Installation
  31. ;;; Change list
  32. ;;; Utilities
  33. ;;; Parser
  34. ;;; Debugger
  35.  
  36. ;;; Introduction
  37. ;;; ------------
  38. ;;; This minor mode allows programmers to step through elisp source
  39. ;;; code while executing functions.  You can also set breakpoints,
  40. ;;; trace (stopping at each expression), evaluate expressions as if
  41. ;;; outside edebug, reevaluate and display a list of expressions,
  42. ;;; catch errors normally caught by debug, and display a debug style
  43. ;;; backtrace.
  44.  
  45. ;;; To install, put edebug.el in some directory in your load-path and
  46. ;;; byte-compile it.  Put the following forms in your .emacs file.
  47.  
  48. ;;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-defun)
  49. ;;; (autoload 'edebug-defun "edebug")
  50.  
  51. ;;; If you wish to change the default edebug global command prefix...
  52. ;;; (setq edebug-global-prefix "...whatever you want")  ; default is C-xX
  53.  
  54. ;;; ... other options, described below.
  55.  
  56. ;;; Evaluate a defun or defmacro for edebug with edebug-defun (C-xx or C-xX).
  57. ;;; Evaluate your function normally and edebug should be invoked.
  58. ;;; Use the "?" command in edebug to describe other commands.
  59. ;;; See edebug.texinfo for more instructions.
  60.  
  61. ;;; Send me your enhancements, ideas, bugs, or fixes.
  62. ;;; There is an edebug mailing list if you want to keep up
  63. ;;; with the latest developments: edebug@cs.uiuc.edu
  64. ;;; (requests to: edebug-request@cs.uiuc.edu)
  65.  
  66. ;;; Daniel LaLiberte   217-244-0785
  67. ;;; University of Illinois, Urbana-Champaign
  68. ;;; Department of Computer Science
  69. ;;; 1304 W Springfield
  70. ;;; Urbana, IL  61801
  71.  
  72. ;;; uiucdcs!liberte
  73. ;;; liberte@cs.uiuc.edu
  74.  
  75.  
  76. ;;;================================================================
  77. ;;; Change list
  78. ;;; -----------
  79.  
  80. ;;; $Header: /import/kaplan/kaplan/liberte/Edebug/RCS/edebug.el,v 2.7 92/03/23 18:29:26 liberte Exp Locker: liberte $
  81. ;;; $Log:    edebug.el,v $
  82. ;;; Revision 2.7  92/03/23  18:29:26  liberte
  83. ;;; Fix edebug-get-displayed-buffer-points to actually change buffers.
  84. ;;; 
  85. ;;; Restore current buffer in edebug-set-buffer-points
  86. ;;; 
  87. ;;; Use epoch::version instead of edebug-epoch-running.
  88. ;;; 
  89. ;;; Apparently we need to set-buffer in edebug-pop-to-buffer,
  90. ;;; even after select-window.
  91. ;;; 
  92. ;;; Define dynamically bound variables to quite byte-compiler,
  93. ;;; but leave them unbound to cause runtime error if used improperly.
  94. ;;; 
  95. ;;; Fix other problems with window-start, current-buffer, and
  96. ;;; edebug-outside-excursion.
  97. ;;; 
  98. ;;; Revision 2.6  92/03/19  12:55:58  liberte
  99. ;;; Disable edebug-save-point.  Now point of source code buffers is always
  100. ;;; saved, mark is never saved, and window-start is always saved.
  101. ;;; 
  102. ;;; Change name of edebug-save-buffer-points to
  103. ;;; edebug-save-displayed-buffer-points.  Also, if non-nil, only displayed
  104. ;;; buffer points are saved.
  105. ;;; 
  106. ;;; Restructure definition of epoch specific functions so there is no
  107. ;;; overhead for non-epoch use.
  108. ;;; 
  109. ;;; Add support for custom-print functions to handle print-level and
  110. ;;; print-circle.  Use edebug-prin* functions instead of standard
  111. ;;; print functions.
  112. ;;; 
  113. ;;; Yet another change of the scheme for wrapping edebug calls:
  114. ;;; edebug-enter gets a lambda form which can be byte-compiled;
  115. ;;; edebug-after gets the after expression index from edebug-before which
  116. ;;; is given the before expression index.  (Perhaps it is false economy to
  117. ;;; avoid the after expression index.)  edebug-after also gets the
  118. ;;; evaluated expression result, so no explicit evals need be done.
  119. ;;; 
  120. ;;; Most of edebug-defun was moved to edebug-func-form which also
  121. ;;; handles embedded defuns.
  122. ;;; 
  123. ;;; Add functions edebug-forms and edebug-sexps.
  124. ;;; 
  125. ;;; Rename edebug-list to edebug-list-form.
  126. ;;; 
  127. ;;; Use edebug-form-specs for all special forms.  The spec may now be
  128. ;;; a function which is called to process args.  Added -form to
  129. ;;; the names of special form parser functions.
  130. ;;; 
  131. ;;; Rename edebug-form-parser to edebug-interpret-form-spec.  Add handling
  132. ;;; of [...], function spec, and backtracking.  &optional now only applies
  133. ;;; to one following spec.  Fixed some other bugs.
  134. ;;; 
  135. ;;; Added macro def-edebug-form-spec for convenience, and to convert
  136. ;;; 0 and t values to edebug-forms and edebug-sexps.
  137. ;;; 
  138. ;;; Add edebug-form-specs for mapcar, mapconcat, mapatoms, apply, and funcall
  139. ;;; that all use the new function spec.
  140. ;;; 
  141. ;;; Rebuilt edebug-read-sexp to be simpler, faster, and more complete.
  142. ;;; 
  143. ;;; Accummulate frequencies of expression evaluation, displayable
  144. ;;; with edebug-display-freq-count.
  145. ;;; 
  146. ;;; No longer do save-restriction since edebug's eval-region doesnt narrow.
  147. ;;; 
  148. ;;; Numerous other display changes related to source code buffer's
  149. ;;; point and window-start.
  150. ;;; 
  151. ;;; Add -mode to the names of mode changing functions.
  152. ;;; 
  153. ;;; Set debugger to edebug-debug while inside edebug - it's almost
  154. ;;; always useful inside, and not useful outside of edebug.
  155. ;;; 
  156. ;;; Add edebug-trace function to output FMT with ARGS to *edebug-trace* buffer.
  157. ;;; 
  158. ;;; Other changes I've forgotten.
  159. ;;; 
  160. ;;;
  161. ;;;
  162. ;;; Revision 2.5  91/07/25  13:32:53  liberte
  163. ;;; Doc string cleanup.
  164. ;;; If edebug-form-spec is t, evaluate all arguments.
  165. ;;; If edebug-form-spec is 0, evaluate no arguments.
  166. ;;; If edebug-form-spec is nil, evaluate macro args according
  167. ;;;     to edebug-eval-macro-args.
  168. ;;; Save the outside value of executing macro.
  169. ;;; Save and restore the outside restriction.
  170. ;;; Dont force update for go and Go-nonstop.
  171. ;;; Save and restore last-command-char, last-command,
  172. ;;;     this-command, last-input-char.
  173. ;;; For epoch, do epoch::dispatch-events before sit-for
  174. ;;;     and input-pending-p since X events could interfere.
  175. ;;; Warn about unsetting non-existent breakpoint.
  176. ;;; Fix edebug-forward-sexp with prefix arg.
  177. ;;; Add edebug-step-out to exit from current sexp.
  178. ;;; 
  179. ;;; Revision 2.4  91/03/18  12:35:44  liberte
  180. ;;; Force update after go or Go-nonstop modes, so overlay arrow is correct.
  181. ;;; Support debug-on-quit.  Remove edebug-on-error.
  182. ;;; Fix edebug-anonymous.  Bug found by jackr@wpd.sgi.com (Jack Repenning).
  183. ;;; Don't discard-input anymore.  Easier to change modes this way.
  184. ;;; Fix max-lisp-eval-depth and max-specpdl-size incrementing.
  185. ;;; Save and restore points in all buffers, if
  186. ;;;         edebug-save-buffer-points is non-nil.  Expensive!
  187. ;;;         Bug caught by wolfgang@wsrcc.com (Wolfgang S. Rupprecht)
  188. ;;; Save standard-output and standard-input in edebug-recursive-edit
  189. ;;;         so that edebug-outside-excursion can restore them.
  190. ;;; Call set-buffer in edebug-pop-to-buffer since
  191. ;;;         select-window does not do that.
  192. ;;; Fix edebug's eval-defun to remember current buffer inside evaluations
  193. ;;;         and to evaluate top-level forms.  Found by Jamie Zawinski.
  194. ;;; Add edebug-interactive-entry to support interactive forms with
  195. ;;;         non-string arg. Bug found by Jack Repenning.
  196. ;;; Simplify edebug-restore-match-data to just store-match-data.
  197. ;;;         Motivated by linus@lysator.liu.se.
  198. ;;; Move the match-data call to before the outside
  199. ;;;         buffer is changed, since it assumes that.
  200. ;;; 
  201. ;;; Revision 2.3  91/01/17  20:55:14  liberte
  202. ;;; Fix bug found by hollen@megatek.uucp.
  203. ;;;     Current buffer was not being restored.
  204. ;;; Call edebug with (edebug begin end 'exp)
  205. ;;;     and add additional wrapper around body of functions:
  206. ;;;     (edebug-enter function body).
  207. ;;; Make &optional only apply to immediate next arg
  208. ;;;     in edebug-interpret-form-spec (was edebug-macro-parser).
  209. ;;; Catch debug errors with edebug.  Yeah!
  210. ;;; Reset edebug-mode on first function entry.  Yeah!
  211. ;;;     Motivated by Dion Hollenbeck.
  212. ;;; Add the missing bindings to the global-edebug-map.
  213. ;;; eval-current-buffer now uses eval-region.
  214. ;;; eval-region now does not narrow region.
  215. ;;;     Narrowing was the cause of the window-start being set wrong.
  216. ;;; Reset edebug-mode only on
  217. ;;;     first entry of any function at each recursive-edit level.
  218. ;;; Add edebug-backtrace, to generate cleaned up
  219. ;;;     backtrace.  It doesnt "work" like the debug backtrace, however.
  220. ;;; Require reselecting outside window even if
  221. ;;;     quit occurs, otherwise save-excursions may restore
  222. ;;;     buffer to the wrong window.
  223. ;;; 
  224. ;;; Revision 2.2  90/11/26  21:14:22  liberte
  225. ;;; Shadow eval-defun and eval-region.  Toggle
  226. ;;;     edebugging with edebug-all-defuns.
  227. ;;; Call edebug with (edebug 'function begin end 'exp)
  228. ;;;     Suggested by Jamie Zawinski <jwz@lucid.com>.
  229. ;;; Add edebug-interpret-form-spec to process macro args.
  230. ;;;     Motivated by Darryl Okahata darrylo@hpnmxx.hp.com.
  231. ;;; Fix by Roland McGrath <roland@ai.mit.edu>
  232. ;;;     to wrap body of edebug-save-restriction in progn.
  233. ;;; Fix by Darryl Okahata <darrylo%hpnmd@hpcea.hp.com>
  234. ;;;     to add (set-window-hscroll (selected-window) 0) to
  235. ;;;     edebug-pop-to-buffer.
  236. ;;; 
  237. ;;; Revision 2.1  90/11/16  21:55:35  liberte
  238. ;;; Clean up.
  239. ;;; Add edebug-form-spec to edebug macro calls. Thanks to Joe Wells.
  240. ;;; edebug-forward-sexp uses step mode if no forward-sexp.
  241. ;;; 
  242. ;;; Revision 2.0  90/11/14  22:30:54  liberte
  243. ;;; Handle lambda forms, function, interactive evals, defmacro.
  244. ;;; Clean up display for Epoch - save and restore screen configurations.
  245. ;;;   Note: epoch 3.2 broke set-window-configuration.
  246. ;;;   Also, sit-for pauses do not always work in epoch.
  247. ;;; Display evaluations window.
  248. ;;; Display result after expression evaluation.
  249. ;;;   Thanks to discussions with Shinichirou Sugou.
  250. ;;; Conditional and temporary breakpoints.
  251. ;;; Change "continue" to "go" mode and add different "continue" mode.
  252. ;;; Option to stop before symbols.
  253. ;;;
  254. ;;; Fix by: Glen Ditchfield  gjditchfield@violet.uwaterloo.ca
  255. ;;; to handle ?# type chars.
  256. ;;;
  257. ;;; Revision 1.5  89/05/10  02:39:27  liberte
  258. ;;; Fix condition-case expression lists.
  259. ;;; Reorganize edebug.
  260. ;;; 
  261. ;;; Revision 1.4  89/02/14  22:58:34  liberte
  262. ;;; Fix broken breakpointing.
  263. ;;; Temporarily widen elisp buffer during edebug.
  264. ;;; 
  265. ;;; Revision 1.3  89/01/30  00:26:09  liberte
  266. ;;; More bug fixes for cond and let.
  267. ;;; Another parsing fix backquote.
  268. ;;; Fix for lambda forms inside defuns.
  269. ;;; Leave point at syntax error, mark at starting position.
  270. ;;; 
  271. ;;; Revision 1.2  88/11/28  12:14:15  liberte
  272. ;;; Bug fixes: cond construct didnt execute.
  273. ;;;   () in sexp list didnt parse
  274. ;;;   () as variable in condition-case didnt parse.
  275. ;;; 
  276. ;;; Revision 1.1  88/11/28  12:11:27  liberte
  277. ;;; Initial revision
  278. ;;; 
  279.  
  280.  
  281. ;;; Options
  282. ;;; -------
  283.  
  284. (defvar edebug-all-defuns nil
  285.   "*If non-nil, all defuns and defmacros evaluated will use edebug.
  286. eval-defun without prefix arg and eval-region will use edebug-defun.
  287.  
  288. If nil, eval-region evaluates normally, but eval-defun with prefix arg
  289. uses edebug-defun.  eval-region is called by eval-defun, eval-last-sexp,
  290. and eval-print-last-sexp.
  291.  
  292. You may wish to make this variable local to each elisp buffer by calling
  293. (make-local-variable 'edebug-all-defuns) in your emacs-lisp-mode-hook.
  294. You can use the function edebug-all-defuns to toggle its value.")
  295.  
  296.  
  297. (defvar edebug-eval-macro-args nil
  298.   "*If non-nil, edebug will assume that all macro call arguments for
  299. macros that have no edebug-form-spec may be evaluated, otherwise it
  300. assumes they will not be evaluated.  To specify exceptions for macros
  301. that have some arguments evaluated and some not, you should specify an
  302. edebug-form-spec")
  303.  
  304. (defvar edebug-stop-before-symbols nil
  305.   "*Non-nil causes edebug to stop before symbols as well as after.
  306. In any case, it is possible to stop before a symbol with a breakpoint or
  307. interrupt.")
  308.  
  309. (defvar edebug-save-windows t
  310.   "*If non-nil, save and restore window configuration on edebug calls.
  311. It takes some time to save and restore, so if your program does not care
  312. what happens to the window configurations, it is better to set this
  313. variable to nil.")
  314.  
  315. ;;(defvar edebug-save-point t
  316. ;;  "*If non-nil, save and restore the point and mark in source code buffers.")
  317.  
  318. (defvar edebug-save-displayed-buffer-points nil
  319.   "*If non-nil, save and restore the points of all displayed buffers.
  320.  
  321. Saving and restoring buffer points is necessary if you are debugging
  322. code that changes the point of a buffer which is displayed in a
  323. non-selected window.  If edebug or the user then selects the
  324. window, the buffer's point will be changed to the window's point.
  325.  
  326. Saving and restoring is an expensive operation since it visits each
  327. window and each displayed buffer twice for each edebug call, so it is
  328. best to avoid it if you can.")
  329.  
  330. (defvar edebug-initial-mode 'step
  331.   "*Global initial mode for edebug, if non-nil.
  332. This is used when edebug is first entered for each recursive-edit level.
  333. Possible values are nil (meaning keep using edebug-mode), step, go,
  334. Go-nonstop, trace, Trace-fast, continue, and Continue-fast.")
  335.  
  336. (defvar edebug-trace nil
  337.   "*Non-nil if edebug should show a trace of function entry and exit.
  338. Tracing output is displayed in a buffer named *edebug-trace*, one
  339. function entry or exit per line, indented by the recursion level.  You
  340. can customize by replacing functions edebug-print-trace-entry and
  341. edebug-print-trace-exit.")
  342.  
  343.  
  344.  
  345. ;;;========================================================================
  346. ;;; Utilities
  347. ;;; ---------
  348.  
  349. (defun edebug-which-function ()
  350.   "Return the symbol of the function we are in."
  351.   (save-excursion
  352.     (end-of-defun)
  353.     (beginning-of-defun)
  354.     (down-list 1)
  355.     (if (not (memq (read (current-buffer)) '(defun defmacro)))
  356.     (error "Not in defun or defmacro."))
  357.     (read (current-buffer))))
  358.  
  359. (defun edebug-last-sexp ()
  360.   "Return the last sexp before point in current buffer.
  361. Assumes elisp syntax is active."
  362.   (car
  363.    (read-from-string
  364.     (buffer-substring
  365.      (save-excursion
  366.        (forward-sexp -1)
  367.        (point))
  368.      (point)))))
  369.  
  370. ;; Not used.
  371. (defun edebug-window-list ()
  372.   "Return a list of windows, in order of next-window."
  373.   ;; This doesnt work for epoch.
  374.   (let* ((first-window (selected-window))
  375.      (window-list (list first-window))
  376.      (next (next-window first-window)))
  377.     (while (not (eq next first-window))
  378.       (setq window-list (cons next window-list))
  379.       (setq next (next-window next)))
  380.     (nreverse window-list)))
  381.  
  382. (defun edebug-get-emacs-displayed-buffer-points ()
  383.   "Return a list of buffer point pairs, for all displayed buffers."
  384.   (save-excursion
  385.     (let* ((first-window (selected-window))
  386.        (next (next-window first-window))
  387.        (buffer-point-list nil)
  388.        buffer)
  389.       (while (not (eq next first-window))
  390.     (set-buffer (setq buffer (window-buffer next)))
  391.     (setq buffer-point-list
  392.           (cons (cons buffer (point)) buffer-point-list))
  393.     (setq next (next-window next)))
  394.       buffer-point-list)))
  395.  
  396.  
  397. (defun edebug-set-buffer-points (buffer-points)
  398.   "Restore the buffer-points created by edebug-get-displayed-buffer-points."
  399.   (let ((current-buffer (current-buffer)))
  400.     (mapcar (function (lambda (buf-point)
  401.             (if (buffer-name (car buf-point)) ; still exists
  402.                 (progn
  403.                   (set-buffer (car buf-point))
  404.                   (goto-char (cdr buf-point))))))
  405.         buffer-points)
  406.     (set-buffer current-buffer)))
  407.  
  408. ;; Not used.
  409. (defun edebug-two-window-p ()
  410.   "Return t if there are two windows."
  411.   (and (not (one-window-p))
  412.        (eq (selected-window)
  413.        (next-window (next-window (selected-window))))))
  414.  
  415. (defun edebug-macrop (object)
  416.   "Return the macro named by OBJECT, or nil if it is not a macro."
  417.   (while (and (symbolp object) (fboundp object))
  418.     (setq object (symbol-function object)))
  419.   (if (and (listp object)
  420.        (eq 'macro (car object))
  421.        (edebug-functionp (cdr object)))
  422.       object))
  423.  
  424. (defun edebug-functionp (object)
  425.   "Returns the function named by OBJECT, or nil if it is not a function."
  426.   (while (and (symbolp object) (fboundp object))
  427.     (setq object (symbol-function object)))
  428.   (if (or (subrp object)
  429.       (and (listp object)
  430.            (eq (car object) 'lambda)
  431.            (listp (car (cdr object)))))
  432.       object))
  433.  
  434. (defun edebug-sort-alist (alist function)
  435.   "Return the ALIST sorted with comparison function FUNCTION.
  436. This uses 'sort so the sorting is destructive."
  437.   (sort alist (function
  438.            (lambda (e1 e2)
  439.          (funcall function (car e1) (car e2))))))
  440.  
  441. (put 'edebug-save-restriction 'edebug-form-spec t)
  442.  
  443. ;; Not used.
  444. (defmacro edebug-save-restriction (&rest body)
  445.   "Evaluate BODY while saving the current buffers restriction.
  446. BODY may change buffer outside of current restriction, unlike
  447. save-restriction.  BODY may change the current buffer,
  448. and the restriction will be restored to the original buffer,
  449. and the current buffer remains current.
  450. Return the result of the last expression in BODY."
  451.   (` (let ((edebug:s-r-beg (point-min-marker))
  452.        (edebug:s-r-end (point-max-marker)))
  453.        (unwind-protect
  454.        (progn (,@ body))
  455.      (save-excursion
  456.        (set-buffer (marker-buffer edebug:s-r-beg))
  457.        (narrow-to-region edebug:s-r-beg edebug:s-r-end))))))
  458.  
  459.  
  460. ;;--------------------------
  461. ;; Epoch related things
  462.  
  463. ;; We could use zones to highlight the current expression,
  464. ;; or to indicate frequency of use.
  465.  
  466. (defvar epoch::version nil
  467.   "This will be predefined as non-nil in epoch.")
  468.  
  469.  
  470. (defmacro def-edebug-func (edebug-func epoch-func emacs-func)
  471.   "Define a function as either the epoch version or the emacs version."
  472.   (` (fset (quote (, edebug-func))
  473.        (if epoch::version
  474.           (symbol-function (quote (, epoch-func)))
  475.         (symbol-function (quote (, emacs-func)))))))
  476.  
  477.  
  478. (defun edebug-get-epoch-displayed-buffer-points ()
  479.   "Return a list of buffer point pairs, for all displayed buffers."
  480.   (let ((buffer-point-list nil))
  481.     (mapcar 
  482.      (function 
  483.       (lambda (screen)
  484.     (select-screen screen)
  485.     (save-excursion
  486.       (let* ((first-window (selected-window))
  487.          (next (next-window first-window)))
  488.         (while (not (eq next first-window))
  489.           (setq buffer-point-list
  490.             (cons (cons (window-buffer next) (point)) 
  491.               buffer-point-list))
  492.           (setq next (next-window next)))
  493.         buffer-point-list))))
  494.      (epoch::screen-list 'unmapped))
  495.     buffer-point-list
  496.     ))
  497.  
  498. (def-edebug-func edebug-get-displayed-buffer-points
  499.   edebug-get-epoch-displayed-buffer-points
  500.   edebug-get-emacs-displayed-buffer-points)
  501.  
  502. (defun edebug-pop-to-buffer (buffer)
  503.   "Like pop-to-buffer, but select a window that buffer was shown in.
  504. If running epoch, use the same screen too."
  505.   (let ((edebug-window (edebug-get-buffer-window buffer)))
  506.     (if edebug-window 
  507.     (select-window edebug-window)
  508.       ;; It is not currently displayed, so find some place to display it.
  509.       (if epoch::version
  510.       ;; Select a screen that the buffer has been displayed in before
  511.       ;; or the current screen otherwise.
  512.       (select-screen
  513.        ;; allowed-screens in epoch 3.2, was called screens before that
  514.        (or (car (symbol-buffer-value 'allowed-screens buffer))
  515.            (epoch::current-screen))))
  516.       (if (one-window-p)
  517.       (split-window))
  518.       (select-window (next-window))
  519.       (set-window-buffer (selected-window) buffer)
  520.       (set-window-hscroll (selected-window) 0)
  521.       ))
  522.   ;; Selecting the window does not set the buffer??  docs says it does.
  523.   ;; But just returning the buffer is not equivalent.
  524.   (set-buffer buffer)
  525.   ;; buffer
  526.   )
  527.  
  528.  
  529. ;; For epoch, we need to save and restore screens as well as windows.
  530.  
  531. (defun edebug-current-screen-configuration ()
  532.   "Return an object recording the current configuration of Epoch screen-list.  
  533. The object is a list of pairs of the form (SCREEN .  CONFIGURATION)
  534. where SCREEN has window-configuration CONFIGURATION.  The current
  535. screen is the head of the list."
  536.   (let ((screen-list (epoch::screen-list 'unmapped))
  537.     (current-screen (epoch::get-screen))
  538.     (current-buffer (current-buffer))
  539.     )
  540.     ;; Put current screen first.
  541.     (setq screen-list (cons current-screen (delq current-screen screen-list)))
  542.     (prog1
  543.     (mapcar (function
  544.          (lambda (screen)
  545.            (cons screen
  546.              (progn
  547.                (epoch::select-screen screen)
  548.                (current-window-configuration)))))
  549.         screen-list)
  550.  
  551.       ;; Recover from the excursion.
  552.       (epoch::select-screen current-screen)
  553.       (set-buffer current-buffer)
  554.       )))
  555.  
  556. "Return the current window or screen configuration."
  557. (def-edebug-func edebug-current-window-configuration 
  558.   edebug-current-screen-configuration
  559.   current-window-configuration)
  560.  
  561.  
  562. (defun edebug-set-screen-configuration (sc)
  563.   "Set the window-configuration for all the screens in SC.
  564. Set the current screen to be the head of SC."
  565.     (mapcar (function
  566.          (lambda (screen-conf)
  567.            (if (epoch::screen-p (car screen-conf))  ; still exist?
  568.            (progn
  569.              (epoch::select-screen (car screen-conf))
  570.              (set-window-configuration (cdr screen-conf))))))
  571.         sc)
  572.     (if (epoch::screen-p (car (car sc)))
  573.     (epoch::select-screen (car (car sc))))
  574.     )
  575.  
  576. "Set the window or screen configuration to CONF."
  577. (def-edebug-func edebug-set-window-configuration 
  578.   edebug-set-screen-configuration
  579.   set-window-configuration)
  580.  
  581.  
  582. (def-edebug-func edebug-get-buffer-window
  583.   epoch::get-buffer-window
  584.   get-buffer-window)
  585.  
  586.  
  587. ;; Input event handling in epoch requires we do a dispatch-events
  588. ;; in order to get the full effect of sit-for and input-pending-p.
  589.  
  590. (defun edebug-epoch-sit-for (arg)
  591.   (epoch::dispatch-events)
  592.   (sit-for arg))
  593.  
  594. (def-edebug-func edebug-sit-for edebug-epoch-sit-for sit-for)
  595.  
  596.  
  597. (defun edebug-epoch-input-pending-p ()
  598.   (epoch::dispatch-events)
  599.   (input-pending-p))
  600.  
  601. (def-edebug-func edebug-input-pending-p
  602.   edebug-epoch-input-pending-p
  603.   input-pending-p)
  604.  
  605. ;;=============================================================
  606. ;; Printing functions
  607.  
  608. (defun edebug-install-custom-print-funcs ()
  609.   "Replace edebug print functions with custom versions.
  610. Updating the custom print functions, or changing print-length,
  611. print-level, print-circle, custom-print-list or custom-print-vector
  612. have immediate effect."
  613.   (interactive)
  614.   (require 'custom-print)
  615.   (fset 'edebug-prin1 'custom-prin1)
  616.   (fset 'edebug-print 'custom-print)
  617.   (fset 'edebug-prin1-to-string 'custom-prin1-to-string)
  618.   (fset 'edebug-format 'custom-format))
  619.  
  620.   
  621. (defun edebug-reset-print-funcs ()
  622.   "Replace edebug custom print functions with internal versions."
  623.   (interactive)
  624.   (require 'custom-print)
  625.   (fset 'edebug-prin1 (symbol-function 'CP::internal-prin1))
  626.   (fset 'edebug-print (symbol-function 'CP::internal-print))
  627.   (fset 'edebug-prin1-to-string
  628.     (symbol-function 'CP::internal-prin1-to-string))
  629.   (fset 'edebug-format (symbol-function 'CP::internal-format))
  630.   )
  631.  
  632. ;; Default print functions are the same as Emacs'.
  633. (fset 'edebug-prin1 (symbol-function 'prin1))
  634. (fset 'edebug-print (symbol-function 'print))
  635. (fset 'edebug-prin1-to-string (symbol-function 'prin1-to-string))
  636. (fset 'edebug-format (symbol-function 'format))
  637.  
  638.  
  639. ;;;=============================================================
  640. ;;; Redefine eval-defun, eval-region, and eval-current-buffer.
  641. ;;; -----------------------------------------------------------
  642.  
  643. (defun edebug-all-defuns ()
  644.   "Toggle edebugging of all defuns and defmacros,
  645. not including those evaluated in the minibuffer, or during load."
  646.   (interactive)
  647.   (setq edebug-all-defuns (not edebug-all-defuns))
  648.   (message "Edebugging is %s." (if edebug-all-defuns "on" "off")))
  649.  
  650.  
  651. (if (not (fboundp 'edebug-emacs-eval-defun))
  652.     (fset 'edebug-emacs-eval-defun (symbol-function 'eval-defun)))
  653. ;; Use the following to undo the above.
  654. ;;(fset 'eval-defun (symbol-function 'edebug-emacs-eval-defun))
  655.  
  656. (defun eval-defun (edebug-debug-it)
  657.   "Edebug replacement for eval-defun.  Print value in the minibuffer.
  658. Evaluate the top-level form that point is in or before.  Note:
  659. eval-defun normally evaluates any top-level form, not just defuns.  
  660.  
  661. Here are the differences from the standard eval-defun:  If the prefix
  662. argument is the same as edebug-all-defuns (nil or non-nil), evaluate
  663. normally; otherwise edebug-defun is called to wrap edebug calls around
  664. evaluatable expressions in the defun or defmacro body.  Also, the
  665. value printed by edebug-defun is not just the function name."
  666.   (interactive "P")
  667.   (let ((edebug-all-defuns
  668.      (not (eq (not edebug-debug-it) (not edebug-all-defuns)))))
  669.     (edebug-emacs-eval-defun nil)
  670.     ))
  671.  
  672.  
  673. (if (not (fboundp 'edebug-emacs-eval-region))
  674.     (fset 'edebug-emacs-eval-region (symbol-function 'eval-region)))
  675. ;; Use the following to undo the above.
  676. ;; (fset 'eval-region (symbol-function 'edebug-emacs-eval-region))
  677.  
  678. (defun eval-region (edebug-e-r-start edebug-e-r-end
  679.                       &optional edebug-e-r-output)
  680.   "Edebug replacement for eval-region.
  681. Like eval-region, but call edebug-defun for defuns or defmacros.
  682. Also, this eval-region does not narrow to the region and
  683. if an error occurs, point is left at the error."
  684.   ;; One other piddling difference concerns whitespace after the expression.
  685.   (interactive "r")
  686.   (let ((standard-output (or edebug-e-r-output 'symbolp))
  687.     (edebug-e-r-pnt (point))
  688.     (edebug-e-r-buf (current-buffer))
  689.     (edebug-e-r-inside-buf (current-buffer))
  690.     ;; Mark the end because it may move.
  691.     (edebug-e-r-end-marker (set-marker (make-marker) edebug-e-r-end))
  692.     edebug-e-r-val
  693.     )
  694.     (goto-char edebug-e-r-start)
  695.     (edebug-skip-whitespace)
  696.     (while (< (point) edebug-e-r-end-marker)
  697.       (if (and edebug-all-defuns
  698.            (eq 'lparen (edebug-next-token-class))
  699.            (save-excursion
  700.          (forward-char 1)    ; skip \(
  701.          (memq (edebug-read-sexp) '(defun defmacro))))
  702.       (progn
  703.         (edebug-defun)
  704.         ;; Potential problem: edebug-defun always prints name.
  705.         (forward-sexp 1)        ; skip the defun
  706.         )
  707.     (if (and (eq 'lparen (edebug-next-token-class))
  708.          (save-excursion
  709.            (forward-char 1)    ; skip \(
  710.            (memq (edebug-read-sexp) '(defun defmacro))))
  711.         ;; If it's a defun or defmacro, but not edebug-all-defuns
  712.         ;; reset the symbols edebug property to be just a marker at
  713.         ;; the definitions source code.
  714.         (put (edebug-which-function) 'edebug (point-marker)))
  715.  
  716.     ;; Evaluate normally - after restoring the current-buffer.
  717.     (setq edebug-e-r-val (edebug-read-sexp))
  718.     (save-excursion
  719.       (set-buffer edebug-e-r-inside-buf)
  720.       (setq edebug-e-r-val (eval edebug-e-r-val))
  721.       ;; Remember current buffer for next time.
  722.       (setq edebug-e-r-inside-buf (current-buffer)))
  723.  
  724.     (if edebug-e-r-output
  725.         (progn
  726.           (setq values (cons edebug-e-r-val values))
  727.           (if (eq standard-output t)
  728.           (prin1 edebug-e-r-val)
  729.         (princ "\n")
  730.         (prin1 edebug-e-r-val)
  731.         (princ "\n")
  732.         )))
  733.     )
  734.       (goto-char
  735.        (min (max edebug-e-r-end-marker (point))
  736.         (progn (edebug-skip-whitespace) (point))))
  737.       )                    ; while
  738.     (if (null edebug-e-r-output)
  739.     ;; do the save-excursion recovery
  740.     (progn
  741.       ;; but mark is not restored
  742.       (set-buffer edebug-e-r-buf)
  743.       (goto-char edebug-e-r-pnt)))
  744.     nil
  745.     ))
  746.  
  747.  
  748. ;; The standard eval-current-buffer doesn't use eval-region.
  749. (if (not (fboundp 'edebug-emacs-eval-current-buffer))
  750.     (fset 'edebug-emacs-eval-current-buffer
  751.       (symbol-function 'eval-current-buffer)))
  752. ;; Use the following to undo the above.
  753. ;; (fset 'eval-current-buffer (symbol-function 'edebug-emacs-eval-current-buffer))
  754.  
  755. (defun eval-current-buffer (&optional edebug-e-c-b-output)
  756.   "Call eval-region on the whole buffer."
  757.   (interactive)
  758.   (eval-region (point-min) (point-max) edebug-e-c-b-output))
  759.  
  760.  
  761.  
  762. ;;;======================================================================
  763. ;;; The Parser
  764. ;;; ----------
  765.  
  766. ;;; The top level function for parsing defuns is edebug-defun; it
  767. ;;; calls all the rest.  It checks the syntax a bit and leaves point
  768. ;;; at any error it finds, but otherwise should appear to work like
  769. ;;; eval-defun.
  770.  
  771. ;;; The basic plan is to surround each expression with a call to
  772. ;;; the edebug debugger together with indexes into a table of positions of
  773. ;;; all expressions.  Thus an expression "exp" in function foo
  774. ;;; becomes:
  775.  
  776. ;;; (edebug-after (edebug-before 1) exp)
  777.  
  778. ;;; First point moved to to the beginning of exp (offset 1 of the
  779. ;;; current function).  Then the expression is evaluated and point is
  780. ;;; moved to offset 2 (calculated from offset 1), after the end of exp.
  781.  
  782. ;;; The top level expressions of the function are wrapped in a call to
  783. ;;; edebug-enter, which supplies the function name and the actual
  784. ;;; arguments to the function.  See functions edebug-enter, edebug-before,
  785. ;;; and edebug-after for more details.
  786.  
  787.  
  788. (defun edebug-defun ()
  789.   "Evaluate defun or defmacro, like eval-defun, but with edebug calls.
  790. Print its name in the minibuffer and leave point where it is,
  791. or if an error occurs, leave point after it with mark at the original point."
  792.   (interactive)
  793.   (let ((starting-point (point))
  794.     def-name)
  795.   
  796.     (end-of-defun)
  797.     (beginning-of-defun)
  798.     (condition-case err
  799.     (let (def-kind def-name)
  800.       (down-list 1)
  801.       (setq 
  802.        def-kind  (edebug-read-sexp) ; defmacro or defun?
  803.        def-name
  804.        (eval
  805.         (if (not (memq def-kind '(defun defmacro)))
  806.         (edebug-syntax-error "%s is not a defun or defmacro."
  807.                      def-kind)
  808.           (cons def-kind (edebug-func-form)))))
  809.       (message "edebug: %s" def-name)
  810.  
  811.       ;; Recover point, like save-excursion but only if no error occurs.
  812.       (goto-char starting-point)
  813.       def-name
  814.       )                ; progn
  815.       
  816.       (invalid-read-syntax
  817.        ;; Set mark at starting-point so user can return.
  818.        ;; Leave point at error.
  819.        (save-excursion  
  820.      (goto-char starting-point)
  821.      (set-mark-command nil))
  822.        (message "Syntax error: %s" (cdr err))
  823.        ;;       (signal 'invalid-read-syntax (cdr err))  ; pass it on, to who?
  824.        )
  825.       )                    ; condition-case
  826.     ))
  827.  
  828.  
  829. ;; Dynamically bound vars, left unbound, but globally declared.
  830. (defvar edebug-func-mark) ; the mark for function being evaluated.
  831. (defvar edebug-offset-index) ; the next available offset index.
  832. (defvar edebug-offset-list) ; the list of offset positions.
  833. (defvar edebug-before-to-after-alist) ; conversion from before to after index
  834.   
  835. (defvar def-name) ; function or macro being defined, used by interactive-form
  836.  
  837. (defun edebug-func-form ()
  838.   "Process the defun form starting before defun or defmacro."
  839.   ;; This may now be used as a edebug-form-spec function.
  840.   (let (
  841.     def-name
  842.     def-args
  843.     def-docstring
  844.     defun-interactive
  845.     edebug-forms
  846.     (edebug-offset-index 0)
  847.     edebug-offset-list
  848.     edebug-before-to-after-alist
  849.     edebug-func-mark
  850.     tmp-point
  851.     (parse-sexp-ignore-comments t))
  852.     
  853.     (setq edebug-func-mark (point-marker))
  854.     (setq def-name (edebug-read-sexp))
  855.     (if (not (symbolp def-name))
  856.     (edebug-syntax-error "Bad name: %s" def-name))
  857.     (setq def-args (edebug-read-sexp))
  858.     (if (not (listp def-args))
  859.     (edebug-syntax-error "Bad arg list: %s" def-args))
  860.       
  861.     ;; Look for doc string.
  862.     (setq tmp-point (point))
  863.     (if (eq 'string (edebug-next-token-class))
  864.     (progn
  865.       (setq def-docstring (edebug-read-sexp))
  866.       (setq tmp-point (point))))
  867.       
  868.     ;; Look for interactive form.
  869.     (if (eq 'lparen (edebug-next-token-class))
  870.     (progn
  871.       (forward-char 1)        ; skip \(
  872.       (if (eq 'interactive (edebug-read-sexp))
  873.           (progn
  874.         (setq defun-interactive
  875.               (cons 'interactive (edebug-interactive-form)))
  876.         (forward-char 1)    ; skip \)
  877.         (setq tmp-point (point))
  878.         ))))
  879.       
  880.     (goto-char tmp-point)
  881.  
  882.     ;; Process the rest of the body.
  883.     (setq edebug-forms (edebug-forms))
  884.  
  885.     ;; Side effects on the property list of def-name.
  886.     ;; Create and store the after-index vector.
  887.     (put def-name 'edebug-after-index
  888.      (let ((after-vector
  889.         (make-vector (length edebug-offset-list) -1)))
  890.        (mapcar (function
  891.             (lambda (pair)
  892.               (aset after-vector (car pair) (cdr pair))))
  893.            edebug-before-to-after-alist)
  894.        after-vector))
  895.     
  896.     ;; Create initial frequency count vector.
  897.     (put def-name 'edebug-freq-count
  898.      (make-vector (length edebug-offset-list) 0))
  899.                    
  900.     ;; Store the offset list in function's property list.
  901.     ;; destructively modifies edebug-offset-list
  902.     (put def-name 'edebug
  903.      (list edebug-func-mark
  904.            nil            ; clear breakpoints
  905.            (vconcat (nreverse edebug-offset-list))))
  906.  
  907.     ;; Build and return the new arguments.
  908.     (list def-name def-args
  909.       def-docstring
  910.       defun-interactive
  911.       (` (edebug-enter
  912.           (quote (, def-name))
  913.           (list (,@ (delq 'rest (delq '&optional 
  914.                       (copy-sequence def-args)))))
  915.           (function 
  916.            (lambda ()
  917.          ;; the remainder is a list of forms
  918.          (,@ edebug-forms))))
  919.          ))
  920.     ))
  921.  
  922.  
  923. ;;(proclaim-inline 'edebug-forms)
  924.  
  925. (defun edebug-forms ()
  926.   "Process a list of forms."
  927.   (edebug-sexp-list t))
  928.  
  929. ;;(proclaim-inline 'edebug-sexps)
  930.  
  931. (defun edebug-sexps ()
  932.   "Process a list of sexps, unevaluated."
  933.   (edebug-sexp-list nil))
  934.  
  935. (defun edebug-sexp-list (debuggable)
  936.   "Return an edebug form built from the sexp list following point in the
  937. current buffer. If DEBUGGABLE then wrap edebug calls around each sexp.
  938. The sexp list does not start with a left paren; we are already in the list.
  939. Leave point at (before) the trailing right paren."
  940.   (let (sexp-list)
  941.     (while (not (eq 'rparen (edebug-next-token-class)))
  942.       (setq sexp-list (cons (if debuggable
  943.                 (edebug-form)
  944.                   (edebug-read-sexp))
  945.                 sexp-list)))
  946.     (nreverse sexp-list)))
  947.  
  948.  
  949. (defun edebug-increment-offset ()
  950.   ;; modifies edebug-offset-index and edebug-offset-list
  951.   ;; accesses edebug-func-marc and buffer point
  952.   (setq edebug-offset-index (1+ edebug-offset-index))
  953.   (setq edebug-offset-list (cons (- (point) edebug-func-mark)
  954.                  edebug-offset-list)))
  955.  
  956.  
  957. (defun edebug-make-edebug-form (index form)
  958.   "Return the edebug form for the current function at offset INDEX given FORM.
  959. Looks like: (edebug-after (edebug-before INDEX) FORM).
  960. Also increment the offset index."
  961.   (prog1
  962.       (list 'edebug-after
  963.         (if (or (not (symbolp form))
  964.             edebug-stop-before-symbols)
  965.         (list 'edebug-before index)
  966.           edebug-offset-index)
  967.         form)
  968.     (setq edebug-before-to-after-alist 
  969.       (cons (cons index edebug-offset-index) edebug-before-to-after-alist))
  970.     (edebug-increment-offset)
  971.     ))
  972.  
  973.  
  974. (defun edebug-form  ()
  975.   "Return the debug form for the following form.  Add the point offset
  976. to the edebug-offset-list for the function and move point to
  977. immediately after the form."
  978.   (let* ((index edebug-offset-index)
  979.      form class)
  980.     ;; The point must be added to the offset list now
  981.     ;; because edebug-list-form will add more offsets indirectly.
  982.     (edebug-skip-whitespace)
  983.     (edebug-increment-offset)
  984.     (setq class (edebug-next-token-class))
  985.     (cond
  986.      ((eq 'lparen class)
  987.       (edebug-make-edebug-form index (edebug-list-form)))
  988.  
  989.      ((eq 'symbol class)
  990.       (if (and (not (memq (setq form (edebug-read-sexp)) '(nil t)))
  991.            ;; note: symbol includes numbers, see parsing utilities
  992.            (not (numberp form)))
  993.       (edebug-make-edebug-form index form)
  994.     form))
  995.      (t (edebug-read-sexp)))))
  996.  
  997.  
  998. (defun edebug-list-form ()
  999.   "Return an edebug form built from the list form that follows point.
  1000. Insert debug calls as appropriate to the form.  Start with point before
  1001. the left paren; leave point after the right paren."
  1002.   (let (class
  1003.     head)
  1004.     
  1005.     (forward-char 1)    ; skip \(
  1006.     (setq class (edebug-next-token-class))
  1007.     (cond
  1008.      ((eq 'symbol class) (setq head (edebug-read-sexp)))
  1009.      ((eq 'lparen class) (setq head (edebug-anonymous-form)))
  1010.      ((eq 'rparen class) (setq head nil))  ; () is legal
  1011.  
  1012.      (t (edebug-syntax-error
  1013.      "Head of list must be a symbol or lambda expression.")))
  1014.     
  1015.     (prog1
  1016.     (if head
  1017.         (cons head
  1018.           (cond
  1019.            ((symbolp head)
  1020.             (let ((form (get head 'edebug-form-spec)))
  1021.               (if form
  1022.               (if (symbolp form)
  1023.                   (funcall form)
  1024.  
  1025.                 ;; Otherwise it is a spec.
  1026.                 (edebug-interpret-form-spec form))
  1027.             
  1028.             ;; No edebug-form-spec provided.
  1029.             (if (edebug-macrop head)
  1030.                 (edebug-sexp-list edebug-eval-macro-args)
  1031.               ;; Otherwise it is a function call.
  1032.               (edebug-forms))
  1033.             )))
  1034.  
  1035.            (t (edebug-forms))
  1036.            )))
  1037.       
  1038.       ;; Is this needed?                 
  1039.       (if (eq 'rparen (edebug-next-token-class))
  1040.       (forward-char 1) ; skip \)
  1041.     (edebug-syntax-error "Too many arguments."))
  1042.       )))
  1043.  
  1044.  
  1045. (defun edebug-interpret-form-spec (specs)
  1046.   "Parse the macro arguments that follow based on SPECS.  
  1047. SPECS describes the types of the arguments of a list form.  Each of the SPECS
  1048. is processed left to right, in the same order as the arguments of the
  1049. list form.  See the edebug documentation for more details.  The SPECS
  1050. may be one of the following:
  1051.  
  1052.  sexp - An unevaluated sexp (it may be an atom or list).
  1053.  form - An evaluated sexp.
  1054.  function - A function argument may be a quoted symbol or lambda
  1055.     expression (using quote or function) or a form (that evaluates
  1056.     to a function or lambda expression).
  1057.  
  1058.  foo -  Any other symbol should be the name of a function; this
  1059.     function is called on the argument as a predicate and an error
  1060.     is signaled if the predicate fails.  Standard predicates
  1061.      include symbolp, integerp, stringp, vectorp, and atom.
  1062.      An atom is an unevaluated number, string, symbol, or vector.
  1063.  
  1064.  &optional - All following specs in the list may or may not appear. 
  1065.  &rest - All following specs are repeated zero or more times.
  1066.     This is an extension of the normal meaning of &rest.
  1067.  &or -  Each of the following specs are alternatives, processed left to
  1068.     right until one succeeds.
  1069.  
  1070.  (...) - A sublist of the same format as the top level, processed recursively.
  1071.     Special case: if the car of the list is quote, the argument must match
  1072.     the quoted sexp (see example below of 'for macro).
  1073.  
  1074.  [...] - A sublist of the same format as the top level, processed recursively.
  1075.     It is processed like (...) except the matched arguments are inserted
  1076.     in-line into the arguments matched by the containing list.  This may be
  1077.     used for grouping to get one list element of the higher level list.
  1078. "
  1079.   ;; At the top level, we just catch any errors found and not caught below.
  1080.   (let* ((edebug-form)
  1081.      (error
  1082.       (catch 'no-match
  1083.         (setq edebug-form (edebug-interpret-form-spec1 specs nil))
  1084.         nil)))
  1085.     (if error
  1086.     (edebug-syntax-error error))
  1087.     edebug-form))
  1088.  
  1089.  
  1090. (defun edebug-interpret-form-spec1 (specs in-line)
  1091.   "Helper for edebug-interpret-form-spec.
  1092. If in-line is non-nil, don't reverse the resulting edebug form,
  1093. and don't complain about extra arguments."
  1094.   ;; Basic plan is to traverse the specs while matching with actual
  1095.   ;; arguments.  If a match fails, or if a spec is to be skipped,
  1096.   ;; no-match is thrown and caught within the loop.
  1097.  
  1098.   (let ((speclist specs)
  1099.     spec form form-list class was-in-line
  1100.     &optional &rest &or)
  1101.  
  1102.     ;; Process spec list until end of argument list.
  1103.     (while (and speclist
  1104.         (not (eq 'rparen (setq class (edebug-next-token-class)))))
  1105.       (setq spec (car speclist)
  1106.         speclist (cdr speclist)
  1107.         &or (and &or speclist)) ; Alternatives exist as long as specs do.
  1108.       
  1109.       ;; Process all the special specs.
  1110.       (while (memq spec '(&optional &rest &or))
  1111.       ;; Check reasonableness of specs
  1112.       (if (and (eq spec '&optional)
  1113.            (or &or &rest))
  1114.           (error "&optional doesn't make sense after %s"
  1115.              (if &or '&or '&rest)))
  1116.       (if (and (eq spec '&rest) &or)
  1117.           (error "&rest doesn't make sense after &or"))
  1118.  
  1119.       ;; Remember speclist at this point.
  1120.       (set spec speclist)
  1121.       (setq spec (car speclist)
  1122.         speclist (cdr speclist)
  1123.         &or (and &or speclist)))
  1124.       
  1125.       (let ((pnt (point)) ; Remember the last point we started matching at.
  1126.         (error
  1127.          (catch 'no-match
  1128.  
  1129.            (cond
  1130.         ((eq spec 'form)
  1131.          (setq form (edebug-form)))
  1132.  
  1133.         ((eq spec 'sexp)
  1134.          (setq form (edebug-read-sexp)))
  1135.  
  1136.         ((eq spec 'function)
  1137.          ;; A function argument may be a quoted symbol or lambda form
  1138.          ;; (with quote or function) or any evaluated form.
  1139.          ;; This needs a hand-crafted function for speed.
  1140.          (setq form 
  1141.                (edebug-interpret-form-spec1 
  1142.             '(&or ('function
  1143.                    &or symbolp 
  1144.                    ('lambda (&rest symbolp) &rest form))
  1145.                   ('quote 
  1146.                    &or symbolp
  1147.                    ('lambda (&rest symbolp) &rest form))
  1148.                   form)
  1149.             'in-line))
  1150.          (setq was-in-line t))
  1151.       
  1152.         ((listp spec)
  1153.          (cond
  1154.  
  1155.           ((eq 'quote (car spec))
  1156.            ;; Special case, match the quoted symbol.
  1157.            (setq spec (car (cdr spec)))
  1158.            (if (not (and (eq class 'symbol)
  1159.                  (eq spec (setq form (edebug-read-sexp)))))
  1160.                (throw 'no-match (format "\"%s\" expected." spec))
  1161.              ))
  1162.  
  1163.           ((eq class 'lparen)
  1164.            (forward-char 1)    ; skip \(
  1165.            (setq form (edebug-interpret-form-spec1 spec nil))
  1166.            (forward-char 1)    ; skip \)
  1167.            )
  1168.         
  1169.           ;; Handle weird special case for '(lambda ...).
  1170.           ((and (eq class 'quote)
  1171.             (equal (car spec) '(quote quote)))
  1172.            (forward-char 1)    ; skip \'
  1173.            (setq form 
  1174.              (cons 'function 
  1175.                    (edebug-interpret-form-spec1 (cdr spec) t))))
  1176.        
  1177.           (t (throw 'no-match "List expected."))
  1178.           ))
  1179.  
  1180.         ((symbolp spec)
  1181.          (let ((pred (if (fboundp spec) 
  1182.                  (symbol-function spec)
  1183.                    (error "%s is not a function." spec))))
  1184.            (if (not (funcall pred (setq form (edebug-read-sexp))))
  1185.                (throw 'no-match
  1186.                   (format "Predicate %s failed on %s." spec form))
  1187.              )))
  1188.  
  1189.         ((vectorp spec)
  1190.          (setq form (edebug-interpret-form-spec1 (append spec nil) t))
  1191.          (setq was-in-line t)    ; only if successful
  1192.          )
  1193.  
  1194.         (t (error "Bad item in edebug-form-spec: %s" spec))
  1195.         )            ; cond
  1196.  
  1197.            ;; The following are skipped by no-match throw.
  1198.  
  1199.            ;; Add the form to the form list.
  1200.            (if was-in-line
  1201.            (setq form-list (append form form-list)
  1202.              was-in-line nil)
  1203.          (setq form-list (cons form form-list)))
  1204.  
  1205.            ;; Since we matched, if we are in an &or, 
  1206.            ;; then skip rest of the spec.
  1207.            (if &or (setq speclist nil
  1208.                  &or nil))    ; Means the &or was matched.
  1209.  
  1210.            ;; If speclist is nil and &rest is not, reset speclist.
  1211.            (if (and &rest (null speclist))
  1212.            (setq speclist &rest))
  1213.  
  1214.            nil
  1215.            )            ; catch no-match
  1216.          ))
  1217.  
  1218.     (if error
  1219.         (if (not (or &or &optional))
  1220.         (throw 'no-match error)    ; leave point at error
  1221.           (goto-char pnt)        ; retry
  1222.           )))
  1223.       ) ; while
  1224.  
  1225.     ;; Check for errors at end of list.
  1226.     ;; Are there specs left over?
  1227.     (if (and speclist (not (or &optional &rest
  1228.                    ;; &optional or &rest may be next
  1229.                    (memq (car speclist)
  1230.                      '(&optional &rest)))))
  1231.     (throw 'no-match "Not enough arguments."))
  1232.  
  1233.     (if in-line nil
  1234.       ;; Are there arguments left over?
  1235.       (if (not (eq 'rparen (setq class (edebug-next-token-class))))
  1236.       (if (and &or (not (or &optional &rest)))
  1237.           (throw 'no-match "Unrecognized argument.")
  1238.         (throw 'no-match "Too many arguments.")))
  1239.  
  1240.       ;; Also reverse the elements of the form-list if not in a vector.
  1241.       (setq form-list (nreverse form-list))
  1242.       )
  1243.     form-list))
  1244.  
  1245.  
  1246. (defmacro def-edebug-form-spec (symbol form)
  1247.   "Set the edebug-form-spec property of SYMBOL according to FORM.  If
  1248. FORM is t, set it to edebug-forms.  If 0, set it to edebug-sexps.
  1249. Otherwise just use the evaluated FORM.  FORM can evaluate to a symbol,
  1250. which should be the name of a function, or a spec list for
  1251. edebug-interpret-form-spec."
  1252.   (` (put (quote (, symbol)) 'edebug-form-spec 
  1253.       (, (cond ((eq form t)
  1254.         '(quote edebug-forms))
  1255.            ((eq form 0)
  1256.         '(quote edebug-sexps))
  1257.            (t form))))))
  1258.  
  1259. (def-edebug-form-spec testit t)
  1260.  
  1261. (def-edebug-form-spec mapcar '(function form))
  1262. (def-edebug-form-spec mapconcat '(function form form))
  1263. (def-edebug-form-spec mapatoms '(function &optional form))
  1264. (def-edebug-form-spec apply '(function &rest form))
  1265. (def-edebug-form-spec funcall '(function &rest form))
  1266.  
  1267.  
  1268. ;; for loop defined in elisp manual
  1269. (def-edebug-form-spec for '(symbolp 'from form 'to form 'do &rest form))
  1270.  
  1271. ;; case and do defined in cl.el
  1272. (def-edebug-form-spec case '(form &rest (sexp form)))
  1273.  
  1274. (def-edebug-form-spec do
  1275.   '((&rest &or symbolp (symbolp &optional form form))
  1276.     (form &rest form)
  1277.     &rest body))
  1278.  
  1279. ;; quote allows only one argument.
  1280. (def-edebug-form-spec quote 'edebug-read-sexp)
  1281.  
  1282. ;; The defs.
  1283. (def-edebug-form-spec defvar '(symbolp &optional form stringp))
  1284.  
  1285. (def-edebug-form-spec defconst '(symbolp &optional form stringp))
  1286.  
  1287. ;; This is not right because the top level edebug-enter form is missing.
  1288. (def-edebug-form-spec defun 
  1289.   '(symbolp (&rest symbolp)
  1290.         &optional stringp
  1291.         ('interactive &optional &or stringp form)
  1292.         &rest form))
  1293. ;; Use edebug-func-form instead.
  1294. (def-edebug-form-spec defun 'edebug-func-form)
  1295.  
  1296. (def-edebug-form-spec defmacro 'edebug-func-form)
  1297.  
  1298.  
  1299. ;; function expects a symbol or a lambda expression
  1300. ;; A macro is allowed by Emacs.
  1301. (def-edebug-form-spec function
  1302.   '(&or symbolp 
  1303.     ([&optional 'macro] 'lambda (&rest symbolp) &rest form)))
  1304.  
  1305.  
  1306. (defun edebug-anonymous-form ()
  1307.   "Return the edebug form for an anonymous lambda or macro.
  1308. Point starts before the left paren and ends after it."
  1309.   (forward-char 1)    ; skip \(
  1310.   (prog1
  1311.       (let ((head (edebug-read-sexp)))
  1312.     (cond 
  1313.      ((eq head 'lambda)
  1314.       (edebug-lambda-form))
  1315.      ((eq head 'macro)
  1316.       (if (not (eq 'lambda (edebug-read-sexp)))
  1317.           (edebug-syntax-error "lambda expected."))
  1318.       (cons 'macro (edebug-lambda-form)))
  1319.      (t (edebug-syntax-error "Anonymous lambda or macro expected."))))
  1320.     (forward-char 1)    ; skip \)
  1321.     ))
  1322.  
  1323.  
  1324. (defun edebug-lambda-form ()
  1325.   "Return the edebug form for the lambda form that follows.
  1326. Point starts after the lambda symbol and is moved to before the right paren."
  1327.   (append
  1328.    (list 'lambda (edebug-read-sexp)) ; the args
  1329.    (edebug-forms))) ; the body
  1330.  
  1331.  
  1332.  
  1333. (def-edebug-form-spec let
  1334.   '((&rest
  1335.     &or symbolp (symbolp &optional form))
  1336.    &rest form))
  1337.  
  1338. (def-edebug-form-spec let*
  1339.   '((&rest
  1340.      &or symbolp (symbolp &optional form))
  1341.     &rest form))
  1342.  
  1343. (def-edebug-form-spec let 'edebug-let-form)
  1344. (def-edebug-form-spec let* 'edebug-let-form)
  1345.  
  1346.  
  1347. (defun edebug-let-form ()
  1348.   "Return the edebug form of the let or let* form.
  1349. Leave point before the right paren."
  1350.   (let (var-value-list
  1351.     token
  1352.     class)
  1353.     (cons
  1354.      ;; first process the var/value list
  1355.      (if (not (eq 'lparen (edebug-next-token-class)))
  1356.      (if (setq token (edebug-read-sexp))
  1357.          (edebug-syntax-error "Bad var list in let.") ; should be nil
  1358.        token  ; == nil
  1359.        )
  1360.        
  1361.        (forward-char 1)            ; lparen
  1362.        (while (not (eq 'rparen (setq class (edebug-next-token-class))))
  1363.      (setq var-value-list
  1364.            (cons
  1365.         (if (not (eq 'lparen class))
  1366.             (edebug-read-sexp)
  1367.           (forward-char 1)        ; lparen
  1368.           (prog1
  1369.               (edebug-var-value)
  1370.             (if (not (eq 'rparen (edebug-next-token-class)))
  1371.             (edebug-syntax-error "Right paren expected in let.")
  1372.               (forward-char 1)        ; rparen
  1373.               )))
  1374.         var-value-list)))
  1375.        (forward-char 1)            ; rparen
  1376.        (nreverse var-value-list))
  1377.      
  1378.      ;; now process the expression list
  1379.      (edebug-forms))))
  1380.  
  1381.  
  1382. (defun edebug-var-value ()
  1383.   "Return the edebug form of the var and optional value that follow point.  
  1384. Leave point after the value, if there is one."
  1385.   (list
  1386.    (edebug-read-sexp) ; the variable
  1387.    (if (not (eq 'rparen (edebug-next-token-class)))
  1388.        (edebug-form))))
  1389.  
  1390.  
  1391. (def-edebug-form-spec setq
  1392.   '(&rest symbolp form))
  1393.  
  1394. (def-edebug-form-spec setq-default
  1395.   '(&rest symbolp form))
  1396.  
  1397. (def-edebug-form-spec setq 'edebug-setq-form)
  1398. (def-edebug-form-spec setq-default 'edebug-setq-form)
  1399.  
  1400.  
  1401. (defun edebug-setq-form ()
  1402.   "Return the edebug form of the setq or setq-default var-value list."
  1403.   (let (var-value-list)
  1404.     (while (not (eq 'rparen (edebug-next-token-class)))
  1405.       (setq var-value-list
  1406.         (append var-value-list
  1407.             (edebug-var-value))))
  1408.     var-value-list))
  1409.  
  1410.  
  1411. (def-edebug-form-spec interactive
  1412.   '(&optional &or stringp form))
  1413. ;; This should not be used, since the interactive form will not be seen.
  1414. (def-edebug-form-spec interactive 'edebug-interactive-form)
  1415.  
  1416. (defun edebug-interactive-form ()
  1417.   "Return the edebug form of the interactive form."
  1418.   (list
  1419.    (if (not (eq 'rparen (edebug-next-token-class)))
  1420.        (if (eq 'string (edebug-next-token-class))
  1421.        (edebug-read-sexp)
  1422.      (prog1
  1423.          (` (edebug-enter
  1424.          (quote (, def-name))  ; from edebug-defun
  1425.          'nil
  1426.          (function (lambda () (, (edebug-form))))))
  1427.        (if (not (eq 'rparen (edebug-next-token-class)))
  1428.            (edebug-syntax-error 
  1429.         "Only first expression used in interactive form.")))))))
  1430.  
  1431.  
  1432. (def-edebug-form-spec cond
  1433.   '(&rest (form &rest form)))
  1434. (def-edebug-form-spec cond 'edebug-cond-form)
  1435.  
  1436. (defun edebug-cond-form ()
  1437.   "Return the edebug form of the cond form."
  1438.   (let (value-value-list
  1439.     class)
  1440.     (while (not (eq 'rparen (setq class (edebug-next-token-class))))
  1441.       (setq value-value-list
  1442.         (cons
  1443.          (if (not (eq 'lparen class))
  1444.          (let ((thing (edebug-read-sexp)))
  1445.            (if thing
  1446.                (edebug-syntax-error "Condition expected in cond")
  1447.              nil))
  1448.            (forward-char 1) ; \(
  1449.            (prog1
  1450.            (cons
  1451.             (edebug-form)
  1452.             (if (eq 'rparen (edebug-next-token-class))
  1453.             nil
  1454.               (edebug-forms)))
  1455.          (if (not (eq 'rparen (edebug-next-token-class)))
  1456.              (edebug-syntax-error "Right paren expected in cond"))
  1457.          (forward-char 1) ; \)
  1458.          ))
  1459.          value-value-list)))
  1460.     (nreverse value-value-list)))
  1461.  
  1462.  
  1463. (def-edebug-form-spec condition-case
  1464.   '(symbolp
  1465.     form
  1466.     &rest (symbolp &optional form)))
  1467. (def-edebug-form-spec condition-case 'edebug-condition-case-form)
  1468.  
  1469. (defun edebug-condition-case-form ()
  1470.   "Return the edebug form of the condition-case form."
  1471.   (cons
  1472.    (let (token)
  1473.      ;; read the variable or nil
  1474.      (setq token (edebug-read-sexp))
  1475.      (if (not (symbolp token))
  1476.      (edebug-syntax-error
  1477.       "Variable or nil required for condition-case; found: %s" token))
  1478.      token)
  1479.    
  1480.    (cons
  1481.     (edebug-form)            ; the form
  1482.     
  1483.     ;; process handlers
  1484.     (let (symb-sexp-list
  1485.       class)
  1486.       (while (not (eq 'rparen (setq class (edebug-next-token-class))))
  1487.     (setq symb-sexp-list
  1488.           (cons
  1489.            (if (not (eq 'lparen class))
  1490.            (edebug-syntax-error "Bad handler in condition-case.")
  1491.          (forward-char 1)    ; \(
  1492.          (prog1
  1493.              (cons 
  1494.               (edebug-read-sexp) ; the error-condition
  1495.               (and (not (eq 'rparen (edebug-next-token-class)))
  1496.                (edebug-forms)))
  1497.            (forward-char 1)    ; \)
  1498.            ))
  1499.            symb-sexp-list)))
  1500.       (nreverse symb-sexp-list)))))
  1501.  
  1502.  
  1503.  
  1504. ;;------------------------------------------------
  1505. ;; Parser utilities
  1506.  
  1507. (defconst edebug-syntax-table
  1508.   (let ((table (make-vector 256 'symbol))
  1509.     (i 0))
  1510.     (while (< i ?!)
  1511.       (aset table i 'space)
  1512.       (setq i (1+ i)))
  1513.     (aset table ?\( 'lparen)
  1514.     (aset table ?\) 'rparen)
  1515.     (aset table ?\' 'quote)
  1516.     (aset table ?\" 'string)
  1517.     (aset table ?\? 'char)
  1518.     (aset table ?\[ 'vector)
  1519.     (aset table ?\] 'vector-end)
  1520.     (aset table ?\. 'dot)
  1521.     ;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
  1522.     ;; We dont care about any other chars since they wont be seen.
  1523.     table)
  1524.   "Lookup table for significant characters indicating the class of the
  1525. token that follows.  This is not a \"real\" syntax table.")
  1526.  
  1527. (defun edebug-next-token-class ()
  1528.   "Move to the next token and return its class.  We only care about
  1529. lparen, rparen, dot, quote, string, char, vector, or symbol."
  1530.   (edebug-skip-whitespace)
  1531.   (aref edebug-syntax-table (following-char)))
  1532.  
  1533.  
  1534. (defun edebug-syntax-error (msg &rest args)
  1535.   "Signal an invalid-read-syntax with MSG and ARGS.  
  1536.    This is caught by edebug-defun."
  1537.   (signal 'invalid-read-syntax (apply 'format msg args)))
  1538.  
  1539.  
  1540. (defun edebug-skip-whitespace ()
  1541.   "Leave point before the next token, skipping white space and comments."
  1542.   (skip-chars-forward " \t\r\n\f")
  1543.   (while (= (following-char) ?\;)
  1544.     (skip-chars-forward "^\n\r")  ; skip the comment
  1545.     (skip-chars-forward " \t\r\n\f")))
  1546.  
  1547.  
  1548. (defun edebug-read-sexp ()
  1549.   "Read one sexp from the current buffer starting at point.
  1550. Leave point immediately after it.  A sexp can be a list or atom.
  1551. An atom is a symbol (or number), character, string, or vector."
  1552.   ;; This works for reading anything legitimate, but it
  1553.   ;; is gummed up by parser inconsistencies (bugs?)
  1554.   (let ((class (edebug-next-token-class)))
  1555.     (cond
  1556.      ;; read goes one too far if a (possibly quoted) string or symbol
  1557.      ;; is immediately followed by non-whitespace.
  1558.      ((eq class 'symbol) (prog1
  1559.                  (read (current-buffer))
  1560.                (if (not (eq (aref edebug-syntax-table 
  1561.                           (preceding-char)) 'symbol))
  1562.                    (forward-char -1))))
  1563.      ((eq class 'string) (prog1
  1564.                  (read (current-buffer))
  1565.                (if (/= (preceding-char) ?\")
  1566.                    (forward-char -1))))
  1567.      ((eq class 'quote) (forward-char 1)
  1568.       (list 'quote (edebug-read-sexp)))
  1569.      (t 
  1570.       (read (current-buffer))))))
  1571.  
  1572.  
  1573.  
  1574.  
  1575. ;;;=================================================================
  1576. ;;; The debugger itself
  1577. ;;; -------------------
  1578.  
  1579.  
  1580. (defvar edebug-active nil
  1581.   "Non-nil when edebug is active")
  1582.  
  1583.  
  1584. ;;; add minor-mode-alist entry
  1585. (or (assq 'edebug-active minor-mode-alist)
  1586.     (setq minor-mode-alist (cons (list 'edebug-active " *Debugging*")
  1587.                  minor-mode-alist)))
  1588.  
  1589. (defvar edebug-stack nil
  1590.   "Stack of active functions evaluated via edebug.
  1591. Should be nil at the top level.")
  1592.  
  1593. (defvar edebug-stack-depth -1
  1594.   "Index of last edebug-stack item.")
  1595.  
  1596. (defvar edebug-offset-indices nil  ; not used yet.
  1597.   "Stack of offset indices of visited edebug sexps.
  1598. Should be nil at the top level.")
  1599.  
  1600. (defvar edebug-entered nil
  1601.   "Non-nil if edebug has already been entered at this recursive edit level.
  1602. This should stay nil at the top level.")
  1603.  
  1604. ;;(defvar edebug-buffer-visited nil
  1605. ;;  "Remember whether each buffer was visited since the last command
  1606. ;;outside of edebug.  Should be nil at top level.")
  1607.  
  1608. ;;(setq-default edebug-buffer-visited nil)
  1609. ;;(make-variable-buffer-local 'edebug-buffer-visited)
  1610.  
  1611. ;;     (edebug-buffer-visited edebug-buffer-visited)
  1612.  
  1613.  
  1614. ;; Dynamically bound variables, declared globally but left unbound.
  1615. (defvar edebug-function) ; the function being executed
  1616. (defvar edebug-args) ; the arguments of the function
  1617. (defvar edebug-data) ; the edebug data for the function
  1618. (defvar edebug-after-index-vector)
  1619. (defvar edebug-func-mark) ; the mark for the function
  1620. (defvar edebug-freq-count) ; the count of expression visits.
  1621. (defvar edebug-buffer) ; which buffer the function is in.
  1622. (defvar edebug-result) ; the result of the function call returned by body
  1623. (defvar edebug-outside-executing-macro)
  1624.  
  1625. (defvar edebug-mode 'step
  1626.   "Current edebug mode set by user.")
  1627.  
  1628. (defun edebug-enter
  1629.   (edebug-function edebug-args edebug-body)
  1630.   "Entering FUNC.  The arguments are ARGS, and the body is BODY.
  1631. Setup edebug variables and evaluate BODY.  This function is called
  1632. when a function evaluated with edebug-defun is entered.  Return the
  1633. result of BODY."
  1634.  
  1635.   ;; Is this the first time we are entering edebug since
  1636.   ;; lower-level recursive-edit command?
  1637.   (if (and (not edebug-entered)
  1638.        edebug-initial-mode)
  1639.       ;; Reset edebug-mode to the initial mode.
  1640.       (setq edebug-mode edebug-initial-mode))
  1641.  
  1642.   (let* ((edebug-entered t)
  1643.      (edebug-data (get edebug-function 'edebug))
  1644.      (edebug-after-index-vector (get edebug-function 'edebug-after-index))
  1645.      (edebug-func-mark (car edebug-data))    ; mark at function start
  1646.      (edebug-freq-count (get edebug-function 'edebug-freq-count))
  1647.  
  1648.      (edebug-buffer (marker-buffer edebug-func-mark))
  1649.      (edebug-stack (cons edebug-function edebug-stack))
  1650.      (edebug-offset-indices edebug-offset-indices) ; protect from quit
  1651.  
  1652.      (max-lisp-eval-depth (+ 5 max-lisp-eval-depth))  ; too much??
  1653.      (max-specpdl-size (+ 15 max-specpdl-size)) ; the args and these vars
  1654.  
  1655.      ;; Save the outside value of executing macro.
  1656.      (edebug-outside-executing-macro executing-macro)
  1657.      ;; Don't keep reading from an executing kbd macro within edebug!
  1658.      (executing-macro nil)
  1659.  
  1660.      (debugger 'edebug-debug)  ; only while edebug is active.
  1661.      )
  1662.     (if edebug-trace
  1663.     (let ((edebug-stack-depth (1+ edebug-stack-depth))
  1664.           edebug-result)
  1665.       (edebug-print-trace-entry)
  1666.       (setq edebug-result (funcall edebug-body))
  1667.       (edebug-print-trace-exit)
  1668.       edebug-result)
  1669.  
  1670.       (funcall edebug-body)
  1671.       )))
  1672.  
  1673.  
  1674. (defun edebug-print-trace-entry ()
  1675.   (edebug-trace-display
  1676.    "*edebug-trace*"
  1677.    "%s> %s args: %s\n" 
  1678.    (make-string edebug-stack-depth ?\-) 
  1679.    edebug-function edebug-args))
  1680.  
  1681. (defun edebug-print-trace-exit ()
  1682.   (edebug-trace-display
  1683.    "*edebug-trace*"
  1684.    "%s< %s result: %s\n" 
  1685.    (make-string edebug-stack-depth ?\-) 
  1686.    edebug-function edebug-result))
  1687.  
  1688.  
  1689. (defun edebug-display-freq-count ()
  1690.   "Display the frequency count in front of each line of the current function."
  1691.   (interactive)
  1692.   (let* ((edebug-function (edebug-which-function))
  1693.      (edebug-freq-count (get edebug-function 'edebug-freq-count))
  1694.      (edebug-after-index-vector (get edebug-function 'edebug-after-index))
  1695.      (edebug-data (get edebug-function 'edebug))
  1696.      (edebug-func-mark (car edebug-data))    ; mark at function start
  1697.      (edebug-points (car (cdr (cdr edebug-data))))
  1698.      (len (length edebug-points))
  1699.      (i len)
  1700.      (last-point)
  1701.      (last-count)
  1702.      )
  1703.     (save-excursion
  1704.       (while (and (>= (setq i (1- i)) 0)
  1705.           (= -1 (aref edebug-after-index-vector i))))
  1706.       (goto-char (+ edebug-func-mark (aref edebug-points i))))
  1707.       (beginning-of-line)
  1708.       (setq last-point (point))
  1709.  
  1710.       ;; Traverse in reverse order so offsets are correct.
  1711.       (while (>= (setq i (1- i)) 0)
  1712.     (if (< 0 (aref edebug-after-index-vector i))
  1713.         (let ((count (aref edebug-freq-count i)))
  1714.           (goto-char (+ edebug-func-mark (aref edebug-points i)))
  1715.           (beginning-of-line)
  1716.           (if (/= last-point (point))
  1717.           (save-excursion
  1718.             (goto-char last-point)
  1719.             (insert (format "%3d:" last-count))))
  1720.           (setq last-point (point)
  1721.             last-count count))))
  1722.       (goto-char last-point)
  1723.       (insert (format "%3d:" last-count)))
  1724.     )
  1725.  
  1726.  
  1727. (defun edebug-before (edebug-before-index)
  1728.   "Debug current function given BEFORE position.
  1729. edebug-before is called from functions compiled with edebug-defun.  
  1730. Return the after index corresponding to this before index."
  1731.   (setq edebug-offset-indices
  1732.    (cons edebug-before-index edebug-offset-indices))
  1733.  
  1734.   ;; Increment frequency count 
  1735.   (aset edebug-freq-count edebug-before-index
  1736.     (1+ (aref edebug-freq-count edebug-before-index)))
  1737.  
  1738.   (if (not (and (eq edebug-mode 'Go-nonstop)
  1739.         (not (edebug-input-pending-p))))
  1740.       (edebug-debugger edebug-before-index 'enter nil))
  1741.   ;; Return the after-index
  1742.   (aref edebug-after-index-vector edebug-before-index))
  1743.  
  1744.  
  1745. (defun edebug-after (edebug-after-index edebug-value)
  1746.   "Debug current function given AFTER position and VALUE.
  1747. edebug is called from functions compiled with edebug-defun.
  1748. Return VALUE."
  1749.   ;; Pop the before index.
  1750.   (setq edebug-offset-indices (cdr edebug-offset-indices))
  1751.   (if (and (eq edebug-mode 'Go-nonstop)
  1752.        (not (edebug-input-pending-p)))
  1753.       ;; Just return result.
  1754.       edebug-value
  1755.     (edebug-debugger edebug-after-index 'exit edebug-value)
  1756.     ))
  1757.  
  1758.  
  1759. ;; Dynamically declared unbound variables.
  1760. (defvar edebug-arg-mode)  ; the mode, either enter, exit, or error
  1761. (defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
  1762. (defvar edebug-break) ; whether a break occurred.
  1763. (defvar edebug-exp) ; the result of the last expression.
  1764.  
  1765.  
  1766. (defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-exp)
  1767.   "Check breakpoints and pending input.
  1768. If edebug display should be updated, call edebug-display.
  1769. Return edebug-exp."
  1770.   (let* ((max-lisp-eval-depth (+ 1 max-lisp-eval-depth)) ; edebug-after
  1771.      (max-specpdl-size (+ 10 max-specpdl-size)) ; the args and vars
  1772.  
  1773.      ;; This needs to be here since breakpoints may be changed.
  1774.      (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
  1775.      (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
  1776.      (edebug-break
  1777.       (if edebug-break-data
  1778.           (let ((edebug-break-condition
  1779.              (car (cdr edebug-break-data))))
  1780.         (or (not edebug-break-condition)
  1781.             (eval edebug-break-condition)))))
  1782.      )
  1783.     (if (and edebug-break
  1784.          (car (cdr (cdr edebug-break-data)))) ; is it temporary?
  1785.     ;; Delete the breakpoint.
  1786.     (setcdr edebug-data
  1787.         (cons (delq edebug-break-data edebug-breakpoints)
  1788.               (cdr (cdr edebug-data)))))
  1789.       
  1790.     ;; Dont do anything if mode is go, continue, or Continue-fast
  1791.     ;; and no break, and no input.
  1792.     (if (or (not (memq edebug-mode '(go continue Continue-fast)))
  1793.         (edebug-input-pending-p)
  1794.         edebug-break)
  1795.     (edebug-display))   ; <--------------- display
  1796.     
  1797.     edebug-exp
  1798.     ))
  1799.  
  1800.  
  1801. (defvar edebug-window-start nil
  1802.   "Remember where each buffers' window starts between edebug calls.
  1803. This is to avoid spurious recentering.")
  1804.  
  1805. (setq-default edebug-window-start nil)
  1806. (make-variable-buffer-local 'edebug-window-start)
  1807.  
  1808.  
  1809. ;; Dynamically declared unbound vars
  1810. (defvar edebug-point) ; the point in edebug buffer
  1811. (defvar edebug-outside-buffer) ; the current-buffer outside of edebug
  1812. (defvar edebug-outside-point) ; the point outside of edebug
  1813. (defvar edebug-outside-mark) ; the mark outside of edebug
  1814. (defvar edebug-outside-windows) ; outside window configuration
  1815. (defvar edebug-eval-buffer) ; for the evaluation list.
  1816. (defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
  1817. (defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
  1818. (defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
  1819.  
  1820. (defvar edebug-eval-list nil
  1821.   "List of expressions to evaluate.")
  1822.  
  1823. (defvar edebug-previous-result nil
  1824.   "Last result returned from an expression.")
  1825.  
  1826.  
  1827.  
  1828. (defun edebug-display ()
  1829.   "Setup windows for edebug, determine mode, maybe enter recursive-edit."
  1830.   ;; Uses local variables of edebug-enter, edebug, and edebug-debugger.
  1831.   (let ((edebug-active t)        ; for minor mode alist
  1832.     edebug-stop            ; should we enter recursive-edit
  1833.     (edebug-point (+ edebug-func-mark
  1834.              (aref (car (cdr (cdr edebug-data)))
  1835.                    edebug-offset-index)))
  1836.     edebug-window            ; window displaying edebug-buffer
  1837.     (edebug-outside-window (selected-window))
  1838.     (edebug-outside-buffer (current-buffer))
  1839.     (edebug-outside-point (point))
  1840.     (edebug-outside-mark (mark))
  1841.     edebug-outside-windows        ; window or screen configuration
  1842.     ;; edebug-outside-edebug-point    ; current point in edebug buffer
  1843.     ;; edebug-outside-edebug-mark      ; mark is too much trouble
  1844.     edebug-buffer-points
  1845.     
  1846.     edebug-eval-buffer        ; declared here so we can kill it below
  1847.     (edebug-eval-result-list (and edebug-eval-list
  1848.                       (edebug-eval-result-list)))
  1849.     (edebug-outside-o-a-p overlay-arrow-position)
  1850.     (edebug-outside-o-a-s overlay-arrow-string)
  1851.     (edebug-outside-c-i-e-a cursor-in-echo-area)
  1852.  
  1853.     ;;edebug-outside-point-min
  1854.     ;;edebug-outside-point-max
  1855.  
  1856.     overlay-arrow-position
  1857.     overlay-arrow-string
  1858.     (cursor-in-echo-area nil)
  1859.     ;; any others??
  1860.     )
  1861.     (if (not (buffer-name edebug-buffer))
  1862.     (let ((debug-on-error nil))
  1863.       (error "Buffer defining %s not found." edebug-function)))
  1864.     
  1865.     ;; Save windows now before we modify them.
  1866.     (if edebug-save-windows
  1867.     (setq edebug-outside-windows (edebug-current-window-configuration)))
  1868.     
  1869.     (if edebug-save-displayed-buffer-points
  1870.     (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
  1871.  
  1872.     ;; First move the edebug buffer point to edebug-point
  1873.     ;; so that window start doesnt get changed when we display it.
  1874.     ;; I dont know if this is going to help.
  1875.     ;;(set-buffer edebug-buffer)
  1876.     ;;(goto-char edebug-point)
  1877.  
  1878.     ;; If edebug-buffer is not currently displayed,
  1879.     ;; first find a window for it.
  1880.     (edebug-pop-to-buffer edebug-buffer)
  1881.     (setq edebug-window (selected-window))
  1882.  
  1883.     ;; Now display eval list, if any.
  1884.     ;; This is done after the pop to edebug-buffer 
  1885.     ;; so that buffer-window correspondence is correct after quitting.
  1886.     (edebug-eval-display edebug-eval-result-list)
  1887.     ;; The evaluation list better not have deleted edebug-window.
  1888.     (select-window edebug-window)
  1889.  
  1890.     (goto-char edebug-point)
  1891.         
  1892.     ;; If edebug-buffer has not been visited yet, set its edebug-window-start
  1893.     ;;      (if (not edebug-buffer-visited)
  1894.     ;;      (setq edebug-buffer-visited t
  1895.     ;;        edebug-window-start (window-start)))
  1896.     (setq edebug-window-start
  1897.       (edebug-adjust-window edebug-window-start))
  1898.         
  1899.     ;; Test if there is input, not including keyboard macros.
  1900.     (if (edebug-input-pending-p)
  1901.     (progn
  1902.       (setq edebug-mode 'step)
  1903.       (setq edebug-stop t)
  1904.       (edebug-stop)
  1905.       ;;        (discard-input)        ; is this unfriendly??
  1906.       ))
  1907.     ;; Now display arrow based on mode.
  1908.     (edebug-overlay-arrow)
  1909.         
  1910.     (cond
  1911.      ((eq 'exit edebug-arg-mode)
  1912.       ;; Display result of previous evaluation.
  1913.       (setq edebug-previous-result edebug-exp)
  1914.       (edebug-previous-result))
  1915.  
  1916.      ((eq 'error edebug-arg-mode)
  1917.       ;; Display error message
  1918.       (beep)
  1919.       (if (eq 'quit (car edebug-exp))
  1920.       (message "Quit")
  1921.     (message "%s: %s"
  1922.          (get (car edebug-exp) 'error-message)
  1923.          (car (cdr edebug-exp)))))
  1924.      
  1925.      (edebug-break
  1926.       (message "Break"))
  1927.      (t (message "")))
  1928.     
  1929.     (if edebug-break
  1930.     (if (not (memq edebug-mode '(continue Continue-fast)))
  1931.         (setq edebug-stop t)
  1932.       (if (eq edebug-mode 'continue)
  1933.           (edebug-sit-for 1)
  1934.         (edebug-sit-for 0)))
  1935.       ;; not edebug-break
  1936.       (if (eq edebug-mode 'trace)
  1937.       (edebug-sit-for 1)        ; Force update and pause.
  1938.     (if (eq edebug-mode 'Trace-fast)
  1939.         (edebug-sit-for 0)        ; Force update and continue.
  1940.       )))
  1941.     
  1942.     (unwind-protect
  1943.     (if (or edebug-stop
  1944.         (eq edebug-mode 'step)
  1945.         (eq edebug-arg-mode 'error)) 
  1946.         (progn
  1947.           (setq edebug-mode 'step)
  1948.           (edebug-overlay-arrow)    ; this doesnt always show up.
  1949.           (edebug-recursive-edit));;   <---------- Recursive edit
  1950.       )
  1951.  
  1952.       ;; Reset the edebug-window to whatever it is now.
  1953.       (setq edebug-window (edebug-get-buffer-window edebug-buffer))
  1954.       ;; Remember the window start for the edebug buffer,
  1955.       ;; if it is still displayed.
  1956.       (if edebug-window
  1957.       (progn
  1958.         (set-buffer edebug-buffer) ; to set buffer-local var
  1959.         (setq edebug-window-start (window-start edebug-window))))
  1960.  
  1961.       ;; Restore windows before continuing.
  1962.       (if edebug-save-windows
  1963.       (progn
  1964.         (edebug-set-window-configuration edebug-outside-windows)
  1965.         ;; Unrestore edebug-buffer's window start, if displayed.
  1966.         (setq edebug-window (edebug-get-buffer-window edebug-buffer))
  1967.         (if edebug-window
  1968.         (save-excursion
  1969.           (set-buffer edebug-buffer)
  1970.           (set-window-start edebug-window 
  1971.                     edebug-window-start 'no-force))))
  1972.     ;; Since we may be in a save-excursion, in case of quit,
  1973.     ;; reselect the outside window only.
  1974.     ;; Only needed if we are not recovering windows.
  1975.     (if (window-point edebug-outside-window)
  1976.         (select-window edebug-outside-window))
  1977.     )  ; if edebug-save-windows
  1978.  
  1979.       ;; Restore displayed buffer points.
  1980.       ;; Is this needed if restoring windows??
  1981.       (if edebug-save-displayed-buffer-points
  1982.       (edebug-set-buffer-points edebug-buffer-points))
  1983.  
  1984.       ;; Restore current buffer, point, and mark
  1985.       ;; Is this needed if restoring windows??
  1986.       (set-buffer edebug-outside-buffer)  ; must do this
  1987.       (goto-char edebug-outside-point)
  1988.       (if (marker-buffer (mark-marker))
  1989.       (set-marker (mark-marker) edebug-outside-mark))
  1990.       )                    ; unwind-protect
  1991.     ;; None of the following is done if quit or signal occurs.
  1992.     ;; ... nothing anymore.
  1993.    ))
  1994.  
  1995.  
  1996.  
  1997. (defvar edebug-depth 0
  1998.   "Number of recursive edits started by edebug.
  1999. Should be 0 at the top level.")
  2000.  
  2001. (defvar edebug-recursion-depth 0
  2002.   "Value of recursion-depth when edebug was called.")
  2003.  
  2004.  
  2005. ;; Dynamically declared unbound vars
  2006. (defvar edebug-outside-match-data) ; match data outside of edebug
  2007. (defvar edebug-backtrace-buffer) ; each recursive edit gets its own
  2008. (defvar edebug-inside-windows) 
  2009.  
  2010. (defvar edebug-outside-map)
  2011. (defvar edebug-outside-standard-output)
  2012. (defvar edebug-outside-standard-input)
  2013. (defvar edebug-outside-last-command-char)
  2014. (defvar edebug-outside-last-command)
  2015. (defvar edebug-outside-this-command)
  2016. (defvar edebug-outside-last-input-char)
  2017.  
  2018.  
  2019. (defun edebug-recursive-edit ()
  2020.   "Start up a recursive edit inside of edebug."
  2021.   ;; The current buffer is the edebug-buffer, which is put into edebug-mode.
  2022.   ;; Assume that none of the variables below are buffer-local.
  2023.   (let ((edebug-buffer-read-only buffer-read-only)
  2024.     ;; match-data must be done in the outside buffer
  2025.     (edebug-outside-match-data
  2026.      (save-excursion  ; might be unnecessary now??
  2027.        (set-buffer edebug-outside-buffer)  ; in case match buffer different
  2028.        (match-data)))
  2029.  
  2030.     (edebug-depth (1+ edebug-depth))
  2031.     (edebug-recursion-depth (recursion-depth))
  2032.     edebug-entered            ; bind locally to nil
  2033.     edebug-backtrace-buffer        ; each recursive edit gets its own
  2034.     ;; The window configuration may be saved and restored
  2035.     ;; during a recursive-edit
  2036.     edebug-inside-windows
  2037.  
  2038.     (edebug-outside-map (current-local-map))
  2039.     (edebug-outside-standard-output standard-output)
  2040.     (edebug-outside-standard-input standard-input)
  2041.  
  2042.     (edebug-outside-last-command-char last-command-char)
  2043.     (edebug-outside-last-command last-command)
  2044.     (edebug-outside-this-command this-command)
  2045.     (edebug-outside-last-input-char last-input-char)
  2046. ;;    (edebug-outside-unread-command-char unread-command-char)
  2047.  
  2048.     ;; Declare the following local variables to protect global values.
  2049.     ;; Make it local, but use global value.
  2050.     ;; We could set these to the values for previous edebug call.
  2051.     (last-command-char last-command-char)
  2052.     (last-command last-command) 
  2053.     (this-command this-command)
  2054.     (last-input-char last-input-char)
  2055.     ;; Assume no edebug command sets unread-command-char.
  2056. ;;    (unread-command-char -1)
  2057.  
  2058.     (debug-on-error debug-on-error)
  2059.     
  2060.     ;; others??
  2061.     )
  2062.  
  2063.     (if (and (eq edebug-mode 'go)
  2064.          (not (memq edebug-arg-mode '(exit error))))
  2065.     (message "Break"))
  2066.     (edebug-mode)
  2067.     (if (boundp 'edebug-outside-debug-on-error)
  2068.     (setq debug-on-error edebug-outside-debug-on-error))
  2069.  
  2070.     (setq buffer-read-only t)
  2071.     (unwind-protect
  2072.     (recursive-edit)     ;  <<<<<<<<<< Recursive edit
  2073.  
  2074.       ;; Do the following, even if quit occurs.
  2075.       (if edebug-backtrace-buffer
  2076.       (kill-buffer edebug-backtrace-buffer))
  2077.       ;; Could be an option to keep eval display up.
  2078.       (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
  2079.  
  2080.       ;; Remember selected-window after recursive-edit.
  2081. ;;      (setq edebug-inside-window (selected-window))
  2082.  
  2083.       (store-match-data edebug-outside-match-data)
  2084.  
  2085.       ;; Recursive edit may have changed buffers,
  2086.       ;; so set it back before exiting let.
  2087.       (if (buffer-name edebug-buffer)    ; if it still exists
  2088.       (progn
  2089.         (set-buffer edebug-buffer)
  2090.         (if (memq edebug-mode '(go Go-nonstop))
  2091.         (edebug-overlay-arrow))
  2092.         (setq buffer-read-only edebug-buffer-read-only)
  2093.         (use-local-map edebug-outside-map)
  2094.         )
  2095.     ;; gotta have some other buffer
  2096.     (get-buffer-create " bogus edebug buffer"))
  2097.       )))
  2098.  
  2099.  
  2100. ;;--------------------------
  2101. ;; Display related functions
  2102.  
  2103. (defun edebug-adjust-window (old-start)
  2104.   "If pos is not visible, adjust current window to fit following context."
  2105. ;;  (message "window-start: %s" (window-start)) (sit-for 1)
  2106.   (if old-start
  2107.       (set-window-start (selected-window) old-start))
  2108.   (if (not (pos-visible-in-window-p))
  2109.       (progn
  2110.     (set-window-start
  2111.      (selected-window)
  2112.      (save-excursion
  2113.        (forward-line
  2114.         (if (< (point) (window-start)) -1    ; one line before if in back
  2115.           (- (/ (window-height) 2)) ; center the line moving forward
  2116.           ))
  2117.        (beginning-of-line)
  2118.        (point)))))
  2119.   (window-start))
  2120.   
  2121.  
  2122.  
  2123. (defconst edebug-arrow-alist
  2124.   '((Continue-fast . ">")
  2125.     (Trace-fast . ">")
  2126.     (continue . ">")
  2127.     (trace . "->")
  2128.     (step . "=>")
  2129.     (go . "<>")
  2130.     (Go-nonstop . "..")  ; not used
  2131.     )
  2132.   "Association list of arrows for each edebug mode.
  2133. If you come up with arrows that make more sense, let me know.")
  2134.  
  2135. (defun edebug-overlay-arrow ()
  2136.   "Set up the overlay arrow at beginning-of-line in current buffer.
  2137. The arrow string is derived from edebug-arrow-alist and edebug-mode."
  2138.   (let* ((pos))
  2139.     (save-excursion
  2140.       (beginning-of-line)
  2141.       (setq pos (point)))
  2142.     (setq overlay-arrow-string
  2143.       (cdr (assq edebug-mode edebug-arrow-alist)))
  2144.     (setq overlay-arrow-position (make-marker))
  2145.     (set-marker overlay-arrow-position pos (current-buffer))))
  2146.  
  2147.  
  2148.  
  2149.  
  2150. (defun edebug-toggle-save-windows ()
  2151.   "Toggle the edebug-save-windows variable.
  2152. Each time you toggle it, the inside and outside window configurations
  2153. become the same as the current configuration."
  2154.   (interactive)
  2155.   (if (setq edebug-save-windows (not edebug-save-windows))
  2156.       (setq edebug-inside-windows
  2157.         (setq edebug-outside-windows
  2158.           (edebug-current-window-configuration))))
  2159.   (message "Window saving is %s."
  2160.        (if edebug-save-windows "on" "off")))
  2161.  
  2162.  
  2163. (defun edebug-where ()
  2164.   "Show the debug windows and where we stopped in the program."
  2165.   (interactive)
  2166.   (if (not edebug-active)
  2167.       (error "edebug is not active."))
  2168.   (edebug-pop-to-buffer edebug-buffer)
  2169.   (goto-char edebug-point)  ; from edebug
  2170.   )
  2171.  
  2172. (defun edebug-view-outside ()
  2173.   "Change to the outside window configuration."
  2174.   (interactive)
  2175.   (if (not edebug-active)
  2176.       (error "edebug is not active."))
  2177.   (setq edebug-inside-windows (edebug-current-window-configuration))
  2178.   (edebug-set-window-configuration edebug-outside-windows)
  2179.   (goto-char edebug-outside-point)
  2180.   (message "Window configuration outside of edebug.  Return with %s"
  2181.        (substitute-command-keys "\\<global-map>\\[edebug-where]")))
  2182.  
  2183.  
  2184. (defun edebug-bounce-point ()
  2185.   "Bounce the point in the outside current buffer."
  2186.   (interactive)
  2187.   (if (not edebug-active)
  2188.       (error "edebug is not active."))
  2189.   (save-excursion
  2190.     ;; If the buffer's currently displayed, avoid the set-window-configuration.
  2191.     (save-window-excursion
  2192.       (edebug-pop-to-buffer edebug-outside-buffer)
  2193.       (goto-char edebug-outside-point)
  2194.       (if (marker-buffer (mark-marker))
  2195.       (message "Current buffer: %s Point: %s Mark: %s" 
  2196.            (current-buffer) (point) (+ 0 (mark-marker)))
  2197.     (message "Current buffer: %s point: %s" (current-buffer) (point)))
  2198.       (edebug-sit-for 1)
  2199.       (edebug-pop-to-buffer edebug-buffer))))
  2200.  
  2201.  
  2202.  
  2203.  
  2204.  
  2205. ;;---------------------------------------------------
  2206. ;; Breakpoint related functions
  2207.  
  2208. (defun edebug-find-stop-point ()
  2209.   "Return (function . index) of the nearest edebug stop point."
  2210.   (let* ((def-name (edebug-which-function))
  2211.      (edebug-data
  2212.       (or (get def-name 'edebug)
  2213.           (error
  2214.            "%s must first be evaluated with edebug-defun." def-name)))
  2215.      ;; pull out parts of edebug-data.
  2216.      (edebug-func-mark (car edebug-data))
  2217.      (edebug-breakpoints (car (cdr edebug-data)))
  2218.  
  2219.      (offset-vector (car (cdr (cdr edebug-data))))
  2220.      (offset (- (save-excursion
  2221.               (if (looking-at "[ \t]")
  2222.               ;; skip backwards until non-whitespace, or bol
  2223.               (skip-chars-backward " \t"))
  2224.               (point))
  2225.             edebug-func-mark))
  2226.      len i)
  2227.     ;; the offsets are in order so we can do a linear search
  2228.     (setq len (length offset-vector))
  2229.     (setq i 0)
  2230.     (while (and (< i len) (> offset (aref offset-vector i)))
  2231.       (setq i (1+ i)))
  2232.     (if (and (< i len)
  2233.          (<= offset (aref offset-vector i)))
  2234.     ;; return the relevant info
  2235.     (cons def-name i)
  2236.       (message "Point is not on an expression in %s."
  2237.            def-name)
  2238.       )))
  2239.  
  2240.  
  2241. (defun edebug-next-breakpoint ()
  2242.   "Move point to the next breakpoint, or first if none past point."
  2243.   (interactive)
  2244.   (let ((edebug-stop-point (edebug-find-stop-point)))
  2245.     (if edebug-stop-point
  2246.     (let* ((def-name (car edebug-stop-point))
  2247.            (index (cdr edebug-stop-point))
  2248.            (edebug-data (get def-name 'edebug))
  2249.            
  2250.            ;; pull out parts of edebug-data
  2251.            (edebug-func-mark (car edebug-data))
  2252.            (edebug-breakpoints (car (cdr edebug-data)))
  2253.            (offset-vector (car (cdr (cdr edebug-data))))
  2254.            breakpoint)
  2255.       (if (not edebug-breakpoints)
  2256.           (message "No breakpoints in this function.")
  2257.         (let ((breaks edebug-breakpoints))
  2258.           (while (and breaks
  2259.               (<= (car (car breaks)) index))
  2260.         (setq breaks (cdr breaks)))
  2261.           (setq breakpoint
  2262.             (if breaks
  2263.             (car breaks)
  2264.               ;; goto the first breakpoint
  2265.               (car edebug-breakpoints)))
  2266.           (goto-char (+ edebug-func-mark
  2267.                 (aref offset-vector (car breakpoint))))
  2268.           
  2269.           (message (concat (if (car (cdr (cdr breakpoint)))
  2270.                    "Temporary " "")
  2271.                    (if (car (cdr breakpoint))
  2272.                    (format "Condition: %s"
  2273.                        (edebug-prin1-to-string
  2274.                         (car (cdr breakpoint))))
  2275.                  "")))
  2276.           ))))))
  2277.  
  2278.  
  2279. (defun edebug-modify-breakpoint (flag &optional condition temporary)
  2280.   "Modify the breakpoint for the form at point or after it according
  2281. to FLAG: set if t, clear if nil.  Then move to that point.
  2282. If CONDITION or TEMPORARY are non-nil, add those attributes to
  2283. the breakpoint.  "  
  2284.   (let ((edebug-stop-point (edebug-find-stop-point)))
  2285.     (if edebug-stop-point
  2286.     (let* ((def-name (car edebug-stop-point))
  2287.            (index (cdr edebug-stop-point))
  2288.            (edebug-data (get def-name 'edebug))
  2289.            
  2290.            ;; pull out parts of edebug-data
  2291.            (edebug-func-mark (car edebug-data))
  2292.            (edebug-breakpoints (car (cdr edebug-data)))
  2293.            (offset-vector (car (cdr (cdr edebug-data))))
  2294.            present)
  2295.       ;; delete it either way
  2296.       (setq present (assq index edebug-breakpoints))
  2297.       (setq edebug-breakpoints (delq present edebug-breakpoints))
  2298.       (if flag
  2299.           (progn
  2300.         ;; add it to the list and resort
  2301.         (setq edebug-breakpoints
  2302.               (edebug-sort-alist
  2303.                (cons
  2304.             (list index condition temporary)
  2305.             edebug-breakpoints) '<))
  2306.         (message "Breakpoint set in %s." def-name))
  2307.         (if present
  2308.         (message "Breakpoint unset in %s." def-name)
  2309.           (message "No breakpoint here.")))
  2310.       
  2311.       (setcdr edebug-data
  2312.           (cons edebug-breakpoints (cdr (cdr edebug-data))))
  2313.       (goto-char (+ edebug-func-mark (aref offset-vector index)))
  2314.       ))))
  2315.  
  2316. (defun edebug-set-breakpoint (arg)
  2317.   "Set the breakpoint of nearest sexp.
  2318. With prefix argument, make it a temporary breakpoint."
  2319.   (interactive "P")
  2320.   (edebug-modify-breakpoint t nil arg))
  2321.  
  2322. (defun edebug-unset-breakpoint ()
  2323.   "Clear the breakpoint of nearest sexp."
  2324.   (interactive)
  2325.   (edebug-modify-breakpoint nil))
  2326.  
  2327. (defun edebug-set-conditional-breakpoint (arg condition)
  2328.   "Set a conditional breakpoint at nearest sexp.
  2329. The condition is evaluated in the outside context.
  2330. With prefix argument, make it a temporary breakpoint."
  2331.   (interactive "P\nxCondition: ")
  2332.   (edebug-modify-breakpoint t condition arg))
  2333.  
  2334.  
  2335. ;;--------------------------
  2336. ;; Mode switching functions
  2337.  
  2338. (defun edebug-set-mode (mode shortmsg msg)
  2339.   "Set the edebug mode to MODE.
  2340. Display SHORTMSG, or MSG if not within edebug."
  2341.   (interactive)
  2342.   (setq edebug-mode mode)
  2343.   (if (< 0 edebug-depth)
  2344.       (if (eq (current-buffer) edebug-buffer)
  2345.       (progn
  2346.         (message shortmsg)
  2347.         (exit-recursive-edit)))
  2348.     (message msg)))
  2349.  
  2350.  
  2351. (defun edebug-step-through-mode ()
  2352.   "Proceed to next debug step."
  2353.   (interactive)
  2354.   (edebug-set-mode 'step "" "edebug will stop before next eval."))
  2355.  
  2356. (defun edebug-go-mode (arg)
  2357.   "Go, evaluating until break.
  2358. With ARG set temporary break at stop point and go."
  2359.   (interactive "P")
  2360.   (if arg
  2361.       (edebug-set-breakpoint t))
  2362.   (edebug-set-mode 'go "Go..." "edebug will go until break."))
  2363.  
  2364. (defun edebug-Go-nonstop-mode ()
  2365.   "Go, evaluating without debugging."
  2366.   (interactive)
  2367.   (edebug-set-mode 'Go-nonstop "Go-Nonstop..."
  2368.            "edebug will not stop at breaks."))
  2369.  
  2370.  
  2371. (defun edebug-trace-mode ()
  2372.   "Begin trace mode."
  2373.   (interactive)
  2374.   (edebug-set-mode 'trace "Tracing..." "edebug will trace with pause."))
  2375.  
  2376. (defun edebug-Trace-fast-mode ()
  2377.   "Trace with no wait at each step."
  2378.   (interactive)
  2379.   (edebug-set-mode 'Trace-fast
  2380.            "Trace fast..." "edebug will trace without pause."))
  2381.  
  2382. (defun edebug-continue-mode ()
  2383.   "Begin continue mode."
  2384.   (interactive)
  2385.   (edebug-set-mode 'continue "Continue..."
  2386.            "edebug will pause at breakpoints."))
  2387.  
  2388. (defun edebug-Continue-fast-mode ()
  2389.   "Trace with no wait at each step."
  2390.   (interactive)
  2391.   (edebug-set-mode 'Continue-fast "Continue fast..."
  2392.            "edebug will stop and go at breakpoints."))
  2393.  
  2394. ;; ------------------------------------------------------------
  2395. ;; The following use the mode changing commands and breakpoints.
  2396.  
  2397.  
  2398. (defun edebug-goto-here ()
  2399.   "Proceed to this stop point."
  2400.   (interactive)
  2401.   (edebug-go-mode t)
  2402.   )
  2403.  
  2404.  
  2405. (defun edebug-stop ()
  2406.   "Stop execution and do not continue.
  2407. Useful for exiting from trace loop."
  2408.   (interactive)
  2409.   (message "Stop"))
  2410.  
  2411.  
  2412. (defun edebug-forward-sexp (arg)
  2413.   "Proceed from the current point to the end of the ARGth sexp ahead.
  2414. If there are not ARG sexps ahead, then do edebug-step-out."
  2415.   (interactive "p")
  2416.   (condition-case err
  2417.       (let ((parse-sexp-ignore-comments t))
  2418.     ;; Call forward-sexp repeatedly until done or failure.
  2419.     (forward-sexp arg)
  2420.     (edebug-go-mode t))
  2421.     (error
  2422.      (edebug-step-out)
  2423.      )))
  2424.  
  2425. (defun edebug-step-out ()
  2426.   "Proceed from the current point to the end of the containing sexp.
  2427. If there is no containing sexp that is not the top level defun,
  2428. go to the end of the last sexp, or if that is the same point, then step."
  2429.   (interactive)
  2430.   (condition-case err
  2431.       (let ((parse-sexp-ignore-comments t))
  2432.     (up-list 1)
  2433.     (save-excursion
  2434.       ;; Is there still a containing expression?
  2435.       (up-list 1))
  2436.     (edebug-go-mode t))
  2437.     (error
  2438.      ;; At top level - 1, so first check if there are more sexps at this level.
  2439.      (let ((start-point (point)))
  2440. ;;       (up-list 1)
  2441.        (down-list -1)
  2442.        (if (= (point) start-point)
  2443.        (edebug-step-through-mode)    ; No more at this level, so step.
  2444.      (edebug-go-mode t)
  2445.      )))))
  2446.  
  2447. (defun edebug-step-in ()
  2448.   "Step into the function about to be called.
  2449. Do this before the arguments are evaluated since otherwise it will be
  2450. too late.  One side effect of using edebug-step-in is that the next
  2451. time the function is called, edebug will be called there as well."
  2452.   (interactive)
  2453.   (if (not (eq 'enter edebug-arg-mode))
  2454.       (error "You must be in front of a function or macro call."))
  2455.   (let (func func-marker)
  2456.     (save-excursion
  2457.       (edebug-where)
  2458.       (forward-char 1)
  2459.       (setq func (read (current-buffer)))
  2460.       )
  2461.     (setq func-marker (get func 'edebug))
  2462.     (cond
  2463.      ((markerp func-marker)
  2464.       (save-excursion
  2465.     (set-buffer (marker-buffer func-marker))
  2466.     (goto-char func-marker)
  2467.     (edebug-defun)))
  2468.      ((listp func-marker)
  2469.       ;; Its already been evaluated for edebug.
  2470.       nil)
  2471.      (t (error "First please eval the def of %s so edebug knows where it is." func))))
  2472.   (exit-recursive-edit))
  2473.  
  2474.  
  2475. ;;(defun edebug-exit-out ()
  2476. ;;  "Go until the current function exits."
  2477. ;;  (interactive)
  2478. ;;  (edebug-set-mode 'exiting "Exit..."))
  2479.  
  2480.  
  2481.  
  2482. ;;--------------------------
  2483. ;; Evaluation of expressions
  2484.  
  2485. (def-edebug-form-spec edebug-outside-excursion t)
  2486.  
  2487. (defmacro edebug-outside-excursion (&rest body)
  2488.   "Evaluate an expression list in the outside context.
  2489. Return the result of the last expression."
  2490.   (` (save-excursion            ; of current-buffer
  2491.        (if edebug-save-windows
  2492.        (progn
  2493.          ;; After excursion, we will 
  2494.          ;; restore to current window configuration.
  2495.          (setq edebug-inside-windows
  2496.            (edebug-current-window-configuration))
  2497.          ;; Restore outside windows.
  2498.          (edebug-set-window-configuration edebug-outside-windows)))
  2499.  
  2500.        (set-buffer edebug-buffer)  ; why?
  2501.        ;; (use-local-map edebug-outside-map)
  2502.        (store-match-data edebug-outside-match-data)
  2503.        ;; Restore outside context.
  2504.        (let ((edebug-inside-map (current-local-map))
  2505.          (last-command-char edebug-outside-last-command-char)
  2506.          (last-command edebug-outside-last-command)
  2507.          (this-command edebug-outside-this-command)
  2508. ;;         (unread-command-char edebug-outside-unread-command-char)
  2509.          (last-input-char edebug-outside-last-input-char)
  2510.          (overlay-arrow-position edebug-outside-o-a-p)
  2511.          (overlay-arrow-string edebug-outside-o-a-s)
  2512.          (cursor-in-echo-area edebug-outside-c-i-e-a)
  2513.          (standard-output edebug-outside-standard-output)
  2514.          (standard-input edebug-outside-standard-input)
  2515.          (executing-macro edebug-outside-executing-macro)
  2516.          )
  2517.      (unwind-protect
  2518.          (save-excursion        ; of edebug-buffer
  2519.            (set-buffer edebug-outside-buffer)
  2520.            (goto-char edebug-outside-point)
  2521.            (if (marker-buffer (mark-marker))
  2522.            (set-marker (mark-marker) edebug-outside-mark))
  2523.            (,@ body))
  2524.  
  2525.        ;; Back to edebug-buffer.  Restore rest of inside context.
  2526.        ;; (use-local-map edebug-inside-map)
  2527.        (if edebug-save-windows
  2528.            ;; Restore inside windows.
  2529.            (edebug-set-window-configuration edebug-inside-windows))
  2530.        ))                ; let
  2531.        )))
  2532.  
  2533.  
  2534. (defun edebug-previous-result ()
  2535.   "Return the previous result."
  2536.   (interactive)
  2537.   (let ((print-escape-newlines t)
  2538.     (print-length 50))
  2539.     (message "Result: %s" (edebug-prin1-to-string edebug-previous-result))))
  2540.  
  2541.  
  2542. (defun edebug-eval (expr)
  2543.   "Evaluate EXPR in the outside environment."
  2544.   (if (not edebug-active)
  2545.       (error "edebug is not active."))
  2546.   (edebug-outside-excursion
  2547.    (eval expr)))
  2548.  
  2549. (defun edebug-eval-expression (expr)
  2550.   "Prompt and evaluate an expression in the outside environment.  
  2551. Print result in minibuffer."
  2552.   (interactive "xEval: ")
  2553.   (edebug-prin1 (edebug-eval expr)))
  2554.  
  2555. (defun edebug-eval-last-sexp ()
  2556.   "Evaluate sexp before point in the outside environment;
  2557. print value in minibuffer."
  2558.   (interactive)
  2559.   (edebug-prin1 (edebug-eval (edebug-last-sexp))))
  2560.  
  2561. (defun edebug-eval-print-last-sexp ()
  2562.   "Evaluate sexp before point in the outside environment; 
  2563. print value into current buffer."
  2564.   (interactive)
  2565.   (let ((standard-output (current-buffer)))
  2566.     (edebug-print 
  2567.      (condition-case err
  2568.      (edebug-eval (edebug-last-sexp))
  2569.        (error (edebug-format "%s: %s"
  2570.                  (get (car err) 'error-message)
  2571.                  (car (cdr err))))))))
  2572.  
  2573. ;;;---------------------------------
  2574. ;;; edebug minor mode initialization
  2575.  
  2576. (defvar edebug-mode-map nil)
  2577. (if edebug-mode-map
  2578.     nil
  2579.   (progn
  2580.     (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))
  2581.     ;; control
  2582.     (define-key edebug-mode-map " " 'edebug-step-through-mode)
  2583.     (define-key edebug-mode-map "g" 'edebug-go-mode)
  2584.     (define-key edebug-mode-map "G" 'edebug-Go-nonstop-mode)
  2585.     (define-key edebug-mode-map "t" 'edebug-trace-mode)
  2586.     (define-key edebug-mode-map "T" 'edebug-Trace-fast-mode)
  2587.     (define-key edebug-mode-map "c" 'edebug-continue-mode)
  2588.     (define-key edebug-mode-map "C" 'edebug-Continue-fast-mode)
  2589.  
  2590.     (define-key edebug-mode-map "f" 'edebug-forward-sexp)
  2591.     (define-key edebug-mode-map "h" 'edebug-goto-here)
  2592.  
  2593.     (define-key edebug-mode-map "r" 'edebug-previous-result)
  2594.  
  2595.     (define-key edebug-mode-map "i" 'edebug-step-in)
  2596.     (define-key edebug-mode-map "o" 'edebug-step-out)
  2597.     
  2598.     (define-key edebug-mode-map "q" 'top-level)
  2599.     (define-key edebug-mode-map "a" 'abort-recursive-edit)
  2600.     (define-key edebug-mode-map "S" 'edebug-stop)
  2601.  
  2602.     ;; breakpoints
  2603.     (define-key edebug-mode-map "b" 'edebug-set-breakpoint)
  2604.     (define-key edebug-mode-map "u" 'edebug-unset-breakpoint)
  2605.     (define-key edebug-mode-map "B" 'edebug-next-breakpoint)
  2606.     (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)
  2607.     
  2608.     ;; evaluation
  2609.     (define-key edebug-mode-map "e" 'edebug-eval-expression)
  2610.     (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
  2611.     (define-key edebug-mode-map "E" 'edebug-visit-eval-list)
  2612.     
  2613.     ;; views
  2614.     (define-key edebug-mode-map "w" 'edebug-where)
  2615.     (define-key edebug-mode-map "v" 'edebug-view-outside)
  2616.     (define-key edebug-mode-map "p" 'edebug-bounce-point)
  2617.     (define-key edebug-mode-map "W" 'edebug-toggle-save-windows)
  2618.     
  2619.     ;; misc
  2620.     (define-key edebug-mode-map "?" 'edebug-help)
  2621.     (define-key edebug-mode-map "d" 'edebug-backtrace)
  2622.     
  2623.     (define-key edebug-mode-map "-" 'negative-argument)
  2624.     ))
  2625.  
  2626.  
  2627. (defvar global-edebug-prefix "\^XX"
  2628.   "Prefix key for global edebug commands, available from any buffer.")
  2629.  
  2630. (defvar global-edebug-map nil
  2631.   "Global map of edebug commands, available from any buffer.")
  2632.  
  2633. (if global-edebug-map
  2634.     nil
  2635.   (setq global-edebug-map (make-sparse-keymap))
  2636.  
  2637.   (global-unset-key global-edebug-prefix)
  2638.   (global-set-key global-edebug-prefix global-edebug-map)
  2639.  
  2640.   (define-key global-edebug-map " " 'edebug-step-through-mode)
  2641.   (define-key global-edebug-map "g" 'edebug-go-mode)
  2642.   (define-key global-edebug-map "G" 'edebug-Go-nonstop-mode)
  2643.   (define-key global-edebug-map "t" 'edebug-trace-mode)
  2644.   (define-key global-edebug-map "T" 'edebug-Trace-fast-mode)
  2645.   (define-key global-edebug-map "c" 'edebug-continue-mode)
  2646.   (define-key global-edebug-map "C" 'edebug-Continue-fast-mode)
  2647.  
  2648.   (define-key global-edebug-map "b" 'edebug-set-breakpoint)
  2649.   (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint)
  2650.   (define-key global-edebug-map "u" 'edebug-unset-breakpoint)
  2651.   (define-key global-edebug-map "w" 'edebug-where)
  2652.   (define-key global-edebug-map "q" 'top-level)
  2653.   )
  2654.  
  2655.  
  2656. (defun edebug-help ()
  2657.   (interactive)
  2658.   (describe-function 'edebug-mode))
  2659.  
  2660.  
  2661. (defun edebug-mode ()
  2662.   "Mode for Emacs Lisp buffers while in edebug.
  2663.  
  2664. There are both buffer local and global key bindings to several
  2665. functions.  E.g. edebug-step-through is bound to
  2666. \\[edebug-step-through] in the debug buffer and \\<global-map>\\[edebug-step-through] in any buffer.
  2667.  
  2668. Also see bindings for the eval list buffer, *edebug*.
  2669.  
  2670. The edebug buffer commands:
  2671. \\{edebug-mode-map}
  2672.  
  2673. Global commands prefixed by global-edbug-prefix:
  2674. \\{global-edebug-map}
  2675.  
  2676. Options:
  2677. edebug-all-defuns
  2678. edebug-eval-macro-args
  2679. edebug-stop-before-symbols
  2680. edebug-save-windows
  2681. edebug-save-displayed-buffer-points
  2682. edebug-initial-mode
  2683. edebug-trace
  2684. "
  2685.   (use-local-map edebug-mode-map))
  2686.  
  2687.  
  2688.  
  2689. ;;===============================================
  2690. ;; edebug eval list mode
  2691. ;; A list of expressions and their evaluations is displayed in *edebug*.
  2692.  
  2693. ;;(defvar edebug-eval-buffer "*edebug*"
  2694. ;;  "*Declared globally so edebug-eval-display can be called independent
  2695. ;;of edebug (not implemented yet).")
  2696.  
  2697.  
  2698. (defun edebug-eval-result-list ()
  2699.   "Return a list of evaluations of edebug-eval-list"
  2700.   ;; Assumes in outside environment.
  2701.   (mapcar (function
  2702.        (lambda (expr)
  2703.          (condition-case err
  2704.          (eval expr)
  2705.            (error (edebug-format "%s: %s"
  2706.                      (get (car err) 'error-message)
  2707.                      (car (cdr err))))
  2708.            )))
  2709.       edebug-eval-list))
  2710.  
  2711. (defun edebug-eval-display-list (edebug-eval-result-list)
  2712.   ;; Assumes edebug-eval-buffer exists.
  2713.   (let ((edebug-eval-list-temp edebug-eval-list)
  2714.     (standard-output edebug-eval-buffer)
  2715.     (edebug-display-line
  2716.      (format ";%s\n" (make-string (- (window-width) 2) ?-))))
  2717.     (edebug-pop-to-buffer edebug-eval-buffer)
  2718.     (erase-buffer)
  2719.     (while edebug-eval-list-temp
  2720.       (prin1 (car edebug-eval-list-temp)) (terpri)
  2721.       (edebug-prin1 (car edebug-eval-result-list)) (terpri)
  2722.       (princ edebug-display-line)
  2723.       (setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
  2724.       (setq edebug-eval-result-list (cdr edebug-eval-result-list)))
  2725.     ))
  2726.  
  2727. (defun edebug-create-eval-buffer ()
  2728.   (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer)))
  2729.       (progn
  2730.     (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
  2731.     (edebug-eval-mode))))
  2732.  
  2733. ;; Should generalize this to be callable outside of edebug
  2734. ;; with calls in user functions, e.g. (edebug-eval-display)
  2735.  
  2736. (defun edebug-eval-display (edebug-eval-result-list)
  2737.   "Display expressions and evaluations in EVAL-LIST.
  2738. It modifies the context by popping up the eval display."
  2739.   (if edebug-eval-result-list
  2740.       (progn
  2741.     (edebug-create-eval-buffer)
  2742.     (edebug-pop-to-buffer edebug-eval-buffer)
  2743.     (edebug-eval-display-list edebug-eval-result-list)
  2744.     )))
  2745.  
  2746. (defun edebug-eval-redisplay ()
  2747.   "Redisplay eval list in outside environment.
  2748. May only be called from within edebug-recursive-edit."
  2749.   (edebug-create-eval-buffer)
  2750.   (edebug-pop-to-buffer edebug-eval-buffer)
  2751.   (edebug-outside-excursion
  2752.    (edebug-eval-display-list (edebug-eval-result-list))
  2753.    ))
  2754.  
  2755. (defun edebug-visit-eval-list ()
  2756.   (interactive)
  2757.   (edebug-eval-redisplay)
  2758.   (edebug-pop-to-buffer edebug-eval-buffer))
  2759.  
  2760.  
  2761. (defun edebug-update-eval-list ()
  2762.   "Replace the evaluation list with the sexps now in the eval buffer."
  2763.   (interactive)
  2764.   (let ((starting-point (point))
  2765.     new-list)
  2766.     (goto-char (point-min))
  2767.     ;; get the first expression
  2768.     (edebug-skip-whitespace)
  2769.     (if (not (eobp))
  2770.     (progn
  2771.       (forward-sexp 1)
  2772.       (setq new-list (cons (edebug-last-sexp) new-list))))
  2773.     
  2774.     (while (re-search-forward "^;" nil t)
  2775.       (forward-line 1)
  2776.       (skip-chars-forward " \t\n\r")
  2777.       (if (and (/= ?\; (following-char))
  2778.            (not (eobp)))
  2779.       (progn
  2780.         (forward-sexp 1)
  2781.         (setq new-list (cons (edebug-last-sexp) new-list)))))
  2782.     
  2783.     (setq edebug-eval-list (nreverse new-list))
  2784.     (edebug-eval-redisplay)
  2785.     (goto-char starting-point)))
  2786.  
  2787.  
  2788. (defun edebug-delete-eval-item ()
  2789.   "Delete the item under point and redisplay."
  2790.   ;; could add arg to do repeatedly
  2791.   (interactive)
  2792.   (if (re-search-backward "^;" nil 'nofail)
  2793.       (forward-line 1))
  2794.   (delete-region
  2795.    (point) (progn (re-search-forward "^;" nil 'nofail)
  2796.           (beginning-of-line)
  2797.           (point)))
  2798.   (edebug-update-eval-list))
  2799.  
  2800.  
  2801.  
  2802. (defvar edebug-eval-mode-map nil
  2803.   "Keymap for edebug-eval-mode.  Superset of lisp-interaction-mode.")
  2804.  
  2805. (if edebug-eval-mode-map
  2806.     nil
  2807.   (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
  2808.   
  2809.   (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
  2810.   (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
  2811.   (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
  2812.   (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
  2813.   (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp)
  2814.   )
  2815.  
  2816.  
  2817. (defun edebug-eval-mode ()
  2818.   "Mode for data display buffer while in edebug.  Under construction.
  2819. ... ignore the following...
  2820. There are both buffer local and global key bindings to several
  2821. functions.  E.g. edebug-step-through is bound to
  2822. \\[edebug-step-through] in the debug buffer and
  2823. \\<global-map>\\[edebug-step-through] in any buffer.
  2824.  
  2825. Eval list buffer commands:
  2826. \\{edebug-eval-mode-map}
  2827.  
  2828. Global commands prefixed by global-edbug-prefix:
  2829. \\{global-edebug-map}
  2830. "
  2831.   (lisp-interaction-mode)
  2832.   (setq major-mode 'edebug-eval-mode)
  2833.   (setq mode-name "Edebug-Eval")
  2834.   (use-local-map edebug-eval-mode-map))
  2835.  
  2836.  
  2837. ;;========================================
  2838. ;; Interface with standard debugger.
  2839.  
  2840. ;; (setq debugger 'edebug-debug) ; to use the edebug debugger
  2841. ;; (setq debugger 'debug)  ; use the standard debugger
  2842.  
  2843. ;; Note that debug and its utilities must be byte-compiled to work, since
  2844. ;; they depend on the backtrace looking a certain way.
  2845.  
  2846. (defun edebug-debug (&rest debugger-args)
  2847.   "Replacement for debug.  
  2848. If an error or quit occurred and we are running an edebugged function,
  2849. show where we last were.  Otherwise call debug normally."
  2850.   (if (and edebug-entered  ; anything active?
  2851.        (eq (recursion-depth) edebug-recursion-depth)
  2852.        )
  2853.  
  2854.       ;; Where were we before the error occurred?
  2855.       (let ((edebug-offset-index (car edebug-offset-indices))
  2856.         (edebug-arg-mode (car debugger-args))
  2857.         (edebug-exp (car (cdr debugger-args)))
  2858.         edebug-break-data 
  2859.         edebug-break
  2860.         (edebug-outside-debug-on-eror debug-on-error)
  2861.         (debug-on-error nil))
  2862.     (edebug-display)
  2863.     )
  2864.  
  2865.     ;; Otherwise call debug normally.
  2866.     ;; Still need to remove extraneous edebug calls from stack.
  2867.     (apply 'debug debugger-args)
  2868.     ))
  2869.  
  2870.  
  2871. (defun edebug-backtrace ()
  2872.   "Display a non-working backtrace.  Better than nothing..."
  2873.   (interactive)
  2874.   (let ((old-buf (current-buffer)))
  2875.     (if (not edebug-backtrace-buffer)
  2876.     (setq edebug-backtrace-buffer
  2877.           (let ((default-major-mode 'fundamental-mode))
  2878.         (generate-new-buffer "*Backtrace*"))))
  2879.     (edebug-pop-to-buffer edebug-backtrace-buffer)
  2880.     (erase-buffer)
  2881.     (let ((standard-output (current-buffer))
  2882.       (print-escape-newlines t)
  2883.       (print-length 50)
  2884.       last-ok-point
  2885.       )
  2886.       (setq truncate-lines t)
  2887.       (backtrace)
  2888.  
  2889.       ;; Clean up the backtrace.  Not quite right for current edebug scheme.
  2890.       (goto-char (point-min))
  2891.       (delete-region
  2892.        (point)
  2893.        (progn
  2894.      ;; Everything up to the first edebug is internal.
  2895.      (re-search-forward "^  edebug")
  2896.      (forward-line 1)
  2897.      (point)))
  2898.       (forward-line 1)
  2899.       (setq last-ok-point (point))
  2900.  
  2901.       ;; Delete interspersed edebug internals.
  2902.       (while (re-search-forward "^  edebug" nil t)
  2903.     (if (looking-at "-enter")
  2904.         ;; delete extraneous progn at top level of function body
  2905.         (save-excursion
  2906.           (goto-char last-ok-point)
  2907.           (forward-line -1)
  2908.           (setq last-ok-point (point))))
  2909.     (forward-line 1)
  2910.     (delete-region last-ok-point (point))
  2911.     (forward-line 1) ; skip past the good line
  2912.     (setq last-ok-point (point))
  2913.     )
  2914.       )
  2915.     (edebug-pop-to-buffer old-buf)
  2916.     ))
  2917.  
  2918.  
  2919. ;;========================================================================
  2920. ;; Trace display - append text to a buffer, and update display.
  2921. ;;; e.g.
  2922. ;;;     (edebug-trace-display
  2923. ;;;      "*trace-point*"
  2924. ;;;      "saving: point = %s  window-start = %s\n"
  2925. ;;;      (point) (window-start))
  2926.  
  2927. (defun edebug-trace-display (buf-name fmt &rest args)
  2928.   "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
  2929. The buffer is created if it does not exist.
  2930. You must include newlines in FMT to break lines."
  2931.   (let* ((selected-window (selected-window))
  2932.      (buffer (get-buffer-create buf-name))
  2933.      (buf-window))
  2934.     (edebug-pop-to-buffer buffer)
  2935.     (save-excursion
  2936.       (setq buf-window (selected-window))
  2937.       (set-buffer buffer)
  2938.       (goto-char (point-max))
  2939.       (insert (apply 'edebug-format fmt args))
  2940.       (set-window-point buf-window (point))
  2941.       (forward-line (- 1 (window-height buf-window)))
  2942.       (set-window-start buf-window (point))
  2943. ;;      (edebug-sit-for 1)
  2944.       (bury-buffer buffer)
  2945.       )
  2946.     (select-window selected-window))
  2947.   buf-name)
  2948.  
  2949.  
  2950. (defun edebug-trace (fmt &rest args)
  2951.   "Convenience call to edebug-trace-display for buffer *edebug-trace*"
  2952.   (apply 'edebug-trace-display "*edebug-trace*" fmt args))
  2953.  
  2954.