dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

cider-ns.el (11551B)


      1 ;;; cider-ns.el --- Namespace manipulation 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 ;; Smart code refresh functionality based on ideas from:
     26 ;; http://thinkrelevance.com/blog/2013/06/04/clojure-workflow-reloaded
     27 ;;
     28 ;; Note that refresh with clojure.tools.namespace.repl is a smarter way to
     29 ;; reload code: the traditional way to reload Clojure code without restarting
     30 ;; the JVM is (require ... :reload) or an editor/IDE feature that does the same
     31 ;; thing.
     32 ;;
     33 ;; This has several problems:
     34 ;;
     35 ;; If you modify two namespaces which depend on each other, you must remember to
     36 ;; reload them in the correct order to avoid compilation errors.
     37 ;;
     38 ;; If you remove definitions from a source file and then reload it, those
     39 ;; definitions are still available in memory.  If other code depends on those
     40 ;; definitions, it will continue to work but will break the next time you
     41 ;; restart the JVM.
     42 ;;
     43 ;; If the reloaded namespace contains defmulti, you must also reload all of the
     44 ;; associated defmethod expressions.
     45 ;;
     46 ;; If the reloaded namespace contains defprotocol, you must also reload any
     47 ;; records or types implementing that protocol and replace any existing
     48 ;; instances of those records/types with new instances.
     49 ;;
     50 ;; If the reloaded namespace contains macros, you must also reload any
     51 ;; namespaces which use those macros.
     52 ;;
     53 ;; If the running program contains functions which close over values in the
     54 ;; reloaded namespace, those closed-over values are not updated (This is common
     55 ;; in web applications which construct the "handler stack" as a composition of
     56 ;; functions.)
     57 
     58 ;;; Code:
     59 
     60 (require 'map)
     61 (require 'seq)
     62 (require 'subr-x)
     63 
     64 (require 'cider-client)
     65 (require 'cider-eval)
     66 (require 'cider-popup)
     67 (require 'cider-stacktrace)
     68 
     69 (defcustom cider-ns-save-files-on-refresh 'prompt
     70   "Controls whether to prompt to save files before refreshing.
     71 If nil, files are not saved.
     72 If 'prompt, the user is prompted to save files if they have been modified.
     73 If t, save the files without confirmation."
     74   :type '(choice (const prompt :tag "Prompt to save files if they have been modified")
     75                  (const nil :tag "Don't save the files")
     76                  (const t :tag "Save the files without confirmation"))
     77   :group 'cider
     78   :package-version '(cider . "0.15.0"))
     79 
     80 (defcustom cider-ns-save-files-on-refresh-modes '(clojure-mode)
     81   "Controls which files might be saved before refreshing.
     82 If a list of modes, any buffers visiting files on the classpath whose major
     83 mode is derived from any of the modes might be saved.
     84 If t, all buffers visiting files on the classpath might be saved."
     85   :type '(choice listp
     86                  (const t))
     87   :group 'cider
     88   :package-version '(cider . "0.21.0"))
     89 
     90 (defconst cider-ns-refresh-log-buffer "*cider-ns-refresh-log*")
     91 
     92 (defcustom cider-ns-refresh-show-log-buffer nil
     93   "Controls when to display the refresh log buffer.
     94 If non-nil, the log buffer will be displayed every time `cider-ns-refresh' is
     95 called.  If nil, the log buffer will still be written to, but will never be
     96 displayed automatically.  Instead, the most relevant information will be
     97 displayed in the echo area."
     98   :type '(choice (const :tag "always" t)
     99                  (const :tag "never" nil))
    100   :group 'cider
    101   :package-version '(cider . "0.10.0"))
    102 
    103 (defcustom cider-ns-refresh-before-fn nil
    104   "Clojure function for `cider-ns-refresh' to call before reloading.
    105 If nil, nothing will be invoked before reloading.  Must be a
    106 namespace-qualified function of zero arity.  Any thrown exception will
    107 prevent reloading from occurring."
    108   :type 'string
    109   :group 'cider
    110   :package-version '(cider . "0.10.0"))
    111 
    112 (defcustom cider-ns-refresh-after-fn nil
    113   "Clojure function for `cider-ns-refresh' to call after reloading.
    114 If nil, nothing will be invoked after reloading.  Must be a
    115 namespace-qualified function of zero arity."
    116   :type 'string
    117   :group 'cider
    118   :package-version '(cider . "0.10.0"))
    119 
    120 (defun cider-ns-refresh--handle-response (response log-buffer)
    121   "Refresh LOG-BUFFER with RESPONSE."
    122   (nrepl-dbind-response response (out err reloading status error error-ns after before)
    123     (cl-flet* ((log (message &optional face)
    124                     (cider-emit-into-popup-buffer log-buffer message face t))
    125 
    126                (log-echo (message &optional face)
    127                          (log message face)
    128                          (unless cider-ns-refresh-show-log-buffer
    129                            (let ((message-truncate-lines t))
    130                              (message "cider-ns-refresh: %s" message)))))
    131       (cond
    132        (out
    133         (log out))
    134 
    135        (err
    136         (log err 'font-lock-warning-face))
    137 
    138        ((member "invoking-before" status)
    139         (log-echo (format "Calling %s\n" before) 'font-lock-string-face))
    140 
    141        ((member "invoked-before" status)
    142         (log-echo (format "Successfully called %s\n" before) 'font-lock-string-face))
    143 
    144        ((member "invoked-not-resolved" status)
    145         (log-echo "Could not resolve refresh function\n" 'font-lock-string-face))
    146 
    147        (reloading
    148         (log-echo (format "Reloading %s\n" reloading) 'font-lock-string-face))
    149 
    150        ((member "reloading" (nrepl-dict-keys response))
    151         (log-echo "Nothing to reload\n" 'font-lock-string-face))
    152 
    153        ((member "ok" status)
    154         (log-echo "Reloading successful\n" 'font-lock-string-face))
    155 
    156        (error-ns
    157         (log-echo (format "Error reloading %s\n" error-ns) 'font-lock-warning-face))
    158 
    159        ((member "invoking-after" status)
    160         (log-echo (format "Calling %s\n" after) 'font-lock-string-face))
    161 
    162        ((member "invoked-after" status)
    163         (log-echo (format "Successfully called %s\n" after) 'font-lock-string-face))))
    164 
    165     (with-selected-window (or (get-buffer-window cider-ns-refresh-log-buffer)
    166                               (selected-window))
    167       (with-current-buffer cider-ns-refresh-log-buffer
    168         (goto-char (point-max))))
    169 
    170     (when (member "error" status)
    171       (cider--render-stacktrace-causes error))))
    172 
    173 (defun cider-ns-refresh--save-modified-buffers ()
    174   "Ensure any relevant modified buffers are saved before refreshing.
    175 Its behavior is controlled by `cider-ns-save-files-on-refresh' and
    176 `cider-ns-save-files-on-refresh-modes'."
    177   (when cider-ns-save-files-on-refresh
    178     (let ((dirs (seq-filter #'file-directory-p
    179                             (cider-classpath-entries))))
    180       (save-some-buffers
    181        (not (eq cider-ns-save-files-on-refresh 'prompt))
    182        (lambda ()
    183          (and (seq-some #'derived-mode-p cider-ns-save-files-on-refresh-modes)
    184               (seq-some (lambda (dir)
    185                           (file-in-directory-p buffer-file-name dir))
    186                         dirs)))))))
    187 
    188 ;;;###autoload
    189 (defun cider-ns-reload (&optional prompt)
    190   "Send a (require 'ns :reload) to the REPL.
    191 
    192 With an argument PROMPT, it prompts for a namespace name.  This is the
    193 Clojure out of the box reloading experience and does not rely on
    194 org.clojure/tools.namespace.  See Commentary of this file for a longer list
    195 of differences.  From the Clojure doc: \":reload forces loading of all the
    196 identified libs even if they are already loaded\"."
    197   (interactive "P")
    198   (let ((ns (if prompt
    199                 (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns)))
    200               (clojure-find-ns))))
    201     (cider-interactive-eval (format "(require '%s :reload)" ns))))
    202 
    203 ;;;###autoload
    204 (defun cider-ns-reload-all (&optional prompt)
    205   "Send a (require 'ns :reload-all) to the REPL.
    206 
    207 With an argument PROMPT, it prompts for a namespace name.  This is the
    208 Clojure out of the box reloading experience and does not rely on
    209 org.clojure/tools.namespace.  See Commentary of this file for a longer list
    210 of differences.  From the Clojure doc: \":reload-all implies :reload and
    211 also forces loading of all libs that the identified libs directly or
    212 indirectly load via require\"."
    213   (interactive "P")
    214   (let ((ns (if prompt
    215                 (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns)))
    216               (clojure-find-ns))))
    217     (cider-interactive-eval (format "(require '%s :reload-all)" ns))))
    218 
    219 ;;;###autoload
    220 (defun cider-ns-refresh (&optional mode)
    221   "Reload modified and unloaded namespaces on the classpath.
    222 
    223 With a single prefix argument, or if MODE is `refresh-all', reload all
    224 namespaces on the classpath unconditionally.
    225 
    226 With a double prefix argument, or if MODE is `clear', clear the state of
    227 the namespace tracker before reloading.  This is useful for recovering from
    228 some classes of error (for example, those caused by circular dependencies)
    229 that a normal reload would not otherwise recover from.  The trade-off of
    230 clearing is that stale code from any deleted files may not be completely
    231 unloaded.
    232 
    233 With a negative prefix argument, or if MODE is `inhibit-fns', prevent any
    234 refresh functions (defined in `cider-ns-refresh-before-fn' and
    235 `cider-ns-refresh-after-fn') from being invoked."
    236   (interactive "p")
    237   (cider-ensure-connected)
    238   (cider-ensure-op-supported "refresh")
    239   (cider-ns-refresh--save-modified-buffers)
    240   (let ((clear? (member mode '(clear 16)))
    241         (refresh-all? (member mode '(refresh-all 4)))
    242         (inhibit-refresh-fns (member mode '(inhibit-fns -1))))
    243     (cider-map-repls :clj
    244       (lambda (conn)
    245         ;; Inside the lambda, so the buffer is not created if we error out.
    246         (let ((log-buffer (or (get-buffer cider-ns-refresh-log-buffer)
    247                               (cider-make-popup-buffer cider-ns-refresh-log-buffer))))
    248           (when cider-ns-refresh-show-log-buffer
    249             (cider-popup-buffer-display log-buffer))
    250           (when inhibit-refresh-fns
    251             (cider-emit-into-popup-buffer log-buffer
    252                                           "inhibiting refresh functions\n"
    253                                           nil
    254                                           t))
    255           (when clear?
    256             (cider-nrepl-send-sync-request '("op" "refresh-clear") conn))
    257           (cider-nrepl-send-request
    258            (thread-last
    259              (map-merge 'list
    260                         `(("op" ,(if refresh-all? "refresh-all" "refresh")))
    261                         (cider--nrepl-print-request-map fill-column)
    262                         (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn)
    263                           `(("before" ,cider-ns-refresh-before-fn)))
    264                         (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn)
    265                           `(("after" ,cider-ns-refresh-after-fn))))
    266              (seq-mapcat #'identity))
    267            (lambda (response)
    268              (cider-ns-refresh--handle-response response log-buffer))
    269            conn))))))
    270 
    271 (provide 'cider-ns)
    272 ;;; cider-ns.el ends here