Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

208 regels
7.4 KiB

4 jaren geleden
  1. ;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*-
  2. ;; Copyright © 2014-2019 Edwin Watkeys and CIDER contributors
  3. ;; Author: Edwin Watkeys <edw@poseur.com>
  4. ;; Juan E. Maya <jmayaalv@gmail.com>
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;; Provides coarse-grained interactive profiling support.
  17. ;; Based on earlier work by Edwin Watkeys (https://github.com/thunknyc/nrepl-profile).
  18. ;;; Code:
  19. (require 'cider-client)
  20. (require 'cider-popup)
  21. (require 'cider-eval)
  22. (defconst cider-profile-buffer "*cider-profile*")
  23. (defvar cider-profile-map
  24. (let ((map (define-prefix-command 'cider-profile-map)))
  25. (define-key map (kbd "t") #'cider-profile-toggle)
  26. (define-key map (kbd "c") #'cider-profile-clear)
  27. (define-key map (kbd "S") #'cider-profile-summary)
  28. (define-key map (kbd "s") #'cider-profile-var-summary)
  29. (define-key map (kbd "n") #'cider-profile-ns-toggle)
  30. (define-key map (kbd "v") #'cider-profile-var-profiled-p)
  31. (define-key map (kbd "+") #'cider-profile-samples)
  32. map)
  33. "CIDER profiler keymap.")
  34. (defconst cider-profile-menu
  35. '("Profile"
  36. ["Toggle var profiling" cider-profile-toggle]
  37. ["Toggle namespace profiling" cider-profile-ns-toggle]
  38. "--"
  39. ["Display var profiling status" cider-profile-var-profiled-p]
  40. ["Display max sample count" cider-profile-samples]
  41. ["Display summary" cider-profile-summary]
  42. ["Clear data" cider-profile-clear])
  43. "CIDER profiling submenu.")
  44. (defun cider-profile--make-response-handler (handler &optional buffer)
  45. "Make a response handler using value handler HANDLER for connection BUFFER.
  46. Optional argument BUFFER defaults to current buffer."
  47. (nrepl-make-response-handler
  48. (or buffer (current-buffer)) handler nil nil nil))
  49. ;;;###autoload
  50. (defun cider-profile-samples (&optional query)
  51. "Displays current max-sample-count.
  52. If optional QUERY is specified, set max-sample-count and display new value."
  53. (interactive "P")
  54. (cider-ensure-op-supported "set-max-samples")
  55. (cider-ensure-op-supported "get-max-samples")
  56. (if (not (null query))
  57. (cider-nrepl-send-request
  58. (let ((max-samples (if (numberp query) query '())))
  59. (message "query: %s" max-samples)
  60. `("op" "set-max-samples" "max-samples" ,max-samples))
  61. (cider-profile--make-response-handler
  62. (lambda (_buffer value)
  63. (let ((value (if (zerop (length value)) "unlimited" value)))
  64. (message "max-sample-count is now %s" value)))))
  65. (cider-nrepl-send-request
  66. '("op" "get-max-samples")
  67. (cider-profile--make-response-handler
  68. (lambda (_buffer value)
  69. (let ((value (if (zerop (length value)) "unlimited" value)))
  70. (message "max-sample-count is now %s" value))))))
  71. query)
  72. ;;;###autoload
  73. (defun cider-profile-var-profiled-p (query)
  74. "Displays the profiling status of var under point.
  75. Prompts for var if none under point or QUERY is present."
  76. (interactive "P")
  77. (cider-ensure-op-supported "is-var-profiled")
  78. (cider-read-symbol-name
  79. "Report profiling status for var: "
  80. (lambda (sym)
  81. (let ((ns (cider-current-ns)))
  82. (cider-nrepl-send-request
  83. `("op" "is-var-profiled"
  84. "ns" ,ns
  85. "sym" ,sym)
  86. (cider-profile--make-response-handler
  87. (lambda (_buffer value)
  88. (pcase value
  89. ("profiled" (message "Profiling is currently enabled for %s/%s" ns sym))
  90. ("unprofiled" (message "Profiling is currently disabled for %s/%s" ns sym))
  91. ("unbound" (message "%s/%s is unbound" ns sym)))))))))
  92. query)
  93. ;;;###autoload
  94. (defun cider-profile-ns-toggle (&optional query)
  95. "Toggle profiling for the ns associated with optional QUERY.
  96. If optional argument QUERY is non-nil, prompt for ns. Otherwise use
  97. current ns."
  98. (interactive "P")
  99. (cider-ensure-op-supported "toggle-profile-ns")
  100. (let ((ns (if query
  101. (completing-read "Toggle profiling for ns: "
  102. (cider-sync-request:ns-list))
  103. (cider-current-ns))))
  104. (cider-nrepl-send-request
  105. `("op" "toggle-profile-ns"
  106. "ns" ,ns)
  107. (cider-profile--make-response-handler
  108. (lambda (_buffer value)
  109. (pcase value
  110. ("profiled" (message "Profiling enabled for %s" ns))
  111. ("unprofiled" (message "Profiling disabled for %s" ns)))))))
  112. query)
  113. ;;;###autoload
  114. (defun cider-profile-toggle (query)
  115. "Toggle profiling for the given QUERY.
  116. Defaults to the symbol at point.
  117. With prefix arg or no symbol at point, prompts for a var."
  118. (interactive "P")
  119. (cider-ensure-op-supported "toggle-profile")
  120. (cider-read-symbol-name
  121. "Toggle profiling for var: "
  122. (lambda (sym)
  123. (let ((ns (cider-current-ns)))
  124. (cider-nrepl-send-request
  125. `("op" "toggle-profile"
  126. "ns" ,ns
  127. "sym" ,sym)
  128. (cider-profile--make-response-handler
  129. (lambda (_buffer value)
  130. (pcase value
  131. ("profiled" (message "Profiling enabled for %s/%s" ns sym))
  132. ("unprofiled" (message "Profiling disabled for %s/%s" ns sym))
  133. ("unbound" (message "%s/%s is unbound" ns sym)))))))))
  134. query)
  135. (defun cider-profile-display-stats (stats-response)
  136. "Displays the STATS-RESPONSE on `cider-profile-buffer`."
  137. (let ((table (nrepl-dict-get stats-response "err")))
  138. (if cider-profile-buffer
  139. (let ((buffer (cider-make-popup-buffer cider-profile-buffer)))
  140. (with-current-buffer buffer
  141. (let ((inhibit-read-only t)) (insert table)))
  142. (display-buffer buffer)
  143. (let ((window (get-buffer-window buffer)))
  144. (set-window-point window 0)
  145. (select-window window)
  146. (fit-window-to-buffer window)))
  147. (cider-emit-interactive-eval-err-output table))))
  148. ;;;###autoload
  149. (defun cider-profile-summary ()
  150. "Display a summary of currently collected profile data."
  151. (interactive)
  152. (cider-ensure-op-supported "profile-summary")
  153. (cider-profile-display-stats
  154. (cider-nrepl-send-sync-request '("op" "profile-summary"))))
  155. ;;;###autoload
  156. (defun cider-profile-var-summary (query)
  157. "Display profile data for var under point QUERY.
  158. Defaults to the symbol at point. With prefix arg or no symbol at point,
  159. prompts for a var."
  160. (interactive "P")
  161. (cider-ensure-op-supported "profile-var-summary")
  162. (cider-read-symbol-name
  163. "Profile-summary for var: "
  164. (lambda (sym)
  165. (cider-profile-display-stats
  166. (cider-nrepl-send-sync-request
  167. `("op" "profile-var-summary"
  168. "ns" ,(cider-current-ns)
  169. "sym" ,sym)))))
  170. query)
  171. ;;;###autoload
  172. (defun cider-profile-clear ()
  173. "Clear any collected profile data."
  174. (interactive)
  175. (cider-ensure-op-supported "clear-profile")
  176. (cider-nrepl-send-request
  177. '("op" "clear-profile")
  178. (cider-profile--make-response-handler
  179. (lambda (_buffer value)
  180. (when (equal value "cleared")
  181. (message "Cleared profile data"))))))
  182. (provide 'cider-profile)
  183. ;;; cider-profile.el ends here