/[emacs]/emacs/lisp/emacs-lisp/edebug.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/edebug.el

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

revision 3.53.2.1 by miles, Fri Apr 4 06:20:16 2003 UTC revision 3.53.2.2 by miles, Tue Oct 14 23:32:21 2003 UTC
# Line 1  Line 1 
1  ;;; edebug.el --- a source-level debugger for Emacs Lisp  ;;; edebug.el --- a source-level debugger for Emacs Lisp
2    
3  ;; Copyright (C) 1988, 89, 90, 91, 92, 93, 94, 95, 97, 1999, 2000, 2001  ;; Copyright (C) 1988, 89, 90, 91, 92, 93, 94, 95, 97, 1999, 2000, 01, 2003
4  ;;       Free Software Foundation, Inc.  ;;       Free Software Foundation, Inc.
5    
6  ;; Author: Daniel LaLiberte <liberte@holonexus.org>  ;; Author: Daniel LaLiberte <liberte@holonexus.org>
# Line 302  A lambda list keyword is a symbol that s Line 302  A lambda list keyword is a symbol that s
302    "Return a list of windows, in order of `next-window'."    "Return a list of windows, in order of `next-window'."
303    ;; This doesn't work for epoch.    ;; This doesn't work for epoch.
304    (let (window-list)    (let (window-list)
305      (walk-windows (lambda (w) (setq window-list (cons w window-list))))      (walk-windows (lambda (w) (push w window-list)))
306      (nreverse window-list)))      (nreverse window-list)))
307    
308  ;; Not used.  ;; Not used.
# Line 322  A lambda list keyword is a symbol that s Line 322  A lambda list keyword is a symbol that s
322    (setq object (edebug-lookup-function object))    (setq object (edebug-lookup-function object))
323    (if (and (listp object)    (if (and (listp object)
324             (eq 'macro (car object))             (eq 'macro (car object))
325             (edebug-functionp (cdr object)))             (functionp (cdr object)))
       object))  
   
 (defun edebug-functionp (object)  
   "Returns the function named by OBJECT, or nil if it is not a function."  
   (setq object (edebug-lookup-function object))  
   (if (or (subrp object)  
           (byte-code-function-p object)  
           (and (listp object)  
                (eq (car object) 'lambda)  
                (listp (car (cdr object)))))  
326        object))        object))
327    
328  (defun edebug-sort-alist (alist function)  (defun edebug-sort-alist (alist function)
# Line 397  Return the result of the last expression Line 387  Return the result of the last expression
387    (let (list)    (let (list)
388      (walk-windows (lambda (w)      (walk-windows (lambda (w)
389                      (unless (eq w (selected-window))                      (unless (eq w (selected-window))
390                        (setq list (cons (cons (window-buffer w)                        (push (cons (window-buffer w)
391                                               (window-point w))                                    (window-point w))
392                                         list)))))                              list))))
393      list))      list))
394    
395    
396  (defun edebug-set-buffer-points (buffer-points)  (defun edebug-set-buffer-points (buffer-points)
397    ;; Restore the buffer-points created by edebug-get-displayed-buffer-points.    ;; Restore the buffer-points created by edebug-get-displayed-buffer-points.
398    (let ((current-buffer (current-buffer)))    (save-current-buffer
399      (mapcar (function (lambda (buf-point)      (mapcar (lambda (buf-point)
400                          (if (buffer-name (car buf-point)) ; still exists                (when (buffer-live-p (car buf-point))
401                              (progn                  (set-buffer (car buf-point))
402                                (set-buffer (car buf-point))                  (goto-char (cdr buf-point))))
403                                (goto-char (cdr buf-point))))))              buffer-points)))
             buffer-points)  
     (set-buffer current-buffer)))  
404    
405  (defun edebug-current-windows (which-windows)  (defun edebug-current-windows (which-windows)
406    ;; Get either a full window configuration or some window information.    ;; Get either a full window configuration or some window information.
# Line 822  already is one.)" Line 810  already is one.)"
810    ;; Ignore the last created offset pair.    ;; Ignore the last created offset pair.
811    (setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))    (setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))
812    
 (def-edebug-spec edebug-storing-offsets (form body))  
 (put 'edebug-storing-offsets 'lisp-indent-hook 1)  
   
