diff options
| -rw-r--r-- | lisp/emacs-lisp/backtrace.el | 89 |
1 files changed, 56 insertions, 33 deletions
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index b8969041346..d6c04bb4c67 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el | |||
| @@ -349,39 +349,60 @@ Set it to VALUE unless the button is a `backtrace-ellipsis' button." | |||
| 349 | (button-put beg 'skip value)) | 349 | (button-put beg 'skip value)) |
| 350 | (setq beg (next-button beg))))) | 350 | (setq beg (next-button beg))))) |
| 351 | 351 | ||
| 352 | (defun backtrace-toggle-print-circle () | 352 | (defun backtrace-toggle-print-circle (&optional all) |
| 353 | "Toggle `print-circle' for the backtrace frame at point." | 353 | "Toggle `print-circle' for the backtrace frame at point. |
| 354 | ;; TODO with argument, toggle the whole buffer. | 354 | With prefix argument ALL, toggle the value of :print-circle in |
| 355 | (interactive) | 355 | `backtrace-view', which affects all of the backtrace frames in |
| 356 | (backtrace--toggle-feature :print-circle)) | 356 | the buffer." |
| 357 | 357 | (interactive "P") | |
| 358 | (defun backtrace--toggle-feature (feature) | 358 | (backtrace--toggle-feature :print-circle all)) |
| 359 | "Toggle FEATURE for the backtrace frame at point. | 359 | |
| 360 | FEATURE should be one of the options in `backtrace-view'. | 360 | (defun backtrace--toggle-feature (feature all) |
| 361 | After toggling the feature, reprint the frame and position | 361 | "Toggle FEATURE for the current backtrace frame or for the buffer. |
| 362 | point at the start of the section of the frame it was in | 362 | FEATURE should be one of the options in `backtrace-view'. If ALL |
| 363 | before." | 363 | is non-nil, toggle FEATURE for all frames in the buffer. After |
| 364 | (let ((index (backtrace-get-index)) | 364 | toggling the feature, reprint the affected frame(s). Afterwards |
| 365 | (view (copy-sequence (backtrace-get-view)))) | 365 | position point at the start of the frame it was in before." |
| 366 | (unless index | 366 | (if all |
| 367 | (user-error "Not in a stack frame")) | 367 | (let ((index (backtrace-get-index)) |
| 368 | (setq view (plist-put view feature (not (plist-get view feature)))) | 368 | (pos (point)) |
| 369 | (let ((inhibit-read-only t) | 369 | (at-end (= (point) (point-max))) |
| 370 | (index (backtrace-get-index)) | 370 | (value (not (plist-get backtrace-view feature)))) |
| 371 | (section (backtrace-get-section)) | 371 | (setq backtrace-view (plist-put backtrace-view feature value)) |
| 372 | (min (backtrace-get-frame-start)) | 372 | (goto-char (point-min)) |
| 373 | (max (backtrace-get-frame-end))) | 373 | ;; Skip the header. |
| 374 | (delete-region min max) | 374 | (unless (backtrace-get-index) |
| 375 | (goto-char min) | 375 | (goto-char (backtrace-get-frame-end))) |
| 376 | (backtrace-print-frame (nth index backtrace-frames) view) | 376 | (while (< (point) (point-max)) |
| 377 | (add-text-properties min (point) | 377 | (backtrace--set-feature feature value) |
| 378 | `(backtrace-index ,index backtrace-view ,view)) | 378 | (goto-char (backtrace-get-frame-end))) |
| 379 | (goto-char min) | 379 | (if (not index) |
| 380 | (when (not (eq section (backtrace-get-section))) | 380 | (goto-char (if at-end (point-max) pos)) |
| 381 | (if-let ((pos (text-property-any (backtrace-get-frame-start) | 381 | (goto-char (point-min)) |
| 382 | (backtrace-get-frame-end) | 382 | (while (and (not (eql index (backtrace-get-index))) |
| 383 | 'backtrace-section section))) | 383 | (< (point) (point-max))) |
| 384 | (goto-char pos)))))) | 384 | (goto-char (backtrace-get-frame-end))))) |
| 385 | (let ((index (backtrace-get-index))) | ||
| 386 | (unless index | ||
| 387 | (user-error "Not in a stack frame")) | ||
| 388 | (backtrace--set-feature feature | ||
| 389 | (not (plist-get (backtrace-get-view) feature)))))) | ||
| 390 | |||
| 391 | (defun backtrace--set-feature (feature value) | ||
| 392 | "Set FEATURE in the view plist of the frame at point to VALUE. | ||
| 393 | Reprint the frame with the new view plist." | ||
| 394 | (let ((inhibit-read-only t) | ||
| 395 | (view (copy-sequence (backtrace-get-view))) | ||
| 396 | (index (backtrace-get-index)) | ||
| 397 | (min (backtrace-get-frame-start)) | ||
| 398 | (max (backtrace-get-frame-end))) | ||
| 399 | (setq view (plist-put view feature value)) | ||
| 400 | (delete-region min max) | ||
| 401 | (goto-char min) | ||
| 402 | (backtrace-print-frame (nth index backtrace-frames) view) | ||
| 403 | (add-text-properties min (point) | ||
| 404 | `(backtrace-index ,index backtrace-view ,view)) | ||
| 405 | (goto-char min))) | ||
| 385 | 406 | ||
| 386 | (defun backtrace-expand-ellipsis (button) | 407 | (defun backtrace-expand-ellipsis (button) |
| 387 | "Expand display of the elided form at BUTTON." | 408 | "Expand display of the elided form at BUTTON." |
| @@ -771,6 +792,8 @@ followed by `backtrace-print-frame', once for each stack frame." | |||
| 771 | ;; (set-buffer-multibyte t) | 792 | ;; (set-buffer-multibyte t) |
| 772 | (setq-local revert-buffer-function #'backtrace-revert) | 793 | (setq-local revert-buffer-function #'backtrace-revert) |
| 773 | (setq-local filter-buffer-substring-function #'backtrace--filter-visible) | 794 | (setq-local filter-buffer-substring-function #'backtrace--filter-visible) |
| 795 | (setq-local indent-line-function 'lisp-indent-line) | ||
| 796 | (setq-local indent-region-function 'lisp-indent-region) | ||
| 774 | (add-hook 'xref-backend-functions #'backtrace--xref-backend nil t)) | 797 | (add-hook 'xref-backend-functions #'backtrace--xref-backend nil t)) |
| 775 | 798 | ||
| 776 | (put 'backtrace-mode 'mode-class 'special) | 799 | (put 'backtrace-mode 'mode-class 'special) |