diff options
45 files changed, 1100 insertions, 480 deletions
diff --git a/.travis.yml b/.travis.yml index 9ca8a9f3..ad31a0ad 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,28 +1,54 @@ sudo: false language: emacs-lisp + +addons: + apt: + packages: + - autogen + - ca-certificates + - curl + - gcc + - libgmp-dev + - m4 + - make + - pkg-config + - xz-utils + +cache: + directories: + - $HOME/local + env: - - EMACS_BINARY=emacs-24.4-travis MAKE_TEST=test - - EMACS_BINARY=emacs-24.4-travis MAKE_TEST=test-bytecomp - - EMACS_BINARY=emacs-24.5-travis MAKE_TEST=test - - EMACS_BINARY=emacs-24.5-travis MAKE_TEST=test-bytecomp - - EMACS_BINARY=emacs-25.1-travis MAKE_TEST=test - - EMACS_BINARY=emacs-25.1-travis MAKE_TEST=test-bytecomp - - EMACS_BINARY=emacs-25.2-travis MAKE_TEST=test - - EMACS_BINARY=emacs-25.2-travis MAKE_TEST=test-bytecomp - - EMACS_BINARY=emacs-25.2-travis MAKE_TEST=test-checks - - EMACS_BINARY=emacs-git-snapshot-travis MAKE_TEST=test - - EMACS_BINARY=emacs-git-snapshot-travis MAKE_TEST=test-bytecomp - - EMACS_BINARY=emacs-git-snapshot-travis MAKE_TEST=test-checks + global: + - PATH=$HOME/local/bin:$HOME/local/evm/bin:$HOME/local/cask/bin:$PATH + matrix: + - EMACS_BINARY=emacs-24.4-travis MAKE_TEST=test + - EMACS_BINARY=emacs-24.4-travis MAKE_TEST=test-bytecomp + - EMACS_BINARY=emacs-24.5-travis MAKE_TEST=test + - EMACS_BINARY=emacs-24.5-travis MAKE_TEST=test-bytecomp + - EMACS_BINARY=emacs-25.1-travis MAKE_TEST=test + - EMACS_BINARY=emacs-25.1-travis MAKE_TEST=test-bytecomp + - EMACS_BINARY=emacs-25.2-travis MAKE_TEST=test + - EMACS_BINARY=emacs-25.2-travis MAKE_TEST=test-bytecomp + - EMACS_BINARY=emacs-25.3-travis MAKE_TEST=test + - EMACS_BINARY=emacs-25.3-travis MAKE_TEST=test-bytecomp + - EMACS_BINARY=emacs-25.3-travis MAKE_TEST=test-checks + - EMACS_BINARY=emacs-26-pretest-travis MAKE_TEST=test + - EMACS_BINARY=emacs-26-pretest-travis MAKE_TEST=test-bytecomp + - EMACS_BINARY=emacs-26-pretest-travis MAKE_TEST=test-checks + - EMACS_BINARY=emacs-git-snapshot-travis MAKE_TEST=test + - EMACS_BINARY=emacs-git-snapshot-travis MAKE_TEST=test-bytecomp + - EMACS_BINARY=emacs-git-snapshot-travis MAKE_TEST=test-checks before_script: - - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh + - sh travis-ci/install-gnutls.sh + - gnutls-cli -v + - sh travis-ci/install-evm.sh - evm install $EMACS_BINARY --use --skip - - make elpa + - sh travis-ci/install-cask.sh script: - emacs --version - make $MAKE_TEST -matrix: - - env: EMACS_BINARY=emacs-git-snapshot-travis notifications: webhooks: diff --git a/CHANGELOG.md b/CHANGELOG.md index bff6b219..b7462d38 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,33 @@ ## master (unreleased) +## 0.16.0 (2017-12-28) + +### New Features + +* [#2082](https://github.com/clojure-emacs/cider/pull/2082), [cider-nrepl#440](https://github.com/clojure-emacs/cider-nrepl/pull/440): Add specialized stacktraces for clojure.spec assertions. +* [#2111](https://github.com/clojure-emacs/cider/pull/2111): Add `cider-pprint-eval-last-sexp-to-comment` and `cider-pprint-eval-defun-to-comment`. +* Add a REPL shortcut for `cider-repl-require-repl-utils` (this makes it easy to require common functions like `doc`, `source`, etc. in REPL buffers). +* [#2112](https://github.com/clojure-emacs/cider/issues/2112): Add a new interactive command `cider-find-keyword` (bound to `C-c C-:`). +* [#2144](https://github.com/clojure-emacs/cider/issues/2144): Create a Docker image to mimic the Travis CI environment. + +### Changes + +* `cider-switch-to-last-clojure-buffer` switches to most recent relevant Clojure(Script) buffer instead of the last "remembered" buffer. +* [cider-nrepl#438](https://github.com/clojure-emacs/cider-nrepl/pull/438): Improve startup time by deferring loading CIDER's middleware until the first usage. +* [#2078](https://github.com/clojure-emacs/cider/pull/2078): Improve startup time by bundling together sync requests during startup. +* `cider-rotate-default-connection` will warn if you use it with only a single active connection. +* `cider-format-buffer` tries to preserve the point position. + +### Bugs Fixed + +* [#2084](https://github.com/clojure-emacs/cider/issues/2084): Select correct REPL type (clj or cljs) in `cider-switch-to-repl-buffer` conditional on the current buffer. +* [#2088](https://github.com/clojure-emacs/cider/issues/2088): Fix functions defined with `def` being font-locked as vars instead of functions. +* [#1651](https://github.com/clojure-emacs/cider/issues/1651), [cider-nrepl#445](https://github.com/clojure-emacs/cider-nrepl/pull/455): Fix `cider-expected-ns` returns `nil` on boot projects. +* [#2120](https://github.com/clojure-emacs/cider/issues/2120): Fix Travis CI build errors for Emacs versions >25.2. +* [#2117](https://github.com/clojure-emacs/cider/pull/2117): Ensure `cider-repl-result-prefix` is only inserted before the first result chunk. +* [#2123](https://github.com/clojure-emacs/cider/issues/2123): Process properly the Java version in Java 9. + ## 0.15.1 (2017-09-13) ### New Features diff --git a/Dockerfile b/Dockerfile new file mode 100644 index 00000000..58a1cb32 --- /dev/null +++ b/Dockerfile @@ -0,0 +1,34 @@ +FROM travisci/ci-garnet:packer-1490989530 + +RUN apt-get update -y \ + && apt-get install -y \ + autogen \ + ca-certificates \ + curl \ + gcc \ + git \ + libgmp-dev \ + m4 \ + make \ + pkg-config \ + python \ + ruby \ + xz-utils + +USER travis +ENV HOME=/home/travis +ENV PATH="${HOME}/local/evm/bin:${HOME}/local/cask/bin:${HOME}/local/bin:${PATH}" + +ADD travis-ci/ ${HOME}/cider-setup/travis-ci/ +RUN echo ". ${HOME}/cider-setup/travis-ci/prompt.sh" >> ${HOME}/.bashrc + +RUN ${HOME}/cider-setup/travis-ci/install-gnutls.sh +RUN ${HOME}/cider-setup/travis-ci/install-evm.sh +RUN ${HOME}/cider-setup/travis-ci/install-cask.sh + +RUN evm install emacs-25.3-travis --use +RUN evm install emacs-26-pretest-travis +RUN evm install emacs-git-snapshot-travis + +WORKDIR /home/travis/cider +CMD /bin/bash @@ -4,9 +4,10 @@ [](https://travis-ci.org/clojure-emacs/cider) [](https://gitter.im/clojure-emacs/cider?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) -[](https://gratipay.com/cider/) +[](https://liberapay.com/bbatsov/donate) [](#open-collective-backers) [](#open-collective-sponsors) +[](https://www.patreon.com/bbatsov) [](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=GRQKNBM6P8VRQ) <p align="center"> @@ -167,9 +168,8 @@ to become a CIDER sponsor. You can support the development of CIDER, [clojure-mode][] and [inf-clojure][] via [Open Collective](https://opencollective.com/cider), [Salt](https://salt.bountysource.com/teams/cider), -[Gratipay](https://www.gratipay.com/cider) and PayPal. - -[](https://gratipay.com/cider) +[Patreon](https://www.patreon.com/bbatsov), +[Liberapay](https://liberapay.com/bbatsov/donate) and PayPal. [](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=GRQKNBM6P8VRQ) @@ -250,7 +250,7 @@ Copyright © 2012-2017 Tim King, Phil Hagelberg, Bozhidar Batsov, Artur Malabarb Distributed under the GNU General Public License, version 3 [badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg -[nREPL]: https://github.com/clojure/tools.nrepl +[nREPL]:https://github.com/cemerick/nREPL [SLIME]: https://github.com/slime/slime [swank-clojure]: https://github.com/technomancy/swank-clojure [Sly]: https://github.com/capitaomorte/sly diff --git a/cider-apropos.el b/cider-apropos.el index b9a6fd79..ee214622 100644 --- a/cider-apropos.el +++ b/cider-apropos.el @@ -144,9 +144,9 @@ optionally search doc strings (based on DOCS-P), include private vars (y-or-n-p "Case-sensitive? "))))) (cider-ensure-connected) (cider-ensure-op-supported "apropos") - (if-let ((summary (cider-apropos-summary - query ns docs-p privates-p case-sensitive-p)) - (results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))) + (if-let* ((summary (cider-apropos-summary + query ns docs-p privates-p case-sensitive-p)) + (results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))) (cider-show-apropos summary results query docs-p) (message "No apropos matches for %S" query))) @@ -191,10 +191,10 @@ optionally search doc strings (based on DOCS-P), include private vars (y-or-n-p "Case-sensitive? "))))) (cider-ensure-connected) (cider-ensure-op-supported "apropos") - (if-let ((summary (cider-apropos-summary - query ns docs-p privates-p case-sensitive-p)) - (results (mapcar (lambda (r) (nrepl-dict-get r "name")) - (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))) + (if-let* ((summary (cider-apropos-summary + query ns docs-p privates-p case-sensitive-p)) + (results (mapcar (lambda (r) (nrepl-dict-get r "name")) + (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))) (cider-apropos-act-on-symbol (completing-read (concat summary ": ") results)) (message "No apropos matches for %S" query))) diff --git a/cider-browse-spec.el b/cider-browse-spec.el index 858fbf98..da4440b2 100644 --- a/cider-browse-spec.el +++ b/cider-browse-spec.el @@ -282,7 +282,7 @@ may also be a button, so this function can be used a the button's `action' property." (interactive) (let ((pos (or pos (point)))) - (when-let ((spec (button-get pos 'spec-name))) + (when-let* ((spec (button-get pos 'spec-name))) (cider-browse-spec--browse spec)))) ;; Interactive Functions @@ -292,8 +292,8 @@ property." (interactive) (cider-ensure-connected) (cider-ensure-op-supported "spec-example") - (if-let ((spec cider-browse-spec--current-spec)) - (if-let ((example (cider-sync-request:spec-example spec))) + (if-let* ((spec cider-browse-spec--current-spec)) + (if-let* ((example (cider-sync-request:spec-example spec))) (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer t) (cider-browse-spec-example-mode) (setq-local cider-browse-spec--current-spec spec) diff --git a/cider-classpath.el b/cider-classpath.el index 831d6d59..5dbbf3b0 100644 --- a/cider-classpath.el +++ b/cider-classpath.el @@ -104,7 +104,7 @@ (interactive) (cider-ensure-connected) (cider-ensure-op-supported "classpath") - (when-let ((entry (completing-read "Classpath entries: " (cider-sync-request:classpath)))) + (when-let* ((entry (completing-read "Classpath entries: " (cider-sync-request:classpath)))) (find-file-other-window entry))) (provide 'cider-classpath) diff --git a/cider-client.el b/cider-client.el index b07954eb..68c2513f 100644 --- a/cider-client.el +++ b/cider-client.el @@ -161,11 +161,11 @@ precedence over other connections associated with the same project. If ALL-CONNECTIONS is non-nil, the return value is a list and all matching connections are returned, instead of just the most recent." - (when-let ((project-directory (or project-directory + (when-let* ((project-directory (or project-directory (clojure-project-dir (cider-current-dir)))) (fn (if all-connections #'seq-filter #'seq-find))) (or (funcall fn (lambda (conn) - (when-let ((conn-proj-dir (with-current-buffer conn + (when-let* ((conn-proj-dir (with-current-buffer conn nrepl-project-dir))) (equal (file-truename project-directory) (file-truename conn-proj-dir)))) @@ -178,17 +178,19 @@ connections are returned, instead of just the most recent." cider-connections (car cider-connections))))) -(defun cider-connection-type-for-buffer () - "Return the matching connection type (clj or cljs) for the current buffer. +(defun cider-connection-type-for-buffer (&optional buffer) + "Return the matching connection type (clj or cljs) for BUFFER. In cljc and cljx buffers return \"multi\". This function infers connection type based on the major mode. See `cider-project-connections-types' for a -list of types of actual connections within a project." - (cond - ((derived-mode-p 'clojurescript-mode) "cljs") - ((derived-mode-p 'clojurec-mode) "multi") - ((derived-mode-p 'clojurex-mode) "multi") - ((derived-mode-p 'clojure-mode) "clj") - (cider-repl-type))) +list of types of actual connections within a project. BUFFER defaults to +the `current-buffer'." + (with-current-buffer (or buffer (current-buffer)) + (cond + ((derived-mode-p 'clojurescript-mode) "cljs") + ((derived-mode-p 'clojurec-mode) "multi") + ((derived-mode-p 'clojurex-mode) "multi") + ((derived-mode-p 'clojure-mode) "clj") + (cider-repl-type)))) (defun cider-project-connections-types () "Return a list of types of connections within current project." @@ -304,7 +306,7 @@ at all." "Return the first connection of another type than CONNECTION. Only return connections in the same project or nil. CONNECTION defaults to `cider-current-connection'." - (when-let ((connection (or connection (cider-current-connection))) + (when-let* ((connection (or connection (cider-current-connection))) (connection-type (cider--connection-type connection))) (cider-current-connection (pcase connection-type (`"clj" "cljs") @@ -317,7 +319,7 @@ CONNECTION defaults to `cider-current-connection'." DO NOT USE THIS FUNCTION. It was written only to be used in `cider-map-connections', as a workaround to a still-undetermined bug in the state-stracker backend." - (when-let ((project-connections (cider-find-connection-buffer-for-project-directory + (when-let* ((project-connections (cider-find-connection-buffer-for-project-directory nil :all-connections)) (cljs-conn ;; So we have multiple connections. Look for the connection type we @@ -329,7 +331,7 @@ to a still-undetermined bug in the state-stracker backend." (unless cider--has-warned-about-bad-repl-type (setq cider--has-warned-about-bad-repl-type t) (read-key - (concat "The ClojureScript REPL seems to be is misbehaving." + (concat "The ClojureScript REPL seems to be misbehaving." (substitute-command-keys "\nWe have applied a workaround, but please also file a bug report with `\\[cider-report-bug]'.") "\nPress any key to continue."))) @@ -387,7 +389,7 @@ connection but can be invoked from any buffer (like `cider-refresh')." ((err "needs a ClojureScript REPL"))))))) (funcall function curr) (when (eq which :both) - (when-let ((other-connection (cider-other-connection curr))) + (when-let* ((other-connection (cider-other-connection curr))) (funcall function other-connection)))))) @@ -417,7 +419,7 @@ connection but can be invoked from any buffer (like `cider-refresh')." (defun cider-connection-browser () "Open a browser buffer for nREPL connections." (interactive) - (if-let ((buffer (get-buffer cider--connection-browser-buffer-name))) + (if-let* ((buffer (get-buffer cider--connection-browser-buffer-name))) (progn (cider--connections-refresh-buffer buffer) (unless (get-buffer-window buffer) @@ -428,7 +430,7 @@ connection but can be invoked from any buffer (like `cider-refresh')." "Refresh the connections buffer, if the buffer exists. The connections buffer is determined by `cider--connection-browser-buffer-name'" - (when-let ((buffer (get-buffer cider--connection-browser-buffer-name))) + (when-let* ((buffer (get-buffer cider--connection-browser-buffer-name))) (cider--connections-refresh-buffer buffer))) (add-hook 'nrepl-disconnected-hook #'cider--connections-refresh) @@ -620,7 +622,7 @@ REPL's ns, otherwise fall back to \"user\". When NO-DEFAULT is non-nil, it will return nil instead of \"user\"." (or cider-buffer-ns (clojure-find-ns) - (when-let ((repl-buf (cider-current-connection))) + (when-let* ((repl-buf (cider-current-connection))) (buffer-local-value 'cider-buffer-ns repl-buf)) (if no-default nil "user"))) @@ -833,19 +835,19 @@ unless ALL is truthy." "Find the definition of VAR, optionally at a specific LINE. Display the results in a different window." - (if-let ((info (cider-var-info var))) + (if-let* ((info (cider-var-info var))) (progn (if line (setq info (nrepl-dict-put info "line" line))) (cider--jump-to-loc-from-info info t)) - (user-error "Symbol %s not resolved" var))) + (user-error "Symbol `%s' not resolved" var))) (defun cider--find-var (var &optional line) "Find the definition of VAR, optionally at a specific LINE." - (if-let ((info (cider-var-info var))) + (if-let* ((info (cider-var-info var))) (progn (if line (setq info (nrepl-dict-put info "line" line))) (cider--jump-to-loc-from-info info)) - (user-error "Symbol %s not resolved" var))) + (user-error "Symbol `%s' not resolved" var))) (defun cider-find-var (&optional arg var line) "Find definition for VAR at LINE. @@ -929,11 +931,11 @@ Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." (defun cider-sync-request:complete (str context) "Return a list of completions for STR using nREPL's \"complete\" op. CONTEXT represents a completion context for compliment." - (when-let ((dict (thread-first `("op" "complete" - "ns" ,(cider-current-ns) - "symbol" ,str - "context" ,context) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) + (when-let* ((dict (thread-first `("op" "complete" + "ns" ,(cider-current-ns) + "symbol" ,str + "context" ,context) + (cider-nrepl-send-sync-request nil 'abort-on-input)))) (nrepl-dict-get dict "completions"))) (defun cider-sync-request:complete-flush-caches () @@ -956,22 +958,22 @@ CONTEXT represents a completion context for compliment." (defun cider-sync-request:eldoc (symbol &optional class member) "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER." - (when-let ((eldoc (thread-first `("op" "eldoc" - "ns" ,(cider-current-ns) - ,@(when symbol `("symbol" ,symbol)) - ,@(when class `("class" ,class)) - ,@(when member `("member" ,member))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) + (when-let* ((eldoc (thread-first `("op" "eldoc" + "ns" ,(cider-current-ns) + ,@(when symbol `("symbol" ,symbol)) + ,@(when class `("class" ,class)) + ,@(when member `("member" ,member))) + (cider-nrepl-send-sync-request nil 'abort-on-input)))) (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) nil eldoc))) (defun cider-sync-request:eldoc-datomic-query (symbol) "Send \"eldoc-datomic-query\" op with parameter SYMBOL." - (when-let ((eldoc (thread-first `("op" "eldoc-datomic-query" - "ns" ,(cider-current-ns) - ,@(when symbol `("symbol" ,symbol))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) + (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query" + "ns" ,(cider-current-ns) + ,@(when symbol `("symbol" ,symbol))) + (cider-nrepl-send-sync-request nil 'abort-on-input)))) (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) nil eldoc))) @@ -1043,10 +1045,13 @@ returned." (nrepl-dict-get "resource-path"))) (defun cider-sync-request:resources-list () - "Return a list of all resources on the classpath." - (thread-first '("op" "resources-list") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resources-list"))) + "Return a list of all resources on the classpath. + +The result entries are relative to the classpath." + (when-let* ((resources (thread-first '("op" "resources-list") + (cider-nrepl-send-sync-request) + (nrepl-dict-get "resources-list")))) + (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources))) (defun cider-sync-request:format-code (code) "Perform nREPL \"format-code\" op with CODE." @@ -1150,11 +1155,13 @@ default connection." "Rotate and display the default nREPL connection." (interactive) (cider-ensure-connected) - (setq cider-connections - (append (cdr cider-connections) - (list (car cider-connections)))) - (message "Default nREPL connection: %s" - (cider--connection-info (car cider-connections)))) + (if (= (length (cider-connections)) 1) + (user-error "There's just a single active nREPL connection") + (setq cider-connections + (append (cdr cider-connections) + (list (car cider-connections)))) + (message "Default nREPL connection: %s" + (cider--connection-info (car cider-connections))))) (defun cider-replicate-connection (&optional conn) "Establish a new connection based on an existing connection. diff --git a/cider-common.el b/cider-common.el index 053100d7..55a23798 100644 --- a/cider-common.el +++ b/cider-common.el @@ -132,11 +132,14 @@ Return the tramp prefix, or nil if BUFFER is local." (with-current-buffer buffer default-directory)))) (when (tramp-tramp-file-p name) - (let ((vec (tramp-dissect-file-name name))) - (tramp-make-tramp-file-name (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - nil))))) + (with-parsed-tramp-file-name name v + ;; `tramp-make-tramp-file-name' was changed to take 6 mandatory + ;; parameters in Emacs 26 instead of 4 + (if (version< emacs-version "26") + (with-no-warnings + (tramp-make-tramp-file-name v-method v-user v-host v-localname)) + (with-no-warnings + (tramp-make-tramp-file-name v-method v-user v-domain v-host v-port v-localname))))))) (defun cider--client-tramp-filename (name &optional buffer) "Return the tramp filename for path NAME relative to BUFFER. @@ -192,14 +195,14 @@ relative, it is expanded within each of the open Clojure buffers till an existing file ending with URL has been found." (require 'arc-mode) (cond ((string-match "^file:\\(.+\\)" url) - (when-let ((file (cider--url-to-file (match-string 1 url))) - (path (cider--file-path file))) + (when-let* ((file (cider--url-to-file (match-string 1 url))) + (path (cider--file-path file))) (find-file-noselect path))) ((string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" url) - (when-let ((entry (match-string 3 url)) - (file (cider--url-to-file (match-string 2 url))) - (path (cider--file-path file)) - (name (format "%s:%s" path entry))) + (when-let* ((entry (match-string 3 url)) + (file (cider--url-to-file (match-string 2 url))) + (path (cider--file-path file)) + (name (format "%s:%s" path entry))) (or (find-buffer-visiting name) (if (tramp-tramp-file-p path) (progn @@ -223,7 +226,7 @@ existing file ending with URL has been found." (set-buffer-modified-p nil) (set-auto-mode) (current-buffer)))))) - (t (if-let ((path (cider--file-path url))) + (t (if-let* ((path (cider--file-path url))) (find-file-noselect path) (unless (file-name-absolute-p url) (let ((cider-buffers (cider-util--clojure-buffers)) diff --git a/cider-compat.el b/cider-compat.el index 7387f833..816b8635 100644 --- a/cider-compat.el +++ b/cider-compat.el @@ -125,33 +125,27 @@ threading." (eval-and-compile - (unless (fboundp 'if-let) - (defmacro if-let (bindings then &rest else) + (unless (fboundp 'if-let*) + (defmacro if-let* (bindings then &rest else) "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. Argument BINDINGS is a list of tuples whose car is a symbol to be bound and (optionally) used in THEN, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." +evalled to set symbol's value." (declare (indent 2) (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) - (when (and (<= (length bindings) 2) - (not (listp (car bindings)))) - ;; Adjust the single binding case - (setq bindings (list bindings))) `(let* ,(internal--build-bindings bindings) (if ,(car (internal--listify (car (last bindings)))) ,then ,@else)))) - (unless (fboundp 'when-let) - (defmacro when-let (bindings &rest body) + (unless (fboundp 'when-let*) + (defmacro when-let* (bindings &rest body) "Process BINDINGS and if all values are non-nil eval BODY. Argument BINDINGS is a list of tuples whose car is a symbol to be bound and (optionally) used in BODY, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." - (declare (indent 1) (debug if-let)) - `(if-let ,bindings ,(macroexp-progn body))))) +evalled to set symbol's value." + (declare (indent 1) (debug if-let*)) + `(if-let* ,bindings ,(macroexp-progn body))))) (eval-and-compile diff --git a/cider-debug.el b/cider-debug.el index 3bb9f784..7754fed5 100644 --- a/cider-debug.el +++ b/cider-debug.el @@ -122,8 +122,8 @@ This variable must be set before starting the repl connection." (defun cider-browse-instrumented-defs () "List all instrumented definitions." (interactive) - (if-let ((all (thread-first (cider-nrepl-send-sync-request '("op" "debug-instrumented-defs")) - (nrepl-dict-get "list")))) + (if-let* ((all (thread-first (cider-nrepl-send-sync-request '("op" "debug-instrumented-defs")) + (nrepl-dict-get "list")))) (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t) (let ((inhibit-read-only t)) (erase-buffer) @@ -230,7 +230,7 @@ Each element of LOCALS should be a list of at least two elements." (format (propertize "%s\n" 'face 'default) (string-join (nrepl-dict-map (lambda (char cmd) - (when-let ((pos (cl-search char cmd))) + (when-let* ((pos (cl-search char cmd))) (put-text-property pos (1+ pos) 'face 'cider-debug-prompt-face cmd)) cmd) command-dict) @@ -320,7 +320,7 @@ In order to work properly, this mode must be activated by (apply-partially #'cider--debug-lexical-eval (nrepl-dict-get cider--debug-mode-response "key"))) ;; Set the keymap. - (nrepl-dict-map (lambda (char cmd) + (nrepl-dict-map (lambda (char _cmd) (unless (string= char "h") ; `here' needs a special command. (define-key cider--debug-mode-map char #'cider-debug-mode-send-reply)) (when (string= char "o") @@ -343,8 +343,8 @@ In order to work properly, this mode must be activated by ;; We wait a moment before clearing overlays and the read-onlyness, so that ;; cider-nrepl has a chance to send the next message, and so that the user ;; doesn't accidentally hit `n' between two messages (thus editing the code). - (when-let ((proc (unless nrepl-ongoing-sync-request - (get-buffer-process (cider-current-connection))))) + (when-let* ((proc (unless nrepl-ongoing-sync-request + (get-buffer-process (cider-current-connection))))) (accept-process-output proc 1)) (unless cider--debug-mode (setq buffer-read-only nil) @@ -443,7 +443,7 @@ Return trimmed CODE." ID is the id of the message that instrumented CODE. REASON is a keyword describing why this buffer was necessary." (let ((buffer-name (format cider--debug-buffer-format id))) - (if-let ((buffer (get-buffer buffer-name))) + (if-let* ((buffer (get-buffer buffer-name))) (cider-popup-buffer-display buffer 'select) (with-current-buffer (cider-popup-buffer buffer-name 'select #'clojure-mode 'ancillary) @@ -465,7 +465,7 @@ REASON is a keyword describing why this buffer was necessary." (defun cider--debug-goto-keyval (key) "Find KEY in current sexp or return nil." - (when-let ((limit (ignore-errors (save-excursion (up-list) (point))))) + (when-let* ((limit (ignore-errors (save-excursion (up-list) (point))))) (search-forward-regexp (concat "\\_<" (regexp-quote key) "\\_>") limit 'noerror))) @@ -580,9 +580,9 @@ is a coordinate measure in sexps." (save-excursion (let ((out)) ;; We prefer in-source debugging. - (when-let ((buf (and file line column - (ignore-errors - (cider--find-buffer-for-file file))))) + (when-let* ((buf (and file line column + (ignore-errors + (cider--find-buffer-for-file file))))) ;; The logic here makes it hard to use `with-current-buffer'. (with-current-buffer buf ;; This is for restoring point inside buf. @@ -648,7 +648,7 @@ needed. It is expected to contain at least \"key\", \"input-type\", and RESPONSE is a message received from the nrepl describing the value and coordinates of a sexp. Create an overlay after the specified sexp displaying its value." - (when-let ((marker (cider--debug-find-source-position response))) + (when-let* ((marker (cider--debug-find-source-position response))) (with-current-buffer (marker-buffer marker) (save-excursion (goto-char marker) diff --git a/cider-doc.el b/cider-doc.el index 7b33fc76..52a953a0 100644 --- a/cider-doc.el +++ b/cider-doc.el @@ -226,8 +226,8 @@ opposite of what that option dictates." "Open the source for the current symbol, if available." (interactive) (if cider-docview-file - (if-let ((buffer (and (not (cider--tooling-file-p cider-docview-file)) - (cider-find-file cider-docview-file)))) + (if-let* ((buffer (and (not (cider--tooling-file-p cider-docview-file)) + (cider-find-file cider-docview-file)))) (cider-jump-to buffer (if cider-docview-line (cons cider-docview-line nil) cider-docview-symbol) @@ -262,12 +262,12 @@ opposite of what that option dictates." (defun cider-create-doc-buffer (symbol) "Populates *cider-doc* with the documentation for SYMBOL." - (when-let ((info (cider-var-info symbol))) + (when-let* ((info (cider-var-info symbol))) (cider-docview-render (cider-make-popup-buffer cider-doc-buffer) symbol info))) (defun cider-doc-lookup (symbol) "Look up documentation for SYMBOL." - (if-let ((buffer (cider-create-doc-buffer symbol))) + (if-let* ((buffer (cider-create-doc-buffer symbol))) (cider-popup-buffer-display buffer cider-doc-auto-select-buffer) (user-error "Symbol %s not resolved" symbol))) @@ -396,9 +396,9 @@ Tables are marked to be ignored by line wrap." (depr (nrepl-dict-get info "deprecated")) (macro (nrepl-dict-get info "macro")) (special (nrepl-dict-get info "special-form")) - (forms (when-let ((str (nrepl-dict-get info "forms-str"))) + (forms (when-let* ((str (nrepl-dict-get info "forms-str"))) (split-string str "\n"))) - (args (when-let ((str (nrepl-dict-get info "arglists-str"))) + (args (when-let* ((str (nrepl-dict-get info "arglists-str"))) (split-string str "\n"))) (doc (or (nrepl-dict-get info "doc") "Not documented.")) @@ -428,7 +428,7 @@ Tables are marked to be ignored by line wrap." (emit (concat " "(cider-font-lock-as 'java-mode iface))))) (when (or super ifaces) (insert "\n")) - (when-let ((forms (or forms args))) + (when-let* ((forms (or forms args))) (dolist (form forms) (insert " ") (emit (cider-font-lock-as-clojure form)))) diff --git a/cider-eldoc.el b/cider-eldoc.el index 58422977..81926638 100644 --- a/cider-eldoc.el +++ b/cider-eldoc.el @@ -101,8 +101,8 @@ CLASS-NAMES is a list of classes to which a Java interop form belongs. Only keep the first `cider-eldoc-max-class-names-to-display' names, and add a \"& x more\" suffix. Return nil if the CLASS-NAMES list is empty or mapping `cider-eldoc-ns-function' on it returns an empty list." - (when-let ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names))) - (eldoc-class-names-length (length eldoc-class-names))) + (when-let* ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names))) + (eldoc-class-names-length (length eldoc-class-names))) (cond ;; truncate class-names list and then format it ((and cider-eldoc-max-class-names-to-display @@ -130,13 +130,13 @@ THING represents the thing at point which triggered eldoc. Normally NS and SYMBOL are used (they are derived from THING), but when empty we fallback to THING (e.g. for Java methods). Format it as a function, if FUNCTION-P is non-nil. Else format it as a variable." - (if-let ((method-name (if (and symbol (not (string= symbol ""))) - symbol - thing)) - (propertized-method-name (cider-propertize method-name type)) - (ns-or-class (if (and ns (stringp ns)) - (funcall cider-eldoc-ns-function ns) - (cider--eldoc-format-class-names ns)))) + (if-let* ((method-name (if (and symbol (not (string= symbol ""))) + symbol + thing)) + (propertized-method-name (cider-propertize method-name type)) + (ns-or-class (if (and ns (stringp ns)) + (funcall cider-eldoc-ns-function ns) + (cider--eldoc-format-class-names ns)))) (format "%s/%s" ;; we set font-lock properties of classes in `cider--eldoc-format-class-names' ;; to avoid font locking the parentheses and "& x more" @@ -206,10 +206,11 @@ Otherwise, only the docstring is returned." ;; so we just display the docstring (t docstring)))) -(defun cider-eldoc-format-variable (thing pos eldoc-info) +(defun cider-eldoc-format-variable (thing eldoc-info) "Return the formatted eldoc string for a variable. -THING is the variable name. POS will always be 0 here. -ELDOC-INFO is a p-list containing the eldoc information." + +THING is the variable name. ELDOC-INFO is a p-list containing the eldoc +information." (let* ((ns (lax-plist-get eldoc-info "ns")) (symbol (lax-plist-get eldoc-info "symbol")) (docstring (lax-plist-get eldoc-info "docstring")) @@ -320,8 +321,8 @@ Then go back to the point and return its eldoc." (cider-eldoc-beginning-of-sexp) (unless (member (or (char-before (point)) 0) '(?\" ?\{ ?\[)) (goto-char current-point) - (when-let (eldoc-info (cider-eldoc-info - (cider--eldoc-remove-dot (cider-symbol-at-point)))) + (when-let* ((eldoc-info (cider-eldoc-info + (cider--eldoc-remove-dot (cider-symbol-at-point))))) `("eldoc-info" ,eldoc-info "thing" ,(cider-symbol-at-point) "pos" 0))))))) @@ -329,14 +330,14 @@ Then go back to the point and return its eldoc." (defun cider-eldoc-info-at-sexp-beginning () "Return eldoc info for first symbol in the sexp." (save-excursion - (when-let ((beginning-of-sexp (cider-eldoc-beginning-of-sexp)) - ;; If we are at the beginning of function name, this will be -1 - (argument-index (max 0 (1- beginning-of-sexp)))) + (when-let* ((beginning-of-sexp (cider-eldoc-beginning-of-sexp)) + ;; If we are at the beginning of function name, this will be -1 + (argument-index (max 0 (1- beginning-of-sexp)))) (unless (or (memq (or (char-before (point)) 0) '(?\" ?\{ ?\[)) (cider-in-comment-p)) - (when-let (eldoc-info (cider-eldoc-info - (cider--eldoc-remove-dot (cider-symbol-at-point)))) + (when-let* ((eldoc-info (cider-eldoc-info + (cider--eldoc-remove-dot (cider-symbol-at-point))))) `("eldoc-info" ,eldoc-info "thing" ,(cider-symbol-at-point) "pos" ,argument-index)))))) @@ -388,7 +389,7 @@ This includes the arglist and ns and symbol name (if available)." ;; generic case (t (if (equal thing (car cider-eldoc-last-symbol)) (cadr cider-eldoc-last-symbol) - (when-let ((eldoc-info (cider-sync-request:eldoc thing))) + (when-let* ((eldoc-info (cider-sync-request:eldoc thing))) (let* ((arglists (nrepl-dict-get eldoc-info "eldoc")) (docstring (nrepl-dict-get eldoc-info "docstring")) (type (nrepl-dict-get eldoc-info "type")) @@ -409,7 +410,7 @@ This includes the arglist and ns and symbol name (if available)." "type" type))) ;; add context dependent args if requested by defcustom ;; do not cache this eldoc info to avoid showing info - ;: of the previous context + ;: of the previous context (if cider-eldoc-display-context-dependent-info (cond ;; add inputs of datomic query @@ -467,7 +468,7 @@ Only useful for interop forms. Clojure forms would be returned unchanged." (when eldoc-info (if (equal (cider-eldoc-thing-type eldoc-info) 'fn) (cider-eldoc-format-function thing pos eldoc-info) - (cider-eldoc-format-variable thing pos eldoc-info)))))) + (cider-eldoc-format-variable thing eldoc-info)))))) (defun cider-eldoc-setup () "Setup eldoc in the current buffer. diff --git a/cider-grimoire.el b/cider-grimoire.el index 8dc61733..959f99ea 100644 --- a/cider-grimoire.el +++ b/cider-grimoire.el @@ -58,7 +58,7 @@ (defun cider-grimoire-web-lookup (symbol) "Open the grimoire documentation for SYMBOL in a web browser." - (if-let ((var-info (cider-var-info symbol))) + (if-let* ((var-info (cider-var-info symbol))) (let ((name (nrepl-dict-get var-info "name")) (ns (nrepl-dict-get var-info "ns"))) (browse-url (cider-grimoire-url name ns))) @@ -95,7 +95,7 @@ opposite of what that option dictates." If SYMBOL is a special form, the clojure.core ns is used, as is Grimoire's convention." - (if-let ((var-info (cider-var-info symbol))) + (if-let* ((var-info (cider-var-info symbol))) (let ((name (nrepl-dict-get var-info "name")) (ns (nrepl-dict-get var-info "ns" "clojure.core")) (url-request-method "GET") diff --git a/cider-inspector.el b/cider-inspector.el index 95eac986..cf324446 100644 --- a/cider-inspector.el +++ b/cider-inspector.el @@ -142,7 +142,7 @@ Interactively, EXPR is read from the minibuffer, and NS the current buffer's namespace." (interactive (list (cider-read-from-minibuffer "Inspect expression: " (cider-sexp-at-point)) (cider-current-ns))) - (when-let (value (cider-sync-request:inspect-expr expr ns (or cider-inspector-page-size 32))) + (when-let* ((value (cider-sync-request:inspect-expr expr ns (or cider-inspector-page-size 32)))) (cider-inspector--render-value value))) (defun cider-inspector-pop () @@ -150,21 +150,21 @@ current buffer's namespace." See `cider-sync-request:inspect-pop' and `cider-inspector--render-value'." (interactive) (setq cider-inspector-last-command 'cider-inspector-pop) - (when-let (value (cider-sync-request:inspect-pop)) + (when-let* ((value (cider-sync-request:inspect-pop))) (cider-inspector--render-value value))) (defun cider-inspector-push (idx) "Inspect the value at IDX in the inspector stack and render it. See `cider-sync-request:insepect-push' and `cider-inspector--render-value'" (push (point) cider-inspector-location-stack) - (when-let (value (cider-sync-request:inspect-push idx)) + (when-let* ((value (cider-sync-request:inspect-push idx))) (cider-inspector--render-value value))) (defun cider-inspector-refresh () "Re-render the currently inspected value. See `cider-sync-request:insepect-refresh' and `cider-inspector--render-value'" (interactive) - (when-let (value (cider-sync-request:inspect-refresh)) + (when-let* ((value (cider-sync-request:inspect-refresh))) (cider-inspector--render-value value))) (defun cider-inspector-next-page () @@ -173,7 +173,7 @@ See `cider-sync-request:insepect-refresh' and `cider-inspector--render-value'" Does nothing if already on the last page." (interactive) (push (point) cider-inspector-page-location-stack) - (when-let (value (cider-sync-request:inspect-next-page)) + (when-let* ((value (cider-sync-request:inspect-next-page))) (cider-inspector--render-value value))) (defun cider-inspector-prev-page () @@ -182,7 +182,7 @@ Does nothing if already on the last page." Does nothing if already on the first page." (interactive) (setq cider-inspector-last-command 'cider-inspector-prev-page) - (when-let (value (cider-sync-request:inspect-prev-page)) + (when-let* ((value (cider-sync-request:inspect-prev-page))) (cider-inspector--render-value value))) (defun cider-inspector-set-page-size (page-size) @@ -190,7 +190,7 @@ Does nothing if already on the first page." Current page will be reset to zero." (interactive "nPage size: ") - (when-let (value (cider-sync-request:inspect-set-page-size page-size)) + (when-let* ((value (cider-sync-request:inspect-set-page-size page-size))) (cider-inspector--render-value value))) ;; nREPL interactions diff --git a/cider-interaction.el b/cider-interaction.el index 3626fb26..c8ac4f54 100644 --- a/cider-interaction.el +++ b/cider-interaction.el @@ -244,6 +244,24 @@ namespace-qualified function of zero arity." "Face used to highlight compilation warnings in Clojure buffers." :group 'cider) +(defcustom cider-comment-prefix ";; => " + "The prefix to insert before the first line of commented output." + :type 'string + :group 'cider + :package-version '(cider . "0.16.0")) + +(defcustom cider-comment-continued-prefix ";; " + "The prefix to use on the second and subsequent lines of commented output." + :type 'string + :group 'cider + :package-version '(cider . "0.16.0")) + +(defcustom cider-comment-postfix "" + "The postfix to be appended after the final line of commented output." + :type 'string + :group 'cider + :package-version '(cider . "0.16.0")) + (defconst cider-clojure-artifact-id "org.clojure/clojure" "Artifact identifier for Clojure.") @@ -316,7 +334,7 @@ When invoked with a prefix ARG the command doesn't prompt for confirmation." (defun cider--quit-error-window () "Buries the `cider-error-buffer' and quits its containing window." - (when-let ((error-win (get-buffer-window cider-error-buffer))) + (when-let* ((error-win (get-buffer-window cider-error-buffer))) (quit-window nil error-win))) ;;; @@ -392,12 +410,12 @@ A default value of thing at point is given when prompted." CALLBACK upon failure to invoke prompt if not prompted previously. Show results in a different window if OTHER-WINDOW is true." - (if-let ((info (cider-var-info symbol-file))) + (if-let* ((info (cider-var-info symbol-file))) (cider--jump-to-loc-from-info info other-window) (progn (cider-ensure-op-supported "resource") - (if-let ((resource (cider-sync-request:resource symbol-file)) - (buffer (cider-find-file resource))) + (if-let* ((resource (cider-sync-request:resource symbol-file)) + (buffer (cider-find-file resource))) (cider-jump-to buffer 0 other-window) (if (cider--prompt-for-symbol-p current-prefix-arg) (error "Resource or var %s not resolved" symbol-file) @@ -430,8 +448,8 @@ value is thing at point." (cider-ensure-op-supported "resource") (when (= (length path) 0) (error "Cannot find resource for empty path")) - (if-let ((resource (cider-sync-request:resource path)) - (buffer (cider-find-file resource))) + (if-let* ((resource (cider-sync-request:resource path)) + (buffer (cider-find-file resource))) (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg)) (if (cider--prompt-for-symbol-p current-prefix-arg) (error "Cannot find resource %s" path) @@ -468,9 +486,9 @@ Invert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be." (defun cider--find-ns (ns &optional other-window) "Find the file containing NS's definition. Optionally open it in a different window if OTHER-WINDOW is truthy." - (if-let ((path (cider-sync-request:ns-path ns))) + (if-let* ((path (cider-sync-request:ns-path ns))) (cider-jump-to (cider-find-file path) nil other-window) - (user-error "Can't find %s" ns))) + (user-error "Can't find namespace `%s'" ns))) (defun cider-find-ns (&optional arg ns) "Find the file containing NS. @@ -486,6 +504,39 @@ the results to be displayed in a different window." (ns (completing-read "Find namespace: " namespaces))) (cider--find-ns ns (cider--open-other-window-p arg))))) +(defun cider-find-keyword (&optional arg) + "Find the namespace of the keyword at point and its first occurrence there. + +For instance - if the keyword at point is \":cider.demo/keyword\", this command +would find the namespace \"cider.demo\" and afterwards find the first mention +of \"::keyword\" there. + +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point." + (interactive "P") + (cider-ensure-connected) + (let* ((kw (let ((kw-at-point (cider-symbol-at-point 'look-back))) + (if (or cider-prompt-for-symbol arg) + (read-string + (format "Keyword (default %s): " kw-at-point) + nil nil kw-at-point) + kw-at-point))) + (ns-qualifier (and + (string-match "^:+\\(.+\\)/.+$" kw) + (match-string 1 kw))) + (kw-ns (if ns-qualifier + (cider-resolve-alias (cider-current-ns) ns-qualifier) + (cider-current-ns))) + (kw-to-find (concat "::" (replace-regexp-in-string "^:+\\(.+/\\)?" "" kw)))) + + (when (and ns-qualifier (string= kw-ns (cider-current-ns))) + (error "Could not resolve alias `%s' in `%s'" ns-qualifier (cider-current-ns))) + (cider--find-ns kw-ns arg) + (search-forward-regexp kw-to-find nil 'noerror))) + (defvar cider-completion-last-context nil) (defun cider-completion-symbol-start-pos () @@ -584,7 +635,7 @@ The formatting is performed by `cider-annotate-completion-function'." (defun cider-complete-at-point () "Complete the symbol at point." - (when-let ((bounds (bounds-of-thing-at-point 'symbol))) + (when-let* ((bounds (bounds-of-thing-at-point 'symbol))) (when (and (cider-connected-p) (not (or (cider-in-string-p) (cider-in-comment-p)))) (list (car bounds) (cdr bounds) @@ -608,7 +659,7 @@ has started." Returns the cons of the buffer itself and the location of VAR's definition in the buffer." - (when-let ((info (cider-var-info var)) + (when-let* ((info (cider-var-info var)) (file (nrepl-dict-get info "file")) (line (nrepl-dict-get info "line")) (buffer (cider-find-file file))) @@ -649,8 +700,10 @@ in the buffer." (defun cider-stdin-handler (&optional buffer) "Make a stdin response handler for BUFFER." (nrepl-make-response-handler (or buffer (current-buffer)) - (lambda (buffer value) - (cider-repl-emit-result buffer value t)) + (let (after-first-result-chunk) + (lambda (buffer value) + (cider-repl-emit-result buffer value (not after-first-result-chunk) t) + (setq after-first-result-chunk t))) (lambda (buffer out) (cider-repl-emit-stdout buffer out)) (lambda (buffer err) @@ -795,6 +848,30 @@ COMMENT-PREFIX is the comment prefix to use." (cider-emit-interactive-eval-err-output err)) '())) +(defun cider-eval-pprint-with-multiline-comment-handler (buffer location comment-prefix continued-prefix comment-postfix) + "Make a handler for evaluating and inserting results in BUFFER. +The inserted text is pretty-printed and region will be commented. +LOCATION is the location at which to insert. +COMMENT-PREFIX is the comment prefix for the first line of output. +CONTINUED-PREFIX is the comment prefix to use for the remaining lines. +COMMENT-POSTFIX is the text to output after the last line." + (cl-flet ((multiline-comment-handler (buffer value) + (with-current-buffer buffer + (save-excursion + (goto-char location) + (let ((lines (split-string value "[\n]+" t))) + ;; only the first line gets the normal comment-prefix + (insert (concat comment-prefix (pop lines))) + (dolist (elem lines) + (insert (concat "\n" continued-prefix elem))) + (unless (string= comment-postfix "") + (insert comment-postfix))))))) + (nrepl-make-response-handler buffer + '() + #'multiline-comment-handler + #'multiline-comment-handler + '()))) + (defun cider-popup-eval-out-handler (&optional buffer) "Make a handler for evaluating and printing stdout/stderr in popup BUFFER. @@ -815,7 +892,7 @@ This is used by pretty-printing commands and intentionally discards their result (defun cider-visit-error-buffer () "Visit the `cider-error-buffer' (usually *cider-error*) if it exists." (interactive) - (if-let ((buffer (get-buffer cider-error-buffer))) + (if-let* ((buffer (get-buffer cider-error-buffer))) (cider-popup-buffer-display buffer cider-auto-select-error-buffer) (user-error "No %s buffer" cider-error-buffer))) @@ -993,7 +1070,7 @@ If location could not be found, return nil." (col (nth 2 info))) (unless (or (not (stringp file)) (cider--tooling-file-p file)) - (when-let ((buffer (cider-find-file file))) + (when-let* ((buffer (cider-find-file file))) (with-current-buffer buffer (save-excursion (save-restriction @@ -1011,9 +1088,9 @@ If location could not be found, return nil." "Highlight and jump to compilation error extracted from MESSAGE. EVAL-BUFFER is the buffer that was current during user's interactive evaluation command. Honor `cider-auto-jump-to-error'." - (when-let ((loc (cider--find-last-error-location message)) - (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc))) - (info (cider-extract-error-info cider-compilation-regexp message))) + (when-let* ((loc (cider--find-last-error-location message)) + (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc))) + (info (cider-extract-error-info cider-compilation-regexp message))) (let* ((face (nth 3 info)) (note (nth 4 info)) (auto-jump (if (eq cider-auto-jump-to-error 'errors-only) @@ -1034,7 +1111,7 @@ evaluation command. Honor `cider-auto-jump-to-error'." ;; configuration (https://github.com/clojure-emacs/cider/issues/847). In ;; that case we don't jump at all in order to avoid covering *cider-error* ;; buffer. - (when-let ((win (get-buffer-window eval-buffer))) + (when-let* ((win (get-buffer-window eval-buffer))) (with-selected-window win (cider-jump-to (nth 2 loc) (car loc))))))))) @@ -1132,12 +1209,12 @@ arguments and only proceed with evaluation if it returns nil." (interactive "r") (cider-interactive-eval nil nil (list start end))) -(defun cider-eval-last-sexp (&optional prefix) +(defun cider-eval-last-sexp (&optional output-to-current-buffer) "Evaluate the expression preceding point. -If invoked with a PREFIX argument, print the result in the current buffer." +If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current buffer." (interactive "P") (cider-interactive-eval nil - (when prefix (cider-eval-print-handler)) + (when output-to-current-buffer (cider-eval-print-handler)) (cider-last-sexp 'bounds))) (defun cider-eval-last-sexp-and-replace () @@ -1150,26 +1227,94 @@ If invoked with a PREFIX argument, print the result in the current buffer." (backward-kill-sexp) (cider-interactive-eval last-sexp (cider-eval-print-handler)))) -(defun cider-eval-sexp-at-point (&optional prefix) +(defun cider-eval-sexp-at-point (&optional output-to-current-buffer) "Evaluate the expression around point. -If invoked with a PREFIX argument, print the result in the current buffer." + +If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." (interactive "P") (save-excursion (goto-char (cadr (cider-sexp-at-point 'bounds))) - (cider-eval-last-sexp prefix))) + (cider-eval-last-sexp output-to-current-buffer))) + +(defun cider-eval-defun-to-comment (&optional insert-before) + "Evaluate the \"top-level\" form and insert result as comment. -(defun cider-eval-defun-to-comment (loc) - "Evaluate the \"top-level\" form and insert result as comment at LOC. +The formatting of the comment is defined in `cider-comment-prefix` +which, by default, is \";; => \" and can be customized. -With a prefix arg, LOC, insert before the form, otherwise afterwards." +With the prefix arg INSERT-BEFORE, insert before the form, otherwise afterwards." (interactive "P") (let* ((bounds (cider-defun-at-point 'bounds)) - (insertion-point (nth (if loc 0 1) bounds))) + (insertion-point (nth (if insert-before 0 1) bounds))) (cider-interactive-eval nil (cider-eval-print-with-comment-handler - (current-buffer) insertion-point ";; => ") + (current-buffer) + insertion-point + cider-comment-prefix) bounds))) +(defun cider-pprint-form-to-comment (form-fn insert-before) + "Evaluate the form selected by FORM-FN and insert result as comment. +FORM-FN can be either `cider-last-sexp` or `cider-defun-at-point`. + +The formatting of the comment is controlled via three options: + `cider-comment-prefix` \";; => \" + `cider-comment-continued-prefix` \";; \" + `cider-comment-postfix` \"\" + +so that with customization you can optionally wrap the output +in the reader macro \"#_( .. )\", or \"(comment ... )\", or any +other desired formatting. + +If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." + (let* ((bounds (funcall form-fn 'bounds)) + (insertion-point (nth (if insert-before 0 1) bounds)) + ;; when insert-before, we need a newline after the output to + ;; avoid commenting the first line of the form + (comment-postfix (concat cider-comment-postfix + (if insert-before "\n" "")))) + (cider-interactive-eval nil + (cider-eval-pprint-with-multiline-comment-handler + (current-buffer) + insertion-point + cider-comment-prefix + cider-comment-continued-prefix + comment-postfix) + bounds + (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) + +(defun cider-pprint-eval-last-sexp-to-comment (&optional insert-before) + "Evaluate the last sexp and insert result as comment. + +The formatting of the comment is controlled via three options: + `cider-comment-prefix` \";; => \" + `cider-comment-continued-prefix` \";; \" + `cider-comment-postfix` \"\" + +so that with customization you can optionally wrap the output +in the reader macro \"#_( .. )\", or \"(comment ... )\", or any +other desired formatting. + +If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." + (interactive "P") + (cider-pprint-form-to-comment 'cider-last-sexp insert-before)) + +(defun cider-pprint-eval-defun-to-comment (&optional insert-before) + "Evaluate the \"top-level\" form and insert result as comment. + +The formatting of the comment is controlled via three options: + `cider-comment-prefix` \";; => \" + `cider-comment-continued-prefix` \";; \" + `cider-comment-postfix` \"\" + +so that with customization you can optionally wrap the output +in the reader macro \"#_( .. )\", or \"(comment ... )\", or any +other desired formatting. + +If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." + (interactive "P") + (cider-pprint-form-to-comment 'cider-defun-at-point insert-before)) + (declare-function cider-switch-to-repl-buffer "cider-mode") (defun cider-eval-last-sexp-to-repl (&optional prefix) @@ -1186,11 +1331,10 @@ If invoked with a PREFIX argument, switch to the REPL buffer." "Evaluate expr before point and insert its pretty-printed result in the REPL. If invoked with a PREFIX argument, switch to the REPL buffer." (interactive "P") - (let* ((conn-buffer (cider-current-connection))) - (cider-interactive-eval nil - (cider-insert-eval-handler conn-buffer) - (cider-last-sexp 'bounds) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width)))) + (cider-interactive-eval nil + (cider-insert-eval-handler (cider-current-connection)) + (cider-last-sexp 'bounds) + (cider--nrepl-pprint-request-plist (cider--pretty-print-width))) (when prefix (cider-switch-to-repl-buffer))) @@ -1211,10 +1355,14 @@ Print its value into the current buffer." (when (consp form) form) (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) -(defun cider-pprint-eval-last-sexp () - "Evaluate the sexp preceding point and pprint its value in a popup buffer." - (interactive) - (cider--pprint-eval-form (cider-last-sexp 'bounds))) +(defun cider-pprint-eval-last-sexp (&optional output-to-current-buffer) + "Evaluate the sexp preceding point and pprint its value. +If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current +buffer, else display in a popup buffer." + (interactive "P") + (if output-to-current-buffer + (cider-pprint-eval-last-sexp-to-comment) + (cider--pprint-eval-form (cider-last-sexp 'bounds)))) (defun cider--prompt-and-insert-inline-dbg () "Insert a #dbg button at the current sexp." @@ -1258,10 +1406,14 @@ command `cider-debug-defun-at-point'." (concat "#dbg\n" (cider-defun-at-point))) nil (cider-defun-at-point 'bounds)))) -(defun cider-pprint-eval-defun-at-point () - "Evaluate the \"top-level\" form at point and pprint its value in a popup buffer." - (interactive) - (cider--pprint-eval-form (cider-defun-at-point 'bounds))) +(defun cider-pprint-eval-defun-at-point (&optional output-to-current-buffer) + "Evaluate the \"top-level\" form at point and pprint its value. +If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current +buffer, else display in a popup buffer." + (interactive "P") + (if output-to-current-buffer + (cider-pprint-eval-defun-to-comment) + (cider--pprint-eval-form (cider-defun-at-point 'bounds)))) (defun cider-eval-ns-form () "Evaluate the current buffer's namespace form." @@ -1511,7 +1663,7 @@ Defaults to the current ns. With prefix arg QUERY, prompts for a ns." (defun cider-save-project-buffers () "Ensure modified project buffers are saved before certain operations. Its behavior is controlled by `cider-save-files-on-cider-refresh'." - (when-let ((project-root (clojure-project-dir))) + (when-let* ((project-root (clojure-project-dir))) (when cider-save-files-on-cider-refresh (save-some-buffers (eq cider-save-files-on-cider-refresh t) @@ -1626,7 +1778,7 @@ The heavy lifting is done by `cider-load-buffer'." (when (buffer-file-name) (file-name-nondirectory (buffer-file-name)))))) - (if-let ((buffer (find-buffer-visiting filename))) + (if-let* ((buffer (find-buffer-visiting filename))) (cider-load-buffer buffer) (find-file filename) (cider-load-buffer (current-buffer)))) @@ -1646,29 +1798,8 @@ The heavy lifting is done by `cider-load-buffer'." (defalias 'cider-eval-buffer 'cider-load-buffer "A convenience alias as some people are confused by the load-* names.") -(defun cider--format-buffer (formatter) - "Format the contents of the current buffer. - -Uses FORMATTER, a function of one argument, to convert the string contents -of the buffer into a formatted string." - (let* ((original (substring-no-properties (buffer-string))) - (formatted (funcall formatter original))) - (unless (equal original formatted) - (erase-buffer) - (insert formatted)))) - -(defun cider-format-buffer () - "Format the Clojure code in the current buffer." - (interactive) - (cider-ensure-connected) - (cider--format-buffer #'cider-sync-request:format-code)) - -(defun cider-format-edn-buffer () - "Format the EDN data in the current buffer." - (interactive) - (cider-ensure-connected) - (cider--format-buffer (lambda (edn) - (cider-sync-request:format-edn edn (cider--pretty-print-width))))) + +;; Format (defun cider--format-reindent (formatted start) "Reindent FORMATTED to align with buffer position START." @@ -1676,18 +1807,41 @@ of the buffer into a formatted string." (indent-line (concat "\n" (make-string start-column ? )))) (replace-regexp-in-string "\n" indent-line formatted))) + +;;; Format region + (defun cider--format-region (start end formatter) "Format the contents of the given region. START and END represent the region's boundaries. + FORMATTER is a function of one argument which is used to convert -the string contents of the region into a formatted string." +the string contents of the region into a formatted string. + +Uses the following heuristic to try to maintain point position: + +- Take a snippet of text starting at current position, up to 64 chars. +- Search for the snippet, with lax whitespace, in the formatted text. + - If snippet is less than 64 chars (point was near end of buffer), search + from end instead of beginning. +- Place point at match beginning, or `point-min' if no match." (let* ((original (buffer-substring-no-properties start end)) (formatted (funcall formatter original)) (indented (cider--format-reindent formatted start))) (unless (equal original indented) - (delete-region start end) - (insert indented)))) + (let* ((pos (point)) + (pos-max (1+ (buffer-size))) + (l 64) + (endp (> (+ pos l) pos-max)) + (snippet (thread-last (buffer-substring-no-properties + pos (min (+ pos l) pos-max)) + (replace-regexp-in-string "[[:space:]\t\n\r]+" "[[:space:]\t\n\r]*")))) + (delete-region start end) + (insert indented) + (goto-char (if endp (point-max) (point-min))) + (funcall (if endp #'re-search-backward #'re-search-forward) snippet nil t) + (goto-char (or (match-beginning 0) start)) + (when (looking-at-p "\n") (forward-char)))))) (defun cider-format-region (start end) "Format the Clojure code in the current region. @@ -1696,6 +1850,43 @@ START and END represent the region's boundaries." (cider-ensure-connected) (cider--format-region start end #'cider-sync-request:format-code)) + +;;; Format defun + +(defun cider-format-defun () + "Format the code in the current defun." + (interactive) + (cider-ensure-connected) + (save-excursion + (mark-defun) + (cider-format-region (region-beginning) (region-end)))) + + +;;; Format buffer + +(defun cider--format-buffer (formatter) + "Format the contents of the current buffer. + +Uses FORMATTER, a function of one argument, to convert the string contents +of the buffer into a formatted string." + (cider--format-region 1 (1+ (buffer-size)) formatter)) + +(defun cider-format-buffer () + "Format the Clojure code in the current buffer." + (interactive) + (cider-ensure-connected) + (cider--format-buffer #'cider-sync-request:format-code)) + + +;;; Format EDN + +(defun cider-format-edn-buffer () + "Format the EDN data in the current buffer." + (interactive) + (cider-ensure-connected) + (cider--format-buffer (lambda (edn) + (cider-sync-request:format-edn edn (cider--pretty-print-width))))) + (defun cider-format-edn-region (start end) "Format the EDN data in the current region. START and END represent the region's boundaries." @@ -1707,15 +1898,9 @@ START and END represent the region's boundaries." (lambda (edn) (cider-sync-request:format-edn edn right-margin))))) -(defun cider-format-defun () - "Format the code in the current defun." - (interactive) - (cider-ensure-connected) - (save-excursion - (mark-defun) - (cider-format-region (region-beginning) (region-end)))) + +;;; Interrupt evaluation -;;; interrupt evaluation (defun cider-interrupt-handler (buffer) "Create an interrupt response handler for BUFFER." (nrepl-make-response-handler buffer nil nil nil nil)) @@ -1753,7 +1938,7 @@ START and END represent the region's boundaries." "Close the BUFFER and kill its associated process (if any)." (when (buffer-live-p buffer) (with-current-buffer buffer - (when-let ((proc (get-buffer-process buffer))) + (when-let* ((proc (get-buffer-process buffer))) (when (process-live-p proc) (when (or (not nrepl-server-buffer) ;; Sync request will hang if the server is dead. @@ -1784,7 +1969,7 @@ and all ancillary CIDER buffers." (cider-ensure-connected) (if (and quit-all (y-or-n-p "Are you sure you want to quit all CIDER connections? ")) (progn - (when-let ((scratch (get-buffer cider-scratch-buffer-name))) + (when-let* ((scratch (get-buffer cider-scratch-buffer-name))) (when (y-or-n-p (format "Kill %s buffer? " cider-scratch-buffer-name)) (kill-buffer cider-scratch-buffer-name))) (dolist (connection cider-connections) @@ -1854,10 +2039,10 @@ With a prefix argument, prompt for function to run instead of -main." (interactive (list (when current-prefix-arg (read-string "Function name: ")))) (cider-ensure-connected) (let ((name (or function "-main"))) - (when-let ((response (cider-nrepl-send-sync-request - `("op" "ns-list-vars-by-name" - "name" ,name)))) - (if-let ((vars (split-string (substring (nrepl-dict-get response "var-list") 1 -1)))) + (when-let* ((response (cider-nrepl-send-sync-request + `("op" "ns-list-vars-by-name" + "name" ,name)))) + (if-let* ((vars (split-string (substring (nrepl-dict-get response "var-list") 1 -1)))) (cider-interactive-eval (if (= (length vars) 1) (concat "(" (car vars) ")") diff --git a/cider-macroexpansion.el b/cider-macroexpansion.el index 82ba966d..6f0dab54 100644 --- a/cider-macroexpansion.el +++ b/cider-macroexpansion.el @@ -89,7 +89,7 @@ This variable specifies both what was expanded and the expander.") (defun cider-macroexpand-expr (expander expr) "Macroexpand, use EXPANDER, the given EXPR." - (when-let ((expansion (cider-sync-request:macroexpand expander expr))) + (when-let* ((expansion (cider-sync-request:macroexpand expander expr))) (setq cider-last-macroexpand-expression expr) (cider-initialize-macroexpansion-buffer expansion (cider-current-ns)))) diff --git a/cider-mode.el b/cider-mode.el index 5d0c6115..690a8326 100644 --- a/cider-mode.el +++ b/cider-mode.el @@ -50,7 +50,7 @@ "Return info for the `cider-mode' modeline. Info contains project name and host:port endpoint." - (if-let ((current-connection (ignore-errors (cider-current-connection)))) + (if-let* ((current-connection (ignore-errors (cider-current-connection)))) (with-current-buffer current-connection (concat cider-repl-type @@ -83,21 +83,6 @@ entirely." ;;; Switching between REPL & source buffers -(defvar-local cider-last-clojure-buffer nil - "A buffer-local variable holding the last Clojure source buffer. -`cider-switch-to-last-clojure-buffer' uses this variable to jump -back to last Clojure source buffer.") - -(defun cider-remember-clojure-buffer (buffer) - "Try to remember the BUFFER from which the user jumps. -The BUFFER needs to be a Clojure buffer and current major mode needs -to be `cider-repl-mode'. The user can use `cider-switch-to-last-clojure-buffer' -to jump back to the last Clojure source buffer." - (when (and buffer - (with-current-buffer buffer - (derived-mode-p 'clojure-mode)) - (derived-mode-p 'cider-repl-mode)) - (setq cider-last-clojure-buffer buffer))) (defun cider--switch-to-repl-buffer (repl-buffer &optional set-namespace) "Select the REPL-BUFFER, when possible in an existing window. @@ -117,7 +102,6 @@ that of the namespace in the Clojure source buffer." ;; then if necessary we update its namespace (when set-namespace (cider-repl-set-ns (with-current-buffer buffer (cider-current-ns)))) - (cider-remember-clojure-buffer buffer) (goto-char (point-max)))) (defun cider-switch-to-repl-buffer (&optional set-namespace) @@ -138,9 +122,17 @@ With a prefix arg SET-NAMESPACE sets the namespace in the REPL buffer to that of the namespace in the Clojure source buffer." (interactive "P") (let* ((connections (cider-connections)) - (buffer (seq-find (lambda (b) (member b connections)) - (buffer-list)))) - (cider--switch-to-repl-buffer buffer set-namespace))) + (type (cider-connection-type-for-buffer)) + (a-repl) + (the-repl (seq-find (lambda (b) + (when (member b connections) + (unless a-repl + (setq a-repl b)) + (equal type (cider-connection-type-for-buffer b)))) + (buffer-list)))) + (if-let* ((repl (or the-repl a-repl))) + (cider--switch-to-repl-buffer repl set-namespace) + (user-error "No REPL found")))) (declare-function cider-load-buffer "cider-interaction") @@ -159,12 +151,23 @@ the same as `cider-switch-to-repl-buffer', so that it is very convenient to jump between a Clojure buffer and the REPL buffer." (interactive) - (if (and (derived-mode-p 'cider-repl-mode) - (buffer-live-p cider-last-clojure-buffer)) - (if cider-repl-display-in-current-window - (pop-to-buffer-same-window cider-last-clojure-buffer) - (pop-to-buffer cider-last-clojure-buffer)) - (message "Don't know the original Clojure buffer"))) + (if (derived-mode-p 'cider-repl-mode) + (let* ((a-buf) + (the-buf (let ((repl-type (cider-connection-type-for-buffer))) + (seq-find (lambda (b) + (unless (with-current-buffer b (derived-mode-p 'cider-repl-mode)) + (when-let* ((type (cider-connection-type-for-buffer b))) + (unless a-buf + (setq a-buf b)) + (or (equal type "multi") + (equal type repl-type))))) + (buffer-list))))) + (if-let* ((buf (or the-buf a-buf))) + (if cider-repl-display-in-current-window + (pop-to-buffer-same-window buf) + (pop-to-buffer buf)) + (user-error "No Clojure buffer found"))) + (user-error "Not in a CIDER REPL buffer"))) (defun cider-find-and-clear-repl-output (&optional clear-repl) "Find the current REPL buffer and clear it. @@ -235,8 +238,10 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b ["Eval last sexp and replace" cider-eval-last-sexp-and-replace] ["Eval last sexp to REPL" cider-eval-last-sexp-to-repl] ["Eval last sexp and pretty-print to REPL" cider-pprint-eval-last-sexp-to-repl] + ["Eval last sexp and pretty-print to comment" cider-pprint-eval-last-sexp-to-comment] ["Insert last sexp in REPL" cider-insert-last-sexp-in-repl] ["Eval top-level sexp to comment" cider-eval-defun-to-comment] + ["Eval top-level sexp and pretty-print to comment" cider-pprint-eval-defun-to-comment] "--" ["Load this buffer" cider-load-buffer] ["Load another file" cider-load-file] @@ -263,7 +268,9 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b ,cider-doc-menu ("Find (jump to)" ["Find definition" cider-find-var] + ["Find namespace" cider-find-ns] ["Find resource" cider-find-resource] + ["Find keyword" cider-find-keyword] ["Go back" cider-pop-back]) ("Macroexpand" ["Macroexpand-1" cider-macroexpand-1] @@ -296,6 +303,7 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b (define-key map (kbd "C-c C-d") 'cider-doc-map) (define-key map (kbd "M-.") #'cider-find-var) (define-key map (kbd "C-c C-.") #'cider-find-ns) + (define-key map (kbd "C-c C-:") #'cider-find-keyword) (define-key map (kbd "M-,") #'cider-pop-back) (define-key map (kbd "C-c M-.") #'cider-find-resource) (define-key map (kbd "M-TAB") #'complete-symbol) @@ -375,9 +383,9 @@ re-visited." (defun cider--get-symbol-indent (symbol-name) "Return the indent metadata for SYMBOL-NAME in the current namespace." (let* ((ns (cider-current-ns))) - (if-let ((meta (cider-resolve-var ns symbol-name)) - (indent (or (nrepl-dict-get meta "style/indent") - (nrepl-dict-get meta "indent")))) + (if-let* ((meta (cider-resolve-var ns symbol-name)) + (indent (or (nrepl-dict-get meta "style/indent") + (nrepl-dict-get meta "indent")))) (let ((format (format ":indent metadata on ‘%s’ is unreadable! \nERROR: %%s" symbol-name))) (with-demoted-errors format @@ -385,9 +393,9 @@ re-visited." ;; There's no indent metadata, but there might be a clojure-mode ;; indent-spec with fully-qualified namespace. (when (string-match cider-resolve--prefix-regexp symbol-name) - (when-let ((sym (intern-soft (replace-match (save-match-data - (cider-resolve-alias ns (match-string 1 symbol-name))) - t t symbol-name 1)))) + (when-let* ((sym (intern-soft (replace-match (save-match-data + (cider-resolve-alias ns (match-string 1 symbol-name))) + t t symbol-name 1)))) (get sym 'clojure-indent-function)))))) @@ -580,7 +588,8 @@ with the given LIMIT." (push sym deprecated)) (cond ((and do-macro (nrepl-dict-get meta "macro")) (push sym macros)) - ((and do-function (nrepl-dict-get meta "arglists")) + ((and do-function (or (nrepl-dict-get meta "fn") + (nrepl-dict-get meta "arglists"))) (push sym functions)) (do-var (push sym vars)))))))) (when (memq 'core cider-font-lock-dynamically) @@ -626,8 +635,8 @@ namespace itself." (when (and cider-font-lock-dynamically font-lock-mode) (font-lock-remove-keywords nil cider--dynamic-font-lock-keywords) - (when-let ((ns (or ns (cider-current-ns))) - (symbols (cider-resolve-ns-symbols ns))) + (when-let* ((ns (or ns (cider-current-ns))) + (symbols (cider-resolve-ns-symbols ns))) (setq-local cider--dynamic-font-lock-keywords (cider--compile-font-lock-keywords symbols (cider-resolve-ns-symbols (cider-resolve-core-ns)))) @@ -787,7 +796,7 @@ See \(info \"(elisp) Special Properties\")" (ignore-errors (save-excursion (goto-char pos) - (when-let ((sym (cider-symbol-at-point))) + (when-let* ((sym (cider-symbol-at-point))) (if (member sym (get-text-property (point) 'cider-locals)) (concat (format "`%s' is a local" sym) (when cider--debug-mode diff --git a/cider-overlays.el b/cider-overlays.el index 731088ff..7cbed0bd 100644 --- a/cider-overlays.el +++ b/cider-overlays.el @@ -239,11 +239,9 @@ overlay." #'cider--remove-result-overlay-after-command nil 'local) (cider--remove-result-overlay-after-command)))) - (when-let ((win (get-buffer-window buffer))) + (when-let* ((win (get-buffer-window buffer))) ;; Left edge is visible. - (when (and (<= (window-start win) (point)) - ;; In 24.3 `<=' is still a binary perdicate. - (<= (point) (window-end win)) + (when (and (<= (window-start win) (point) (window-end win)) ;; Right edge is visible. This is a little conservative ;; if the overlay contains line breaks. (or (< (+ (current-column) (string-width value)) diff --git a/cider-repl-history.el b/cider-repl-history.el index 6a9cdfec..c1a5a387 100644 --- a/cider-repl-history.el +++ b/cider-repl-history.el @@ -426,7 +426,7 @@ text is still inserted at the end." (defun cider-repl-history-update-highlighed-entry () "Update highlighted entry, when feature is turned on." (when cider-repl-history-highlight-current-entry - (if-let ((current-overlay (cider-repl-history-target-overlay-at (point) t))) + (if-let* ((current-overlay (cider-repl-history-target-overlay-at (point) t))) (unless (equal cider-repl-history-previous-overlay current-overlay) ;; We've changed overlay. Clear current highlighting, ;; and highlight the new overlay. @@ -615,7 +615,7 @@ text from the *cider-repl-history* buffer." #'copy-sequence #'substring-no-properties) cider-command-history))) - (when (not cider-repl-history-display-duplicates) + (unless cider-repl-history-display-duplicates ;; display highest or lowest duplicate. ;; if `cider-repl-history-display-duplicate-highest' is t, ;; display highest (most recent) duplicate. diff --git a/cider-repl.el b/cider-repl.el index e6168aef..ec412478 100644 --- a/cider-repl.el +++ b/cider-repl.el @@ -219,11 +219,11 @@ via `cider-current-connection'.") ;; Metadata changed, so signatures may have changed too. (setq cider-eldoc-last-symbol nil) (when (or cider-mode (derived-mode-p 'cider-repl-mode)) - (when-let ((ns-dict (or (nrepl-dict-get changed-namespaces (cider-current-ns)) - (let ((ns-dict (cider-resolve--get-in (cider-current-ns)))) - (when (seq-find (lambda (ns) (nrepl-dict-get changed-namespaces ns)) - (nrepl-dict-get ns-dict "aliases")) - ns-dict))))) + (when-let* ((ns-dict (or (nrepl-dict-get changed-namespaces (cider-current-ns)) + (let ((ns-dict (cider-resolve--get-in (cider-current-ns)))) + (when (seq-find (lambda (ns) (nrepl-dict-get changed-namespaces ns)) + (nrepl-dict-get ns-dict "aliases")) + ns-dict))))) (cider-refresh-dynamic-font-lock ns-dict)))))))))) (declare-function cider-default-err-handler "cider-interaction") @@ -255,52 +255,62 @@ ENDPOINT is a plist as returned by `nrepl-connect'." (add-hook 'nrepl-disconnected-hook 'cider--disconnected-handler nil 'local) (current-buffer)))) -(defun cider-repl-require-repl-utils () - "Require standard REPL util functions into the current REPL." - (interactive) - (cider-nrepl-request:eval - "(when (clojure.core/resolve 'clojure.main/repl-requires) - (clojure.core/map clojure.core/require clojure.main/repl-requires))" - (lambda (_response) nil))) - (declare-function cider-set-buffer-ns "cider-mode") (defun cider-repl-set-initial-ns (buffer) - "Set the REPL BUFFER's initial namespace (by altering `cider-buffer-ns'). -This is \"user\" by default but can be overridden in apps like lein (:init-ns)." + "Require standard REPL util functions and set the ns of the REPL's BUFFER. +Namespace is \"user\" by default, but can be overridden in apps like +lein (:init-ns). Both of these operations need to be done as a sync +request at the beginning of the session. Bundling them together for +efficiency." ;; we don't want to get a timeout during init (let ((nrepl-sync-request-timeout nil)) (with-current-buffer buffer - (let ((initial-ns (or (read - (nrepl-dict-get - (cider-nrepl-sync-request:eval "(str *ns*)") - "value")) - "user"))) + (let* ((response (nrepl-send-sync-request + (lax-plist-put (nrepl--eval-request "(str *ns*))") + "inhibit-cider-middleware" "true") + (cider-current-connection))) + (initial-ns (or (read (nrepl-dict-get response "value")) + "user"))) (cider-set-buffer-ns initial-ns))))) -(defvar cider-current-clojure-buffer nil - "This variable holds current buffer temporarily when connecting to a REPL. -It is set to current buffer when `cider' or `cider-jack-in' is called. -After the REPL buffer is created, the value of this variable is used -to call `cider-remember-clojure-buffer'.") - -(declare-function cider-remember-clojure-buffer "cider-mode") +(defun cider-repl-require-repl-utils () + "Require standard REPL util functions into the current REPL." + (interactive) + (nrepl-send-sync-request + (lax-plist-put + (nrepl--eval-request + "(when (clojure.core/resolve 'clojure.main/repl-requires) + (clojure.core/map clojure.core/require clojure.main/repl-requires))") + "inhibit-cider-middleware" "true") + (cider-current-connection))) (defun cider-repl-init (buffer &optional no-banner) "Initialize the REPL in BUFFER. BUFFER must be a REPL buffer with `cider-repl-mode' and a running client process connection. Unless NO-BANNER is non-nil, insert a banner." - (cider-repl-set-initial-ns buffer) - (cider-repl-require-repl-utils) - (unless no-banner - (cider-repl--insert-banner-and-prompt buffer)) (when cider-repl-display-in-current-window (add-to-list 'same-window-buffer-names (buffer-name buffer))) (pcase cider-repl-pop-to-buffer-on-connect (`display-only (display-buffer buffer)) ((pred identity) (pop-to-buffer buffer))) - (cider-remember-clojure-buffer cider-current-clojure-buffer) + (cider-repl-set-initial-ns buffer) + (cider-repl-require-repl-utils) + (unless no-banner + (cider-repl--insert-banner-and-prompt buffer)) buffer) +(defun cider-repl--insert-banner-and-prompt (buffer) + "Insert REPL banner and REPL prompt in BUFFER." + (with-current-buffer buffer + (when (zerop (buffer-size)) + (insert (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face)) + (when cider-repl-display-help-banner + (insert (propertize (cider-repl--help-banner) 'font-lock-face 'font-lock-comment-face)))) + (goto-char (point-max)) + (cider-repl--mark-output-start) + (cider-repl--mark-input-start) + (cider-repl--insert-prompt cider-buffer-ns))) + (defun cider-repl--banner () "Generate the welcome REPL buffer banner." (let ((host (cider--connection-host (current-buffer))) @@ -361,18 +371,6 @@ client process connection. Unless NO-BANNER is non-nil, insert a banner." ;; ====================================================================== ")) -(defun cider-repl--insert-banner-and-prompt (buffer) - "Insert REPL banner and REPL prompt in BUFFER." - (with-current-buffer buffer - (when (zerop (buffer-size)) - (insert (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face)) - (when cider-repl-display-help-banner - (insert (propertize (cider-repl--help-banner) 'font-lock-face 'font-lock-comment-face)))) - (goto-char (point-max)) - (cider-repl--mark-output-start) - (cider-repl--mark-input-start) - (cider-repl--insert-prompt cider-buffer-ns))) - ;;; REPL interaction @@ -557,7 +555,7 @@ When there is a possible unfinished ansi control sequence, (defun cider-repl--ns-form-changed-p (ns-form connection) "Return non-nil if NS-FORM for CONNECTION changed since last eval." - (when-let ((ns (cider-ns-from-form ns-form))) + (when-let* ((ns (cider-ns-from-form ns-form))) (not (string= ns-form (lax-plist-get (buffer-local-value 'cider-repl--ns-forms-plist connection) @@ -575,7 +573,7 @@ When there is a possible unfinished ansi control sequence, (defun cider-repl--cache-ns-form (ns-form connection) "Given NS-FORM cache root ns in CONNECTION." (with-current-buffer connection - (when-let ((ns (cider-ns-from-form ns-form))) + (when-let* ((ns (cider-ns-from-form ns-form))) ;; cache ns-form (setq cider-repl--ns-forms-plist (lax-plist-put cider-repl--ns-forms-plist ns ns-form)) @@ -702,9 +700,10 @@ If BOL is non-nil, emit at the beginning of the line." (cider-repl--insert-prompt cider-buffer-ns)))) (cider-repl--show-maximum-output))) -(defun cider-repl-emit-result (buffer string &optional bol) +(defun cider-repl-emit-result (buffer string show-prefix &optional bol) "Emit into BUFFER the result STRING and mark it as an evaluation result. -If BOL is non-nil insert at the beginning of the line." +If SHOW-PREFIX is non-nil insert `cider-repl-result-prefix' at the beginning +of the line. If BOL is non-nil insert at the beginning of the line." (with-current-buffer buffer (save-excursion (cider-save-marker cider-repl-output-start @@ -712,7 +711,8 @@ If BOL is non-nil insert at the beginning of the line." (goto-char cider-repl-input-start-mark) (when (and bol (not (bolp))) (insert-before-markers "\n")) - (insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face)) + (when show-prefix + (insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) (if cider-repl-use-clojure-font-lock (insert-before-markers (cider-font-lock-as-clojure string)) (cider-propertize-region @@ -770,8 +770,10 @@ the symbol." (defun cider-repl-handler (buffer) "Make an nREPL evaluation handler for the REPL BUFFER." (nrepl-make-response-handler buffer - (lambda (buffer value) - (cider-repl-emit-result buffer value t)) + (let (after-first-result-chunk) + (lambda (buffer value) + (cider-repl-emit-result buffer value (not after-first-result-chunk) t) + (setq after-first-result-chunk t))) (lambda (buffer out) (cider-repl-emit-stdout buffer out)) (lambda (buffer err) @@ -779,8 +781,10 @@ the symbol." (lambda (buffer) (cider-repl-emit-prompt buffer)) nrepl-err-handler - (lambda (buffer pprint-out) - (cider-repl-emit-result buffer pprint-out nil)))) + (let (after-first-result-chunk) + (lambda (buffer pprint-out) + (cider-repl-emit-result buffer pprint-out (not after-first-result-chunk)) + (setq after-first-result-chunk t))))) (defun cider-repl--send-input (&optional newline) "Go to the end of the input and send the current input. @@ -896,7 +900,7 @@ text property `cider-old-input'." (defun cider-repl-switch-to-other () "Switch between the Clojure and ClojureScript REPLs for the current project." (interactive) - (if-let (other-connection (cider-other-connection)) + (if-let* ((other-connection (cider-other-connection))) (switch-to-buffer other-connection) (message "There's no other REPL for the current project"))) @@ -1068,7 +1072,7 @@ for locref look up." This function is used from help-echo property inside REPL buffers and uses regexes from `cider-locref-regexp-alist' to infer locations at point." (interactive) - (if-let ((loc (cider-locref-at-point pos))) + (if-let* ((loc (cider-locref-at-point pos))) (let* ((var (plist-get loc :var)) (line (plist-get loc :line)) (file (or @@ -1099,11 +1103,11 @@ regexes from `cider-locref-regexp-alist' to infer locations at point." "Overlay used during hoovering on location references in REPL buffers. One for all REPLs.") -(defun cider-locref-help-echo (win buffer pos) +(defun cider-locref-help-echo (_win buffer pos) "Function for help-echo property in REPL buffers. WIN, BUFFER and POS are the window, buffer and point under mouse position." (with-current-buffer buffer - (if-let ((hl (plist-get (cider-locref-at-point pos) :highlight))) + (if-let* ((hl (plist-get (cider-locref-at-point pos) :highlight))) (move-overlay cider-locref-hoover-overlay (car hl) (cdr hl)) (delete-overlay cider-locref-hoover-overlay)) nil)) @@ -1376,6 +1380,7 @@ constructs." (cider-repl-add-shortcut "quit" #'cider-quit) (cider-repl-add-shortcut "restart" #'cider-restart) (cider-repl-add-shortcut "version" #'cider-version) +(cider-repl-add-shortcut "require-repl-utils" #'cider-repl-require-repl-utils) (defconst cider-repl-shortcuts-help-buffer "*CIDER REPL Shortcuts Help*") @@ -1428,6 +1433,7 @@ constructs." (declare-function cider-find-resource "cider-interaction") (declare-function cider-restart "cider-interaction") (declare-function cider-find-ns "cider-interaction") +(declare-function cider-find-keyword "cider-interaction") (declare-function cider-switch-to-last-clojure-buffer "cider-mode") (defvar cider-repl-mode-map @@ -1437,6 +1443,7 @@ constructs." (define-key map (kbd "C-c C-t") 'cider-test-commands-map) (define-key map (kbd "M-.") #'cider-find-var) (define-key map (kbd "C-c C-.") #'cider-find-ns) + (define-key map (kbd "C-c C-:") #'cider-find-keyword) (define-key map (kbd "M-,") #'cider-pop-back) (define-key map (kbd "C-c M-.") #'cider-find-resource) (define-key map (kbd "RET") #'cider-repl-return) @@ -1482,7 +1489,9 @@ constructs." "--" ("Find" ["Find definition" cider-find-var] + ["Find namespace" cider-find-ns] ["Find resource" cider-find-resource] + ["Find keyword" cider-find-keyword] ["Go back" cider-pop-back]) "--" ["Switch to Clojure buffer" cider-switch-to-last-clojure-buffer] @@ -1502,6 +1511,7 @@ constructs." "--" ["Set REPL ns" cider-repl-set-ns] ["Toggle pretty printing" cider-repl-toggle-pretty-printing] + ["Require REPL utils" cider-repl-require-repl-utils] "--" ["Browse classpath" cider-classpath] ["Browse classpath entry" cider-open-classpath-entry] diff --git a/cider-resolve.el b/cider-resolve.el index 6f9f8ebf..fa328aff 100644 --- a/cider-resolve.el +++ b/cider-resolve.el @@ -95,7 +95,7 @@ Return nil only if VAR cannot be resolved." (cider-resolve--get-in (or var-ns ns) "interns" name) (unless var-ns ;; If the var had no prefix, it might be referred. - (if-let ((referal (cider-resolve--get-in ns "refers" name))) + (if-let* ((referal (cider-resolve--get-in ns "refers" name))) (cider-resolve-var ns referal) ;; Or it might be from core. (unless (equal ns "clojure.core") @@ -114,9 +114,9 @@ This will be clojure.core or cljs.core depending on `cider-repl-type'." "Return a plist of all valid symbols in NS. Each entry's value is the metadata of the var that the symbol refers to. NS can be the namespace name, or a dict of the namespace itself." - (when-let ((dict (if (stringp ns) - (cider-resolve--get-in ns) - ns))) + (when-let* ((dict (if (stringp ns) + (cider-resolve--get-in ns) + ns))) (nrepl-dbind-response dict (interns refers aliases) (append (cdr interns) (nrepl-dict-flat-map (lambda (alias namespace) diff --git a/cider-stacktrace.el b/cider-stacktrace.el index b62a53d5..917c286c 100644 --- a/cider-stacktrace.el +++ b/cider-stacktrace.el @@ -346,14 +346,13 @@ POS-FILTERS ensure that frames with flag is shown." (setq cider-stacktrace-hidden-frame-count hidden))) (cider-stacktrace-indicate-filters neg-filters pos-filters))) - (defun cider-stacktrace-apply-cause-visibility () "Apply `cider-stacktrace-cause-visibility' to causes and reapply filters." (with-current-buffer cider-error-buffer (save-excursion (goto-char (point-min)) (cl-flet ((next-detail (end) - (when-let ((pos (next-single-property-change (point) 'detail))) + (when-let* ((pos (next-single-property-change (point) 'detail))) (when (< pos end) (goto-char pos))))) (let ((inhibit-read-only t)) @@ -403,14 +402,14 @@ grouped with a suppressed error type." "Move point to the previous exception cause, if one exists." (interactive) (with-current-buffer cider-error-buffer - (when-let ((pos (previous-single-property-change (point) 'cause))) + (when-let* ((pos (previous-single-property-change (point) 'cause))) (goto-char pos)))) (defun cider-stacktrace-next-cause () "Move point to the next exception cause, if one exists." (interactive) (with-current-buffer cider-error-buffer - (when-let ((pos (next-single-property-change (point) 'cause))) + (when-let* ((pos (next-single-property-change (point) 'cause))) (goto-char pos)))) (defun cider-stacktrace-cycle-cause (num &optional level) @@ -442,7 +441,7 @@ When it reaches 3, it wraps to 0." "Cycle the visibility of current exception at point, if any." (interactive) (with-current-buffer cider-error-buffer - (when-let ((num (get-text-property (point) 'cause))) + (when-let* ((num (get-text-property (point) 'cause))) (cider-stacktrace-cycle-cause num)))) (defun cider-stacktrace-cycle-cause-1 () @@ -470,7 +469,6 @@ When it reaches 3, it wraps to 0." (interactive) (cider-stacktrace-cycle-cause 5)) - (defun cider-stacktrace-toggle-all () "Reset `cider-stacktrace-filters' if present; otherwise restore prior filters." (interactive) @@ -596,11 +594,22 @@ prompt and whether to use a new window. Similar to `cider-find-var'." ;; Rendering -(defun cider-stacktrace-emit-indented (text indent &optional fill) - "Insert TEXT, and INDENT and optionally FILL the entire block." - (let ((beg (point))) +(defun cider-stacktrace-emit-indented (text &optional indent fill fontify) + "Insert TEXT, and optionally FILL and FONTIFY as clojure the entire block. +INDENT is a string to insert before each line. When INDENT is nil, first +line is not indented and INDENT defaults to a white-spaced string with +length given by `current-column'." + (let ((text (if fontify + (cider-font-lock-as-clojure text) + text)) + (do-first indent) + (indent (or indent (make-string (current-column) ? ))) + (beg (point))) (insert text) (goto-char beg) + (when do-first + (insert indent)) + (forward-line) (while (not (eobp)) (insert indent) (forward-line)) @@ -612,7 +621,6 @@ prompt and whether to use a new window. Similar to `cider-find-var'." (defun cider-stacktrace-render-filters (buffer special-filters filters) "Emit into BUFFER toggle buttons for each of the FILTERS. - SPECIAL-FILTERS are filters that show stack certain stack frames, hiding others." (with-current-buffer buffer @@ -716,10 +724,81 @@ This associates text properties to enable filtering and source navigation." (insert (propertize (format " at (%d:%d)" line column) 'font-lock-face message-face)))))) +(defun cider-stacktrace--toggle-visibility (id) + "Toggle visibility of the region with ID invisibility prop. +ID can also be a button, in which case button's property :id is used +instead. This function can be used directly in button actions." + (let ((id (if (or (numberp id) (symbolp id)) + ;; There is no proper way to identify buttons. Assuming that + ;; id's can be either numbers or symbols. + id + (button-get id :id)))) + (if (and (consp buffer-invisibility-spec) + (assoc id buffer-invisibility-spec)) + (remove-from-invisibility-spec (cons id t)) + (add-to-invisibility-spec (cons id t))))) + +(defun cider-stacktrace--insert-named-group (indent name &rest vals) + "Insert named group with the ability to toggle visibility. +NAME is a string naming the group. VALS are strings to be inserted after +the NAME. The whole group is prefixed by string INDENT." + (let* ((str (and vals (replace-regexp-in-string "\n+\\'" "" (apply #'concat vals)))) + (id (and str + (string-match "\n" str) + (cl-gensym name)))) + (insert indent) + (if id + (let* ((beg-link (string-match "[^ :]" name)) + (end-link (string-match "[ :]" name (1+ beg-link)))) + (insert (substring name 0 beg-link)) + (insert-text-button (substring name beg-link end-link) + :id id + 'face '((:weight bold) (:underline t)) + 'follow-link t + 'help-echo "Toggle visibility" + 'action #'cider-stacktrace--toggle-visibility) + (insert (substring name end-link))) + (insert (propertize name 'face '((:weight bold))))) + (let ((pos (point))) + (when str + (cider-stacktrace-emit-indented (concat str "\n") nil nil t) + (when id + (remove-from-invisibility-spec (cons id t)) + (let ((hide-beg (save-excursion (goto-char pos) (point-at-eol))) + (hide-end (1- (point-at-bol)))) + (overlay-put (make-overlay hide-beg hide-end) 'invisible id))))))) + +(defun cider-stacktrace--emit-spec-problems (spec-data indent) + "Emit SPEC-DATA indented with INDENT." + (nrepl-dbind-response spec-data (spec value problems) + (insert "\n") + (cider-stacktrace--insert-named-group indent " Spec: " spec) + (cider-stacktrace--insert-named-group indent " Value: " value) + (insert "\n") + (cider-stacktrace--insert-named-group indent "Problems: \n") + (let ((indent2 (concat indent " "))) + (dolist (prob problems) + (nrepl-dbind-response prob (in val predicate reason spec at extra) + (insert "\n") + (when (not (string= val value)) + (cider-stacktrace--insert-named-group indent2 " val: " val)) + (when in + (cider-stacktrace--insert-named-group indent2 " in: " in)) + (cider-stacktrace--insert-named-group indent2 "failed: " predicate) + (when spec + (cider-stacktrace--insert-named-group indent2 " spec: " spec)) + (when at + (cider-stacktrace--insert-named-group indent2 " at: " at)) + (when reason + (cider-stacktrace--insert-named-group indent2 "reason: " reason)) + (when extra + (cider-stacktrace--insert-named-group indent2 "extras: \n") + (cider-stacktrace-emit-indented extra (concat indent2 " ") nil t))))))) + (defun cider-stacktrace-render-cause (buffer cause num note) "Emit into BUFFER the CAUSE NUM, exception class, message, data, and NOTE." (with-current-buffer buffer - (nrepl-dbind-response cause (class message data stacktrace) + (nrepl-dbind-response cause (class message data spec stacktrace) (let ((indent " ") (class-face 'cider-stacktrace-error-class-face) (message-face 'cider-stacktrace-error-message-face)) @@ -736,11 +815,13 @@ This associates text properties to enable filtering and source navigation." (cider-stacktrace-render-compile-error buffer cause) (cider-stacktrace-emit-indented (propertize (or message "(No message)") - 'font-lock-face message-face) indent t)) + 'font-lock-face message-face) + indent t)) (insert "\n") + (when spec + (cider-stacktrace--emit-spec-problems spec (concat indent " "))) (when data - (cider-stacktrace-emit-indented - (cider-font-lock-as-clojure data) indent nil))) + (cider-stacktrace-emit-indented data indent nil t))) ;; Detail level 2: stacktrace (cider-propertize-region '(detail 2) (insert "\n") diff --git a/cider-test.el b/cider-test.el index a23a9bf8..524137d4 100644 --- a/cider-test.el +++ b/cider-test.el @@ -222,7 +222,7 @@ Add to this list to have CIDER recognize additional test defining macros." (defun cider-test-show-report () "Show the test report buffer, if one exists." (interactive) - (if-let ((report-buffer (get-buffer cider-test-report-buffer))) + (if-let* ((report-buffer (get-buffer cider-test-report-buffer))) (switch-to-buffer report-buffer) (message "No test report buffer"))) @@ -230,20 +230,20 @@ Add to this list to have CIDER recognize additional test defining macros." "Move point to the previous test result, if one exists." (interactive) (with-current-buffer (get-buffer cider-test-report-buffer) - (when-let ((pos (previous-single-property-change (point) 'type))) + (when-let* ((pos (previous-single-property-change (point) 'type))) (if (get-text-property pos 'type) (goto-char pos) - (when-let ((pos (previous-single-property-change pos 'type))) + (when-let* ((pos (previous-single-property-change pos 'type))) (goto-char pos)))))) (defun cider-test-next-result () "Move point to the next test result, if one exists." (interactive) (with-current-buffer (get-buffer cider-test-report-buffer) - (when-let ((pos (next-single-property-change (point) 'type))) + (when-let* ((pos (next-single-property-change (point) 'type))) (if (get-text-property pos 'type) (goto-char pos) - (when-let ((pos (next-single-property-change pos 'type))) + (when-let* ((pos (next-single-property-change pos 'type))) (goto-char pos)))))) (defun cider-test-jump (&optional arg) @@ -513,8 +513,8 @@ The optional arg TEST denotes an individual test name." "Return the buffer visiting the file in which the NS VAR is defined. Or nil if not found." (cider-ensure-op-supported "info") - (when-let ((info (cider-var-info (concat ns "/" var))) - (file (nrepl-dict-get info "file"))) + (when-let* ((info (cider-var-info (concat ns "/" var))) + (file (nrepl-dict-get info "file"))) (cider-find-file file))) (defun cider-test-highlight-problems (results) @@ -523,7 +523,7 @@ Or nil if not found." (lambda (ns vars) (nrepl-dict-map (lambda (var tests) - (when-let ((buffer (cider-find-var-file ns var))) + (when-let* ((buffer (cider-find-var-file ns var))) (dolist (test tests) (nrepl-dbind-response test (type) (unless (equal "pass" type) @@ -538,7 +538,7 @@ Or nil if not found." (nrepl-dict-map (lambda (ns vars) (dolist (var (nrepl-dict-keys vars)) - (when-let ((buffer (cider-find-var-file ns var))) + (when-let* ((buffer (cider-find-var-file ns var))) (with-current-buffer buffer (remove-overlays nil nil 'category 'cider-test))))) cider-test-last-results))) @@ -563,8 +563,7 @@ The default implementation uses the simple Leiningen convention of appending This uses the Leiningen convention of appending '-test' to the namespace name." (when ns (let ((suffix "-test")) - ;; string-suffix-p is only available in Emacs 24.4+ - (if (string-match-p (rx-to-string `(: ,suffix eos) t) ns) + (if (string-suffix-p suffix ns) ns (concat ns suffix))))) @@ -657,9 +656,9 @@ If SILENT is non-nil, suppress all messages other then test results. With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the current ns." (interactive "P") - (if-let ((ns (if suppress-inference - (cider-current-ns t) - (funcall cider-test-infer-test-ns (cider-current-ns t))))) + (if-let* ((ns (if suppress-inference + (cider-current-ns t) + (funcall cider-test-infer-test-ns (cider-current-ns t))))) (cider-test-execute ns nil silent) (if (eq major-mode 'cider-test-report-mode) (when (y-or-n-p (concat "Test report does not define a namespace. " diff --git a/cider-util.el b/cider-util.el index a2551d6f..3d348d89 100644 --- a/cider-util.el +++ b/cider-util.el @@ -115,7 +115,7 @@ instead." "Return the name of the symbol at point, otherwise nil. Ignores the REPL prompt. If LOOK-BACK is non-nil, move backwards trying to find a symbol if there isn't one at point." - (or (when-let ((str (thing-at-point 'symbol))) + (or (when-let* ((str (thing-at-point 'symbol))) (unless (text-property-any 0 (length str) 'field 'cider-repl-prompt str) (substring-no-properties str))) (when look-back @@ -131,13 +131,13 @@ find a symbol if there isn't one at point." "Return the sexp at point as a string, otherwise nil. If BOUNDS is non-nil, return a list of its starting and ending position instead." - (when-let ((b (or (and (equal (char-after) ?\() - (member (char-before) '(?\' ?\, ?\@)) - ;; hide stuff before ( to avoid quirks with '( etc. - (save-restriction - (narrow-to-region (point) (point-max)) - (bounds-of-thing-at-point 'sexp))) - (bounds-of-thing-at-point 'sexp)))) + (when-let* ((b (or (and (equal (char-after) ?\() + (member (char-before) '(?\' ?\, ?\@)) + ;; hide stuff before ( to avoid quirks with '( etc. + (save-restriction + (narrow-to-region (point) (point-max)) + (bounds-of-thing-at-point 'sexp))) + (bounds-of-thing-at-point 'sexp)))) (funcall (if bounds #'list #'buffer-substring-no-properties) (car b) (cdr b)))) @@ -192,7 +192,8 @@ Can only error if SKIP is non-nil." "Execute BODY and add PROPS to all the inserted text. More precisely, PROPS are added to the region between the point's positions before and after executing BODY." - (declare (indent 1)) + (declare (indent 1) + (debug (sexp body))) (let ((start (make-symbol "start"))) `(let ((,start (point))) (prog1 (progn ,@body) @@ -388,7 +389,7 @@ plugin or dependency with: (cider-add-to-alist 'cider-jack-in-lein-plugins \"plugin/artifact-name\" \"THE-NEW-VERSION\")" (let ((alist (symbol-value symbol))) - (if-let ((cons (assoc car alist))) + (if-let* ((cons (assoc car alist))) (setcdr cons (list cadr)) (set symbol (cons (list car cadr) alist))))) @@ -11,7 +11,7 @@ ;; Steve Purcell <steve@sanityinc.com> ;; Maintainer: Bozhidar Batsov <bozhidar@batsov.com> ;; URL: http://www.github.com/clojure-emacs/cider -;; Version: 0.15.1 +;; Version: 0.16.0 ;; Package-Requires: ((emacs "24.4") (clojure-mode "5.6.0") (pkg-info "0.4") (queue "0.1.1") (spinner "1.7") (seq "2.16")) ;; Keywords: languages, clojure, cider @@ -90,12 +90,12 @@ project inference will take place." (require 'seq) -(defconst cider-version "0.15.1" +(defconst cider-version "0.16.0" "Fallback version used when it cannot be extracted automatically. Normally it won't be used, unless `pkg-info' fails to extract the version from the CIDER package or library.") -(defconst cider-codename "London" +(defconst cider-codename "Riga" "Codename used to denote stable releases.") (defcustom cider-lein-command @@ -300,7 +300,7 @@ Throws an error if PROJECT-TYPE is unknown. Known types are "List of dependencies where elements are lists of artifact name and version.") (put 'cider-jack-in-dependencies 'risky-local-variable t) (cider-add-to-alist 'cider-jack-in-dependencies - "org.clojure/tools.nrepl" "0.2.12") + "org.clojure/tools.nrepl" "0.2.13") (defvar cider-jack-in-dependencies-exclusions nil "List of exclusions for jack in dependencies. @@ -348,7 +348,7 @@ string is quoted for passing as argument to an inferior shell." (defun cider-boot-dependencies (dependencies) "Return a list of boot artifact strings created from DEPENDENCIES." (concat (mapconcat #'cider--list-as-boot-artifact dependencies " ") - (when (not (seq-empty-p dependencies)) " "))) + (unless (seq-empty-p dependencies) " "))) (defun cider-boot-middleware-task (params middlewares) "Create a command to add MIDDLEWARES with corresponding PARAMS." @@ -366,7 +366,7 @@ PLUGINS and MIDDLEWARES. PARAMS and MIDDLEWARES are passed on to `cider-boot-middleware-task` before concatenating and DEPENDENCIES and PLUGINS are passed on to `cider-boot-dependencies`." (concat global-opts - (when (not (seq-empty-p global-opts)) " ") + (unless (seq-empty-p global-opts) " ") "-i \"(require 'cider.tasks)\" " ;; Note the white space at the end here (cider-boot-dependencies (append dependencies plugins)) (cider-boot-middleware-task params middlewares))) @@ -390,7 +390,7 @@ Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, with DEPENDENCIES-EXCLUSIONS removed, LEIN-PLUGINS, and finally PARAMS." (concat global-opts - (when (not (seq-empty-p global-opts)) " ") + (unless (seq-empty-p global-opts) " ") (mapconcat #'identity (append (seq-map (lambda (dep) (let ((exclusions (cadr (assoc (car dep) dependencies-exclusions)))) @@ -447,7 +447,7 @@ dependencies." cider-jack-in-nrepl-middlewares)) ("gradle" (concat global-opts - (when (not (seq-empty-p global-opts)) " ") + (unless (seq-empty-p global-opts) " ") params)) (_ (error "Unsupported project type `%s'" project-type)))) @@ -512,7 +512,7 @@ it should start a ClojureScript REPL." (with-current-buffer server-buffer (save-excursion (goto-char (point-min)) - (when-let ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror) + (when-let* ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror) (match-string 0)))) (when (y-or-n-p (format "Visit ‘%s’ in a browser? " url)) (browse-url url))))))) @@ -561,7 +561,7 @@ should be the regular Clojure REPL started by the server process filter." (defun cider--select-zombie-buffer (repl-buffers) "Return a zombie buffer from REPL-BUFFERS, or nil if none exists." - (when-let ((zombie-buffs (seq-remove #'get-buffer-process repl-buffers))) + (when-let* ((zombie-buffs (seq-remove #'get-buffer-process repl-buffers))) (when (y-or-n-p (format "Zombie REPL buffers exist (%s). Reuse? " (mapconcat #'buffer-name zombie-buffs ", "))) @@ -579,15 +579,15 @@ and has no process, return it. If the process is alive, ask the user for confirmation and return 'new/nil for y/n answer respectively. If other REPL buffers with dead process exist, ask the user if any of those should be reused." - (if-let ((repl-buffers (cider-repl-buffers)) - (exact-buff (seq-find - (lambda (buff) - (with-current-buffer buff - (or (and endpoint - (equal endpoint nrepl-endpoint)) - (and project-directory - (equal project-directory nrepl-project-dir))))) - repl-buffers))) + (if-let* ((repl-buffers (cider-repl-buffers)) + (exact-buff (seq-find + (lambda (buff) + (with-current-buffer buff + (or (and endpoint + (equal endpoint nrepl-endpoint)) + (and project-directory + (equal project-directory nrepl-project-dir))))) + repl-buffers))) (if (get-buffer-process exact-buff) (when (y-or-n-p (format "REPL buffer already exists (%s). \ Do you really want to create a new one? " @@ -604,7 +604,6 @@ start the server. If CLJS-TOO is non-nil, also start a ClojureScript REPL session with its own buffer." (interactive "P") - (setq cider-current-clojure-buffer (current-buffer)) (let* ((project-type (cider-project-type)) (command (cider-jack-in-command project-type)) (command-resolved (cider-jack-in-resolve-command project-type)) @@ -632,7 +631,7 @@ own buffer." (and (null project-dir) (eq cider-allow-jack-in-without-project 'warn) (y-or-n-p "Are you sure you want to run `cider-jack-in' without a Clojure project? "))) - (when-let ((repl-buff (cider-find-reusable-repl-buffer nil project-dir))) + (when-let* ((repl-buff (cider-find-reusable-repl-buffer nil project-dir))) (let ((nrepl-create-client-buffer-function #'cider-repl-create) (nrepl-use-this-as-repl-buffer repl-buff)) (nrepl-start-server-process @@ -657,8 +656,7 @@ Create REPL buffer and start an nREPL client connection. When the optional param PROJECT-DIR is present, the connection gets associated with it." (interactive (cider-select-endpoint)) - (setq cider-current-clojure-buffer (current-buffer)) - (when-let ((repl-buff (cider-find-reusable-repl-buffer `(,host ,port) nil))) + (when-let* ((repl-buff (cider-find-reusable-repl-buffer `(,host ,port) nil))) (let* ((nrepl-create-client-buffer-function #'cider-repl-create) (nrepl-use-this-as-repl-buffer repl-buff) (conn (process-buffer (nrepl-start-client-process host port)))) @@ -708,7 +706,10 @@ gets associated with it." (defun cider--ssh-hosts () "Retrieve all ssh host from local configuration files." (seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s))) - (let ((tramp-completion-mode t)) + ;; `tramp-completion-mode' is obsoleted in 26 + (cl-progv (if (version< emacs-version "26") + '(tramp-completion-mode) + '(non-essential)) '(t) (tramp-completion-handle-file-name-all-completions "" "/ssh:")))) (defun cider--completing-read-host (hosts) @@ -757,7 +758,7 @@ When DIR is non-nil also look for nREPL port files in DIR. Return a list of list of the form (project-dir port)." (let* ((paths (cider--running-nrepl-paths)) (proj-ports (mapcar (lambda (d) - (when-let ((port (and d (nrepl-extract-port (cider--file-path d))))) + (when-let* ((port (and d (nrepl-extract-port (cider--file-path d))))) (list (file-name-nondirectory (directory-file-name d)) port))) (cons (clojure-project-dir dir) paths)))) (seq-uniq (delq nil proj-ports)))) @@ -810,9 +811,9 @@ choose." "Find `cider-lein-command' on `exec-path' if possible, or return nil. In case `default-directory' is non-local we assume the command is available." - (when-let ((command (or (and (file-remote-p default-directory) cider-lein-command) - (executable-find cider-lein-command) - (executable-find (concat cider-lein-command ".bat"))))) + (when-let* ((command (or (and (file-remote-p default-directory) cider-lein-command) + (executable-find cider-lein-command) + (executable-find (concat cider-lein-command ".bat"))))) (shell-quote-argument command))) ;; TODO: Implement a check for `cider-boot-command' over tramp @@ -820,9 +821,9 @@ In case `default-directory' is non-local we assume the command is available." "Find `cider-boot-command' on `exec-path' if possible, or return nil. In case `default-directory' is non-local we assume the command is available." - (when-let ((command (or (and (file-remote-p default-directory) cider-boot-command) - (executable-find cider-boot-command) - (executable-find (concat cider-boot-command ".exe"))))) + (when-let* ((command (or (and (file-remote-p default-directory) cider-boot-command) + (executable-find cider-boot-command) + (executable-find (concat cider-boot-command ".exe"))))) (shell-quote-argument command))) ;; TODO: Implement a check for `cider-gradle-command' over tramp @@ -830,9 +831,9 @@ In case `default-directory' is non-local we assume the command is available." "Find `cider-gradle-command' on `exec-path' if possible, or return nil. In case `default-directory' is non-local we assume the command is available." - (when-let ((command (or (and (file-remote-p default-directory) cider-gradle-command) - (executable-find cider-gradle-command) - (executable-find (concat cider-gradle-command ".exe"))))) + (when-let* ((command (or (and (file-remote-p default-directory) cider-gradle-command) + (executable-find cider-gradle-command) + (executable-find (concat cider-gradle-command ".exe"))))) (shell-quote-argument command))) @@ -841,7 +842,7 @@ In case `default-directory' is non-local we assume the command is available." ;; file. (defun cider--check-required-nrepl-version () "Check whether we're using a compatible nREPL version." - (if-let ((nrepl-version (cider--nrepl-version))) + (if-let* ((nrepl-version (cider--nrepl-version))) (when (version< nrepl-version cider-required-nrepl-version) (cider-repl-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" "CIDER requires nREPL %s (or newer) to work properly" @@ -852,7 +853,7 @@ In case `default-directory' is non-local we assume the command is available." (defun cider--check-clojure-version-supported () "Ensure that we are meeting the minimum supported version of Clojure." - (if-let ((clojure-version (cider--clojure-version))) + (if-let* ((clojure-version (cider--clojure-version))) (when (version< clojure-version cider-minimum-clojure-version) (cider-repl-manual-warning "installation/#prerequisites" "Clojure version (%s) is not supported (minimum %s). CIDER will not work." @@ -874,12 +875,12 @@ message in the REPL area." cider-version middleware-version)))) (defun cider--subscribe-repl-to-server-out () - "Subscribe to the server's *out*." + "Subscribe to the nREPL server's *out*." (cider-nrepl-send-request '("op" "out-subscribe") (cider-interactive-eval-handler (current-buffer)))) (defun cider--connected-handler () - "Handle cider initialization after nREPL connection has been established. + "Handle CIDER initialization after nREPL connection has been established. This function is appended to `nrepl-connected-hook' in the client process buffer." ;; `nrepl-connected-hook' is run in the connection buffer @@ -892,10 +893,15 @@ buffer." (cider--check-required-nrepl-version) (cider--check-clojure-version-supported) (cider--check-middleware-compatibility) - (cider--debug-init-connection) (cider--subscribe-repl-to-server-out) (when cider-auto-mode (cider-enable-on-existing-clojure-buffers)) + ;; Middleware on cider-nrepl's side is deferred until first usage, but + ;; loading middleware concurrently can lead to occasional "require" issues + ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards + ;; the end, allowing for the faster "server-out" middleware to load + ;; first. + (cider--debug-init-connection) (run-hooks 'cider-connected-hook))) (defun cider--disconnected-handler () diff --git a/doc/about/contributing.md b/doc/about/contributing.md index 107af8d2..de79d5e5 100644 --- a/doc/about/contributing.md +++ b/doc/about/contributing.md @@ -68,9 +68,8 @@ to become a CIDER sponsor. You can support the development of CIDER, [clojure-mode][] and [inf-clojure][] via [Open Collective](https://opencollective.com/cider), [Salt](https://salt.bountysource.com/teams/cider), -[Gratipay](https://www.gratipay.com/cider) and PayPal. - -[Support via Gratipay](https://gratipay.com/cider) +[Patreon](https://www.patreon.com/bbatsov), +[Liberapay](https://liberapay.com/bbatsov/donate) and PayPal. [Paypal](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=GRQKNBM6P8VRQ) diff --git a/doc/caveats.md b/doc/caveats.md index 8db678fa..64a87cfe 100644 --- a/doc/caveats.md +++ b/doc/caveats.md @@ -82,4 +82,4 @@ Leingingen also pulls in starting up the REPL will fail if `:pedantic? :abort` is set. Either remove the `:pedantic? :abort` setting or switch off injecting the dependencies with setting `cider-inject-dependencies-at-jack-in` to `nil` and provide the dependencies by editing your `~/.lein/profiles.clj` as described in -the [standalone REPL](#setting-up-a-standalone-repl) section. +the [standalone REPL](installation.md#setting-up-a-standalone-repl) section. diff --git a/doc/hacking_on_cider.md b/doc/hacking_on_cider.md index 11c4e80f..908e49ff 100644 --- a/doc/hacking_on_cider.md +++ b/doc/hacking_on_cider.md @@ -77,6 +77,77 @@ You can also check for the presence of byte-compilation warnings in batch mode: $ make test-bytecomp ``` +#### Running the tests in Travis CI + +If you prefer to see the full Travis CI test suite run successfully, the easiest +way to achieve that is to create your own personal account on +https://travis-ci.org. View your profile details on the Travis CI site, and +toggle the switch to enable builds on your fork of the cider project. + +Subsequent pushes to your fork will generate a Travis CI build you can monitor +for success or failure. + +#### Simulating the Travis CI tests locally in Docker + +If you prefer not to wait for Travis CI all the time, or if you need to debug +something that fails in Travis CI but does not fail for you on your own machine, +then you can also run the Travis CI tests manually in Docker. + +You will need to run some scripts to build and launch the Docker image. + +To build: + +``` +$ docker/build.sh +``` + +The build script uses a base image provided by the engineers at Travis CI. + +*Note: The Travis docker image is currently more than 8GB, so be prepared with a +good internet connection and time to spare.* + +The resulting docker image is tagged simply `cider-travis`. You can run this +image by hand, but there is a convenience script available: + +``` +$ docker/run.sh +``` + +This script launches a docker container and bind-mounts your cider project +directory as `/home/travis/cider` such that you can instantly see any code +changes reflected inside the docker environment. + +For instance, first you can run tests on Emacs 25.3: + +``` +(emacs-25.3-travis) ~/cider$ make test +``` + +And then switch to Emacs 26.1 and test again: + +``` +(emacs-25.3-travis) ~/cider$ evm use Emacs-26-pretest-travis +(emacs-26-pretest-travis) ~/cider$ cask install +(emacs-26-pretest-travis) ~/cider$ make test +``` + +You can test byte compilation too + +``` +(emacs-26-pretest-travis) ~/cider$ make test-bytecomp +``` + +When you are done working in docker, just `exit` the bash prompt, and the docker +container will also exit. Note that `docker/run.sh` runs the container with +`--rm`, meaning any changes to the docker container are discarded when the +container exits. + +So for example, by default, the docker image pre-installs only the most recent +releases of Emacs 25, Emacs 26, and a recent snapshot of the Emacs git +repository. The `evm` tool is available should you need to install some other +specific build. However additional versions of Emacs will be discarded when +you exit the docker container. + ## Hacking on cider-nrepl ### Obtaining the code diff --git a/doc/indent_spec.md b/doc/indent_spec.md index 2166a63f..cf101284 100644 --- a/doc/indent_spec.md +++ b/doc/indent_spec.md @@ -53,7 +53,7 @@ or `0` for short. (want)) ``` -Sticking to simplicity, the `when-let` macro has one special argument (the +Sticking to simplicity, the `when-let*` macro has one special argument (the binding vector) and there's no out-of-the-ordinary internal structure involved. So the indent spec is just `1` (which is shorthand for `[1]`). diff --git a/doc/installation.md b/doc/installation.md index 98fef5b5..3cf6def7 100644 --- a/doc/installation.md +++ b/doc/installation.md @@ -34,7 +34,7 @@ Use the convenient plugin for defaults, either in your project's A minimal `profiles.clj` for CIDER would be: ```clojure -{:repl {:plugins [[cider/cider-nrepl "0.15.1"]]}} +{:repl {:plugins [[cider/cider-nrepl "0.16.0"]]}} ``` **Be careful not to place this in the `:user` profile, as this way CIDER's @@ -50,7 +50,7 @@ all of their projects using a `~/.boot/profile.boot` file like so: (require 'boot.repl) (swap! boot.repl/*default-dependencies* - concat '[[cider/cider-nrepl "0.15.1"]]) + concat '[[cider/cider-nrepl "0.16.0"]]) (swap! boot.repl/*default-middleware* conj 'cider.nrepl/cider-middleware) @@ -77,6 +77,6 @@ It goes without saying that your project should depend on `cider-nrepl`. *** -`x.y.z` should match the version of CIDER you're currently using (say `0.15.1`). +`x.y.z` should match the version of CIDER you're currently using (say `0.16.0`). For snapshot releases of CIDER you should use the snapshot of the plugin as well -(say `0.15.1-SNAPSHOT`). +(say `0.16.0-SNAPSHOT`). diff --git a/doc/interactive_programming.md b/doc/interactive_programming.md index d9716e32..815a6fd6 100644 --- a/doc/interactive_programming.md +++ b/doc/interactive_programming.md @@ -22,8 +22,8 @@ Here's a list of `cider-mode`'s keybindings: `cider-eval-last-sexp-and-replace` |<kbd>C-c C-v w</kbd> | Evaluate the form preceding point and replace it with its result. `cider-eval-last-sexp-to-repl` |<kbd>C-c M-e</kbd> | Evaluate the form preceding point and output it result to the REPL buffer. If invoked with a prefix argument, takes you to the REPL buffer after being invoked. `cider-insert-last-sexp-in-repl` |<kbd>C-c M-p</kbd> | Load the form preceding point in the REPL buffer. -`cider-pprint-eval-last-sexp` |<kbd>C-c C-p</kbd> | Evaluate the form preceding point and pretty-print the result in a popup buffer. -`cider-pprint-eval-defun-at-point` |<kbd>C-c C-f</kbd> | Evaluate the top level form under point and pretty-print the result in a popup buffer. +`cider-pprint-eval-last-sexp` |<kbd>C-c C-p</kbd> | Evaluate the form preceding point and pretty-print the result in a popup buffer. If invoked with a prefix argument, insert the result into the current buffer as a comment. +`cider-pprint-eval-defun-at-point` |<kbd>C-c C-f</kbd> | Evaluate the top level form under point and pretty-print the result in a popup buffer. If invoked with a prefix argument, insert the result into the current buffer as a comment. `cider-eval-defun-at-point` |<kbd>C-M-x</kbd> <br/> <kbd>C-c C-c</kbd> | Evaluate the top level form under point and display the result in the echo area. `cider-eval-sexp-at-point` |<kbd>C-c C-v v</kbd> | Evaluate the form around point. `cider-eval-defun-at-point` |<kbd>C-u C-M-x</kbd> <br/> <kbd>C-u C-c C-c</kbd> | Debug the top level form under point and walk through its evaluation diff --git a/doc/running_tests.md b/doc/running_tests.md index fce7ba6a..29cbcfba 100644 --- a/doc/running_tests.md +++ b/doc/running_tests.md @@ -3,11 +3,22 @@ You can run `clojure.test` tests pretty quickly in CIDER. Pressing <kbd>C-c C-t n</kbd> or <kbd>C-c C-t C-n</kbd> in a source buffer or a REPL buffer will run the tests for the namespace you're currently in. CIDER is smart enough to figure -out the namespace containing the tests. You can also run all loaded tests with -<kbd>C-c C-t l</kbd> or <kbd>C-c C-t C-l</kbd> and all tests within a project -with <kbd>C-c C-t p</kbd> or <kbd>C-c C-t C-p</kbd> (note that this will load -**all** namespaces in your project). Using <kbd>C-c C-t t</kbd> or <kbd>C-c C-t -C-t</kbd>, you can execute only the test a point. +out the namespace containing the tests. The inference logic works in a pretty +simple manner - if you're in an implementation namespace (e.g. `some.ns`) CIDER +will try to find a matching test namespace (by default `some.ns-test`) and run +the tests there. On the other hand - if you're in something that looks like a +test namespace (e.g. `some.ns-test`), then the command will simply run the tests +in that namespace. From time to time, however, you might want to suppress the +test namespace inference logic (e.g. you have some tests in the implementation +namespace that were defined with `clojure.test/with-test`) +- in such cases you should use <kbd>C-u C-c C-t C-n</kbd>, which will simply run +whatever tests are present in the currently visited/active namespace. + +You can also run all loaded tests with <kbd>C-c C-t l</kbd> or <kbd>C-c C-t +C-l</kbd> and all tests within a project with <kbd>C-c C-t p</kbd> or <kbd>C-c +C-t C-p</kbd> (note that this will load **all** namespaces in your +project). Using <kbd>C-c C-t t</kbd> or <kbd>C-c C-t C-t</kbd>, you can execute +only the test a point. All test commands are available in REPL buffers as well. There you can also use <kbd>,</kbd> to invoke some of the testing commands. @@ -77,3 +88,6 @@ As a test framework author, supporting the built-in `clojure.test` machinery The `test.check` library is a good example here. It was also designed completely independently of `clojure.test`. It just adds compatibility in this [namespace](https://github.com/clojure/test.check/blob/24f74b83f1c7a032f98efdcc1db9d74b3a6a794d/src/main/clojure/clojure/test/check/clojure_test.cljc). + +[clojure-expectations](https://github.com/clojure-expectations/expectations) added +support for `clojure.test` in version 2.2 and should also work with CIDER. diff --git a/doc/troubleshooting.md b/doc/troubleshooting.md index 5d4a119b..982d8ddc 100644 --- a/doc/troubleshooting.md +++ b/doc/troubleshooting.md @@ -2,9 +2,13 @@ In case you run into issues here are a few tips that can help you diagnose the problem. Generally, it's not a bad idea to configure Emacs to spit the backtrace on error -(instead of just logging the error in the `*Messages*` buffer. You can toggle +(instead of just logging the error in the `*Messages*` buffer). You can toggle this behavior by using <kbd>M-x</kbd> `toggle-debug-on-error`. +Another good idea is to check the exchange of requests and responses between +CIDER and the nREPL server. You can find them in the `*nrepl-messages*` buffer, +provided you've enabled nREPL message logging. + ## Debugging CIDER commands Emacs features a super powerful built-in diff --git a/docker/build.sh b/docker/build.sh new file mode 100755 index 00000000..67c48bb6 --- /dev/null +++ b/docker/build.sh @@ -0,0 +1,4 @@ +#!/bin/bash + +docker build -t cider-travis . + diff --git a/docker/run.sh b/docker/run.sh new file mode 100755 index 00000000..33ff3e2f --- /dev/null +++ b/docker/run.sh @@ -0,0 +1,4 @@ +#!/bin/bash + +docker run -it --rm -v `pwd`:/home/travis/cider cider-travis bash + diff --git a/nrepl-client.el b/nrepl-client.el index 706e4719..1bed8f72 100644 --- a/nrepl-client.el +++ b/nrepl-client.el @@ -501,7 +501,7 @@ and kill the process buffer." (message "[nREPL] Connection closed unexpectedly (%s)" (substring message 0 -1))) (when (equal (process-status process) 'closed) - (when-let ((client-buffer (process-buffer process))) + (when-let* ((client-buffer (process-buffer process))) (nrepl--clear-client-sessions client-buffer) (with-current-buffer client-buffer (run-hooks 'nrepl-disconnected-hook) @@ -545,9 +545,9 @@ key-values depending on the connection type." If NO-ERROR is non-nil, show messages instead of throwing an error." (if (not (and host port)) (unless no-error - (when (not host) + (unless host (error "[nREPL] Host not provided")) - (when (not port) + (unless port (error "[nREPL] Port not provided"))) (message "[nREPL] Establishing direct connection to %s:%s ..." host port) (condition-case nil @@ -584,7 +584,7 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." (defun nrepl--ssh-tunnel-command (ssh dir port) "Command string to open SSH tunnel to the host associated with DIR's PORT." - (with-parsed-tramp-file-name dir nil + (with-parsed-tramp-file-name dir v ;; this abuses the -v option for ssh to get output when the port ;; forwarding is set up, which is used to synchronise on, so that ;; the port forwarding is up when we try to connect. @@ -592,8 +592,8 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." "%s -v -N -L %p:localhost:%p %u'%h'" `((?s . ,ssh) (?p . ,port) - (?h . ,host) - (?u . ,(if user (format "-l '%s' " user) "")))))) + (?h . ,v-host) + (?u . ,(if v-user (format "-l '%s' " v-user) "")))))) (autoload 'comint-watch-for-password-prompt "comint" "(autoload).") @@ -664,11 +664,11 @@ process." (process-put client-proc :response-q (nrepl-response-queue)) (with-current-buffer client-buf - (when-let ((server-buf (and server-proc (process-buffer server-proc)))) + (when-let* ((server-buf (and server-proc (process-buffer server-proc)))) (setq nrepl-project-dir (buffer-local-value 'nrepl-project-dir server-buf) nrepl-server-buffer server-buf)) (setq nrepl-endpoint `(,host ,port) - nrepl-tunnel-buffer (when-let ((tunnel (plist-get endpoint :tunnel))) + nrepl-tunnel-buffer (when-let* ((tunnel (plist-get endpoint :tunnel))) (process-buffer tunnel)) nrepl-pending-requests (make-hash-table :test 'equal) nrepl-completed-requests (make-hash-table :test 'equal))) @@ -732,7 +732,7 @@ CONN-BUFFER refers to a (presumably) dead connection, which we can eventually re It is safe to call this function multiple times on the same ID." ;; FIXME: This should go away eventually when we get rid of ;; pending-request hash table - (when-let ((handler (gethash id nrepl-pending-requests))) + (when-let* ((handler (gethash id nrepl-pending-requests))) (puthash id handler nrepl-completed-requests) (remhash id nrepl-pending-requests))) @@ -841,7 +841,7 @@ connection/session drift. Return the ID of the sent message. Optional argument TOOLING Set to t if desiring the tooling session rather than the standard session." (with-current-buffer connection - (when-let ((session (if tooling nrepl-tooling-session nrepl-session))) + (when-let* ((session (if tooling nrepl-tooling-session nrepl-session))) (setq request (append request `("session" ,session)))) (let* ((id (nrepl-next-request-id connection)) (request (cons 'dict (lax-plist-put request "id" id))) @@ -1044,7 +1044,7 @@ client process is started, the function is called with the client buffer." (set-marker (process-mark process) (point))) (when moving (goto-char (process-mark process)) - (when-let ((win (get-buffer-window))) + (when-let* ((win (get-buffer-window))) (set-window-point win (point)))))) ;; detect the port the server is listening on from its output (when (string-match "nREPL server started on port \\([0-9]+\\)" output) @@ -1159,7 +1159,7 @@ described by `nrepl-message-buffer-name-template'." (nrepl-log-pp-object (nrepl-decorate-msg msg type) (nrepl-log--message-color (lax-plist-get (cdr msg) "id")) t) - (when-let ((win (get-buffer-window))) + (when-let* ((win (get-buffer-window))) (set-window-point win (point-max))) (setq buffer-read-only t)))) @@ -1183,7 +1183,7 @@ This in effect enables or disables the logging of nREPL messages." "Expand the objects hidden in BUTTON's :nrepl-object property. BUTTON defaults the button at point." (interactive) - (if-let ((button (or button (button-at (point))))) + (if-let* ((button (or button (button-at (point))))) (let* ((start (overlay-start button)) (end (overlay-end button)) (obj (overlay-get button :nrepl-object)) @@ -1282,7 +1282,7 @@ it into the buffer." (let ((min-dict-fold-size 1) (min-list-fold-size 10) (min-string-fold-size 60)) - (if-let ((head (car-safe object))) + (if-let* ((head (car-safe object))) ;; list-like objects (cond ;; top level dicts (always expanded) @@ -1337,7 +1337,7 @@ The default buffer name is *nrepl-error*." (setq buffer-read-only nil) (goto-char (point-max)) (insert msg) - (when-let ((win (get-buffer-window))) + (when-let* ((win (get-buffer-window))) (set-window-point win (point-max))) (setq buffer-read-only t))) diff --git a/test/cider-tests--no-auto.el b/test/cider-tests--no-auto.el index 714e3f10..0b7db012 100644 --- a/test/cider-tests--no-auto.el +++ b/test/cider-tests--no-auto.el @@ -52,7 +52,7 @@ from the latter. Remaining content is compared for string equality." (replace-match "")) (goto-line 2) (buffer-substring (point) (point-max))))) - (cider-doc (if-let (doc-buffer (cider-doc-buffer-for sym)) + (cider-doc (if-let* ((doc-buffer (cider-doc-buffer-for sym)) (with-current-buffer doc-buffer (let ((inhibit-read-only t)) (goto-char (point-min)) @@ -85,7 +85,7 @@ from the latter. Remaining content is compared for string equality." (let ((name (cond ((symbolp sym) (symbol-name sym)) ((listp sym) (symbol-name (cadr sym)))))) (if name - (when (not (cider-test-doc name)) + (unless (cider-test-doc name) (setq diffs (cons sym diffs))) (setq untested (cons sym untested))))) (when untested diff --git a/test/nrepl-bencode-tests.el b/test/nrepl-bencode-tests.el index fc2ed9a7..827a76ed 100644 --- a/test/nrepl-bencode-tests.el +++ b/test/nrepl-bencode-tests.el @@ -28,6 +28,7 @@ ;;; Code: (require 'buttercup) +(require 'cl-lib) (require 'nrepl-client) (defun nrepl-bdecode-string (string) @@ -74,8 +75,10 @@ If object is incomplete, return a decoded path." (it "decodes queues" (expect (nrepl-bdecode "lli1ei2ei3eeli5ei6eee") :to-equal (cons - [cl-struct-queue nil nil] - [cl-struct-nrepl-response-queue (((1 2 3) (5 6))) (((1 2 3) (5 6))) nil]))) + (make-queue) + (let ((q (nrepl-response-queue))) + (queue-enqueue q '((1 2 3) (5 6))) + q)))) (it "decodes list of ints" (expect (nrepl-bdecode-string "li1ei2ei3ei4ei5ei6ei7ei8ee") @@ -164,28 +167,25 @@ If object is incomplete, return a decoded path." items, returns val and f is not called. 7:session36:6fc999d0-3795-4d51-85fc-ccca7537ee57ed2:id2:182:ns4:user7:session36:6fc999d0-3795-4d51-85fc-ccca7537ee575:value3:niled2:id2:187:session36:6fc999d0-3795-4d51-85fc-ccca7537ee576:statusl4:doneee") :to-equal (cons - [cl-struct-queue nil nil] - [cl-struct-nrepl-response-queue - ((dict "id" "18" - "out" "clojure.core/reduce\n" - "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57") - (dict "id" "18" - "out" "([f coll] [f val coll])\n" - "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57") - (dict "id" "18" - "out" " f should be a function of 2 arguments. If val is not supplied,\n returns the result of applying f to the first 2 items in coll, then\n applying f to that result and the 3rd item, etc. If coll contains no\n items, f must accept no arguments as well, and reduce returns the\n result of calling f with no arguments. If coll has only 1 item, it\n is returned and f is not called. If val is supplied, returns the\n result of applying f to val and the first item in coll, then\n applying f to that result and the 2nd item, etc. If coll contains no\n items, returns val and f is not called.\n" - "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57") - (dict "id" "18" - "ns" "user" - "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57" - "value" "nil") - (dict "id" "18" - "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57" - "status" ("done"))) - ((dict "id" "18" - "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57" - "status" ("done"))) - nil]))) + (make-queue) + (cl-reduce (lambda (q dict) (queue-enqueue q dict) q) + '((dict "id" "18" + "out" "clojure.core/reduce\n" + "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57") + (dict "id" "18" + "out" "([f coll] [f val coll])\n" + "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57") + (dict "id" "18" + "out" " f should be a function of 2 arguments. If val is not supplied,\n returns the result of applying f to the first 2 items in coll, then\n applying f to that result and the 3rd item, etc. If coll contains no\n items, f must accept no arguments as well, and reduce returns the\n result of calling f with no arguments. If coll has only 1 item, it\n is returned and f is not called. If val is supplied, returns the\n result of applying f to val and the first item in coll, then\n applying f to that result and the 2nd item, etc. If coll contains no\n items, returns val and f is not called.\n" + "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57") + (dict "id" "18" + "ns" "user" + "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57" + "value" "nil") + (dict "id" "18" + "session" "6fc999d0-3795-4d51-85fc-ccca7537ee57" + "status" ("done"))) + :initial-value (nrepl-response-queue))))) (it "decodes nrepl responses with multibyte chars" (expect (nrepl-bdecode-string @@ -214,9 +214,12 @@ If object is incomplete, return a decoded path." (it "decodes queues" (expect (nrepl-bdecode "lli1ei2ei3eeli5ei6eeelli1ei2ei3eeli5ei6") :to-equal (cons - [cl-struct-queue ("i6") ("i6")] - [cl-struct-nrepl-response-queue (((1 2 3) (5 6))) (((1 2 3) (5 6))) - ((5) ((1 2 3)))])))) + (let ((q (make-queue))) + (queue-enqueue q "i6") + q) + (let ((q (nrepl-response-queue '((5) ((1 2 3)))))) + (queue-enqueue q '((1 2 3) (5 6))) + q))))) (describe "when bencode strings are split into parts" (it "decodes dict" diff --git a/test/scripts/cider-bytecomp-warnings.el b/test/scripts/cider-bytecomp-warnings.el index ee6960ff..cdc632d9 100644 --- a/test/scripts/cider-bytecomp-warnings.el +++ b/test/scripts/cider-bytecomp-warnings.el @@ -35,6 +35,12 @@ (package-initialize) (load-file "cider-autoloads.el") (setq byte-compile-error-on-warn t) + +;; Avoid spurious unused lexical arg warning from `condition-case' +;; See: https://emacs.stackexchange.com/a/10058/10269 +(when (version< emacs-version "25.1") + (setq byte-compile--use-old-handlers nil)) + (batch-byte-compile) ;;; cider-bytecomp-warnings.el ends here diff --git a/travis-ci/install-cask.sh b/travis-ci/install-cask.sh new file mode 100755 index 00000000..fc2438b6 --- /dev/null +++ b/travis-ci/install-cask.sh @@ -0,0 +1,35 @@ +#!/bin/bash -x + +# Install cask for Travis CI +# or if already installed, then check for updates + +WORKDIR=${HOME}/local +CASKDIR=$WORKDIR/cask +SCRIPTDIR=`dirname $(readlink -f $0)` + +. $SCRIPTDIR/retry.sh + +cask_upgrade_cask_or_reset() { + cask upgrade-cask || { rm -rf $HOME/.emacs.d/.cask && false; } +} + +cask_install_or_reset() { + cask install || { rm -rf .cask && false; } +} + +# Bootstrap the cask tool and its dependencies +if [ -d $CASKDIR ] +then + travis_retry cask_upgrade_cask_or_reset +else + git clone https://github.com/cask/cask.git $CASKDIR + travis_retry cask_upgrade_cask_or_reset +fi + +# Install dependencies for cider as descriped in ./Cask +# Effect is identical to "make elpa", but here we can retry +# in the event of network failures. +if [ -f Cask ] +then + travis_retry cask_install_or_reset && touch elpa-emacs +fi diff --git a/travis-ci/install-evm.sh b/travis-ci/install-evm.sh new file mode 100755 index 00000000..ef9bb979 --- /dev/null +++ b/travis-ci/install-evm.sh @@ -0,0 +1,20 @@ +#!/bin/bash -x + +# Install evm for Travis CI +# or if already installed, then check for updates + +WORKDIR=${HOME}/local +EVMDIR=$WORKDIR/evm +SCRIPTDIR=`dirname $(readlink -f $0)` + +. $SCRIPTDIR/retry.sh + +if [ -d $EVMDIR ] +then + cd $EVMDIR + git pull origin master +else + git clone https://github.com/rejeep/evm.git $EVMDIR + evm config path /tmp + travis_retry evm install emacs-24.3-travis --use --skip +fi diff --git a/travis-ci/install-gnutls.sh b/travis-ci/install-gnutls.sh new file mode 100755 index 00000000..bd3316b4 --- /dev/null +++ b/travis-ci/install-gnutls.sh @@ -0,0 +1,51 @@ +#!/bin/bash -x + +# Setup a newer gnutls-cli on Travis CI +# We need this as long as the Travis workers are Ubuntu 14.04 +# and the TLS cert chain on elpa.gnu.org is out-of-order + +# adjust these versions as needed +export NETTLE_VERSION=3.4 +export GNUTLS_VERSION=3.5.16 + +export WORKDIR=${HOME}/local/ +export LD_LIBRARY_PATH=${WORKDIR}/lib/ +export PKG_CONFIG_PATH=${WORKDIR}/lib/pkgconfig/ + +# make sure workdir exists +if [ ! -d ${WORKDIR} ] +then + mkdir $WORKDIR +fi + +# exit if the cache is valid and up-to-date +if [ -f ${WORKDIR}/bin/gnutls-cli ] && \ + [ -f ${WORKDIR}/nettle-${NETTLE_VERSION}.tar.gz ] && \ + [ -f ${WORKDIR}/gnutls-${GNUTLS_VERSION}.tar.xz ] +then + exit 0 +fi + +# delete cache and rebuild +rm -rf $WORKDIR/bin $WORKDIR/lib $WORKDIR/share $WORKDIR/include +rm -rf $WORKDIR/nettle* $WORKDIR/gnutls* + +cd $WORKDIR +curl -O https://ftp.gnu.org/gnu/nettle/nettle-${NETTLE_VERSION}.tar.gz \ + && tar xfz nettle-${NETTLE_VERSION}.tar.gz \ + && cd nettle-${NETTLE_VERSION} \ + && ./configure --prefix=${WORKDIR} \ + && make -j4 install \ + && make distclean + +cd $WORKDIR +curl -O https://www.gnupg.org/ftp/gcrypt/gnutls/v3.5/gnutls-${GNUTLS_VERSION}.tar.xz \ + && xz -d -k gnutls-${GNUTLS_VERSION}.tar.xz \ + && tar xf gnutls-${GNUTLS_VERSION}.tar \ + && cd gnutls-${GNUTLS_VERSION} \ + && ./configure --prefix=${WORKDIR} \ + --with-included-libtasn1 \ + --with-included-unistring \ + --without-p11-kit \ + && make -j4 install \ + && make distclean diff --git a/travis-ci/prompt.sh b/travis-ci/prompt.sh new file mode 100644 index 00000000..ef95931c --- /dev/null +++ b/travis-ci/prompt.sh @@ -0,0 +1 @@ +export PS1="(\$(sed -ne 's/^.*\(emacs-.*-travis\).*$/\1/p' ~/local/evm/.config)) \w$ " diff --git a/travis-ci/retry.sh b/travis-ci/retry.sh new file mode 100644 index 00000000..7a5e2c81 --- /dev/null +++ b/travis-ci/retry.sh @@ -0,0 +1,27 @@ +# Copied retry logic from Travis CI [http://bit.ly/2jPDCtV] + +ANSI_RED="\033[31;1m" +ANSI_GREEN="\033[32;1m" +ANSI_RESET="\033[0m" +ANSI_CLEAR="\033[0K" + +travis_retry() { + local result=0 + local count=1 + while [ $count -le 3 ]; do + [ $result -ne 0 ] && { + echo -e "\n${ANSI_RED}The command \"$@\" failed. Retrying, $count of 3.${ANSI_RESET}\n" >&2 + } + "$@" + result=$? + [ $result -eq 0 ] && break + count=$(($count + 1)) + sleep 1 + done + + [ $count -gt 3 ] && { + echo -e "\n${ANSI_RED}The command \"$@\" failed 3 times.${ANSI_RESET}\n" >&2 + } + + return $result +} |