813  (defmacro edebug-storing-offsets (point &rest body)  (defmacro edebug-storing-offsets (point &rest body)
814      (declare (debug (form body)) (indent 1))
815    `(unwind-protect    `(unwind-protect
816         (progn         (progn
817           (edebug-store-before-offset ,point)           (edebug-store-before-offset ,point)
# Line 849  already is one.)" Line 835  already is one.)"
835      ))      ))
836    
837  (defun edebug-read-storing-offsets (stream)  (defun edebug-read-storing-offsets (stream)
838    (let ((class (edebug-next-token-class))    (let (edebug-read-dotted-list) ; see edebug-store-after-offset
         func  
         edebug-read-dotted-list) ; see edebug-store-after-offset  
839      (edebug-storing-offsets (point)      (edebug-storing-offsets (point)
840        (if (setq func (assq class edebug-read-alist))        (funcall
841            (funcall (cdr func) stream)         (or (cdr (assq (edebug-next-token-class) edebug-read-alist))
842          ;; anything else, just read it.             ;; anything else, just read it.
843          (edebug-original-read stream))             'edebug-original-read)
844        )))         stream))))
845    
846  (defun edebug-read-symbol (stream)  (defun edebug-read-symbol (stream)
847    (edebug-original-read stream))    (edebug-original-read stream))
# Line 869  already is one.)" Line 853  already is one.)"
853    ;; Turn 'thing into (quote thing)    ;; Turn 'thing into (quote thing)
854    (forward-char 1)    (forward-char 1)
855    (list    (list
856     (edebug-storing-offsets (point)  'quote)     (edebug-storing-offsets (1- (point)) 'quote)
857     (edebug-read-storing-offsets stream)))     (edebug-read-storing-offsets stream)))
858    
859    (defvar edebug-read-backquote-level 0
860      "If non-zero, we're in a new-style backquote.
861    It should never be negative.  This controls how we read comma constructs.")
862    
863  (defun edebug-read-backquote (stream)  (defun edebug-read-backquote (stream)
864    ;; Turn `thing into (\` thing)    ;; Turn `thing into (\` thing)
865    (let ((opoint (point)))    (forward-char 1)
866      (forward-char 1)    (list
867      ;; Generate the same structure of offsets we would have     (edebug-storing-offsets (1- (point)) '\`)
868      ;; if the resulting list appeared verbatim in the input text.     (let ((edebug-read-backquote-level (1+ edebug-read-backquote-level)))
869      (edebug-storing-offsets opoint       (edebug-read-storing-offsets stream))))
       (list  
        (edebug-storing-offsets opoint  '\`)  
        (edebug-read-storing-offsets stream)))))  
   
 (defvar edebug-read-backquote-new nil  
   "Non-nil if reading the inside of a new-style backquote with no parens around it.  
 Value of nil means reading the inside of an old-style backquote construct  
 which is surrounded by an extra set of parentheses.  
 This controls how we read comma constructs.")  
870    
871  (defun edebug-read-comma (stream)  (defun edebug-read-comma (stream)
872    ;; Turn ,thing into (\, thing).  Handle ,@ and ,. also.    ;; Turn ,thing into (\, thing).  Handle ,@ and ,. also.
# Line 902  This controls how we read comma construc Line 881  This controls how we read comma construc
881               (forward-char 1)))               (forward-char 1)))
882        ;; Generate the same structure of offsets we would have        ;; Generate the same structure of offsets we would have
883        ;; if the resulting list appeared verbatim in the input text.        ;; if the resulting list appeared verbatim in the input text.
884        (if edebug-read-backquote-new        (if (zerop edebug-read-backquote-level)
885            (list            (edebug-storing-offsets opoint symbol)
886             (edebug-storing-offsets opoint symbol)          (list
887             (edebug-read-storing-offsets stream))           (edebug-storing-offsets opoint symbol)
888          (edebug-storing-offsets opoint symbol)))))           (let ((edebug-read-backquote-level (1- edebug-read-backquote-level)))
889               (edebug-read-storing-offsets stream)))))))
890    
891  (defun edebug-read-function (stream)  (defun edebug-read-function (stream)
892    ;; Turn #'thing into (function thing)    ;; Turn #'thing into (function thing)
# Line 914  This controls how we read comma construc Line 894  This controls how we read comma construc
894    (cond ((eq ?\' (following-char))    (cond ((eq ?\' (following-char))
895           (forward-char 1)           (forward-char 1)
896           (list           (list
897            (edebug-storing-offsets (point)            (edebug-storing-offsets (- (point) 2)
898              (if (featurep 'cl) 'function* 'function))              (if (featurep 'cl) 'function* 'function))
899            (edebug-read-storing-offsets stream)))            (edebug-read-storing-offsets stream)))
900          ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6          ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
901                                      ?7 ?8 ?9 ?0))                                    ?7 ?8 ?9 ?0))
902           (backward-char 1)           (backward-char 1)
903           (edebug-original-read stream))           (edebug-original-read stream))
904          (t (edebug-syntax-error "Bad char after #"))))          (t (edebug-syntax-error "Bad char after #"))))
# Line 928  This controls how we read comma construc Line 908  This controls how we read comma construc
908    (prog1    (prog1
909        (let ((elements))        (let ((elements))
910          (while (not (memq (edebug-next-token-class) '(rparen dot)))          (while (not (memq (edebug-next-token-class) '(rparen dot)))
911            (if (eq (edebug-next-token-class) 'backquote)            (if (and (eq (edebug-next-token-class) 'backquote)
912                (let ((edebug-read-backquote-new (not (null elements)))                     (null elements)
913                      (opoint (point)))                     (zerop edebug-read-backquote-level))
914                  (if edebug-read-backquote-new                (progn
915                      (setq elements (cons (edebug-read-backquote stream) elements))                  ;; Old style backquote.
916                    (forward-char 1)      ; Skip backquote.                  (forward-char 1)        ; Skip backquote.
917                    ;; Call edebug-storing-offsets here so that we                  ;; Call edebug-storing-offsets here so that we
918                    ;; produce the same offsets we would have had                  ;; produce the same offsets we would have had
919                    ;; if the backquote were an ordinary symbol.                  ;; if the backquote were an ordinary symbol.
920                    (setq elements (cons (edebug-storing-offsets opoint '\`)                  (push (edebug-storing-offsets (1- (point)) '\`) elements))
921                                         elements))))              (push (edebug-read-storing-offsets stream) elements)))
             (setq elements (cons (edebug-read-storing-offsets stream) elements))))  
922          (setq elements (nreverse elements))          (setq elements (nreverse elements))
923          (if (eq 'dot (edebug-next-token-class))          (if (eq 'dot (edebug-next-token-class))
924              (let (dotted-form)              (let (dotted-form)
# Line 959  This controls how we read comma construc Line 938  This controls how we read comma construc
938    (prog1    (prog1
939        (let ((elements))        (let ((elements))
940          (while (not (eq 'rbracket (edebug-next-token-class)))          (while (not (eq 'rbracket (edebug-next-token-class)))
941            (setq elements (cons (edebug-read-storing-offsets stream) elements)))            (push (edebug-read-storing-offsets stream) elements))
942          (apply 'vector (nreverse elements)))          (apply 'vector (nreverse elements)))
943      (forward-char 1)                    ; skip \]      (forward-char 1)                    ; skip \]
944      ))      ))
# Line 981  This controls how we read comma construc Line 960  This controls how we read comma construc
960    (setcdr cursor offsets)    (setcdr cursor offsets)
961    cursor)    cursor)
962    
963  '(defun edebug-copy-cursor (cursor)  (defun edebug-copy-cursor (cursor)
964    ;; Copy the cursor using the same object and offsets.    ;; Copy the cursor using the same object and offsets.
965    (cons (car cursor) (cdr cursor)))    (cons (car cursor) (cdr cursor)))
966    
# Line 1484  expressions; a `progn' form will be retu Line 1463  expressions; a `progn' form will be retu
1463      (edebug-set-cursor cursor (edebug-cursor-expressions cursor)      (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
1464                         (cdr (edebug-cursor-offsets cursor)))                         (cdr (edebug-cursor-offsets cursor)))
1465      (cond      (cond
      ((null head) nil) ; () is legal.  
   
1466       ((symbolp head)       ((symbolp head)
1467        (cond        (cond
1468         ((null head)         ((null head) nil) ; () is legal.
         (edebug-syntax-error "nil head"))  
1469         ((eq head 'interactive-p)         ((eq head 'interactive-p)
1470          ;; Special case: replace (interactive-p) with variable          ;; Special case: replace (interactive-p) with variable
1471          (setq edebug-def-interactive 'check-it)          (setq edebug-def-interactive 'check-it)
# Line 1500  expressions; a `progn' form will be retu Line 1476  expressions; a `progn' form will be retu
1476                      head (edebug-move-cursor cursor))))))                      head (edebug-move-cursor cursor))))))
1477    
1478       ((consp head)       ((consp head)
1479        (if (and (listp head) (eq (car head) ',))        (if (eq (car head) ',)
1480              ;; The head of a form should normally be a symbol or a lambda
1481              ;; expression but it can also be an unquote form to be filled
1482              ;; before evaluation.  We evaluate the arguments anyway, on the
1483              ;; assumption that the unquote form will place a proper function
1484              ;; name (rather than a macro name).
1485            (edebug-match cursor '(("," def-form) body))            (edebug-match cursor '(("," def-form) body))
1486          ;; Process anonymous function and args.          ;; Process anonymous function and args.
1487          ;; This assumes no anonymous macros.          ;; This assumes no anonymous macros.
1488          (edebug-match-specs cursor '(lambda-expr body) 'edebug-match-specs)))          (edebug-match-specs cursor '(lambda-expr body) 'edebug-match-specs)))
1489    
1490       (t (edebug-syntax-error       (t (edebug-syntax-error
1491           "Head of list form must be a symbol or lambda expression.")))           "Head of list form must be a symbol or lambda expression")))
1492        ))        ))
1493    
1494  ;;; Matching of specs.  ;;; Matching of specs.
# Line 1993  expressions; a `progn' form will be retu Line 1974  expressions; a `progn' form will be retu
1974             [&optional ("interactive" interactive)]             [&optional ("interactive" interactive)]
1975             def-body))             def-body))
1976  (def-edebug-spec defmacro  (def-edebug-spec defmacro
1977    (&define name lambda-list def-body))    (&define name lambda-list [&optional ("declare" &rest sexp)] def-body))
 (def-edebug-spec define-derived-mode  
   (&define name symbolp stringp [&optional stringp] def-body))  
 (def-edebug-spec define-minor-mode  
   (&define name stringp  
            [&optional sexp sexp &or consp symbolp]  
            [&rest [keywordp sexp]]  
            def-body))  
 ;; This plain doesn't work ;-(   -sm  
 ;; (def-edebug-spec define-skeleton  
 ;;   (&define name stringp def-body))  
