unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 6c172d6c31da98c55df743b541f5e2fb6eeb71c3 32959 bytes (raw)
name: lisp/emacs-lisp/debug.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
 
;;; debug.el --- debuggers and related commands for Emacs  -*- lexical-binding: t -*-

;; Copyright (C) 1985-1986, 1994, 2001-2022 Free Software Foundation,
;; Inc.

;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, tools, maint

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This is a major mode documented in the Emacs Lisp manual.

;;; Code:

(require 'cl-lib)
(require 'backtrace)

(defgroup debugger nil
  "Debuggers and related commands for Emacs."
  :prefix "debugger-"
  :group 'debug)

(defcustom debugger-mode-hook nil
  "Hooks run when `debugger-mode' is turned on."
  :type 'hook
  :group 'debugger
  :version "20.3")

(defcustom debugger-batch-max-lines 40
  "Maximum lines to show in debugger buffer in a noninteractive Emacs.
When the debugger is entered and Emacs is running in batch mode,
if the backtrace text has more than this many lines,
the middle is discarded, and just the beginning and end are displayed."
  :type 'integer
  :group 'debugger
  :version "21.1")

(defcustom debugger-print-function #'cl-prin1
  "Function used to print values in the debugger backtraces."
  :type '(choice (const cl-prin1)
                 (const prin1)
                 function)
  :version "26.1")

(defcustom debugger-bury-or-kill 'bury
  "What to do with the debugger buffer when exiting `debug'.
The value affects the behavior of operations on any window
previously showing the debugger buffer.

nil means that if its window is not deleted when exiting the
  debugger, invoking `switch-to-prev-buffer' will usually show
  the debugger buffer again.

`append' means that if the window is not deleted, the debugger
  buffer moves to the end of the window's previous buffers so
  it's less likely that a future invocation of
  `switch-to-prev-buffer' will switch to it.  Also, it moves the
  buffer to the end of the frame's buffer list.

`bury' means that if the window is not deleted, its buffer is
  removed from the window's list of previous buffers.  Also, it
  moves the buffer to the end of the frame's buffer list.  This
  value provides the most reliable remedy to not have
  `switch-to-prev-buffer' switch to the debugger buffer again
  without killing the buffer.

`kill' means to kill the debugger buffer.

The value used here is passed to `quit-restore-window'."
  :type '(choice
	  (const :tag "Keep alive" nil)
	  (const :tag "Append" append)
	  (const :tag "Bury" bury)
	  (const :tag "Kill" kill))
  :group 'debugger
  :version "24.3")

(defcustom debug-allow-recursive-debug nil
  "If non-nil, erroring in debug and edebug won't recursively debug."
  :type 'boolean
  :version "29.1")

(defvar debugger-step-after-exit nil
  "Non-nil means \"single-step\" after the debugger exits.")

(defvar debugger-value nil
  "This is the value for the debugger to return, when it returns.")

(defvar debugger-old-buffer nil
  "This is the buffer that was current when the debugger was entered.")

(defvar debugger-previous-window nil
  "This is the window last showing the debugger buffer.")

(defvar debugger-previous-window-height nil
  "The last recorded height of `debugger-previous-window'.")

(defvar debugger-previous-backtrace nil
  "The contents of the previous backtrace (including text properties).
This is to optimize `debugger-make-xrefs'.")

(defvar debugger-outer-match-data)
(defvar debugger-will-be-back nil
  "Non-nil if we expect to get back in the debugger soon.")

(defvar inhibit-debug-on-entry nil
  "Non-nil means that `debug-on-entry' is disabled.")

(defvar debugger-jumping-flag nil
  "Non-nil means that `debug-on-entry' is disabled.
This variable is used by `debugger-jump', `debugger-step-through',
and `debugger-reenable' to temporarily disable `debug-on-entry'.")

(defvar inhibit-trace)                  ;Not yet implemented.

(defvar debugger-args nil
  "Arguments with which the debugger was called.
It is a list expected to take the form (CAUSE . REST)
where CAUSE can be:
- debug: called for entry to a flagged function.
- t: called because of `debug-on-next-call'.
- lambda: same thing but via `funcall'.
- exit: called because of exit of a flagged function.
- error: called because of `debug-on-error'.")

(cl-defstruct (debugger--buffer-state
            (:constructor debugger--save-buffer-state
                          (&aux (mode     major-mode)
                                (header   backtrace-insert-header-function)
                                (frames   backtrace-frames)
                                (content  (buffer-string))
                                (pos      (point)))))
  mode header frames content pos)

(defun debugger--restore-buffer-state (state)
  (unless (derived-mode-p (debugger--buffer-state-mode state))
    (funcall (debugger--buffer-state-mode state)))
  (setq backtrace-insert-header-function (debugger--buffer-state-header state)
        backtrace-frames (debugger--buffer-state-frames state))
  (let ((inhibit-read-only t))
    (erase-buffer)
    (insert (debugger--buffer-state-content state)))
  (goto-char (debugger--buffer-state-pos state)))

;;;###autoload
(setq debugger 'debug)
;;;###autoload
(defun debug (&rest args)
  "Enter debugger.  \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger.
Arguments are mainly for use when this is called from the internals
of the evaluator.

You may call with no args, or you may pass nil as the first arg and
any other args you like.  In that case, the list of args after the
first will be printed into the backtrace buffer.

If `inhibit-redisplay' is non-nil when this function is called,
the debugger will not be entered."
  (interactive)
  (if inhibit-redisplay
      ;; Don't really try to enter debugger within an eval from redisplay.
      debugger-value
    (let ((non-interactive-frame
           (or noninteractive           ;FIXME: Presumably redundant.
               ;; If we're in the initial-frame (where `message' just
               ;; outputs to stdout) so there's no tty or GUI frame to
               ;; display the backtrace and interact with it: just dump a
               ;; backtrace to stdout.  This happens for example while
               ;; handling an error in code from early-init.el with
               ;; --debug-init.
               (and (eq t (framep (selected-frame)))
                    (equal "initial_terminal" (terminal-name)))))
          ;; Don't let `inhibit-message' get in our way (especially important if
          ;; `non-interactive-frame' evaluated to a non-nil value.
          (inhibit-message nil)
          ;; We may be entering the debugger from a context that has
          ;; let-bound `inhibit-read-only', which means that all
          ;; buffers would be read/write while the debugger is running.
          (inhibit-read-only nil))
      (unless non-interactive-frame
        (message "Entering debugger..."))
      (let (debugger-value
	    (debugger-previous-state
             (if (get-buffer "*Backtrace*")
                 (with-current-buffer (get-buffer "*Backtrace*")
                   (debugger--save-buffer-state))))
            (debugger-args args)
	    (debugger-buffer (get-buffer-create "*Backtrace*"))
	    (debugger-old-buffer (current-buffer))
	    (debugger-window nil)
	    (debugger-step-after-exit nil)
            (debugger-will-be-back nil)
	    ;; Don't keep reading from an executing kbd macro!
	    (executing-kbd-macro nil)
	    ;; Save the outer values of these vars for the `e' command
	    ;; before we replace the values.
	    (debugger-outer-match-data (match-data))
	    (debugger-with-timeout-suspend (with-timeout-suspend)))
        ;; Set this instead of binding it, so that `q'
        ;; will not restore it.
        (setq overriding-terminal-local-map nil)
        ;; Don't let these magic variables affect the debugger itself.
        (let ((last-command nil) this-command track-mouse
	      (inhibit-trace t)
	      unread-command-events
	      unread-post-input-method-events
	      last-input-event last-command-event last-nonmenu-event
	      last-event-frame
	      overriding-local-map
	      (load-read-function #'read)
	      ;; If we are inside a minibuffer, allow nesting
	      ;; so that we don't get an error from the `e' command.
	      (enable-recursive-minibuffers
	       (or enable-recursive-minibuffers (> (minibuffer-depth) 0)))
	      (standard-input t) (standard-output t)
	      inhibit-redisplay
	      (cursor-in-echo-area nil)
	      (window-configuration (current-window-configuration)))
	  (unwind-protect
	      (save-excursion
	        (when (eq (car debugger-args) 'debug)
		  ;; Skip the frames for backtrace-debug, byte-code,
		  ;; debug--implement-debug-on-entry and the advice's `apply'.
		  (backtrace-debug 4 t)
		  ;; Place an extra debug-on-exit for macro's.
		  (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
		    (backtrace-debug 5 t)))
                (with-current-buffer debugger-buffer
                  (unless (derived-mode-p 'debugger-mode)
	            (debugger-mode))
	          (debugger-setup-buffer debugger-args)
	          (when non-interactive-frame
		    ;; If the backtrace is long, save the beginning
		    ;; and the end, but discard the middle.
                    (let ((inhibit-read-only t))
		      (when (> (count-lines (point-min) (point-max))
			       debugger-batch-max-lines)
		        (goto-char (point-min))
		        (forward-line (/ debugger-batch-max-lines 2))
		        (let ((middlestart (point)))
		          (goto-char (point-max))
		          (forward-line (- (/ debugger-batch-max-lines 2)))
		          (delete-region middlestart (point)))
		        (insert "...\n")))
		    (message "%s" (buffer-string))
		    (kill-emacs -1)))
	        (pop-to-buffer
	         debugger-buffer
	         `((display-buffer-reuse-window
		    display-buffer-in-previous-window
		    display-buffer-below-selected)
		   . ((window-min-height . 10)
                      (window-height . fit-window-to-buffer)
		      ,@(when (and (window-live-p debugger-previous-window)
				   (frame-visible-p
				    (window-frame debugger-previous-window)))
		          `((previous-window . ,debugger-previous-window))))))
	        (setq debugger-window (selected-window))
		(when debugger-jumping-flag
		  ;; Try to restore previous height of debugger
		  ;; window.
		  (condition-case nil
		      (window-resize
		       debugger-window
		       (- debugger-previous-window-height
			  (window-total-height debugger-window)))
		    (error nil))
		  (setq debugger-previous-window debugger-window))
	        (message "")
	        (let ((standard-output nil)
		      (buffer-read-only t))
		  (message "")
		  ;; Make sure we unbind buffer-read-only in the right buffer.
		  (save-excursion
		    (recursive-edit))))
	    (when (and (window-live-p debugger-window)
		       (eq (window-buffer debugger-window) debugger-buffer))
	      ;; Record height of debugger window.
	      (setq debugger-previous-window-height
		    (window-total-height debugger-window)))
	    (if debugger-will-be-back
	        ;; Restore previous window configuration (Bug#12623).
	        (set-window-configuration window-configuration)
	      (when (and (window-live-p debugger-window)
		         (eq (window-buffer debugger-window) debugger-buffer))
	        (progn
		  ;; Unshow debugger-buffer.
		  (quit-restore-window debugger-window debugger-bury-or-kill)
		  ;; Restore current buffer (Bug#12502).
		  (set-buffer debugger-old-buffer)))
              ;; Forget debugger window, it won't be back (Bug#17882).
              (setq debugger-previous-window nil))
            ;; Restore previous state of debugger-buffer in case we were
            ;; in a recursive invocation of the debugger, otherwise just
            ;; erase the buffer.
	    (when (buffer-live-p debugger-buffer)
	      (with-current-buffer debugger-buffer
	        (if debugger-previous-state
                    (debugger--restore-buffer-state debugger-previous-state)
                  (setq backtrace-insert-header-function nil)
                  (setq backtrace-frames nil)
                  (backtrace-print))))
	    (with-timeout-unsuspend debugger-with-timeout-suspend)
	    (set-match-data debugger-outer-match-data)))
        (setq debug-on-next-call debugger-step-after-exit)
        debugger-value))))
\f
(defun debugger--print (obj &optional stream)
  (condition-case err
      (funcall debugger-print-function obj stream)
    (error
     (message "Error in debug printer: %S" err)
     (prin1 obj stream))))

(make-obsolete 'debugger-insert-backtrace
               "use a `backtrace-mode' buffer or `backtrace-to-string'."
               "27.1")

(defun debugger-insert-backtrace (frames do-xrefs)
  "Format and insert the backtrace FRAMES at point.
Make functions into cross-reference buttons if DO-XREFS is non-nil."
  (insert (if do-xrefs
              (backtrace--to-string frames)
            (backtrace-to-string frames))))

(defun debugger-setup-buffer (args)
  "Initialize the `*Backtrace*' buffer for entry to the debugger.
That buffer should be current already and in `debugger-mode'."
  (setq backtrace-frames (nthcdr
                          ;; Remove debug--implement-debug-on-entry and the
                          ;; advice's `apply' frame.
                          (if (eq (car args) 'debug) 3 1)
                          (backtrace-get-frames 'debug)))
  (when (eq (car-safe args) 'exit)
    (setq debugger-value (nth 1 args))
    (setf (cl-getf (backtrace-frame-flags (car backtrace-frames))
                   :debug-on-exit)
          nil))

  (setq backtrace-view (plist-put backtrace-view :show-flags t)
        backtrace-insert-header-function (lambda ()
                                           (debugger--insert-header args))
        backtrace-print-function debugger-print-function)
  (backtrace-print)
  ;; Place point on "stack frame 0" (bug#15101).
  (goto-char (point-min))
  (search-forward ":" (line-end-position) t)
  (when (and (< (point) (line-end-position))
             (= (char-after) ?\s))
    (forward-char)))

(defun debugger--insert-header (args)
  "Insert the header for the debugger's Backtrace buffer.
Include the reason for debugger entry from ARGS."
  (insert "Debugger entered")
  (pcase (car args)
    ;; lambda is for debug-on-call when a function call is next.
    ;; debug is for debug-on-entry function called.
    ((or 'lambda 'debug)
     (insert "--entering a function:\n"))
    ;; Exiting a function.
    ('exit
     (insert "--returning value: ")
     (insert (backtrace-print-to-string debugger-value))
     (insert ?\n))
    ;; Watchpoint triggered.
    ((and 'watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
     (insert
      "--"
      (pcase details
        ('(makunbound nil) (format "making %s void" symbol))
        (`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
                                       symbol buffer))
        (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
        (`(let ,_) (format "let-binding %s to %s" symbol
                           (backtrace-print-to-string newval)))
        (`(unlet ,_) (format "ending let-binding of %s" symbol))
        ('(set nil) (format "setting %s to %s" symbol
                            (backtrace-print-to-string newval)))
        (`(set ,buffer) (format "setting %s in buffer %s to %s"
                                symbol buffer
                                (backtrace-print-to-string newval)))
        (_ (error "Unrecognized watchpoint triggered %S" (cdr args))))
      ": ")
     (insert ?\n))
    ;; Debugger entered for an error.
    ('error
     (insert "--Lisp error: ")
     (insert (backtrace-print-to-string (nth 1 args)))
     (insert ?\n))
    ;; debug-on-call, when the next thing is an eval.
    ('t
     (insert "--beginning evaluation of function call form:\n"))
    ;; User calls debug directly.
    (_
     (insert ": ")
     (insert (backtrace-print-to-string (if (eq (car args) 'nil)
                                            (cdr args) args)))
     (insert ?\n))))

\f
(defun debugger-step-through ()
  "Proceed, stepping through subexpressions of this expression.
Enter another debugger on next entry to eval, apply or funcall."
  (interactive)
  (setq debugger-step-after-exit t)
  (setq debugger-jumping-flag t)
  (setq debugger-will-be-back t)
  (add-hook 'post-command-hook 'debugger-reenable)
  (message "Proceeding, will debug on next eval or call.")
  (exit-recursive-edit))

(defun debugger-continue ()
  "Continue, evaluating this expression without stopping."
  (interactive)
  (unless debugger-may-continue
    (error "Cannot continue"))
  (message "Continuing.")

  ;; Check to see if we've flagged some frame for debug-on-exit, in which
  ;; case we'll probably come back to the debugger soon.
  (dolist (frame backtrace-frames)
    (when (plist-get (backtrace-frame-flags frame) :debug-on-exit)
      (setq debugger-will-be-back t)))
  (exit-recursive-edit))

(defun debugger-return-value (val)
  "Continue, specifying value to return.
This is only useful when the value returned from the debugger
will be used, such as in a debug on exit from a frame."
  (interactive "XReturn value (evaluated): ")
  (when (memq (car debugger-args) '(t lambda error debug))
    (error "Cannot return a value %s"
           (if (eq (car debugger-args) 'error)
               "from an error" "at function entrance")))
  (setq debugger-value val)
  (princ "Returning " t)
  (debugger--print debugger-value)
    ;; Check to see if we've flagged some frame for debug-on-exit, in which
    ;; case we'll probably come back to the debugger soon.
  (dolist (frame backtrace-frames)
    (when (plist-get (backtrace-frame-flags frame) :debug-on-exit)
      (setq debugger-will-be-back t)))
  (exit-recursive-edit))

(defun debugger-jump ()
  "Continue to exit from this frame, with all `debug-on-entry' suspended."
  (interactive)
  (debugger-frame)
  (setq debugger-jumping-flag t)
  (add-hook 'post-command-hook 'debugger-reenable)
  (message "Continuing through this frame")
  (setq debugger-will-be-back t)
  (exit-recursive-edit))

(defun debugger-reenable ()
  "Turn all `debug-on-entry' functions back on.
This function is put on `post-command-hook' by `debugger-jump' and
removes itself from that hook."
  (setq debugger-jumping-flag nil)
  (remove-hook 'post-command-hook 'debugger-reenable))

(defun debugger-frame-number (&optional skip-base)
  "Return number of frames in backtrace before the one point points at."
  (let ((index (backtrace-get-index))
        (count 0))
    (unless index
      (error "This line is not a function call"))
    (unless skip-base
        (while (not (eq (cadr (backtrace-frame count)) 'debug))
          (setq count (1+ count)))
        ;; Skip debug--implement-debug-on-entry frame.
        (when (eq 'debug--implement-debug-on-entry
                  (cadr (backtrace-frame (1+ count))))
          (setq count (+ 2 count))))
    (+ count index)))

(defun debugger-frame ()
  "Request entry to debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
  (interactive)
  (backtrace-debug (debugger-frame-number) t)
  (setf
   (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
            :debug-on-exit)
   t)
  (backtrace-update-flags))

(defun debugger-frame-clear ()
  "Do not enter debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
  (interactive)
  (backtrace-debug (debugger-frame-number) nil)
  (setf
   (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
            :debug-on-exit)
   nil)
  (backtrace-update-flags))

(defmacro debugger-env-macro (&rest body)
  "Run BODY in original environment."
  (declare (indent 0))
  `(progn
    (set-match-data debugger-outer-match-data)
    (prog1
        (progn ,@body)
      (setq debugger-outer-match-data (match-data)))))

(defun debugger--backtrace-base ()
  "Return the function name that marks the top of the backtrace.
See `backtrace-frame'."
  (cond ((eq 'debug--implement-debug-on-entry
	     (cadr (backtrace-frame 1 'debug)))
	 'debug--implement-debug-on-entry)
	(t 'debug)))

(defun debugger-eval-expression (exp &optional nframe)
  "Eval an expression, in an environment like that outside the debugger.
The environment used is the one when entering the activation frame at point."
  (interactive
   (list (read--expression "Eval in stack frame: ")))
  (let ((nframe (or nframe
                    (condition-case nil (1+ (debugger-frame-number 'skip-base))
                      (error 0)))) ;; If on first line.
	(base (debugger--backtrace-base)))
    (debugger-env-macro
      (let* ((errored nil)
             (val (if debug-allow-recursive-debug
                      (backtrace-eval exp nframe base)
                    (condition-case err
                        (backtrace-eval exp nframe base)
                      (error (setq errored
                                   (format "%s: %s"
                                           (get (car err) 'error-message)
			                   (car (cdr err)))))))))
        (if errored
            (progn
              (message "Error: %s" errored)
              nil)
          (prog1
              (debugger--print val t)
            (let ((str (eval-expression-print-format val)))
              (if str (princ str t)))))))))

(define-obsolete-function-alias 'debugger-toggle-locals
  'backtrace-toggle-locals "28.1")

\f
(defvar debugger-mode-map
  (let ((map (make-keymap)))
    (set-keymap-parent map backtrace-mode-map)
    (define-key map "b" 'debugger-frame)
    (define-key map "c" 'debugger-continue)
    (define-key map "j" 'debugger-jump)
    (define-key map "r" 'debugger-return-value)
    (define-key map "u" 'debugger-frame-clear)
    (define-key map "d" 'debugger-step-through)
    (define-key map "l" 'debugger-list-functions)
    (define-key map "q" 'debugger-quit)
    (define-key map "e" 'debugger-eval-expression)
    (define-key map "R" 'debugger-record-expression)
    (define-key map [mouse-2] 'push-button)
    (easy-menu-define nil map ""
      '("Debugger"
        ["Step through" debugger-step-through
         :help "Proceed, stepping through subexpressions of this expression"]
        ["Continue" debugger-continue
         :help "Continue, evaluating this expression without stopping"]
        ["Jump" debugger-jump
         :help "Continue to exit from this frame, with all debug-on-entry suspended"]
        ["Eval Expression..." debugger-eval-expression
         :help "Eval an expression, in an environment like that outside the debugger"]
        ["Display and Record Expression" debugger-record-expression
         :help "Display a variable's value and record it in `*Backtrace-record*' buffer"]
        ["Return value..." debugger-return-value
         :help "Continue, specifying value to return."]
        "--"
        ["Debug frame" debugger-frame
         :help "Request entry to debugger when this frame exits"]
        ["Cancel debug frame" debugger-frame-clear
         :help "Do not enter debugger when this frame exits"]
        ["List debug on entry functions" debugger-list-functions
         :help "Display a list of all the functions now set to debug on entry"]
        "--"
        ["Next Line" next-line
         :help "Move cursor down"]
        ["Help for Symbol" backtrace-help-follow-symbol
         :help "Show help for symbol at point"]
        ["Describe Debugger Mode" describe-mode
         :help "Display documentation for debugger-mode"]
        "--"
        ["Quit" debugger-quit
         :help "Quit debugging and return to top level"]))
    map))

(put 'debugger-mode 'mode-class 'special)

(define-derived-mode debugger-mode backtrace-mode "Debugger"
  "Mode for debugging Emacs Lisp using a backtrace.
\\<debugger-mode-map>
A frame marked with `*' in the backtrace means that exiting that
frame will enter the debugger.  You can flag frames to enter the
debugger when frame is exited with \\[debugger-frame], and remove
the flag with \\[debugger-frame-clear].

When in debugger invoked due to exiting a frame which was flagged
with a `*', you can use the \\[debugger-return-value] command to
override the value being returned from that frame when the debugger
exits.

Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control
which functions will enter the debugger when called.

Complete list of commands:
\\{debugger-mode-map}"
  (add-hook 'kill-buffer-hook
            (lambda () (if (> (recursion-depth) 0) (top-level)))
            nil t)
  (use-local-map debugger-mode-map))
\f
(defcustom debugger-record-buffer "*Debugger-record*"
  "Buffer name for expression values, for \\[debugger-record-expression]."
  :type 'string
  :group 'debugger
  :version "20.3")

(defun debugger-record-expression  (exp)
  "Display a variable's value and record it in `*Backtrace-record*' buffer."
  (interactive
   (list (read--expression "Record Eval: ")))
  (let* ((buffer (get-buffer-create debugger-record-buffer))
	 (standard-output buffer))
    (princ (format "Debugger Eval (%s): " exp))
    (princ (debugger-eval-expression exp))
    (terpri))

  (with-current-buffer (get-buffer debugger-record-buffer)
    (message "%s"
	     (buffer-substring (line-beginning-position 0)
			       (line-end-position 0)))))

(define-obsolete-function-alias 'debug-help-follow
  'backtrace-help-follow-symbol "28.1")

\f
;; When you change this, you may also need to change the number of
;; frames that the debugger skips.
(defun debug--implement-debug-on-entry (&rest _ignore)
  "Conditionally call the debugger.
A call to this function is inserted by `debug-on-entry' to cause
functions to break on entry."
  (if (or inhibit-debug-on-entry debugger-jumping-flag)
      nil
    (let ((inhibit-debug-on-entry t))
      (funcall debugger 'debug))))

;;;###autoload
(defun debug-on-entry (function)
  "Request FUNCTION to invoke debugger each time it is called.

When called interactively, prompt for FUNCTION in the minibuffer.

This works by modifying the definition of FUNCTION.  If you tell the
debugger to continue, FUNCTION's execution proceeds.  If FUNCTION is a
normal function or a macro written in Lisp, you can also step through
its execution.  FUNCTION can also be a primitive that is not a special
form, in which case stepping is not possible.  Break-on-entry for
primitive functions only works when that function is called from Lisp.

Use \\[cancel-debug-on-entry] to cancel the effect of this command.
Redefining FUNCTION also cancels it."
  (interactive
   (let ((fn (function-called-at-point)) val)
     (when (special-form-p fn)
       (setq fn nil))
     (setq val (completing-read
                (format-prompt "Debug on entry to function" fn)
		obarray
		#'(lambda (symbol)
		    (and (fboundp symbol)
			 (not (special-form-p symbol))))
		'confirm nil nil (symbol-name fn)))
     (list (if (equal val "") fn (intern val)))))
  (advice-add function :before #'debug--implement-debug-on-entry
              '((depth . -100)))
  function)

(defun debug--function-list ()
  "List of functions currently set for debug on entry."
  (let ((funs '()))
    (mapatoms
     (lambda (s)
       (when (advice-member-p #'debug--implement-debug-on-entry s)
         (push s funs))))
    funs))

;;;###autoload
(defun cancel-debug-on-entry (&optional function)
  "Undo effect of \\[debug-on-entry] on FUNCTION.
If FUNCTION is nil, cancel `debug-on-entry' for all functions.
When called interactively, prompt for FUNCTION in the minibuffer.
To specify a nil argument interactively, exit with an empty minibuffer."
  (interactive
   (list (let ((name
		(completing-read
                 (format-prompt "Cancel debug on entry to function"
                                "all functions")
		 (mapcar #'symbol-name (debug--function-list)) nil t)))
	   (when name
	     (unless (string= name "")
	       (intern name))))))
  (if function
      (progn
        (advice-remove function #'debug--implement-debug-on-entry)
	function)
    (message "Canceling debug-on-entry for all functions")
    (mapcar #'cancel-debug-on-entry (debug--function-list))))

(defun debugger-list-functions ()
  "Display a list of all the functions now set to debug on entry."
  (interactive)
  (require 'help-mode)
  (help-setup-xref '(debugger-list-functions)
		   (called-interactively-p 'interactive))
  (with-output-to-temp-buffer (help-buffer)
    (with-current-buffer standard-output
      (let ((funs (debug--function-list)))
        (if (null funs)
            (princ "No debug-on-entry functions now\n")
          (princ "Functions set to debug on entry:\n\n")
          (dolist (fun funs)
            (make-text-button (point) (progn (prin1 fun) (point))
                              'type 'help-function
                              'help-args (list fun))
            (terpri))
          ;; Now that debug--function-list uses advice-member-p, its
          ;; output should be reliable (except for bugs and the exceptional
          ;; case where some other advice ends up overriding ours).
          ;;(terpri)
          ;;(princ "Note: if you have redefined a function, then it may no longer\n")
          ;;(princ "be set to debug on entry, even if it is in the list.")
          )))))

(defun debugger-quit ()
  "Quit debugging and return to the top level."
  (interactive)
  (if (= (recursion-depth) 0)
      (quit-window)
    (top-level)))

(defun debug--implement-debug-watch (symbol newval op where)
  "Conditionally call the debugger.
This function is called when SYMBOL's value is modified."
  (if (or inhibit-debug-on-entry debugger-jumping-flag)
      nil
    (let ((inhibit-debug-on-entry t))
      (funcall debugger 'watchpoint symbol newval op where))))

;;;###autoload
(defun debug-on-variable-change (variable)
  "Trigger a debugger invocation when VARIABLE is changed.

When called interactively, prompt for VARIABLE in the minibuffer.

This works by calling `add-variable-watcher' on VARIABLE.  If you
quit from the debugger, this will abort the change (unless the
change is caused by the termination of a let-binding).

The watchpoint may be circumvented by C code that changes the
variable directly (i.e., not via `set').  Changing the value of
the variable (e.g., `setcar' on a list variable) will not trigger
watchpoint.

Use \\[cancel-debug-on-variable-change] to cancel the effect of
this command.  Uninterning VARIABLE or making it an alias of
another symbol also cancels it."
  (interactive
   (let* ((var-at-point (variable-at-point))
          (var (and (symbolp var-at-point) var-at-point))
          (val (completing-read
                (format-prompt "Debug when setting variable" var)
                obarray #'boundp
                t nil nil (and var (symbol-name var)))))
     (list (if (equal val "") var (intern val)))))
  (add-variable-watcher variable #'debug--implement-debug-watch))

;;;###autoload
(defalias 'debug-watch #'debug-on-variable-change)


(defun debug--variable-list ()
  "List of variables currently set for debug on set."
  (let ((vars '()))
    (mapatoms
     (lambda (s)
       (when (memq #'debug--implement-debug-watch
                   (get s 'watchers))
         (push s vars))))
    vars))

;;;###autoload
(defun cancel-debug-on-variable-change (&optional variable)
  "Undo effect of \\[debug-on-variable-change] on VARIABLE.
If VARIABLE is nil, cancel `debug-on-variable-change' for all variables.
When called interactively, prompt for VARIABLE in the minibuffer.
To specify a nil argument interactively, exit with an empty minibuffer."
  (interactive
   (list (let ((name
                (completing-read
                 (format-prompt "Cancel debug on set for variable"
                                "all variables")
                 (mapcar #'symbol-name (debug--variable-list)) nil t)))
           (when name
             (unless (string= name "")
               (intern name))))))
  (if variable
      (remove-variable-watcher variable #'debug--implement-debug-watch)
    (message "Canceling debug-watch for all variables")
    (mapc #'cancel-debug-watch (debug--variable-list))))

;;;###autoload
(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)

(provide 'debug)

;;; debug.el ends here

debug log:

solving 6c172d6c31 ...
found 6c172d6c31 in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).