cider-tracing.el (3646B)
1 ;;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*- 2 3 ;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors 4 ;; 5 ;; Author: Bozhidar Batsov <bozhidar@batsov.dev> 6 ;; Artur Malabarba <bruce.connor.am@gmail.com> 7 8 ;; This program is free software: you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 12 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 21 ;; This file is not part of GNU Emacs. 22 23 ;;; Commentary: 24 25 ;; A couple of commands for tracing the execution of functions. 26 27 ;;; Code: 28 29 (require 'cider-client) 30 (require 'cider-common) ; for `cider-prompt-for-symbol-function' 31 (require 'cider-util) ; for `cider-propertize' 32 (require 'cider-connection) ; for `cider-map-repls' 33 (require 'nrepl-dict) 34 35 (defun cider-sync-request:toggle-trace-var (sym) 36 "Toggle var tracing for SYM." 37 (thread-first `("op" "toggle-trace-var" 38 "ns" ,(cider-current-ns) 39 "sym" ,sym) 40 (cider-nrepl-send-sync-request))) 41 42 (defun cider--toggle-trace-var (sym) 43 "Toggle var tracing for SYM." 44 (let* ((trace-response (cider-sync-request:toggle-trace-var sym)) 45 (var-name (nrepl-dict-get trace-response "var-name")) 46 (var-status (nrepl-dict-get trace-response "var-status"))) 47 (pcase var-status 48 ("not-found" (error "Var %s not found" (cider-propertize sym 'fn))) 49 ("not-traceable" (error "Var %s can't be traced because it's not bound to a function" (cider-propertize var-name 'fn))) 50 (_ (message "Var %s %s" (cider-propertize var-name 'fn) var-status))))) 51 52 ;;;###autoload 53 (defun cider-toggle-trace-var (arg) 54 "Toggle var tracing. 55 Prompts for the symbol to use, or uses the symbol at point, depending on 56 the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the 57 opposite of what that option dictates." 58 (interactive "P") 59 (cider-ensure-op-supported "toggle-trace-var") 60 (funcall (cider-prompt-for-symbol-function arg) 61 "Toggle trace for var" 62 #'cider--toggle-trace-var)) 63 64 (defun cider-sync-request:toggle-trace-ns (ns) 65 "Toggle namespace tracing for NS." 66 (thread-first `("op" "toggle-trace-ns" 67 "ns" ,ns) 68 (cider-nrepl-send-sync-request))) 69 70 ;;;###autoload 71 (defun cider-toggle-trace-ns (query) 72 "Toggle ns tracing. 73 Defaults to the current ns. With prefix arg QUERY, prompts for a ns." 74 (interactive "P") 75 (cider-map-repls :clj-strict 76 (lambda (conn) 77 (with-current-buffer conn 78 (cider-ensure-op-supported "toggle-trace-ns") 79 (let ((ns (if query 80 (completing-read "Toggle trace for ns: " 81 (cider-sync-request:ns-list)) 82 (cider-current-ns)))) 83 (let* ((trace-response (cider-sync-request:toggle-trace-ns ns)) 84 (ns-status (nrepl-dict-get trace-response "ns-status"))) 85 (pcase ns-status 86 ("not-found" (error "Namespace %s not found" (cider-propertize ns 'ns))) 87 (_ (message "Namespace %s %s" (cider-propertize ns 'ns) ns-status))))))))) 88 89 (provide 'cider-tracing) 90 ;;; cider-tracing.el ends here