1978    
1979  (def-edebug-spec arglist lambda-list)  ;; deprecated - use lambda-list.  (def-edebug-spec arglist lambda-list)  ;; deprecated - use lambda-list.
1980    
# Line 2069  expressions; a `progn' form will be retu Line 2040  expressions; a `progn' form will be retu
2040  (def-edebug-spec backquote-form  (def-edebug-spec backquote-form
2041    (&or    (&or
2042     ([&or "," ",@"] &or ("quote" backquote-form) form)     ([&or "," ",@"] &or ("quote" backquote-form) form)
2043     (backquote-form &rest backquote-form)     ;; The simple version:
2044       ;;   (backquote-form &rest backquote-form)
2045       ;; doesn't handle (a . ,b).  The straightforward fix:
2046       ;;   (backquote-form . [&or nil backquote-form])
2047       ;; uses up too much stack space.
2048       ;; Note that `(foo . ,@bar) is not legal, so we don't need to handle it.
2049       (backquote-form [&rest [&not ","] backquote-form]
2050                       . [&or nil backquote-form])
2051     ;; If you use dotted forms in backquotes, replace the previous line     ;; If you use dotted forms in backquotes, replace the previous line
2052     ;; with the following.  This takes quite a bit more stack space, however.     ;; with the following.  This takes quite a bit more stack space, however.
2053     ;; (backquote-form . [&or nil backquote-form])     ;; (backquote-form . [&or nil backquote-form])
# Line 2105  expressions; a `progn' form will be retu Line 2083  expressions; a `progn' form will be retu
2083    
2084  (def-edebug-spec save-selected-window t)  (def-edebug-spec save-selected-window t)
2085  (def-edebug-spec save-current-buffer t)  (def-edebug-spec save-current-buffer t)
 (def-edebug-spec save-match-data t)  
 (def-edebug-spec with-output-to-string t)  
 (def-edebug-spec with-current-buffer t)  
 (def-edebug-spec combine-after-change-calls t)  
2086  (def-edebug-spec delay-mode-hooks t)  (def-edebug-spec delay-mode-hooks t)
2087  (def-edebug-spec with-temp-file t)  (def-edebug-spec with-temp-file t)
 (def-edebug-spec with-temp-buffer t)  
2088  (def-edebug-spec with-temp-message t)  (def-edebug-spec with-temp-message t)
2089  (def-edebug-spec with-syntax-table t)  (def-edebug-spec with-syntax-table t)
 (def-edebug-spec dolist ((symbolp form &rest form) &rest form))  
 (def-edebug-spec dotimes ((symbolp form &rest form) &rest form))  
2090  (def-edebug-spec push (form sexp))  (def-edebug-spec push (form sexp))
2091  (def-edebug-spec pop (sexp))  (def-edebug-spec pop (sexp))
 (def-edebug-spec unless t)  
 (def-edebug-spec when t)  
2092    
2093  ;; Anything else?  ;; Anything else?
2094    
# Line 2272  error is signaled again." Line 2241  error is signaled again."
2241    
2242              ;; Save the outside value of executing macro.  (here??)              ;; Save the outside value of executing macro.  (here??)
2243              (edebug-outside-executing-macro executing-kbd-macro)              (edebug-outside-executing-macro executing-kbd-macro)
2244              (edebug-outside-pre-command-hook pre-command-hook)              (edebug-outside-pre-command-hook
2245              (edebug-outside-post-command-hook post-command-hook))               (edebug-var-status 'pre-command-hook))
2246                (edebug-outside-post-command-hook
2247                 (edebug-var-status 'post-command-hook)))
2248          (unwind-protect          (unwind-protect
2249              (let (;; Don't keep reading from an executing kbd macro              (let (;; Don't keep reading from an executing kbd macro
2250                    ;; within edebug unless edebug-continue-kbd-macro is                    ;; within edebug unless edebug-continue-kbd-macro is
# Line 2298  error is signaled again." Line 2269  error is signaled again."
2269                      edebug-next-execution-mode nil)                      edebug-next-execution-mode nil)
2270                (edebug-enter edebug-function edebug-args edebug-body))                (edebug-enter edebug-function edebug-args edebug-body))
2271            ;; Reset global variables in case outside value was changed.            ;; Reset global variables in case outside value was changed.
2272            (setq executing-kbd-macro edebug-outside-executing-macro            (setq executing-kbd-macro edebug-outside-executing-macro)
2273                  pre-command-hook edebug-outside-pre-command-hook            (edebug-restore-status
2274                  post-command-hook edebug-outside-post-command-hook             'post-command-hook edebug-outside-post-command-hook)
2275                  )))            (edebug-restore-status
2276               'pre-command-hook edebug-outside-pre-command-hook)))
2277    
2278      (let* ((edebug-data (get edebug-function 'edebug))      (let* ((edebug-data (get edebug-function 'edebug))
2279             (edebug-def-mark (car edebug-data)) ; mark at def start             (edebug-def-mark (car edebug-data)) ; mark at def start
# Line 2322  error is signaled again." Line 2294  error is signaled again."
2294          (funcall edebug-body))          (funcall edebug-body))
2295        )))        )))
2296    
2297    (defun edebug-var-status (var)
2298      "Return a cons cell describing the status of VAR's current binding.
2299    The purpose of this function is so you can properly undo
2300    subsequent changes to the same binding, by passing the status
2301    cons cell to `edebug-restore-status'.  The status cons cell
2302    has the form (LOCUS . VALUE), where LOCUS can be a buffer
2303    \(for a buffer-local binding), a frame (for a frame-local binding),
2304    or nil (if the default binding is current)."
2305      (cons (variable-binding-locus var)
2306            (symbol-value var)))
2307    
2308    (defun edebug-restore-status (var status)
2309      "Reset VAR based on STATUS.
2310    STATUS should be a list you got from `edebug-var-status'."
2311      (let ((locus (car status))
2312            (value (cdr status)))
2313        (cond ((bufferp locus)
2314               (if (buffer-live-p locus)
2315                   (with-current-buffer locus
2316                     (set var value))))
2317              ((framep locus)
2318               (modify-frame-parameters locus (list (cons var value))))
2319              (t
2320               (set var value)))))
2321    
2322  (defun edebug-enter-trace (edebug-body)  (defun edebug-enter-trace (edebug-body)
2323    (let ((edebug-stack-depth (1+ edebug-stack-depth))    (let ((edebug-stack-depth (1+ edebug-stack-depth))
# Line 3542  Return the result of the last expression Line 3538  Return the result of the last expression
3538    
3539             (executing-kbd-macro edebug-outside-executing-macro)             (executing-kbd-macro edebug-outside-executing-macro)
3540             (defining-kbd-macro edebug-outside-defining-kbd-macro)             (defining-kbd-macro edebug-outside-defining-kbd-macro)
3541             (pre-command-hook edebug-outside-pre-command-hook)             ;; Get the values out of the saved statuses.
3542             (post-command-hook edebug-outside-post-command-hook)             (pre-command-hook (cdr edebug-outside-pre-command-hook))
3543               (post-command-hook (cdr edebug-outside-post-command-hook))
3544    
3545             ;; See edebug-display             ;; See edebug-display
3546             (overlay-arrow-position edebug-outside-o-a-p)             (overlay-arrow-position edebug-outside-o-a-p)
# Line 3583  Return the result of the last expression Line 3580  Return the result of the last expression
3580    
3581            edebug-outside-executing-macro executing-kbd-macro            edebug-outside-executing-macro executing-kbd-macro
3582            edebug-outside-defining-kbd-macro defining-kbd-macro            edebug-outside-defining-kbd-macro defining-kbd-macro
           edebug-outside-pre-command-hook pre-command-hook  
           edebug-outside-post-command-hook post-command-hook  
3583    
3584            edebug-outside-o-a-p overlay-arrow-position            edebug-outside-o-a-p overlay-arrow-position
3585            edebug-outside-o-a-s overlay-arrow-string            edebug-outside-o-a-s overlay-arrow-string
3586            edebug-outside-c-i-e-a cursor-in-echo-area            edebug-outside-c-i-e-a cursor-in-echo-area
3587            )))                           ; let            )
3588    
3589             ;; Restore the outside saved values; don't alter
3590             ;; the outside binding loci.
3591             (setcdr edebug-outside-pre-command-hook pre-command-hook)
3592             (setcdr edebug-outside-post-command-hook post-command-hook)
3593    
3594             ))                             ; let
3595       ))       ))
3596    
3597  (defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.  (defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.
# Line 3707  Print result in minibuffer." Line 3709  Print result in minibuffer."
3709      (edebug-safe-prin1-to-string (car values)))))      (edebug-safe-prin1-to-string (car values)))))
3710    
3711  (defun edebug-eval-last-sexp ()  (defun edebug-eval-last-sexp ()
3712    "Evaluate sexp before point in the outside environment;    "Evaluate sexp before point in the outside environment; value in minibuffer."
 print value in minibuffer."  
3713    (interactive)    (interactive)
3714    (edebug-eval-expression (edebug-last-sexp)))    (edebug-eval-expression (edebug-last-sexp)))
3715    
3716  (defun edebug-eval-print-last-sexp ()  (defun edebug-eval-print-last-sexp ()
3717    "Evaluate sexp before point in the outside environment;    "Evaluate sexp before point in the outside environment; insert the value.
3718  print value into current buffer."  This prints the value into current buffer."
3719    (interactive)    (interactive)
3720    (let* ((edebug-form (edebug-last-sexp))    (let* ((edebug-form (edebug-last-sexp))
3721           (edebug-result-string           (edebug-result-string
# Line 3729  print value into current buffer." Line 3730  print value into current buffer."
3730    
3731  ;;; Edebug Minor Mode  ;;; Edebug Minor Mode
3732    
3733  ;; Global GUD bindings for all emacs-lisp-mode buffers.  (defvar gud-inhibit-global-bindings
3734  (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)    "*Non-nil means don't do global rebindings of C-x C-a subcommands.")
 (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)  
 (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)  
 (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)  
3735    
3736    ;; Global GUD bindings for all emacs-lisp-mode buffers.
3737    (unless gud-inhibit-global-bindings
3738      (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
3739      (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
3740      (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
3741      (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where))
3742    
3743  (defvar edebug-mode-map nil)  (defvar edebug-mode-map
3744  (if edebug-mode-map    (let ((map (copy-keymap emacs-lisp-mode-map)))
     nil  
   (progn  
     (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))  
3745      ;; control      ;; control
3746      (define-key edebug-mode-map " " 'edebug-step-mode)      (define-key map " " 'edebug-step-mode)
3747      (define-key edebug-mode-map "n" 'edebug-next-mode)      (define-key map "n" 'edebug-next-mode)
3748      (define-key edebug-mode-map "g" 'edebug-go-mode)      (define-key map "g" 'edebug-go-mode)
3749      (define-key edebug-mode-map "G" 'edebug-Go-nonstop-mode)      (define-key map "G" 'edebug-Go-nonstop-mode)
3750      (define-key edebug-mode-map "t" 'edebug-trace-mode)      (define-key map "t" 'edebug-trace-mode)
3751      (define-key edebug-mode-map "T" 'edebug-Trace-fast-mode)      (define-key map "T" 'edebug-Trace-fast-mode)
3752      (define-key edebug-mode-map "c" 'edebug-continue-mode)      (define-key map "c" 'edebug-continue-mode)
3753      (define-key edebug-mode-map "C" 'edebug-Continue-fast-mode)      (define-key map "C" 'edebug-Continue-fast-mode)
3754    
3755      ;;(define-key edebug-mode-map "f" 'edebug-forward) not implemented      ;;(define-key map "f" 'edebug-forward) not implemented
3756      (define-key edebug-mode-map "f" 'edebug-forward-sexp)      (define-key map "f" 'edebug-forward-sexp)
3757      (define-key edebug-mode-map "h" 'edebug-goto-here)      (define-key map "h" 'edebug-goto-here)
3758    
3759      (define-key edebug-mode-map "I" 'edebug-instrument-callee)      (define-key map "I" 'edebug-instrument-callee)
3760      (define-key edebug-mode-map "i" 'edebug-step-in)      (define-key map "i" 'edebug-step-in)
3761      (define-key edebug-mode-map "o" 'edebug-step-out)      (define-key map "o" 'edebug-step-out)
3762    
3763      ;; quitting and stopping      ;; quitting and stopping
3764      (define-key edebug-mode-map "q" 'top-level)      (define-key map "q" 'top-level)
3765      (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)      (define-key map "Q" 'edebug-top-level-nonstop)
3766      (define-key edebug-mode-map "a" 'abort-recursive-edit)      (define-key map "a" 'abort-recursive-edit)
3767      (define-key edebug-mode-map "S" 'edebug-stop)      (define-key map "S" 'edebug-stop)
3768    
3769      ;; breakpoints      ;; breakpoints
3770      (define-key edebug-mode-map "b" 'edebug-set-breakpoint)      (define-key map "b" 'edebug-set-breakpoint)
3771      (define-key edebug-mode-map "u" 'edebug-unset-breakpoint)      (define-key map "u" 'edebug-unset-breakpoint)
3772      (define-key edebug-mode-map "B" 'edebug-next-breakpoint)      (define-key map "B" 'edebug-next-breakpoint)
3773      (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)      (define-key map "x" 'edebug-set-conditional-breakpoint)
3774      (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)      (define-key map "X" 'edebug-set-global-break-condition)
3775    
3776      ;; evaluation      ;; evaluation
3777      (define-key edebug-mode-map "r" 'edebug-previous-result)      (define-key map "r" 'edebug-previous-result)
3778      (define-key edebug-mode-map "e" 'edebug-eval-expression)      (define-key map "e" 'edebug-eval-expression)
3779      (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)      (define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
3780      (define-key edebug-mode-map "E" 'edebug-visit-eval-list)      (define-key map "E" 'edebug-visit-eval-list)
3781    
3782      ;; views      ;; views
3783      (define-key edebug-mode-map "w" 'edebug-where)      (define-key map "w" 'edebug-where)
3784      (define-key edebug-mode-map "v" 'edebug-view-outside)  ;; maybe obsolete??      (define-key map "v" 'edebug-view-outside) ;; maybe obsolete??
3785      (define-key edebug-mode-map "p" 'edebug-bounce-point)      (define-key map "p" 'edebug-bounce-point)
3786      (define-key edebug-mode-map "P" 'edebug-view-outside) ;; same as v      (define-key map "P" 'edebug-view-outside) ;; same as v
3787      (define-key edebug-mode-map "W" 'edebug-toggle-save-windows)      (define-key map "W" 'edebug-toggle-save-windows)
3788    
3789      ;; misc      ;; misc
3790      (define-key edebug-mode-map "?" 'edebug-help)      (define-key map "?" 'edebug-help)
3791      (define-key edebug-mode-map "d" 'edebug-backtrace)      (define-key map "d" 'edebug-backtrace)
3792    
3793      (define-key edebug-mode-map "-" 'negative-argument)      (define-key map "-" 'negative-argument)
3794    
3795      ;; statistics      ;; statistics
3796      (define-key edebug-mode-map "=" 'edebug-temp-display-freq-count)      (define-key map "=" 'edebug-temp-display-freq-count)
3797    
3798      ;; GUD bindings      ;; GUD bindings
3799      (define-key edebug-mode-map "\C-c\C-s" 'edebug-step-mode)      (define-key map "\C-c\C-s" 'edebug-step-mode)
3800      (define-key edebug-mode-map "\C-c\C-n" 'edebug-next-mode)      (define-key map "\C-c\C-n" 'edebug-next-mode)
3801      (define-key edebug-mode-map "\C-c\C-c" 'edebug-go-mode)      (define-key map "\C-c\C-c" 'edebug-go-mode)
3802    
3803      (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)      (define-key map "\C-x " 'edebug-set-breakpoint)
3804      (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)      (define-key map "\C-c\C-d" 'edebug-unset-breakpoint)
3805      (define-key edebug-mode-map "\C-c\C-t"      (define-key map "\C-c\C-t"
3806        (function (lambda () (edebug-set-breakpoint t))))        (lambda () (interactive) (edebug-set-breakpoint t)))
3807      (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)      (define-key map "\C-c\C-l" 'edebug-where)
3808      ))      map))
3809    
3810  ;; Autoloading these global bindings doesn't make sense because  ;; Autoloading these global bindings doesn't make sense because
3811  ;; they cannot be used anyway unless Edebug is already loaded and active.  ;; they cannot be used anyway unless Edebug is already loaded and active.
# Line 3812  print value into current buffer." Line 3813  print value into current buffer."
3813  (defvar global-edebug-prefix "\^XX"  (defvar global-edebug-prefix "\^XX"
3814    "Prefix key for global edebug commands, available from any buffer.")    "Prefix key for global edebug commands, available from any buffer.")
3815    
3816  (defvar global-edebug-map nil  (defvar global-edebug-map
3817    "Global map of edebug commands, available from any buffer.")    (let ((map (make-sparse-keymap)))
3818    
3819  (if global-edebug-map      (define-key map " " 'edebug-step-mode)
3820      nil      (define-key map "g" 'edebug-go-mode)
3821    (setq global-edebug-map (make-sparse-keymap))      (define-key map "G" 'edebug-Go-nonstop-mode)
3822        (define-key map "t" 'edebug-trace-mode)
3823        (define-key map "T" 'edebug-Trace-fast-mode)
3824        (define-key map "c" 'edebug-continue-mode)
3825        (define-key map "C" 'edebug-Continue-fast-mode)
3826    
3827    (global-unset-key global-edebug-prefix)      ;; breakpoints
3828    (global-set-key global-edebug-prefix global-edebug-map)      (define-key map "b" 'edebug-set-breakpoint)
3829        (define-key map "u" 'edebug-unset-breakpoint)
3830        (define-key map "x" 'edebug-set-conditional-breakpoint)
3831        (define-key map "X" 'edebug-set-global-break-condition)
3832    
3833    (define-key global-edebug-map " " 'edebug-step-mode)      ;; views
3834    (define-key global-edebug-map "g" 'edebug-go-mode)      (define-key map "w" 'edebug-where)
3835    (define-key global-edebug-map "G" 'edebug-Go-nonstop-mode)      (define-key map "W" 'edebug-toggle-save-windows)
3836    (define-key global-edebug-map "t" 'edebug-trace-mode)  
3837    (define-key global-edebug-map "T" 'edebug-Trace-fast-mode)      ;; quitting
3838    (define-key global-edebug-map "c" 'edebug-continue-mode)      (define-key map "q" 'top-level)
3839    (define-key global-edebug-map "C" 'edebug-Continue-fast-mode)      (define-key map "Q" 'edebug-top-level-nonstop)
3840        (define-key map "a" 'abort-recursive-edit)
3841    ;; breakpoints  
3842    (define-key global-edebug-map "b" 'edebug-set-breakpoint)      ;; statistics
3843    (define-key global-edebug-map "u" 'edebug-unset-breakpoint)      (define-key map "=" 'edebug-display-freq-count)
3844    (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint)      map)
3845    (define-key global-edebug-map "X" 'edebug-set-global-break-condition)    "Global map of edebug commands, available from any buffer.")
3846    
3847    ;; views  (global-unset-key global-edebug-prefix)
3848    (define-key global-edebug-map "w" 'edebug-where)  (global-set-key global-edebug-prefix global-edebug-map)
   (define-key global-edebug-map "W" 'edebug-toggle-save-windows)  
   
   ;; quitting  
   (define-key global-edebug-map "q" 'top-level)  
   (define-key global-edebug-map "Q" 'edebug-top-level-nonstop)  
   (define-key global-edebug-map "a" 'abort-recursive-edit)  
3849    
   ;; statistics  
   (define-key global-edebug-map "=" 'edebug-display-freq-count)  
   )  
3850    
3851  (defun edebug-help ()  (defun edebug-help ()
3852    (interactive)    (interactive)
# Line 4451  With prefix argument, make it a temporar Line 4450  With prefix argument, make it a temporar
4450    
4451  (provide 'edebug)  (provide 'edebug)
4452    
4453    ;;; arch-tag: 19c8d05c-4554-426e-ac72-e0fa1fcb0808
4454  ;;; edebug.el ends here  ;;; edebug.el ends here

Legend:
Removed from v.3.53.2.1  
changed lines
  Added in v.3.53.2.2

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