From a419b697321a215c2c998b6b57b62fe2481e56bf Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Thu, 23 Nov 2023 19:13:06 +0100 Subject: [PATCH] update cider Signed-off-by: Andreas Gerler --- elpa/cider-20220417.951/cider-browse-ns.el | 233 --- .../cider-apropos.el | 2 +- .../cider-autoloads.el | 38 +- elpa/cider-20230707.640/cider-browse-ns.el | 550 +++++++ .../cider-browse-spec.el | 124 +- .../cider-cheatsheet.el | 2 +- .../cider-classpath.el | 2 +- .../cider-client.el | 137 +- .../cider-clojuredocs.el | 13 +- .../cider-common.el | 7 +- .../cider-completion.el | 17 +- .../cider-connection.el | 276 +++- .../cider-debug.el | 45 +- .../cider-doc.el | 2 +- .../cider-eldoc.el | 62 +- .../cider-eval.el | 307 +++- .../cider-find.el | 4 +- .../cider-format.el | 7 +- .../cider-inspector.el | 49 +- .../cider-jar.el | 0 elpa/cider-20230707.640/cider-log.el | 1428 +++++++++++++++++ .../cider-macroexpansion.el | 10 +- .../cider-mode.el | 36 +- .../cider-ns.el | 16 +- .../cider-overlays.el | 10 +- .../cider-pkg.el | 11 +- .../cider-popup.el | 4 +- .../cider-profile.el | 2 +- .../cider-repl-history.el | 5 +- .../cider-repl.el | 69 +- .../cider-resolve.el | 2 +- .../cider-scratch.el | 2 +- .../cider-selector.el | 2 +- .../cider-stacktrace.el | 103 +- .../cider-test.el | 26 +- .../cider-tracing.el | 6 +- .../cider-util.el | 17 +- .../cider-xref.el | 2 +- .../cider.el | 575 +++++-- .../nrepl-client.el | 179 ++- .../nrepl-dict.el | 14 +- 41 files changed, 3566 insertions(+), 830 deletions(-) delete mode 100644 elpa/cider-20220417.951/cider-browse-ns.el rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-apropos.el (99%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-autoloads.el (94%) create mode 100644 elpa/cider-20230707.640/cider-browse-ns.el rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-browse-spec.el (77%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-cheatsheet.el (99%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-classpath.el (98%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-client.el (88%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-clojuredocs.el (95%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-common.el (98%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-completion.el (91%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-connection.el (78%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-debug.el (96%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-doc.el (99%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-eldoc.el (91%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-eval.el (85%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-find.el (98%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-format.el (96%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-inspector.el (92%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-jar.el (100%) create mode 100644 elpa/cider-20230707.640/cider-log.el rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-macroexpansion.el (96%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-mode.el (98%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-ns.el (95%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-overlays.el (96%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-pkg.el (70%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-popup.el (97%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-profile.el (99%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-repl-history.el (99%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-repl.el (96%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-resolve.el (98%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-scratch.el (98%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-selector.el (99%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-stacktrace.el (90%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-test.el (98%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-tracing.el (95%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-util.el (98%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider-xref.el (99%) rename elpa/{cider-20220417.951 => cider-20230707.640}/cider.el (76%) rename elpa/{cider-20220417.951 => cider-20230707.640}/nrepl-client.el (90%) rename elpa/{cider-20220417.951 => cider-20230707.640}/nrepl-dict.el (93%) diff --git a/elpa/cider-20220417.951/cider-browse-ns.el b/elpa/cider-20220417.951/cider-browse-ns.el deleted file mode 100644 index 8c864cc8..00000000 --- a/elpa/cider-20220417.951/cider-browse-ns.el +++ /dev/null @@ -1,233 +0,0 @@ -;;; cider-browse-ns.el --- CIDER namespace browser -*- lexical-binding: t; -*- - -;; Copyright © 2014-2022 John Andrews, Bozhidar Batsov and CIDER contributors - -;; Author: John Andrews - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; M-x cider-browse-ns -;; -;; Display a list of all vars in a namespace. -;; Pressing will take you to the cider-doc buffer for that var. -;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode'). - -;; M-x cider-browse-ns-all -;; -;; Explore Clojure namespaces by browsing a list of all namespaces. -;; Pressing expands into a list of that namespace's vars as if by -;; executing the command (cider-browse-ns "my.ns"). - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-util) -(require 'nrepl-dict) - -(require 'subr-x) -(require 'easymenu) -(require 'thingatpt) - -(defconst cider-browse-ns-buffer "*cider-ns-browser*") - -(defvar-local cider-browse-ns-current-ns nil) - -;; Mode Definition - -(defvar cider-browse-ns-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map "d" #'cider-browse-ns-doc-at-point) - (define-key map "s" #'cider-browse-ns-find-at-point) - (define-key map (kbd "RET") #'cider-browse-ns-operate-at-point) - (define-key map "^" #'cider-browse-ns-all) - (define-key map "n" #'next-line) - (define-key map "p" #'previous-line) - (easy-menu-define cider-browse-ns-mode-menu map - "Menu for CIDER's namespace browser" - '("Namespace Browser" - ["Show doc" cider-browse-ns-doc-at-point] - ["Go to definition" cider-browse-ns-find-at-point] - "--" - ["Browse all namespaces" cider-browse-ns-all])) - map)) - -(defvar cider-browse-ns-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'cider-browse-ns-handle-mouse) - map)) - -(define-derived-mode cider-browse-ns-mode special-mode "browse-ns" - "Major mode for browsing Clojure namespaces. - -\\{cider-browse-ns-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local cider-browse-ns-current-ns nil)) - -(defun cider-browse-ns--text-face (var-meta) - "Return font-lock-face for a var. -VAR-META contains the metadata information used to decide a face. -Presence of \"arglists\" and \"macro\" indicates a macro form. -Only \"arglists\" indicates a function. Otherwise, its a variable. -If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn." - (cond - ((not var-meta) 'font-lock-function-name-face) - ((and (nrepl-dict-contains var-meta "arglists") - (string= (nrepl-dict-get var-meta "macro") "true")) - 'font-lock-keyword-face) - ((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face) - (t 'font-lock-variable-name-face))) - -(defun cider-browse-ns--properties (var var-meta) - "Decorate VAR with a clickable keymap and a face. -VAR-META is used to decide a font-lock face." - (let ((face (cider-browse-ns--text-face var-meta))) - (propertize var - 'font-lock-face face - 'mouse-face 'highlight - 'keymap cider-browse-ns-mouse-map))) - -(defun cider-browse-ns--list (buffer title items &optional ns noerase) - "Reset contents of BUFFER. -Display TITLE at the top and ITEMS are indented underneath. -If NS is non-nil, it is added to each item as the -`cider-browse-ns-current-ns' text property. If NOERASE is non-nil, the -contents of the buffer are not reset before inserting TITLE and ITEMS." - (with-current-buffer buffer - (cider-browse-ns-mode) - (let ((inhibit-read-only t)) - (unless noerase (erase-buffer)) - (goto-char (point-max)) - (insert (cider-propertize title 'ns) "\n") - (dolist (item items) - (insert (propertize (concat " " item "\n") - 'cider-browse-ns-current-ns ns))) - (goto-char (point-min))))) - -(defun cider-browse-ns--first-doc-line (doc) - "Return the first line of the given DOC string. -If the first line of the DOC string contains multiple sentences, only -the first sentence is returned. If the DOC string is nil, a Not documented -string is returned." - (if doc - (let* ((split-newline (split-string doc "\n")) - (first-line (car split-newline))) - (cond - ((string-match "\\. " first-line) (substring first-line 0 (match-end 0))) - ((= 1 (length split-newline)) first-line) - (t (concat first-line "...")))) - "Not documented.")) - -(defun cider-browse-ns--items (namespace) - "Return the items to show in the namespace browser of the given NAMESPACE. -Each item consists of a ns-var and the first line of its docstring." - (let* ((ns-vars-with-meta (cider-sync-request:ns-vars-with-meta namespace)) - (propertized-ns-vars (nrepl-dict-map #'cider-browse-ns--properties ns-vars-with-meta))) - (mapcar (lambda (ns-var) - (let* ((doc (nrepl-dict-get-in ns-vars-with-meta (list ns-var "doc"))) - ;; to avoid (read nil) - ;; it prompts the user for a Lisp expression - (doc (when doc (read doc))) - (first-doc-line (cider-browse-ns--first-doc-line doc))) - (concat ns-var " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face)))) - propertized-ns-vars))) - -;; Interactive Functions - -;;;###autoload -(defun cider-browse-ns (namespace) - "List all NAMESPACE's vars in BUFFER." - (interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list)))) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) - (cider-browse-ns--list (current-buffer) - namespace - (cider-browse-ns--items namespace)) - (setq-local cider-browse-ns-current-ns namespace))) - -;;;###autoload -(defun cider-browse-ns-all () - "List all loaded namespaces in BUFFER." - (interactive) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) - (let ((names (cider-sync-request:ns-list))) - (cider-browse-ns--list (current-buffer) - "All loaded namespaces" - (mapcar (lambda (name) - (cider-browse-ns--properties name nil)) - names)) - (setq-local cider-browse-ns-current-ns nil)))) - -(defun cider-browse-ns--thing-at-point () - "Get the thing at point. -Return a list of the type ('ns or 'var) and the value." - (let ((line (car (split-string (string-trim (thing-at-point 'line)) " ")))) - (if (string-match "\\." line) - `(ns ,line) - `(var ,(format "%s/%s" - (or (get-text-property (point) 'cider-browse-ns-current-ns) - cider-browse-ns-current-ns) - line))))) - -(declare-function cider-doc-lookup "cider-doc") - -(defun cider-browse-ns-doc-at-point () - "Show the documentation for the thing at current point." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (value (cadr thing))) - ;; value is either some ns or a var - (cider-doc-lookup value))) - -(defun cider-browse-ns-operate-at-point () - "Expand browser according to thing at current point. -If the thing at point is a ns it will be browsed, -and if the thing at point is some var - its documentation will -be displayed." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (type (car thing)) - (value (cadr thing))) - (if (eq type 'ns) - (cider-browse-ns value) - (cider-doc-lookup value)))) - -(declare-function cider-find-ns "cider-find") -(declare-function cider-find-var "cider-find") - -(defun cider-browse-ns-find-at-point () - "Find the definition of the thing at point." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (type (car thing)) - (value (cadr thing))) - (if (eq type 'ns) - (cider-find-ns nil value) - (cider-find-var current-prefix-arg value)))) - -(defun cider-browse-ns-handle-mouse (_event) - "Handle mouse click EVENT." - (interactive "e") - (cider-browse-ns-operate-at-point)) - -(provide 'cider-browse-ns) - -;;; cider-browse-ns.el ends here diff --git a/elpa/cider-20220417.951/cider-apropos.el b/elpa/cider-20230707.640/cider-apropos.el similarity index 99% rename from elpa/cider-20220417.951/cider-apropos.el rename to elpa/cider-20230707.640/cider-apropos.el index 053da66a..5cadc3de 100644 --- a/elpa/cider-20220417.951/cider-apropos.el +++ b/elpa/cider-20230707.640/cider-apropos.el @@ -1,6 +1,6 @@ ;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- -;; Copyright © 2014-2022 Jeff Valk, Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2023 Jeff Valk, Bozhidar Batsov and CIDER contributors ;; ;; Author: Jeff Valk diff --git a/elpa/cider-20220417.951/cider-autoloads.el b/elpa/cider-20230707.640/cider-autoloads.el similarity index 94% rename from elpa/cider-20220417.951/cider-autoloads.el rename to elpa/cider-20230707.640/cider-autoloads.el index 8972845d..e418fe65 100644 --- a/elpa/cider-20220417.951/cider-autoloads.el +++ b/elpa/cider-20230707.640/cider-autoloads.el @@ -88,6 +88,28 @@ Start a connection of any type interactively." t nil) (defalias 'cider-connect #'cider-connect-clj) +(autoload 'cider-jack-in-universal "cider" "\ +Start and connect to an nREPL server for the current project or ARG project id. + +If a project is found in current dir, call `cider-jack-in' passing ARG as +first parameter, of which see. Otherwise, ask user which project type to +start an nREPL server and connect to without a project. + +But if invoked with a numeric prefix ARG, then start an nREPL server for +the project type denoted by ARG number and connect to it, even if there is +no project for it in the current dir. + +The supported project tools and their assigned numeric prefix ids are +sourced from `cider-jack-in-universal-options', of which see. + +You can pass a numeric prefix argument n with `M-n` or `C-u n`. + +For example, to jack in to leiningen which is assigned to prefix arg 2 type + +M-2 \\[cider-jack-in-universal]. + +\(fn ARG)" t nil) + (with-eval-after-load 'clojure-mode (define-key clojure-mode-map (kbd "C-c M-x") #'cider) (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) (require 'sesman) (sesman-install-menu clojure-mode-map) (add-hook 'clojure-mode-hook (lambda nil (setq-local sesman-system 'CIDER)))) (register-definition-prefixes "cider" '("cider-")) @@ -309,7 +331,7 @@ Find and display variable or resource at mouse EVENT. (autoload 'cider-find-dwim "cider-find" "\ Find and display the SYMBOL-FILE at point. SYMBOL-FILE could be a var or a resource. If thing at point is empty then -show dired on project. If var is not found, try to jump to resource of the +show Dired on project. If var is not found, try to jump to resource of the same name. When called interactively, a prompt is given according to the variable `cider-prompt-for-symbol'. A single or double prefix argument inverts the meaning. A prefix of `-' or a double prefix argument causes @@ -422,6 +444,18 @@ current buffer's namespace. (register-definition-prefixes "cider-jar" '("cider-jar-")) +;;;*** + +;;;### (autoloads nil "cider-log" "cider-log.el" (0 0 0 0)) +;;; Generated autoloads from cider-log.el + (autoload 'cider-log-framework "cider-log" "Show the Cider log framework menu." t) + (autoload 'cider-log-appender "cider-log" "Show the Cider log appender menu." t) + (autoload 'cider-log-consumer "cider-log" "Show the Cider log consumer menu." t) + (autoload 'cider-log-event "cider-log" "Show the Cider log event menu." t) + (autoload 'cider-log "cider-log" "Show the Cider log menu." t) + +(register-definition-prefixes "cider-log" '("cider-")) + ;;;*** ;;;### (autoloads nil "cider-macroexpansion" "cider-macroexpansion.el" @@ -757,7 +791,7 @@ Displays the function dependencies for NS and SYMBOL using completing read. ;;;### (autoloads nil "nrepl-client" "nrepl-client.el" (0 0 0 0)) ;;; Generated autoloads from nrepl-client.el -(register-definition-prefixes "nrepl-client" '("cider-enlighten-mode" "emacs-bug-46284/when-27.1-windows-nt" "nrepl-")) +(register-definition-prefixes "nrepl-client" '("cider-" "emacs-bug-46284/when-27.1-windows-nt" "nrepl-")) ;;;*** diff --git a/elpa/cider-20230707.640/cider-browse-ns.el b/elpa/cider-20230707.640/cider-browse-ns.el new file mode 100644 index 00000000..88811fdb --- /dev/null +++ b/elpa/cider-20230707.640/cider-browse-ns.el @@ -0,0 +1,550 @@ +;;; cider-browse-ns.el --- CIDER namespace browser -*- lexical-binding: t; -*- + +;; Copyright © 2014-2023 John Andrews, Bozhidar Batsov and CIDER contributors + +;; Author: John Andrews + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; M-x cider-browse-ns +;; +;; Display a list of all vars in a namespace. +;; Pressing will take you to the cider-doc buffer for that var. +;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode'). + +;; M-x cider-browse-ns-all +;; +;; Explore Clojure namespaces by browsing a list of all namespaces. +;; Pressing expands into a list of that namespace's vars as if by +;; executing the command (cider-browse-ns "my.ns"). + +;;; Code: + +(require 'cider-client) +(require 'cider-popup) +(require 'cider-util) +(require 'nrepl-dict) + +(require 'subr-x) +(require 'easymenu) +(require 'button) +(require 'cl-lib) +(require 'thingatpt) + + +(defgroup cider-browse-ns nil + "Display contents of namespaces for CIDER." + :prefix "cider-browse-ns-" + :group 'cider) + +(defface cider-browse-ns-extra-info-face + '((t (:inherit shadow))) + "Face for displaying extra info of namespace vars." + :package-version '(cider . "1.4.0")) + +(defcustom cider-browse-ns-default-filters nil + "List of default hide filters to apply to browse-ns buffer. + +Available options include `private', `test', `macro', `function', and +`var'." + :type 'list + :package-version '(cider . "1.4.0")) + +(defconst cider-browse-ns-buffer "*cider-ns-browser*") + +(defvar-local cider-browse-ns-current-ns nil) + +(defvar-local cider-browse-ns-filters nil) +(defvar-local cider-browse-ns-show-all nil) +(defvar-local cider-browse-ns-group-by nil) +(defvar-local cider-browse-ns-items nil) +(defvar-local cider-browse-ns-title nil) +(defvar-local cider-browse-ns-group-by nil) + + +;; Mode Definition + +(defvar cider-browse-ns-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map cider-popup-buffer-mode-map) + (define-key map "d" #'cider-browse-ns-doc-at-point) + (define-key map "s" #'cider-browse-ns-find-at-point) + (define-key map (kbd "RET") #'cider-browse-ns-operate-at-point) + (define-key map "^" #'cider-browse-ns-all) + (define-key map "n" #'next-line) + (define-key map "p" #'previous-line) + + (define-key map "a" #'cider-browse-ns-toggle-all) + + (define-key map (kbd "h p") #'cider-browse-ns-toggle-hide-private) + (define-key map (kbd "h t") #'cider-browse-ns-toggle-hide-test) + (define-key map (kbd "h m") #'cider-browse-ns-toggle-hide-macro) + (define-key map (kbd "h f") #'cider-browse-ns-toggle-hide-function) + (define-key map (kbd "h v") #'cider-browse-ns-toggle-hide-var) + + (define-key map (kbd "g t") #'cider-browse-ns-group-by-type) + (define-key map (kbd "g v") #'cider-browse-ns-group-by-visibility) + + (easy-menu-define cider-browse-ns-mode-menu map + "Menu for CIDER's namespace browser" + '("Namespace Browser" + ["Show doc" cider-browse-ns-doc-at-point] + ["Go to definition" cider-browse-ns-find-at-point] + "--" + ["Browse all namespaces" cider-browse-ns-all])) + map)) + +(defvar cider-browse-ns-mouse-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] #'cider-browse-ns-handle-mouse) + map)) + +(define-derived-mode cider-browse-ns-mode special-mode "browse-ns" + "Major mode for browsing Clojure namespaces. + +\\{cider-browse-ns-mode-map}" + (setq-local electric-indent-chars nil) + (setq-local sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (setq-local truncate-lines t)) + (setq-local cider-browse-ns-current-ns nil)) + +(defun cider-browse-ns--text-face (var-meta) + "Return font-lock-face for a var. +VAR-META contains the metadata information used to decide a face. +Presence of \"arglists\" and \"macro\" indicates a macro form. +Only \"arglists\" indicates a function. Otherwise, its a variable. +If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn." + (cond + ((not var-meta) 'font-lock-function-name-face) + ((and (nrepl-dict-contains var-meta "arglists") + (string= (nrepl-dict-get var-meta "macro") "true")) + 'font-lock-keyword-face) + ((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face) + (t 'font-lock-variable-name-face))) + +(defun cider-browse-ns--properties (var var-meta) + "Decorate VAR with a clickable keymap and a face. +VAR-META is used to decide a font-lock face." + (let ((face (cider-browse-ns--text-face var-meta))) + (propertize var + 'font-lock-face face + 'mouse-face 'highlight + 'keymap cider-browse-ns-mouse-map))) + +(defun cider-browse-ns--ns-list (buffer title nss) + "List the namespaces NSS in BUFFER. + +Buffer is rendered with TITLE at the top and lists ITEMS filtered according +to user settings." + (let ((dict (nrepl-dict))) + (dolist (ns nss) + (nrepl-dict-put dict ns (nrepl-dict "ns" "true"))) + (cider-browse-ns--list buffer title dict nil))) + +(defun cider-browse-ns--list (buffer title items ns) + "Initialize rendering of browse-ns BUFFER. + +Initialize the buffer's TITLE, namespace NS, and the nrepl-dict ITEMS to be +displayed." + (with-current-buffer buffer + (cider-browse-ns-mode) + (setq-local cider-browse-ns-items items) + (setq-local cider-browse-ns-title title) + (setq-local cider-browse-ns-filters cider-browse-ns-default-filters) + (setq-local cider-browse-ns-current-ns ns)) + (cider-browse-ns--render-buffer)) + +(defun cider-browse-ns--meta-macro-p (var-meta) + "Return non-nil if VAR-META is the metadata of a macro." + (and (nrepl-dict-contains var-meta "arglists") + (string= (nrepl-dict-get var-meta "macro") "true"))) + +(defun cider-browse-ns--meta-test-p (var-meta) + "Return non-nil if VAR-META is the metadata of a test." + (nrepl-dict-contains var-meta "test")) + +(defun cider-browse-ns--meta-function-p (var-meta) + "Return non-nil if VAR-META is the metadata of a function." + (and (nrepl-dict-contains var-meta "arglists") + (not (cider-browse-ns--meta-macro-p var-meta)))) + +(defun cider-browse-ns--meta-private-p (var-meta) + "Return non-nil if VAR-META indicates a private element." + (string= (nrepl-dict-get var-meta "private") "true")) + +(defun cider-browse-ns--meta-var-p (var-meta) + "Return non-nil if VAR-META indicates a var." + (not (or (cider-browse-ns--meta-test-p var-meta) + (cider-browse-ns--meta-macro-p var-meta) + (cider-browse-ns--meta-function-p var-meta)))) + +(defun cider-browse-ns--item-filter (_ var-meta) + "Return non-nil if item containing VAR-META should be listed in buffer." + (let ((function-filter-p (memq 'function cider-browse-ns-filters)) + (var-filter-p (memq 'var cider-browse-ns-filters)) + (private-filter-p (memq 'private cider-browse-ns-filters)) + (test-filter-p (memq 'test cider-browse-ns-filters)) + (macro-filter-p (memq 'macro cider-browse-ns-filters))) + ;; check if item should be displayed + (let* ((macro-p (cider-browse-ns--meta-macro-p var-meta)) + (function-p (cider-browse-ns--meta-function-p var-meta)) + (private-p (cider-browse-ns--meta-private-p var-meta)) + (test-p (cider-browse-ns--meta-test-p var-meta)) + (var-p (cider-browse-ns--meta-var-p var-meta))) + (or cider-browse-ns-show-all + (not (or (and macro-p macro-filter-p) + (and function-p function-filter-p) + (and test-p test-filter-p) + (and var-p var-filter-p) + (and private-p private-filter-p))))))) + +(defun cider-browse-ns--propertized-item (key items) + "Return propertized line of item KEY in nrepl-dict ITEMS." + (let* ((var-meta (nrepl-dict-get items key)) + (face (cider-browse-ns--text-face (nrepl-dict-get items key))) + (private-p (string= (nrepl-dict-get var-meta "private") "true")) + (test-p (nrepl-dict-contains var-meta "test")) + (ns-p (nrepl-dict-contains var-meta "ns"))) + (concat + (propertize key + 'font-lock-face face + 'ns ns-p) + " " + (cond + (test-p (propertize "(test) " 'face 'cider-browse-ns-extra-info-face)) + (private-p (propertize "(-) " 'face 'cider-browse-ns-extra-info-face)) + (t ""))))) + +(defun cider-browse-ns--display-list (keys items max-length &optional label) + "Render the items of KEYS as condained in the nrepl-dict ITEMS. + +Pad the row to be MAX-LENGTH+1. If LABEL is non-nil, add a header to the +list of items." + (when keys + (when label + (insert " " label ":\n")) + (dolist (key keys) + (let* ((doc (nrepl-dict-get-in items (list key "doc"))) + (doc (when doc (read doc))) + (first-doc-line (cider-browse-ns--first-doc-line doc)) + (item-line (cider-browse-ns--propertized-item key items))) + (insert " ") + (insert item-line) + (when cider-browse-ns-current-ns + (insert (make-string (+ (- max-length (string-width item-line)) 1) ?·)) + (insert " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face))) + (insert "\n"))) + (insert "\n"))) + +(defun cider-browse-ns--column-width (items) + "Determine the display width of displayed ITEMS." + (let* ((propertized-lines + (seq-map (lambda (key) + (cider-browse-ns--propertized-item key items)) + (nrepl-dict-keys items)))) + (if propertized-lines + (apply #'max (seq-map (lambda (entry) (string-width entry)) + propertized-lines)) + 0))) + +(defun cider-browse-ns--render-items (items) + "Render the nrepl-dict ITEMS to the browse-ns buffer." + (let* ((max-length (cider-browse-ns--column-width items))) + (cl-labels + ((keys-from-pred + (pred items) + (nrepl-dict-keys (nrepl-dict-filter (lambda (_ var-meta) + (funcall pred var-meta)) + items)))) + (cond + ((eql cider-browse-ns-group-by 'type) + (let* ((func-keys (keys-from-pred #'cider-browse-ns--meta-function-p items)) + (macro-keys (keys-from-pred #'cider-browse-ns--meta-macro-p items)) + (var-keys (keys-from-pred #'cider-browse-ns--meta-var-p items)) + (test-keys (keys-from-pred #'cider-browse-ns--meta-test-p items))) + (cider-browse-ns--display-list func-keys items max-length "Functions") + (cider-browse-ns--display-list macro-keys items max-length "Macros") + (cider-browse-ns--display-list var-keys items max-length "Vars") + (cider-browse-ns--display-list test-keys items max-length "Tests"))) + ((eql cider-browse-ns-group-by 'visibility) + (let* ((public-keys + (keys-from-pred + (lambda (var-meta) + (not (cider-browse-ns--meta-private-p var-meta))) + items)) + (private-keys (keys-from-pred #'cider-browse-ns--meta-private-p items))) + (cider-browse-ns--display-list public-keys items max-length "Public") + (cider-browse-ns--display-list private-keys items max-length "Private"))) + (t + (cider-browse-ns--display-list + (nrepl-dict-keys items) items max-length)))))) + +(defun cider-browse-ns--filter (flag) + "Toggle the filter indicated by FLAG and re-render the buffer." + (setq cider-browse-ns-filters + (if (memq flag cider-browse-ns-filters) + (remq flag cider-browse-ns-filters) + (cons flag cider-browse-ns-filters))) + (cider-browse-ns--render-buffer)) + +(defun cider-browse-ns--button-filter (button) + "Handle filter action for BUTTON." + (let ((flag (button-get button 'filter))) + (cider-browse-ns--filter flag))) + +(defun cider-browse-ns--group (flag) + "Set the group-by option to FLAG and re-renderthe buffer." + (setq cider-browse-ns-group-by + (if (eql flag cider-browse-ns-group-by) nil flag)) + (cider-browse-ns--render-buffer)) + +(defun cider-browse-ns--button-group (button) + "Handle grouping action for BUTTON." + (let ((flag (button-get button 'group-by))) + (cider-browse-ns--group flag))) + +(defun cider-browse-ns--toggle-all (_button) + "Toggle the display-all visibility setting." + (setq cider-browse-ns-show-all (not cider-browse-ns-show-all)) + (cider-browse-ns--render-buffer)) + +(defun cider-browse-ns--render-header (&optional filtered-items-ct) + "Render the section at the top of the buffer displaying visibility controls. + +If FILTERED-ITEMS-CT is non-nil, then display a message of how many items +are being filtered." + ;; Display Show line + (insert " Show: ") + (insert-text-button "All" + 'follow-link t + 'action #'cider-browse-ns--toggle-all + ;; 'help-echo (cider-stacktrace-tooltip) + 'face (if cider-browse-ns-show-all + 'cider-stacktrace-filter-active-face + nil)) + (insert "\n") + ;; Display Filters + (let ((filters '(("Private" private) + ("Test" test) + ("Macro" macro) + ("Function" function) + ("Var" var)))) + (insert " Hide: ") + (dolist (filter filters) + (seq-let (title key) filter + (let ((is-active (memq key cider-browse-ns-filters))) + (insert-text-button title + 'filter key + 'follow-link t + 'action #'cider-browse-ns--button-filter + ;; 'help-echo (cider-stacktrace-tooltip) + 'face (if (and is-active (not cider-browse-ns-show-all)) + 'cider-stacktrace-filter-active-face + nil)) + (insert " ")))) + (when filtered-items-ct + (insert (format "(%d items filtered)" filtered-items-ct)))) + (insert "\n") + ;; Groupings + (insert " Group-by: ") + (let ((groupings '(("Type" type) + ("Visibility" visibility)))) + (dolist (grouping groupings) + (seq-let (title key) grouping + (let ((is-active (eql key cider-browse-ns-group-by))) + (insert-text-button title + 'group-by key + 'follow-link t + 'action #'cider-browse-ns--button-group + ;; 'help-echo () + 'face (if is-active + 'cider-stacktrace-filter-active-face + nil))) + (insert " ")))) + (insert "\n\n")) + +(defun cider-browse-ns--render-buffer (&optional buffer) + "Render the sections of the browse-ns buffer. + +Render occurs in BUFFER if non-nil. This function is the main entrypoint +for redisplaying the buffer when filters change." + (with-current-buffer (or buffer (current-buffer)) + (let* ((inhibit-read-only t) + (point (point)) + (filtered-items (nrepl-dict-filter #'cider-browse-ns--item-filter + cider-browse-ns-items)) + (filtered-item-ct (- (length (nrepl-dict-keys cider-browse-ns-items)) + (length (nrepl-dict-keys filtered-items))))) + (erase-buffer) + (insert (propertize (cider-propertize cider-browse-ns-title 'ns) 'ns t) "\n") + (when cider-browse-ns-current-ns + (cider-browse-ns--render-header filtered-item-ct)) + (cider-browse-ns--render-items filtered-items) + (goto-char point)))) + +(defun cider-browse-ns--first-doc-line (doc) + "Return the first line of the given DOC string. +If the first line of the DOC string contains multiple sentences, only +the first sentence is returned. If the DOC string is nil, a Not documented +string is returned." + (if doc + (let* ((split-newline (split-string doc "\n")) + (first-line (car split-newline))) + (cond + ((string-match "\\. " first-line) (substring first-line 0 (match-end 0))) + ((= 1 (length split-newline)) first-line) + (t (concat first-line "...")))) + "Not documented.")) + +(defun cider-browse-ns--combined-vars-with-meta (namespace) + "Return the combined public and private vars in NAMESPACE. + +Private vars have the additional metadata \"private\": \"true\" in their +var-meta map." + (let ((items (cider-sync-request:ns-vars-with-meta namespace)) + (private-items (cider-sync-request:private-ns-vars-with-meta namespace))) + (when private-items + (dolist (key (nrepl-dict-keys private-items)) + (let ((var-meta (nrepl-dict-put (nrepl-dict-get private-items key) + "private" "true"))) + (setq items (nrepl-dict-put items key var-meta))))) + items)) + +;; Interactive Functions + +;;;###autoload +(defun cider-browse-ns (namespace) + "List all NAMESPACE's vars in BUFFER." + (interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list)))) + (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) + (cider-browse-ns--list (current-buffer) + namespace + (cider-browse-ns--combined-vars-with-meta namespace) + namespace))) + +;;;###autoload +(defun cider-browse-ns-all () + "List all loaded namespaces in BUFFER." + (interactive) + (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) + (let ((names (cider-sync-request:ns-list))) + (cider-browse-ns--ns-list + (current-buffer) + "All loaded namespaces" + (mapcar (lambda (name) + (cider-browse-ns--properties name nil)) + names))))) + +(defun cider-browse-ns--thing-at-point () + "Get the thing at point. +Return a list of the type ('ns or 'var) and the value." + (let ((ns-p (get-text-property (point) 'ns)) + (line (car (split-string (string-trim (thing-at-point 'line)) " ")))) + (if (or ns-p (string-match "\\." line)) + `(ns ,line) + `(var ,(format "%s/%s" + (or (get-text-property (point) 'cider-browse-ns-current-ns) + cider-browse-ns-current-ns) + line))))) + +(defun cider-browse-ns-toggle-all () + "Toggle showing all of the items in the browse-ns buffer." + (interactive) + (cider-browse-ns--toggle-all nil)) + +(defun cider-browse-ns-toggle-hide-private () + "Toggle visibility of private items displayed in browse-ns buffer." + (interactive) + (cider-browse-ns--filter 'private)) + +(defun cider-browse-ns-toggle-hide-test () + "Toggle visibility of test items displayed in browse-ns buffer." + (interactive) + (cider-browse-ns--filter 'test)) + +(defun cider-browse-ns-toggle-hide-macro () + "Toggle visibility of macro items displayed in browse-ns buffer." + (interactive) + (cider-browse-ns--filter 'macro)) + +(defun cider-browse-ns-toggle-hide-function () + "Toggle visibility of function items displayed in browse-ns buffer." + (interactive) + (cider-browse-ns--filter 'function)) + +(defun cider-browse-ns-toggle-hide-var () + "Toggle visibility of var items displayed in browse-ns buffer." + (interactive) + (cider-browse-ns--filter 'var)) + +(defun cider-browse-ns-group-by-type () + "Toggle visibility of var items displayed in browse-ns buffer." + (interactive) + (cider-browse-ns--group 'type)) + +(defun cider-browse-ns-group-by-visibility () + "Toggle visibility of var items displayed in browse-ns buffer." + (interactive) + (cider-browse-ns--group 'visibility)) + + +(declare-function cider-doc-lookup "cider-doc") + +(defun cider-browse-ns-doc-at-point () + "Show the documentation for the thing at current point." + (interactive) + (let* ((thing (cider-browse-ns--thing-at-point)) + (value (cadr thing))) + ;; value is either some ns or a var + (cider-doc-lookup value))) + +(defun cider-browse-ns-operate-at-point () + "Expand browser according to thing at current point. +If the thing at point is a ns it will be browsed, +and if the thing at point is some var - its documentation will +be displayed." + (interactive) + (let* ((thing (cider-browse-ns--thing-at-point)) + (type (car thing)) + (value (cadr thing))) + (if (eq type 'ns) + (cider-browse-ns value) + (cider-doc-lookup value)))) + +(declare-function cider-find-ns "cider-find") +(declare-function cider-find-var "cider-find") + +(defun cider-browse-ns-find-at-point () + "Find the definition of the thing at point." + (interactive) + (let* ((thing (cider-browse-ns--thing-at-point)) + (type (car thing)) + (value (cadr thing))) + (if (eq type 'ns) + (cider-find-ns nil value) + (cider-find-var current-prefix-arg value)))) + +(defun cider-browse-ns-handle-mouse (_event) + "Handle mouse click EVENT." + (interactive "e") + (cider-browse-ns-operate-at-point)) + +(provide 'cider-browse-ns) + +;;; cider-browse-ns.el ends here diff --git a/elpa/cider-20220417.951/cider-browse-spec.el b/elpa/cider-20230707.640/cider-browse-spec.el similarity index 77% rename from elpa/cider-20220417.951/cider-browse-spec.el rename to elpa/cider-20230707.640/cider-browse-spec.el index 211f93dc..0ccf2390 100644 --- a/elpa/cider-20220417.951/cider-browse-spec.el +++ b/elpa/cider-20230707.640/cider-browse-spec.el @@ -1,6 +1,6 @@ ;;; cider-browse-spec.el --- CIDER spec browser -*- lexical-binding: t; -*- -;; Copyright © 2017-2022 Juan Monetta, Bozhidar Batsov and CIDER contributors +;; Copyright © 2017-2023 Juan Monetta, Bozhidar Batsov and CIDER contributors ;; Author: Juan Monetta @@ -129,7 +129,8 @@ Display TITLE at the top and SPECS are indented underneath." (insert (cider-propertize title 'emph) "\n") (dolist (spec-name specs) (insert (propertize " " 'spec-name spec-name)) - (thread-first (cider-font-lock-as-clojure spec-name) + (thread-first + (cider-font-lock-as-clojure spec-name) (insert-text-button 'type 'cider-browse-spec--spec) (button-put 'spec-name spec-name)) (insert (propertize "\n" 'spec-name spec-name))) @@ -141,21 +142,95 @@ Display TITLE at the top and SPECS are indented underneath." (defun cider--spec-fn-p (value fn-name) "Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME." - (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\)/" fn-name "$") value)) + (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\|clojure.alpha.spec\\)/" fn-name "$") value)) + +(defun cider-browse-spec--render-schema-map (spec-form) + "Render the s/schema map declaration SPEC-FORM." + (let ((name-spec-pairs (seq-partition (cdaadr spec-form) 2))) + (format "(s/schema\n {%s})" + (string-join + (thread-last + (seq-sort-by #'car #'string< name-spec-pairs) + (mapcar (lambda (s) (concat (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) + "\n ")))) + +(defun cider-browse-spec--render-schema-vector (spec-form) + "Render the s/schema vector declaration SPEC-FORM." + (format "(s/schema\n [%s])" + (string-join + (thread-last + (cl-second spec-form) + (mapcar (lambda (s) (cider-browse-spec--pprint s)))) + "\n "))) + +(defun cider-browse-spec--render-schema (spec-form) + "Render the s/schema SPEC-FORM." + (let ((schema-args (cl-second spec-form))) + (if (and (listp schema-args) + (nrepl-dict-p (cl-first schema-args))) + (cider-browse-spec--render-schema-map spec-form) + (cider-browse-spec--render-schema-vector spec-form)))) + +(defun cider-browse-spec--render-select (spec-form) + "Render the s/select SPEC-FORM." + (let ((keyset (cl-second spec-form)) + (selection (cl-third spec-form))) + (format "(s/select\n %s\n [%s])" + (cider-browse-spec--pprint keyset) + (string-join + (thread-last + selection + (mapcar (lambda (s) (cider-browse-spec--pprint s)))) + "\n ")))) + +(defun cider-browse-spec--render-union (spec-form) + "Render the s/union SPEC-FORM." + (let ((keyset (cl-second spec-form)) + (selection (cl-third spec-form))) + (format "(s/union\n %s\n [%s])" + (cider-browse-spec--pprint keyset) + (string-join + (thread-last + selection + (mapcar (lambda (s) (cider-browse-spec--pprint s)))) + "\n ")))) + +(defun cider-browse-spec--render-vector (spec-form) + "Render SPEC-FORM as a vector." + (format "[%s]" (string-join (mapcar #'cider-browse-spec--pprint spec-form)))) + +(defun cider-browse-spec--render-map-entry (spec-form) + "Render SPEC-FORM as a map entry." + (let ((key (cl-first spec-form)) + (value (cl-second spec-form))) + (format "%s %s" (cider-browse-spec--pprint key) + (if (listp value) + (cider-browse-spec--render-vector value) + (cider-browse-spec--pprint value))))) + +(defun cider-browse-spec--render-map (spec-form) + "Render SPEC-FORM as a map." + (let ((map-entries (cl-rest spec-form))) + (format "{%s}" (thread-last + (seq-partition map-entries 2) + (seq-map #'cider-browse-spec--render-map-entry) + (string-join))))) (defun cider-browse-spec--pprint (form) "Given a spec FORM builds a multi line string with a pretty render of that FORM." (cond ((stringp form) (if (cider--qualified-keyword-p form) (with-temp-buffer - (thread-first form + (thread-first + form (insert-text-button 'type 'cider-browse-spec--spec) (button-put 'spec-name form)) (buffer-string)) ;; to make it easier to read replace all clojure.spec ns with s/ ;; and remove all clojure.core ns - (thread-last form - (replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\)/" "s/") + (thread-last + form + (replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\|clojure.alpha.spec\\)/" "s/") (replace-regexp-in-string "^\\(clojure.core\\)/" "")))) ((and (listp form) (stringp (cl-first form))) @@ -168,7 +243,8 @@ Display TITLE at the top and SPECS are indented underneath." (format "(fn [%%] %s)" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))))) ;; prettier (s/and ) ((cider--spec-fn-p form-tag "and") - (format "(s/and\n%s)" (string-join (thread-last (cl-rest form) + (format "(s/and\n%s)" (string-join (thread-last + (cl-rest form) (mapcar #'cider-browse-spec--pprint) (mapcar (lambda (x) (format "%s" x)))) "\n"))) @@ -176,12 +252,14 @@ Display TITLE at the top and SPECS are indented underneath." ((cider--spec-fn-p form-tag "or") (let ((name-spec-pair (seq-partition (cl-rest form) 2))) (format "(s/or\n%s)" (string-join - (thread-last name-spec-pair + (thread-last + name-spec-pair (mapcar (lambda (s) (format "%s %s" (cl-first s) (cider-browse-spec--pprint (cl-second s)))))) "\n")))) ;; prettier (s/merge ) ((cider--spec-fn-p form-tag "merge") - (format "(s/merge\n%s)" (string-join (thread-last (cl-rest form) + (format "(s/merge\n%s)" (string-join (thread-last + (cl-rest form) (mapcar #'cider-browse-spec--pprint) (mapcar (lambda (x) (format "%s" x)))) "\n"))) @@ -189,13 +267,14 @@ Display TITLE at the top and SPECS are indented underneath." ((cider--spec-fn-p form-tag "keys") (let ((keys-args (seq-partition (cl-rest form) 2))) (format "(s/keys%s)" (thread-last - keys-args + keys-args (mapcar (lambda (s) (let ((key-type (cl-first s)) (specs-vec (cl-second s))) (concat "\n" key-type " [" - (string-join (thread-last specs-vec + (string-join (thread-last + specs-vec (mapcar #'cider-browse-spec--pprint) (mapcar (lambda (x) (format "%s" x)))) "\n") @@ -210,7 +289,8 @@ Display TITLE at the top and SPECS are indented underneath." multi-method retag (string-join - (thread-last sub-specs + (thread-last + sub-specs (mapcar (lambda (s) (concat "\n\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) "\n")))) @@ -218,7 +298,8 @@ Display TITLE at the top and SPECS are indented underneath." ((cider--spec-fn-p form-tag "cat") (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) (format "(s/cat %s)" - (thread-last name-spec-pairs + (thread-last + name-spec-pairs (mapcar (lambda (s) (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) (cl-reduce #'concat))))) @@ -226,13 +307,15 @@ Display TITLE at the top and SPECS are indented underneath." ((cider--spec-fn-p form-tag "alt") (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) (format "(s/alt %s)" - (thread-last name-spec-pairs + (thread-last + name-spec-pairs (mapcar (lambda (s) (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) (cl-reduce #'concat))))) ;; prettier (s/fspec ) ((cider--spec-fn-p form-tag "fspec") - (thread-last (seq-partition (cl-rest form) 2) + (thread-last + (seq-partition (cl-rest form) 2) (cl-remove-if (lambda (s) (and (stringp (cl-second s)) (string-empty-p (cl-second s))))) (mapcar (lambda (s) @@ -243,10 +326,21 @@ Display TITLE at the top and SPECS are indented underneath." (cider-browse-spec--pprint (cl-second s))))) (cl-reduce #'concat) (format "%s"))) + ;; prettier (s/schema ) + ((cider--spec-fn-p form-tag "schema") + (cider-browse-spec--render-schema form)) + ;; prettier (s/select ) + ((cider--spec-fn-p form-tag "select") + (cider-browse-spec--render-select form)) + ;; prettier (s/union ) + ((cider--spec-fn-p form-tag "union") + (cider-browse-spec--render-union form)) ;; every other with no special management (t (format "(%s %s)" (cider-browse-spec--pprint form-tag) (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " ")))))) + ((nrepl-dict-p form) + (cider-browse-spec--render-map form)) (t (format "%s" form)))) (defun cider-browse-spec--pprint-indented (spec-form) diff --git a/elpa/cider-20220417.951/cider-cheatsheet.el b/elpa/cider-20230707.640/cider-cheatsheet.el similarity index 99% rename from elpa/cider-20220417.951/cider-cheatsheet.el rename to elpa/cider-20230707.640/cider-cheatsheet.el index 03b34e8f..533dae85 100644 --- a/elpa/cider-20220417.951/cider-cheatsheet.el +++ b/elpa/cider-20230707.640/cider-cheatsheet.el @@ -1,6 +1,6 @@ ;;; cider-cheatsheet.el --- Quick reference for Clojure -*- lexical-binding: t -*- -;; Copyright © 2019-2022 Kris Jenkins, Bozhidar Batsov and CIDER contributors +;; Copyright © 2019-2023 Kris Jenkins, Bozhidar Batsov and CIDER contributors ;; ;; Author: Kris Jenkins diff --git a/elpa/cider-20220417.951/cider-classpath.el b/elpa/cider-20230707.640/cider-classpath.el similarity index 98% rename from elpa/cider-20220417.951/cider-classpath.el rename to elpa/cider-20230707.640/cider-classpath.el index cc795c38..0b628eeb 100644 --- a/elpa/cider-20220417.951/cider-classpath.el +++ b/elpa/cider-20230707.640/cider-classpath.el @@ -1,6 +1,6 @@ ;;; cider-classpath.el --- Basic Java classpath browser -*- lexical-binding: t; -*- -;; Copyright © 2014-2022 Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/elpa/cider-20220417.951/cider-client.el b/elpa/cider-20230707.640/cider-client.el similarity index 88% rename from elpa/cider-20220417.951/cider-client.el rename to elpa/cider-20230707.640/cider-client.el index a523d998..d9975263 100644 --- a/elpa/cider-20220417.951/cider-client.el +++ b/elpa/cider-20230707.640/cider-client.el @@ -1,6 +1,6 @@ ;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*- -;; Copyright © 2013-2022 Bozhidar Batsov +;; Copyright © 2013-2023 Bozhidar Batsov ;; ;; Author: Bozhidar Batsov @@ -135,7 +135,8 @@ will return nil instead of \"user\"." (defun cider-path-to-ns (relpath) "Transform RELPATH to Clojure namespace. Remove extension and substitute \"/\" with \".\", \"_\" with \"-\"." - (thread-last relpath + (thread-last + relpath (file-name-sans-extension) (replace-regexp-in-string "/" ".") (replace-regexp-in-string "_" "-"))) @@ -147,7 +148,8 @@ command falls back to `clojure-expected-ns' in the absence of an active nREPL connection." (if (cider-connected-p) (let* ((path (file-truename (or path buffer-file-name))) - (relpath (thread-last (cider-classpath-entries) + (relpath (thread-last + (cider-classpath-entries) (seq-filter #'file-directory-p) (seq-map (lambda (dir) (when (file-in-directory-p path dir) @@ -251,22 +253,22 @@ the code. See `cider-format-code-options` for details." (when format-options (let* ((indents-dict (when (assoc "indents" format-options) (thread-last - (cadr (assoc "indents" format-options)) + (cadr (assoc "indents" format-options)) (map-pairs) (seq-mapcat #'identity) (apply #'nrepl-dict)))) (alias-map-dict (when (assoc "alias-map" format-options) (thread-last - (cadr (assoc "alias-map" format-options)) + (cadr (assoc "alias-map" format-options)) (map-pairs) (seq-mapcat #'identity) (apply #'nrepl-dict))))) (thread-last - (map-merge 'list - (when indents-dict - `(("indents" ,indents-dict))) - (when alias-map-dict - `(("alias-map" ,alias-map-dict)))) + (map-merge 'list + (when indents-dict + `(("indents" ,indents-dict))) + (when alias-map-dict + `(("alias-map" ,alias-map-dict)))) (map-pairs) (seq-mapcat #'identity) (apply #'nrepl-dict))))) @@ -373,9 +375,9 @@ RIGHT-MARGIN specifies the maximum column-width of the printed result, and is included in the request if non-nil." (let* ((width-option (cider--print-option "right-margin" cider-print-fn)) (print-options (thread-last - (map-merge 'hash-table - `((,width-option ,right-margin)) - cider-print-options) + (map-merge 'hash-table + `((,width-option ,right-margin)) + cider-print-options) (map-pairs) (seq-mapcat #'identity) (apply #'nrepl-dict)))) @@ -392,13 +394,14 @@ is included in the request if non-nil." (defun cider--nrepl-pr-request-map () "Map to merge into requests that do not require pretty printing." - (let ((print-options (thread-last cider-print-options + (let ((print-options (thread-last + cider-print-options (map-pairs) (seq-mapcat #'identity) (apply #'nrepl-dict)))) (map-merge 'list - `(("nrepl.middleware.print/print" "cider.nrepl.pprint/pr" - "nrepl.middleware.print/stream?" nil)) + `(("nrepl.middleware.print/print" "cider.nrepl.pprint/pr") + ("nrepl.middleware.print/stream?" nil)) (unless (nrepl-dict-empty-p print-options) `(("nrepl.middleware.print/options" ,print-options))) (when cider-print-quota @@ -480,6 +483,8 @@ contain a `candidates' key, it is returned as is." info) var-info))) +;; FIXME: Now that nREPL supports a lookup op natively, we should +;; remove this eval-based hack at some point. (defconst cider-info-form " (do (require 'clojure.java.io) @@ -577,7 +582,8 @@ Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." (defun cider-sync-request:classpath () "Return a list of classpath entries." (cider-ensure-op-supported "classpath") - (thread-first '("op" "classpath") + (thread-first + '("op" "classpath") (cider-nrepl-send-sync-request) (nrepl-dict-get "classpath"))) @@ -593,12 +599,14 @@ Do nothing if PATH is already absolute." Sometimes the classpath contains entries like src/main and we need to resolve those to absolute paths." - (let ((classpath (thread-first "(seq (.split (System/getProperty \"java.class.path\") \":\"))" - (cider-sync-tooling-eval) - (nrepl-dict-get "value") - read)) - (project (clojure-project-dir))) - (mapcar (lambda (path) (cider--get-abs-path path project)) classpath))) + (when (cider-runtime-clojure-p) + (let ((classpath (thread-first + "(seq (.split (System/getProperty \"java.class.path\") \":\"))" + (cider-sync-tooling-eval) + (nrepl-dict-get "value") + read)) + (project (clojure-project-dir))) + (mapcar (lambda (path) (cider--get-abs-path path project)) classpath)))) (defun cider-classpath-entries () "Return a list of classpath entries." @@ -612,8 +620,8 @@ resolve those to absolute paths." (when-let* ((dict (thread-first `("op" "completions" "ns" ,(cider-current-ns) "prefix" ,prefix) - (cider-nrepl-send-sync-request (cider-current-repl) - 'abort-on-input)))) + (cider-nrepl-send-sync-request (cider-current-repl) + 'abort-on-input)))) (nrepl-dict-get dict "completions"))) (defun cider-sync-request:complete (prefix context) @@ -624,8 +632,8 @@ CONTEXT represents a completion context for compliment." "prefix" ,prefix "context" ,context ,@(when cider-enhanced-cljs-completion-p '("enhanced-cljs-completion?" "t"))) - (cider-nrepl-send-sync-request (cider-current-repl) - 'abort-on-input)))) + (cider-nrepl-send-sync-request (cider-current-repl) + 'abort-on-input)))) (nrepl-dict-get dict "completions"))) (defun cider-sync-request:complete-flush-caches () @@ -642,7 +650,7 @@ CONTEXT represents a completion context for compliment." ,@(when symbol `("sym" ,symbol)) ,@(when class `("class" ,class)) ,@(when member `("member" ,member))) - (cider-nrepl-send-sync-request (cider-current-repl))))) + (cider-nrepl-send-sync-request (cider-current-repl))))) (if (member "no-info" (nrepl-dict-get var-info "status")) nil var-info))) @@ -653,7 +661,7 @@ CONTEXT represents a completion context for compliment." "ns" ,(cider-current-ns) ,@(when symbol `("sym" ,symbol)) ,@(when lookup-fn `("lookup-fn" ,lookup-fn))) - (cider-nrepl-send-sync-request (cider-current-repl))))) + (cider-nrepl-send-sync-request (cider-current-repl))))) (if (member "lookup-error" (nrepl-dict-get var-info "status")) nil (nrepl-dict-get var-info "info")))) @@ -665,8 +673,8 @@ CONTEXT represents a completion context for compliment." ,@(when symbol `("sym" ,symbol)) ,@(when class `("class" ,class)) ,@(when member `("member" ,member))) - (cider-nrepl-send-sync-request (cider-current-repl) - 'abort-on-input)))) + (cider-nrepl-send-sync-request (cider-current-repl) + 'abort-on-input)))) (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) nil eldoc))) @@ -676,7 +684,7 @@ CONTEXT represents a completion context for compliment." (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query" "ns" ,(cider-current-ns) ,@(when symbol `("sym" ,symbol))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) + (cider-nrepl-send-sync-request nil 'abort-on-input)))) (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) nil eldoc))) @@ -689,71 +697,80 @@ returned." (thread-first `("op" "spec-list" "filter-regex" ,filter-regex "ns" ,(cider-current-ns)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-list"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-list"))) (defun cider-sync-request:spec-form (spec) "Get SPEC's form from registry." (thread-first `("op" "spec-form" "spec-name" ,spec "ns" ,(cider-current-ns)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-form"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-form"))) (defun cider-sync-request:spec-example (spec) "Get an example for SPEC." (thread-first `("op" "spec-example" "spec-name" ,spec) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-example"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-example"))) (defun cider-sync-request:ns-list () "Get a list of the available namespaces." (thread-first `("op" "ns-list" "exclude-regexps" ,cider-filtered-namespaces-regexps) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-list"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-list"))) (defun cider-sync-request:ns-vars (ns) "Get a list of the vars in NS." (thread-first `("op" "ns-vars" "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-vars"))) (defun cider-sync-request:ns-path (ns) "Get the path to the file containing NS." (thread-first `("op" "ns-path" "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "path"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "path"))) (defun cider-sync-request:ns-vars-with-meta (ns) "Get a map of the vars in NS to its metadata information." (thread-first `("op" "ns-vars-with-meta" "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars-with-meta"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-vars-with-meta"))) + +(defun cider-sync-request:private-ns-vars-with-meta (ns) + "Get a map of the vars in NS to its metadata information." + (thread-first `("op" "ns-vars-with-meta" + "ns" ,ns + "var-query" ,(nrepl-dict "private?" "t" + "include-meta-key" '("private"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-vars-with-meta"))) (defun cider-sync-request:ns-load-all () "Load all project namespaces." (thread-first '("op" "ns-load-all") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "loaded-ns"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "loaded-ns"))) (defun cider-sync-request:resource (name) "Perform nREPL \"resource\" op with resource name NAME." (thread-first `("op" "resource" "name" ,name) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resource-path"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "resource-path"))) (defun cider-sync-request: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")))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "resources-list")))) (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources))) (defun cider-sync-request:fn-refs (ns sym) @@ -762,8 +779,8 @@ The result entries are relative to the classpath." (thread-first `("op" "fn-refs" "ns" ,ns "sym" ,sym) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "fn-refs"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "fn-refs"))) (defun cider-sync-request:fn-deps (ns sym) "Return a list of function deps for the function identified by NS and SYM." @@ -771,8 +788,8 @@ The result entries are relative to the classpath." (thread-first `("op" "fn-deps" "ns" ,ns "sym" ,sym) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "fn-deps"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "fn-deps"))) (defun cider-sync-request:format-code (code &optional format-options) "Perform nREPL \"format-code\" op with CODE. @@ -791,10 +808,10 @@ FORMAT-OPTIONS is an optional configuration map for cljfmt." (defun cider-sync-request:format-edn (edn right-margin) "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." (let* ((request (thread-last - (map-merge 'list - `(("op" "format-edn") - ("edn" ,edn)) - (cider--nrepl-print-request-map right-margin)) + (map-merge 'list + `(("op" "format-edn") + ("edn" ,edn)) + (cider--nrepl-print-request-map right-margin)) (seq-mapcat #'identity))) (response (cider-nrepl-send-sync-request request)) (err (nrepl-dict-get response "err"))) diff --git a/elpa/cider-20220417.951/cider-clojuredocs.el b/elpa/cider-20230707.640/cider-clojuredocs.el similarity index 95% rename from elpa/cider-20220417.951/cider-clojuredocs.el rename to elpa/cider-20230707.640/cider-clojuredocs.el index 479a61f5..3e51a075 100644 --- a/elpa/cider-20220417.951/cider-clojuredocs.el +++ b/elpa/cider-20230707.640/cider-clojuredocs.el @@ -1,6 +1,6 @@ ;;; cider-clojuredocs.el --- ClojureDocs integration -*- lexical-binding: t -*- -;; Copyright © 2014-2022 Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors ;; ;; Author: Bozhidar Batsov @@ -43,19 +43,20 @@ (thread-first `("op" "clojuredocs-lookup" "ns" ,ns "sym" ,sym) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "clojuredocs"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "clojuredocs"))) (defun cider-sync-request:clojuredocs-refresh () "Refresh the ClojureDocs cache." (thread-first '("op" "clojuredocs-refresh-cache") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "status"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "status"))) (defun cider-clojuredocs-replace-special (name) "Convert the dashes in NAME to a ClojureDocs friendly format. We need to handle \"?\", \".\", \"..\" and \"/\"." - (thread-last name + (thread-last + name (replace-regexp-in-string "\\?" "_q") (replace-regexp-in-string "\\(\\.+\\)" "_\\1") (replace-regexp-in-string "/" "fs"))) diff --git a/elpa/cider-20220417.951/cider-common.el b/elpa/cider-20230707.640/cider-common.el similarity index 98% rename from elpa/cider-20220417.951/cider-common.el rename to elpa/cider-20230707.640/cider-common.el index c0e81324..90a7382a 100644 --- a/elpa/cider-20220417.951/cider-common.el +++ b/elpa/cider-20230707.640/cider-common.el @@ -1,6 +1,6 @@ ;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- -;; Copyright © 2015-2022 Artur Malabarba +;; Copyright © 2015-2023 Artur Malabarba ;; Author: Artur Malabarba @@ -263,7 +263,8 @@ otherwise, nil." (let* ((buffer (or buffer (current-buffer))) (name (replace-regexp-in-string "^file:" "" name)) (name (concat (cider-tramp-prefix buffer) name))) - (if (tramp-handle-file-exists-p name) + (if (and (tramp-tramp-file-p name) + (tramp-handle-file-exists-p name)) name))) (defun cider--server-filename (name) @@ -286,7 +287,7 @@ in the container, the alist would be `((\"/src\" \"~/projects/foo/src\"))." (defun cider--translate-path (path direction) "Attempt to translate the PATH in the given DIRECTION. Looks at `cider-path-translations' for (container . host) alist of path -prefixes and translates PATH from container to host or viceversa depending on +prefixes and translates PATH from container to host or vice-versa depending on whether DIRECTION is 'from-nrepl or 'to-nrepl." (seq-let [from-fn to-fn path-fn] (cond ((eq direction 'from-nrepl) '(car cdr identity)) ((eq direction 'to-nrepl) '(cdr car expand-file-name))) diff --git a/elpa/cider-20220417.951/cider-completion.el b/elpa/cider-20230707.640/cider-completion.el similarity index 91% rename from elpa/cider-20220417.951/cider-completion.el rename to elpa/cider-20230707.640/cider-completion.el index 2611eb26..20b75e46 100644 --- a/elpa/cider-20220417.951/cider-completion.el +++ b/elpa/cider-20230707.640/cider-completion.el @@ -1,6 +1,6 @@ ;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*- -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Bozhidar Batsov ;; Artur Malabarba @@ -237,7 +237,20 @@ performed by `cider-annotate-completion-function'." (when (and (cider-connected-p) (not (or (cider-in-string-p) (cider-in-comment-p)))) (list (car bounds) (cdr bounds) - (completion-table-dynamic #'cider-complete) + (lambda (prefix pred action) + ;; When the 'action is 'metadata, this lambda returns metadata about this + ;; capf, when action is (boundaries . suffix), it returns nil. With every + ;; other value of 'action (t, nil, or lambda), 'action is forwarded to + ;; (complete-with-action), together with (cider-complete), prefix and pred. + ;; And that function performs the completion based on those arguments. + ;; + ;; This api is better described in the section + ;; '21.6.7 Programmed Completion' of the elisp manual. + (cond ((eq action 'metadata) `(metadata (category . cider))) + ((eq (car-safe action) 'boundaries) nil) + (t (with-current-buffer (current-buffer) + (complete-with-action action + (cider-complete prefix) prefix pred))))) :annotation-function #'cider-annotate-symbol :company-kind #'cider-company-symbol-kind :company-doc-buffer #'cider-create-doc-buffer diff --git a/elpa/cider-20220417.951/cider-connection.el b/elpa/cider-20230707.640/cider-connection.el similarity index 78% rename from elpa/cider-20220417.951/cider-connection.el rename to elpa/cider-20230707.640/cider-connection.el index b81ba4f4..35fc7927 100644 --- a/elpa/cider-20220417.951/cider-connection.el +++ b/elpa/cider-20230707.640/cider-connection.el @@ -1,6 +1,6 @@ ;;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*- ;; -;; Copyright © 2019-2022 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors +;; Copyright © 2019-2023 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors ;; ;; Author: Artur Malabarba ;; Bozhidar Batsov @@ -45,14 +45,6 @@ See `cider-format-connection-params' for available format characters." :group 'cider :package-version '(cider . "0.18.0")) -(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration - "The function to use to generate the message displayed on connect. -When set to nil no additional message will be displayed. A good -alternative to the default is `cider-random-tip'." - :type 'function - :group 'cider - :package-version '(cider . "0.11.0")) - (defcustom cider-redirect-server-output-to-repl t "Controls whether nREPL server output would be redirected to the REPL. When non-nil the output would end up in both the nrepl-server buffer (when @@ -63,12 +55,53 @@ available) and the matching REPL buffer." :package-version '(cider . "0.17.0")) (defcustom cider-auto-mode t - "When non-nil, automatically enable cider mode for all Clojure buffers." + "When non-nil, automatically enable and disable CIDER in all Clojure buffers. + +After an initial connection, `cider-mode' is added to `clojure-mode-hook' and +automatically enabled on all existing Clojure buffers. After the last +connection has been closed, `cider-mode' is disabled in all Clojure buffers, and +has to be manually re-enabled via \\[cider-mode]. + +Useful for switching between alternative minor modes like `inf-clojure-mode'." :type 'boolean :group 'cider :safe #'booleanp :package-version '(cider . "0.9.0")) +(defcustom cider-merge-sessions nil + "Controls session combination behaviour. + +Symbol `host' combines all sessions of a project associated with the same host. +Symbol `project' combines all sessions of a project. + +All other values do not combine any sessions." + :type '(choice (const :tag "Combine all sessions with the same host" host) + (const :tag "Combine all sessions from the same project" project) + (other :tag "Do not combine any sessions")) + :group 'cider + :safe #'symbolp + :package-version '(cider . "1.5")) + +(defcustom cider-reuse-dead-repls 'prompt + "How to deal with existing dead REPL buffers when initializing a connection. + +Possible choices are `prompt', `auto', `any', and nil. +- `prompt' means to always ask the user for a decision. +- `auto' means to automatically reuse a dead REPL without prompting the user + if it is the only available option. When there are multiple buffers to + choose from, the user is is prompted for a choice. +- `any' (or any other non-nil value) means to reuse any dead REPL buffer + available, by default the most relevant according to various heuristics, + and never prompt the user. +- nil means to start a new REPL each time, ignoring existing buffers." + :type '(choice (const :tag "Always prompt for what to do with dead REPLs" prompt) + (const :tag "Reuse dead REPL, prompting only for multiple choice" auto) + (const :tag "Reuse any available dead REPL and never prompt" any) + (const :tag "Never reuse dead REPLs" nil)) + :group 'cider + :safe #'symbolp + :package-version '(cider . "1.8")) + (defconst cider-required-nrepl-version "0.6.0" "The minimum nREPL version that's known to work properly with CIDER.") @@ -127,15 +160,18 @@ PROC-BUFFER is either server or client buffer, defaults to current buffer." nrepl-server-buffer))) (cl-loop for l on nrepl-endpoint by #'cddr do (setq params (plist-put params (car l) (cadr l)))) - (setq params (thread-first params + (setq params (thread-first + params (plist-put :project-dir nrepl-project-dir))) (when (buffer-live-p server-buf) - (setq params (thread-first params + (setq params (thread-first + params (plist-put :server (get-buffer-process server-buf)) (plist-put :server-command nrepl-server-command)))) ;; repl-specific parameters (do not pollute server params!) (unless (nrepl-server-p proc-buffer) - (setq params (thread-first params + (setq params (thread-first + params (plist-put :session-name cider-session-name) (plist-put :repl-type cider-repl-type) (plist-put :cljs-repl-type cider-cljs-repl-type) @@ -162,7 +198,8 @@ buffer." (cider--close-buffer nrepl-tunnel-buffer)) (when no-kill ;; inform sentinel not to kill the server, if any - (thread-first (get-buffer-process repl) + (thread-first + (get-buffer-process repl) (process-plist) (plist-put :keep-server t)))) (let ((proc (get-buffer-process repl))) @@ -171,6 +208,8 @@ buffer." ;; Sync request will hang if the server is dead. (process-live-p (get-buffer-process nrepl-server-buffer)))) (nrepl-sync-request:close repl) + ;; give a chance to the REPL to respond to the closing of the connection + (sleep-for 0.5) (delete-process proc))) (when-let* ((messages-buffer (and nrepl-log-messages (nrepl-messages-buffer repl)))) @@ -257,6 +296,7 @@ message in the REPL area." (cider-nrepl-send-request '("op" "out-subscribe") (cider-interactive-eval-handler (current-buffer)))) +(defvar cider-mode) (declare-function cider-mode "cider-mode") (defun cider-enable-on-existing-clojure-buffers () "Enable CIDER's minor mode on existing Clojure buffers. @@ -265,18 +305,19 @@ See command `cider-mode'." (add-hook 'clojure-mode-hook #'cider-mode) (dolist (buffer (cider-util--clojure-buffers)) (with-current-buffer buffer - (cider-mode +1) - ;; In global-eldoc-mode, a new file-visiting buffer calls - ;; `turn-on-eldoc-mode' which enables eldoc-mode if it's supported in that - ;; buffer as determined by `eldoc--supported-p'. Cider's eldoc support - ;; allows new buffers in cider-mode to enable eldoc-mode. As of 2021-04, - ;; however, clojure-mode itself has no eldoc support, so old clojure - ;; buffers opened before cider started aren't necessarily in eldoc-mode. - ;; Here, we've enabled cider-mode for this old clojure buffer, and now, if - ;; global-eldoc-mode is enabled, try to enable eldoc-mode as if the buffer - ;; had just been created with cider-mode. - (when global-eldoc-mode - (turn-on-eldoc-mode))))) + (unless cider-mode + (cider-mode +1) + ;; In global-eldoc-mode, a new file-visiting buffer calls + ;; `turn-on-eldoc-mode' which enables eldoc-mode if it's supported in that + ;; buffer as determined by `eldoc--supported-p'. Cider's eldoc support + ;; allows new buffers in cider-mode to enable eldoc-mode. As of 2021-04, + ;; however, clojure-mode itself has no eldoc support, so old clojure + ;; buffers opened before cider started aren't necessarily in eldoc-mode. + ;; Here, we've enabled cider-mode for this old clojure buffer, and now, if + ;; global-eldoc-mode is enabled, try to enable eldoc-mode as if the buffer + ;; had just been created with cider-mode. + (when global-eldoc-mode + (turn-on-eldoc-mode)))))) (declare-function cider--debug-mode "cider-debug") (defun cider-disable-on-existing-clojure-buffers () @@ -292,6 +333,26 @@ See command `cider-mode'." (unless (cider-sessions) (cider-disable-on-existing-clojure-buffers))) +(defun cider--set-connection-capabilities (&optional conn-buffer) + "Set `cider-connection-capabilities' for CONN-BUFFER during repl init. +See `cider-connection-capabilities'." + (with-current-buffer (or conn-buffer (current-buffer)) + (setf cider-connection-capabilities + (append + (pcase (cider-runtime) + ('clojure '(clojure jvm-compilation-errors)) + ('babashka '(babashka jvm-compilation-errors)) + (_ '())) + (when + (or + (eq cider-repl-type 'cljs) + ;; This check is currently basically for nbb. + ;; See `cider-sync-tooling-eval', but it is defined on a higher layer + (nrepl-dict-get + (nrepl-sync-request:eval "cljs.core/demunge" (current-buffer) nil 'tooling) + "value")) + '(cljs)))))) + (declare-function cider--debug-init-connection "cider-debug") (declare-function cider-repl-init "cider-repl") (declare-function cider-nrepl-op-supported-p "cider-client") @@ -328,6 +389,8 @@ buffer." ;; first. (cider--debug-init-connection)) + (cider--set-connection-capabilities) + (when cider-repl-init-function (funcall cider-repl-init-function)) @@ -341,7 +404,8 @@ buffer." This function is appended to `nrepl-disconnected-hook' in the client process buffer." ;; `nrepl-connected-hook' is run in the connection buffer - (cider-possibly-disable-on-existing-clojure-buffers) + (when cider-auto-mode + (cider-possibly-disable-on-existing-clojure-buffers)) (run-hooks 'cider-disconnected-hook)) @@ -351,7 +415,8 @@ process buffer." "Retrieve the underlying connection's Java version." (with-current-buffer (cider-current-repl) (when nrepl-versions - (thread-first nrepl-versions + (thread-first + nrepl-versions (nrepl-dict-get "java") (nrepl-dict-get "version-string"))))) @@ -359,7 +424,8 @@ process buffer." "Retrieve the underlying connection's Clojure version." (with-current-buffer (cider-current-repl) (when nrepl-versions - (thread-first nrepl-versions + (thread-first + nrepl-versions (nrepl-dict-get "clojure") (nrepl-dict-get "version-string"))))) @@ -367,7 +433,8 @@ process buffer." "Retrieve the underlying connection's nREPL version." (with-current-buffer (cider-current-repl) (when nrepl-versions - (thread-first nrepl-versions + (thread-first + nrepl-versions (nrepl-dict-get "nrepl") (nrepl-dict-get "version-string"))))) @@ -425,6 +492,19 @@ about this buffer (like variable `cider-repl-type')." (plist-get nrepl-endpoint :host) (plist-get nrepl-endpoint :port)))))) +(defvar-local cider-connection-capabilities '() + "A list of some of the capabilities of this connection buffer. +In other words - what assumptions we make about the runtime. +This is more general than +`cider-nrepl-op-supported-p' and `cider-library-present-p'. +But does not need to replace them.") + +(defun cider-connection-has-capability-p (capability &optional conn-buf) + "Return non nil when the cider connection has CAPABILITY for CONN-BUF. +By default it assumes the connection buffer is current." + (with-current-buffer (or conn-buf (current-buffer)) + (member capability cider-connection-capabilities))) + ;;; Connection Management Commands @@ -451,7 +531,8 @@ entire session." (let* ((repl (or repl (sesman-browser-get 'object) (cider-current-repl nil 'ensure))) - (params (thread-first () + (params (thread-first + () (cider--gather-connect-params repl) (plist-put :session-name (sesman-session-name-for-object 'CIDER repl)) (plist-put :repl-buffer repl)))) @@ -543,7 +624,8 @@ REPL defaults to the current REPL." (process-put proc :cached-classpath cp) cp))) (classpath-roots (or (process-get proc :cached-classpath-roots) - (let ((cp (thread-last classpath + (let ((cp (thread-last + classpath (seq-filter (lambda (path) (not (string-match-p "\\.jar$" path)))) (mapcar #'file-name-directory) (seq-remove #'null) @@ -612,7 +694,8 @@ Fallback on `cider' command." ;; 4) restart the repls reusing the buffer (dolist (r repls) (cider-nrepl-connect - (thread-first () + (thread-first + () (cider--gather-connect-params r) ;; server params (:port, :project-dir etc) have precedence (cider--gather-connect-params server-buf) @@ -624,7 +707,8 @@ Fallback on `cider' command." (dolist (r repls) (cider--close-connection r 'no-kill) (cider-nrepl-connect - (thread-first () + (thread-first + () (cider--gather-connect-params r) (plist-put :session-name ses-name) (plist-put :repl-buffer r))))))) @@ -681,7 +765,8 @@ removed." (ses-name (or (plist-get params :session-name) (format-spec cider-session-name-template specs))) (specs (append `((?s . ,ses-name)) specs))) - (thread-last (format-spec template specs) + (thread-last + (format-spec template specs) ;; remove extraneous separators (replace-regexp-in-string "\\([:-]\\)[:-]+" "\\1") (replace-regexp-in-string "\\(^[:-]\\)\\|\\([:-]$\\)" "") @@ -708,10 +793,17 @@ Session name can be customized with `cider-session-name-template'." (defvar-local cider-repl-type nil "The type of this REPL buffer, usually either clj or cljs.") +(defvar-local cider-repl-cljs-upgrade-pending nil + "Is the cljs repl currently pending?") + (defun cider-repl-type (repl-buffer) "Get REPL-BUFFER's type." (buffer-local-value 'cider-repl-type repl-buffer)) +(defun cider-cljs-pending-p (repl-buffer) + "Returns non nil when REPL-BUFFER is currently a pending cljs repl." + (buffer-local-value 'cider-repl-cljs-upgrade-pending repl-buffer)) + (defun cider-repl-type-for-buffer (&optional buffer) "Return the matching connection type (clj or cljs) for BUFFER. BUFFER defaults to the `current-buffer'. In cljc buffers return @@ -758,27 +850,35 @@ PARAMS is a plist as received by `cider-repl-create'." (let* ((proj-dir (plist-get params :project-dir)) (host (plist-get params :host)) (port (plist-get params :port)) - (cljsp (member (plist-get params :repl-type) '(cljs pending-cljs))) + (type (plist-get params :repl-type)) (scored-repls - (delq nil - (mapcar (lambda (b) - (let ((bparams (cider--gather-connect-params nil b))) - (when (eq cljsp (member (plist-get bparams :repl-type) - '(cljs pending-cljs))) - (cons (buffer-name b) - (+ - (if (equal proj-dir (plist-get bparams :project-dir)) 8 0) - (if (equal host (plist-get bparams :host)) 4 0) - (if (equal port (plist-get bparams :port)) 2 0)))))) - repls)))) - (when scored-repls - (if (> (length scored-repls) 1) - (when (y-or-n-p "Dead REPLs exist. Reuse? ") - (let ((sorted-repls (seq-sort (lambda (a b) (> (cdr a) (cdr b))) scored-repls))) - (get-buffer (completing-read "REPL to reuse: " - (mapcar #'car sorted-repls) nil t nil nil (caar sorted-repls))))) - (when (y-or-n-p (format "A dead REPL %s exists. Reuse? " (caar scored-repls))) - (get-buffer (caar scored-repls)))))))) + (mapcar (lambda (b) + (let ((bparams (ignore-errors (cider--gather-connect-params nil b)))) + (when (eq type (plist-get bparams :repl-type)) + (cons b (+ + (if (equal proj-dir (plist-get bparams :project-dir)) 8 0) + (if (equal host (plist-get bparams :host)) 4 0) + (if (equal port (plist-get bparams :port)) 2 0)))))) + repls)) + (sorted-repls (mapcar #'car (seq-sort-by #'cdr #'> (delq nil scored-repls))))) + (cond ((null sorted-repls) nil) + ((and (= 1 (length sorted-repls)) + (eq cider-reuse-dead-repls 'prompt)) + (if (y-or-n-p (format "A dead REPL %s exists. Reuse buffer? " (car sorted-repls))) + (car sorted-repls) + (and (y-or-n-p "Kill dead REPL buffer?") + (kill-buffer (car sorted-repls)) + nil))) + ((and (< 1 (length sorted-repls)) + (memq cider-reuse-dead-repls '(prompt auto))) + (if (y-or-n-p "Dead REPL buffers exist. Select one to reuse? ") + (get-buffer (completing-read "REPL buffer to reuse: " (mapcar #'buffer-name sorted-repls) + nil t nil nil (car sorted-repls))) + (and (y-or-n-p "Kill all dead REPL buffers?") + (mapc #'kill-buffer sorted-repls) + nil))) + (cider-reuse-dead-repls ;; fallthrough for 'auto / 'any / other non-nil values + (car sorted-repls)))))) (declare-function cider-default-err-handler "cider-eval") (declare-function cider-repl-mode "cider-repl") @@ -796,7 +896,8 @@ function with the repl buffer set as current." ;; Connection might not have been set as yet. Please don't send requests in ;; this function, but use cider--connected-handler instead. (let ((buffer (or (plist-get params :repl-buffer) - (cider--choose-reusable-repl-buffer params) + (and cider-reuse-dead-repls + (cider--choose-reusable-repl-buffer params)) (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*")))) (ses-name (or (plist-get params :session-name) (cider-make-session-name params)))) @@ -812,8 +913,9 @@ function with the repl buffer set as current." mode-name nil cider-session-name ses-name nrepl-project-dir (plist-get params :project-dir) - ;; REPLs start with clj and then "upgrade" to a different type + ;; Cljs repls are pending until they are upgraded. See cider-repl--state-handler cider-repl-type (plist-get params :repl-type) + cider-repl-cljs-upgrade-pending (plist-get params :cider-repl-cljs-upgrade-pending) ;; ran at the end of cider--connected-handler cider-repl-init-function (plist-get params :repl-init-function) cider-launch-params params) @@ -868,7 +970,40 @@ no linked session or there is no REPL of TYPE within the current session." (cond ((null buffer-repl-type) nil) ((or (null type) (eq type 'multi) (eq type 'any)) t) ((listp type) (member buffer-repl-type type)) - (t (string= type buffer-repl-type))))) + (t + (or (string= type buffer-repl-type) + (let ((capabilities + (buffer-local-value 'cider-connection-capabilities buffer))) + (cond ((listp type) + (cl-some (lambda (it) (member it capabilities)) type)) + (t (member type capabilities))))))))) + +(defun cider--get-host-from-session (session) + "Returns the host associated with SESSION." + (plist-get (cider--gather-session-params session) + :host)) + +(defun cider--make-sessions-list-with-hosts (sessions) + "Makes a list of SESSIONS and their hosts. +Returns a list of the form ((session1 host1) (session2 host2) ...)." + (mapcar (lambda (session) + (list session (cider--get-host-from-session session))) + sessions)) + +(defun cider--get-sessions-with-same-host (session sessions) + "Returns a list of SESSIONS with the same host as SESSION." + (mapcar #'car + (seq-filter (lambda (x) + (string-equal (cadr x) + (cider--get-host-from-session session))) + (cider--make-sessions-list-with-hosts sessions)))) + +(defun cider--extract-connections (sessions) + "Returns a flattened list of all session buffers in SESSIONS." + (cl-reduce (lambda (x y) + (append x (cdr y))) + sessions + :initial-value '())) (defun cider-repls (&optional type ensure) "Return cider REPLs of TYPE from the current session. @@ -879,11 +1014,28 @@ throw an error if no linked session exists." ((listp type) (mapcar #'cider-maybe-intern type)) ((cider-maybe-intern type)))) - (repls (cdr (if ensure - (sesman-ensure-session 'CIDER) - (sesman-current-session 'CIDER))))) + (repls (pcase cider-merge-sessions + ('host + (if ensure + (or (cider--extract-connections (cider--get-sessions-with-same-host + (sesman-current-session 'CIDER) + (sesman-current-sessions 'CIDER))) + (user-error "No linked %s sessions" 'CIDER)) + (cider--extract-connections (cider--get-sessions-with-same-host + (sesman-current-session 'CIDER) + (sesman-current-sessions 'CIDER))))) + ('project + (if ensure + (or (cider--extract-connections (sesman-current-sessions 'CIDER)) + (user-error "No linked %s sessions" 'CIDER)) + (cider--extract-connections (sesman-current-sessions 'CIDER)))) + (_ (cdr (if ensure + (sesman-ensure-session 'CIDER) + (sesman-current-session 'CIDER))))))) (or (seq-filter (lambda (b) - (cider--match-repl-type type b)) + (unless + (cider-cljs-pending-p b) + (cider--match-repl-type type b))) repls) (when ensure (cider--no-repls-user-error type))))) diff --git a/elpa/cider-20220417.951/cider-debug.el b/elpa/cider-20230707.640/cider-debug.el similarity index 96% rename from elpa/cider-20220417.951/cider-debug.el rename to elpa/cider-20230707.640/cider-debug.el index 39acb512..ec67a87a 100644 --- a/elpa/cider-20220417.951/cider-debug.el +++ b/elpa/cider-20230707.640/cider-debug.el @@ -1,6 +1,6 @@ ;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*- -;; Copyright © 2015-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; Author: Artur Malabarba @@ -103,29 +103,24 @@ configure `cider-debug-prompt' instead." ;;; Implementation +(declare-function cider-browse-ns--combined-vars-with-meta "cider-browse-ns") + (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")))) + (nrepl-dict-get "list")))) (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t) (let ((inhibit-read-only t)) - (erase-buffer) (dolist (list all) (let* ((ns (car list)) - (ns-vars-with-meta (cider-sync-request:ns-vars-with-meta ns)) - ;; seq of metadata maps of the instrumented vars - (instrumented-meta (mapcar (apply-partially #'nrepl-dict-get ns-vars-with-meta) - (cdr list)))) + (ns-vars-with-meta (cider-browse-ns--combined-vars-with-meta ns)) + (instrumented-meta (nrepl-dict-filter (lambda (k _) + (member k list)) + ns-vars-with-meta))) (cider-browse-ns--list (current-buffer) ns - (seq-mapn #'cider-browse-ns--properties - (cdr list) - instrumented-meta) - - ns 'noerase) - (goto-char (point-max)) - (insert "\n")))) - (goto-char (point-min))) + instrumented-meta + ns))))) (message "No currently instrumented definitions"))) (defun cider--debug-response-handler (response) @@ -147,9 +142,9 @@ configure `cider-debug-prompt' instead." "Initialize a connection with the cider.debug middleware." (cider-nrepl-send-request (thread-last - (map-merge 'list - '(("op" "init-debugger")) - (cider--nrepl-print-request-map fill-column)) + (map-merge 'list + '(("op" "init-debugger")) + (cider--nrepl-print-request-map fill-column)) (seq-mapcat #'identity)) #'cider--debug-response-handler)) @@ -205,13 +200,15 @@ Can be toggled at any time with `\\[cider-debug-toggle-locals]'." (?t "trace" "trace") (?q "quit" "quit")) "A list of debugger command specs. -Specs are in the format (KEY COMMAND-NAME DISPLAY-NAME?) -where KEY is a character which is mapped to the command -COMMAND-NAME is a valid debug command to be passed to the cider-nrepl middleware -DISPLAY-NAME is the string displayed in the debugger overlay -If DISPLAY-NAME is nil, that command is hidden from the overlay but still callable. -The rest of the commands are displayed in the same order as this list." +Specs are in the format (KEY COMMAND-NAME DISPLAY-NAME?) where KEY is a +character which is mapped to the command COMMAND-NAME is a valid debug +command to be passed to the cider-nrepl middleware DISPLAY-NAME is the +string displayed in the debugger overlay + +If DISPLAY-NAME is nil, that command is hidden from the overlay but still +callable. The rest of the commands are displayed in the same order as this +list." :type '(alist :key-type character :value-type (list (string :tag "command name") diff --git a/elpa/cider-20220417.951/cider-doc.el b/elpa/cider-20230707.640/cider-doc.el similarity index 99% rename from elpa/cider-20220417.951/cider-doc.el rename to elpa/cider-20230707.640/cider-doc.el index 56c8d005..5120ecc8 100644 --- a/elpa/cider-20220417.951/cider-doc.el +++ b/elpa/cider-20230707.640/cider-doc.el @@ -1,6 +1,6 @@ ;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- -;; Copyright © 2014-2022 Bozhidar Batsov, Jeff Valk and CIDER contributors +;; Copyright © 2014-2023 Bozhidar Batsov, Jeff Valk and CIDER contributors ;; Author: Jeff Valk diff --git a/elpa/cider-20220417.951/cider-eldoc.el b/elpa/cider-20230707.640/cider-eldoc.el similarity index 91% rename from elpa/cider-20220417.951/cider-eldoc.el rename to elpa/cider-20230707.640/cider-eldoc.el index af5f258b..0a43203b 100644 --- a/elpa/cider-20220417.951/cider-eldoc.el +++ b/elpa/cider-20230707.640/cider-eldoc.el @@ -1,7 +1,7 @@ ;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -45,7 +45,7 @@ "Extra commands to be added to eldoc's safe commands list.") (defcustom cider-eldoc-max-num-sexps-to-skip 30 - "The maximum number of sexps to skip while searching the beginning of current sexp." + "Max number of sexps to skip while searching the beginning of current sexp." :type 'integer :group 'cider :package-version '(cider . "0.10.1")) @@ -107,7 +107,8 @@ mapping `cider-eldoc-ns-function' on it returns an empty list." ((and cider-eldoc-max-class-names-to-display (> eldoc-class-names-length cider-eldoc-max-class-names-to-display)) (format "(%s & %s more)" - (thread-first eldoc-class-names + (thread-first + eldoc-class-names (seq-take cider-eldoc-max-class-names-to-display) (string-join " ") (cider-propertize 'ns)) @@ -116,7 +117,8 @@ mapping `cider-eldoc-ns-function' on it returns an empty list." ;; format the whole list but add surrounding parentheses ((> eldoc-class-names-length 1) (format "(%s)" - (thread-first eldoc-class-names + (thread-first + eldoc-class-names (string-join " ") (cider-propertize 'ns)))) @@ -228,6 +230,22 @@ arglists. ELDOC-INFO is a p-list containing the eldoc information." (cider-eldoc-format-thing ns symbol thing 'fn) (cider-eldoc-format-arglist arglists pos)))) +(defun cider-eldoc-format-special-form (thing pos eldoc-info) + "Return the formatted eldoc string for a special-form. +THING is the special form's name. POS is the argument index of the +special-form's arglists. ELDOC-INFO is a p-list containing the eldoc +information." + (let* ((ns (lax-plist-get eldoc-info "ns")) + (special-form-symbol (lax-plist-get eldoc-info "symbol")) + (arglists (mapcar (lambda (arglist) + (if (equal (car arglist) special-form-symbol) + (cdr arglist) + arglist)) + (lax-plist-get eldoc-info "arglists")))) + (format "%s: %s" + (cider-eldoc-format-thing ns special-form-symbol thing 'fn) + (cider-eldoc-format-arglist arglists pos)))) + (defun cider-highlight-args (arglist pos) "Format the the function ARGLIST for eldoc. POS is the index of the currently highlighted argument." @@ -286,7 +304,7 @@ if the maximum number of sexps to skip is exceeded." (error)) (while (let ((p (point))) - (forward-sexp -1) + (clojure-backward-logical-sexp 1) (when (< (point) p) (setq num-skipped-sexps (unless (and cider-eldoc-max-num-sexps-to-skip @@ -305,12 +323,13 @@ if the maximum number of sexps to skip is exceeded." (defun cider-eldoc-thing-type (eldoc-info) "Return the type of the ELDOC-INFO being displayed by eldoc. It can be a function or var now." - (pcase (lax-plist-get eldoc-info "type") - ("function" 'fn) - ("special-form" 'special-form) - ("macro" 'macro) - ("method" 'method) - ("variable" 'var))) + (or (pcase (lax-plist-get eldoc-info "type") + ("function" 'fn) + ("special-form" 'special-form) + ("macro" 'macro) + ("method" 'method) + ("variable" 'var)) + 'fn)) (defun cider-eldoc-info-at-point () "Return eldoc info at point. @@ -346,7 +365,7 @@ Then go back to the point and return its eldoc." (defun cider-eldoc-info-in-current-sexp () "Return eldoc information from the sexp. -If `cider-eldoc-display-for-symbol-at-poin' is non-nil and +If `cider-eldoc-display-for-symbol-at-point' is non-nil and the symbol at point has a valid eldoc available, return that. Otherwise return the eldoc of the first symbol of the sexp." (or (when cider-eldoc-display-for-symbol-at-point @@ -412,7 +431,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 @@ -447,10 +466,10 @@ Only useful for interop forms. Clojure forms would be returned unchanged." "inputs"))) (if query-inputs (thread-first - (thread-last arglists - (car) - (remove "&") - (remove "inputs")) + (thread-last arglists + (car) + (remove "&") + (remove "inputs")) (append (car query-inputs)) (list)) arglists)) @@ -468,9 +487,12 @@ Only useful for interop forms. Clojure forms would be returned unchanged." (pos (lax-plist-get sexp-eldoc-info "pos")) (thing (lax-plist-get sexp-eldoc-info "thing"))) (when eldoc-info - (if (eq (cider-eldoc-thing-type eldoc-info) 'var) - (cider-eldoc-format-variable thing eldoc-info) - (cider-eldoc-format-function thing pos eldoc-info)))))) + (cond + ((eq (cider-eldoc-thing-type eldoc-info) 'var) + (cider-eldoc-format-variable thing eldoc-info)) + ((eq (cider-eldoc-thing-type eldoc-info) 'special-form) + (cider-eldoc-format-special-form thing pos eldoc-info)) + (t (cider-eldoc-format-function thing pos eldoc-info))))))) (defun cider-eldoc-setup () "Setup eldoc in the current buffer. diff --git a/elpa/cider-20220417.951/cider-eval.el b/elpa/cider-20230707.640/cider-eval.el similarity index 85% rename from elpa/cider-20220417.951/cider-eval.el rename to elpa/cider-20230707.640/cider-eval.el index e0f2e9a7..110505bd 100644 --- a/elpa/cider-20220417.951/cider-eval.el +++ b/elpa/cider-20230707.640/cider-eval.el @@ -1,7 +1,7 @@ ;;; cider-eval.el --- Interactive evaluation (compilation) functionality -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -167,6 +167,15 @@ If t, save the file without confirmation." :group 'cider :package-version '(cider . "0.16.0")) +(defcustom cider-eval-register ?e + "The text register assigned to the most recent evaluation result. +When non-nil, the return value of all CIDER eval commands are +automatically written into this register." + :type '(choice character + (const nil)) + :group 'cider + :package-version '(cider . "1.4.0")) + ;;; Utilities @@ -311,6 +320,7 @@ If CONNECTION is nil, use `cider-current-repl'." "cider.nrepl/wrap-format" "cider.nrepl/wrap-info" "cider.nrepl/wrap-inspect" + "cider.nrepl/wrap-log" "cider.nrepl/wrap-macroexpand" "cider.nrepl/wrap-ns" "cider.nrepl/wrap-out" @@ -453,6 +463,13 @@ Uses the value of the `out' slot in RESPONSE." (cider-nrepl-sync-request:eval "(clojure.stacktrace/print-cause-trace *e)"))) +(defun cider-default-err-eval-print-handler () + "Display the last exception without middleware support. +When clojure.stracktrace is not present." + (cider--handle-err-eval-response + (cider-nrepl-sync-request:eval + "(println (ex-data *e))"))) + (defun cider--render-stacktrace-causes (causes &optional error-types) "If CAUSES is non-nil, render its contents into a new error buffer. Optional argument ERROR-TYPES contains a list which should determine the @@ -466,8 +483,10 @@ op/situation that originated this error." If RESPONSE contains a cause, cons it onto CAUSES and return that. If RESPONSE is the final message (i.e. it contains a status), render CAUSES into a new error buffer." - (nrepl-dbind-response response (class status) - (cond (class (cons response causes)) + (nrepl-dbind-response response (class msg status type) + (cond ((and (member "notification" status) causes) + (nrepl-notify msg type)) + (class (cons response causes)) (status (cider--render-stacktrace-causes causes))))) (defun cider-default-err-op-handler () @@ -476,9 +495,9 @@ into a new error buffer." (let (causes) (cider-nrepl-send-request (thread-last - (map-merge 'list - '(("op" "stacktrace")) - (cider--nrepl-print-request-map fill-column)) + (map-merge 'list + '(("op" "analyze-last-stacktrace")) + (cider--nrepl-print-request-map fill-column)) (seq-mapcat #'identity)) (lambda (response) ;; While the return value of `cider--handle-stacktrace-response' is not @@ -489,9 +508,12 @@ into a new error buffer." (defun cider-default-err-handler () "This function determines how the error buffer is shown. It delegates the actual error content to the eval or op handler." - (if (cider-nrepl-op-supported-p "stacktrace") - (cider-default-err-op-handler) - (cider-default-err-eval-handler))) + (cond ((cider-nrepl-op-supported-p "analyze-last-stacktrace") + (cider-default-err-op-handler)) + ((cider-library-present-p "clojure.stacktrace") + (cider-default-err-eval-handler)) + (t (cider-default-err-eval-print-handler)))) + ;; The format of the error messages emitted by Clojure's compiler changed in ;; Clojure 1.10. That's why we're trying to match error messages to both the @@ -647,16 +669,21 @@ evaluation command. Honor `cider-auto-jump-to-error'." (defun cider-insert-eval-handler (&optional buffer) "Make an nREPL evaluation handler for the BUFFER. The handler simply inserts the result value in BUFFER." - (let ((eval-buffer (current-buffer))) + (let ((eval-buffer (current-buffer)) + (res "")) (nrepl-make-response-handler (or buffer eval-buffer) (lambda (_buffer value) (with-current-buffer buffer - (insert value))) + (insert value)) + (when cider-eval-register + (setq res (concat res value)))) (lambda (_buffer out) (cider-repl-emit-interactive-stdout out)) (lambda (_buffer err) (cider-handle-compilation-errors err eval-buffer)) - '()))) + (lambda (_buffer) + (when cider-eval-register + (set-register cider-eval-register res)))))) (defun cider--emit-interactive-eval-output (output repl-emit-function) "Emit output resulting from interactive code evaluation. @@ -715,38 +742,50 @@ when `cider-auto-inspect-after-eval' is non-nil." (end (or (car-safe (cdr-safe place)) place)) (beg (when beg (copy-marker beg))) (end (when end (copy-marker end))) - (fringed nil)) + (fringed nil) + (res "")) (nrepl-make-response-handler (or buffer eval-buffer) (lambda (_buffer value) - (if beg - (unless fringed - (cider--make-fringe-overlays-for-region beg end) - (setq fringed t)) - (cider--make-fringe-overlay end)) - (cider--display-interactive-eval-result value end)) + (setq res (concat res value)) + (cider--display-interactive-eval-result res end)) (lambda (_buffer out) (cider-emit-interactive-eval-output out)) (lambda (_buffer err) - (unless cider-show-error-buffer + (cider-emit-interactive-eval-err-output err) + + (when (or (not cider-show-error-buffer) + (not (cider-connection-has-capability-p 'jvm-compilation-errors))) + ;; Display errors as temporary overlays (let ((cider-result-use-clojure-font-lock nil)) (cider--display-interactive-eval-result err end 'cider-error-overlay-face))) (cider-handle-compilation-errors err eval-buffer)) - (when (and cider-auto-inspect-after-eval - (boundp 'cider-inspector-buffer) - (windowp (get-buffer-window cider-inspector-buffer 'visible))) - (lambda (buffer) + (lambda (buffer) + (if beg + (unless fringed + (cider--make-fringe-overlays-for-region beg end) + (setq fringed t)) + (cider--make-fringe-overlay end)) + (when (and cider-auto-inspect-after-eval + (boundp 'cider-inspector-buffer) + (windowp (get-buffer-window cider-inspector-buffer 'visible))) (cider-inspect-last-result) - (select-window (get-buffer-window buffer))))))) + (select-window (get-buffer-window buffer))) + (when cider-eval-register + (set-register cider-eval-register res)))))) + (defun cider-load-file-handler (&optional buffer done-handler) "Make a load file handler for BUFFER. Optional argument DONE-HANDLER lambda will be run once load is complete." - (let ((eval-buffer (current-buffer))) + (let ((eval-buffer (current-buffer)) + (res "")) (nrepl-make-response-handler (or buffer eval-buffer) (lambda (buffer value) (cider--display-interactive-eval-result value) + (when cider-eval-register + (setq res (concat res value))) (when (buffer-live-p buffer) (with-current-buffer buffer (cider--make-fringe-overlays-for-region (point-min) (point-max)) @@ -756,12 +795,18 @@ Optional argument DONE-HANDLER lambda will be run once load is complete." (lambda (_buffer err) (cider-emit-interactive-eval-err-output err) (cider-handle-compilation-errors err eval-buffer)) - (or done-handler '()) + (lambda (buffer) + (when cider-eval-register + (set-register cider-eval-register res)) + (when done-handler + (funcall done-handler buffer))) (lambda () (funcall nrepl-err-handler))))) (defun cider-eval-print-handler (&optional buffer) "Make a handler for evaluating and printing result in BUFFER." + ;; NOTE: cider-eval-register behavior is not implemented here for performance reasons. + ;; See https://github.com/clojure-emacs/cider/pull/3162 (nrepl-make-response-handler (or buffer (current-buffer)) (lambda (buffer value) (with-current-buffer buffer @@ -773,24 +818,28 @@ Optional argument DONE-HANDLER lambda will be run once load is complete." (cider-emit-interactive-eval-output out)) (lambda (_buffer err) (cider-emit-interactive-eval-err-output err)) - '())) + ())) (defun cider-eval-print-with-comment-handler (buffer location comment-prefix) "Make a handler for evaluating and printing commented results in BUFFER. LOCATION is the location marker at which to insert. COMMENT-PREFIX is the comment prefix to use." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (with-current-buffer buffer - (save-excursion - (goto-char (marker-position location)) - (insert (concat comment-prefix - value "\n"))))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - '())) + (let ((res "")) + (nrepl-make-response-handler buffer + (lambda (_buffer value) + (setq res (concat res value))) + (lambda (_buffer out) + (cider-emit-interactive-eval-output out)) + (lambda (_buffer err) + (cider-emit-interactive-eval-err-output err)) + (lambda (buffer) + (with-current-buffer buffer + (save-excursion + (goto-char (marker-position location)) + (insert (concat comment-prefix + res "\n")))) + (when cider-eval-register + (set-register cider-eval-register res)))))) (defun cider-maybe-insert-multiline-comment (result comment-prefix continued-prefix comment-postfix) "Insert eval RESULT at current location if RESULT is not empty. @@ -798,11 +847,15 @@ RESULT will be preceded by COMMENT-PREFIX. CONTINUED-PREFIX is inserted for each additional line of output. COMMENT-POSTFIX is inserted after final text output." (unless (string= result "") - (let ((lines (split-string result "[\n]+" t))) + (clojure-indent-line) + (let ((lines (split-string result "[\n]+" t)) + (beg (point)) + (col (current-indentation))) ;; only the first line gets the normal comment-prefix (insert (concat comment-prefix (pop lines))) (dolist (elem lines) (insert (concat "\n" continued-prefix elem))) + (indent-rigidly beg (point) col) (unless (string= comment-postfix "") (insert comment-postfix))))) @@ -825,7 +878,11 @@ COMMENT-POSTFIX is the text to output after the last line." (with-current-buffer buffer (save-excursion (goto-char (marker-position location)) - (cider-maybe-insert-multiline-comment res comment-prefix continued-prefix comment-postfix)))) + ;; edge case: defun at eob + (unless (bolp) (insert "\n")) + (cider-maybe-insert-multiline-comment res comment-prefix continued-prefix comment-postfix))) + (when cider-eval-register + (set-register cider-eval-register res))) nil nil (lambda (_buffer warning) @@ -834,6 +891,8 @@ COMMENT-POSTFIX is the text to output after the last line." (defun cider-popup-eval-handler (&optional buffer) "Make a handler for printing evaluation results in popup BUFFER. This is used by pretty-printing commands." + ;; NOTE: cider-eval-register behavior is not implemented here for performance reasons. + ;; See https://github.com/clojure-emacs/cider/pull/3162 (nrepl-make-response-handler (or buffer (current-buffer)) (lambda (buffer value) @@ -958,7 +1017,7 @@ buffer." (cider--nrepl-pr-request-map)))) (defun cider-eval-list-at-point (&optional output-to-current-buffer) - "Evaluate the list (eg. a function call, surrounded by parens) around point. + "Evaluate the list (eg. a function call, surrounded by parens) around point. If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." (interactive "P") (save-excursion @@ -973,37 +1032,86 @@ If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." (goto-char (cadr (cider-sexp-at-point 'bounds))) (cider-eval-last-sexp output-to-current-buffer))) +(defun cider-tap-last-sexp (&optional output-to-current-buffer) + "Evaluate and tap the expression preceding point. +If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current +buffer." + (interactive "P") + (let ((tapped-form (concat "(clojure.core/doto " (cider-last-sexp) " (clojure.core/tap>))"))) + (cider-interactive-eval tapped-form + (when output-to-current-buffer (cider-eval-print-handler)) + nil + (cider--nrepl-pr-request-map)))) + +(defun cider-tap-sexp-at-point (&optional output-to-current-buffer) + "Evaluate and tap the expression around point. +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-tap-last-sexp output-to-current-buffer))) + (defvar-local cider-previous-eval-context nil "The previous evaluation context if any. That's set by commands like `cider-eval-last-sexp-in-context'.") -(defun cider--eval-in-context (code) - "Evaluate CODE in user-provided evaluation context." - (let* ((code (string-trim-right code)) - (eval-context (read-string - (format "Evaluation context (let-style) for `%s': " code) - cider-previous-eval-context)) + +(defun cider--guess-eval-context () + "Return context for `cider--eval-in-context'. +This is done by extracting all parent let bindings." + (save-excursion + (let ((res "")) + (condition-case nil + (while t + (backward-up-list) + (when (looking-at (rx "(" (or "when-let" "if-let" "let") (opt "*") + symbol-end (* space) + (group "["))) ;; binding vector + (let ((beg (match-end 1)) + (end (save-excursion + (goto-char (match-beginning 1)) + (forward-sexp 1) + (1- (point))))) + (setq res (concat (buffer-substring-no-properties beg end) ", " res))))) + (scan-error res))))) + +(defun cider--eval-in-context (bounds &optional guess) + "Evaluate code at BOUNDS in user-provided evaluation context. +When GUESS is non-nil, attempt to extract the context from parent let-bindings." + (let* ((code (string-trim-right + (buffer-substring-no-properties (car bounds) (cadr bounds)))) + (eval-context + (minibuffer-with-setup-hook (if guess #'beginning-of-buffer #'ignore) + (read-string "Evaluation context (let-style): " + (if guess (cider--guess-eval-context) + cider-previous-eval-context)))) (code (concat "(let [" eval-context "]\n " code ")"))) + (setq-local cider-previous-eval-context eval-context) (cider-interactive-eval code nil - nil - (cider--nrepl-pr-request-map)) - (setq-local cider-previous-eval-context eval-context))) + bounds + (cider--nrepl-pr-request-map)))) -(defun cider-eval-last-sexp-in-context () +(defun cider-eval-last-sexp-in-context (guess) "Evaluate the preceding sexp in user-supplied context. The context is just a let binding vector (without the brackets). -The context is remembered between command invocations." - (interactive) - (cider--eval-in-context (cider-last-sexp))) +The context is remembered between command invocations. -(defun cider-eval-sexp-at-point-in-context () - "Evaluate the preceding sexp in user-supplied context. +When GUESS is non-nil, or called interactively with \\[universal-argument], +attempt to extract the context from parent let-bindings." + (interactive "P") + (cider--eval-in-context (cider-last-sexp 'bounds) guess)) + +(defun cider-eval-sexp-at-point-in-context (guess) + "Evaluate the sexp around point in user-supplied context. The context is just a let binding vector (without the brackets). -The context is remembered between command invocations." - (interactive) - (cider--eval-in-context (cider-sexp-at-point))) +The context is remembered between command invocations. + +When GUESS is non-nil, or called interactively with \\[universal-argument], +attempt to extract the context from parent let-bindings." + (interactive "P") + (cider--eval-in-context (cider-sexp-at-point 'bounds) guess)) (defun cider-eval-defun-to-comment (&optional insert-before) "Evaluate the \"top-level\" form and insert result as comment. @@ -1257,12 +1365,15 @@ buffer, else display in a popup 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." - (interactive) - (when (clojure-find-ns) +(defun cider-eval-ns-form (&optional undef-all) + "Evaluate the current buffer's namespace form. +When UNDEF-ALL is non-nil, unmap all symbols and aliases first." + (interactive "P") + (when-let ((ns (clojure-find-ns))) (save-excursion (goto-char (match-beginning 0)) + (when undef-all + (cider-undef-all ns)) (cider-eval-defun-at-point)))) (defun cider-read-and-eval (&optional value) @@ -1293,6 +1404,33 @@ passing arguments." (form (format "(%s)" fn-name))) (cider-read-and-eval (cons form (length form))))) +(defun cider-kill-last-result () + "Save the last evaluated result into the kill ring." + (interactive) + (kill-new + (nrepl-dict-get (cider-nrepl-sync-request:eval "*1") "value"))) + +(defun cider-undef () + "Undefine a symbol from the current ns." + (interactive) + (cider-ensure-op-supported "undef") + (cider-read-symbol-name + "Undefine symbol: " + (lambda (sym) + (cider-nrepl-send-request + `("op" "undef" + "ns" ,(cider-current-ns) + "sym" ,sym) + (cider-interactive-eval-handler (current-buffer)))))) + +(defun cider-undef-all (&optional ns) + "Undefine all symbols and aliases from the namespace NS." + (interactive) + (cider-ensure-op-supported "undef-all") + (cider-nrepl-send-sync-request + `("op" "undef-all" + "ns" ,(or ns (cider-current-ns))))) + ;; Eval keymaps (defvar cider-eval-pprint-commands-map (let ((map (define-prefix-command 'cider-eval-pprint-commands-map))) @@ -1319,13 +1457,16 @@ passing arguments." (define-key map (kbd "n") #'cider-eval-ns-form) (define-key map (kbd "d") #'cider-eval-defun-at-point) (define-key map (kbd "e") #'cider-eval-last-sexp) + (define-key map (kbd "q") #'cider-tap-last-sexp) (define-key map (kbd "l") #'cider-eval-list-at-point) (define-key map (kbd "v") #'cider-eval-sexp-at-point) + (define-key map (kbd "t") #'cider-tap-sexp-at-point) (define-key map (kbd "o") #'cider-eval-sexp-up-to-point) (define-key map (kbd ".") #'cider-read-and-eval-defun-at-point) (define-key map (kbd "z") #'cider-eval-defun-up-to-point) (define-key map (kbd "c") #'cider-eval-last-sexp-in-context) (define-key map (kbd "b") #'cider-eval-sexp-at-point-in-context) + (define-key map (kbd "k") #'cider-kill-last-result) (define-key map (kbd "f") 'cider-eval-pprint-commands-map) ;; duplicates with C- for convenience @@ -1334,13 +1475,16 @@ passing arguments." (define-key map (kbd "C-n") #'cider-eval-ns-form) (define-key map (kbd "C-d") #'cider-eval-defun-at-point) (define-key map (kbd "C-e") #'cider-eval-last-sexp) + (define-key map (kbd "C-q") #'cider-tap-last-sexp) (define-key map (kbd "C-l") #'cider-eval-list-at-point) (define-key map (kbd "C-v") #'cider-eval-sexp-at-point) + (define-key map (kbd "C-t") #'cider-tap-sexp-at-point) (define-key map (kbd "C-o") #'cider-eval-sexp-up-to-point) (define-key map (kbd "C-.") #'cider-read-and-eval-defun-at-point) (define-key map (kbd "C-z") #'cider-eval-defun-up-to-point) (define-key map (kbd "C-c") #'cider-eval-last-sexp-in-context) (define-key map (kbd "C-b") #'cider-eval-sexp-at-point-in-context) + (define-key map (kbd "C-k") #'cider-kill-last-result) (define-key map (kbd "C-f") 'cider-eval-pprint-commands-map) map)) @@ -1351,13 +1495,15 @@ passing arguments." (widen) (substring-no-properties (buffer-string))))) -(defun cider-load-buffer (&optional buffer callback) +(defun cider-load-buffer (&optional buffer callback undef-all) "Load (eval) BUFFER's file in nREPL. If no buffer is provided the command acts on the current buffer. If the buffer is for a cljc file, and both a Clojure and ClojureScript REPL exists for the project, it is evaluated in both REPLs. -Optional argument CALLBACK will override the default ‘cider-load-file-handler’." - (interactive) +Optional argument CALLBACK will override the default ‘cider-load-file-handler’. +When UNDEF-ALL is non-nil or called with \\[universal-argument], removes +all ns aliases and var mappings from the namespace before reloading it." + (interactive (list (current-buffer) nil (equal current-prefix-arg '(4)))) (setq buffer (or buffer (current-buffer))) ;; When cider-load-buffer or cider-load-file are called in programs the ;; current context might not match the buffer's context. We use the caller @@ -1375,6 +1521,8 @@ Optional argument CALLBACK will override the default ‘cider-load-file-handler (y-or-n-p (format "Save file %s? " buffer-file-name)))) (save-buffer)) (remove-overlays nil nil 'cider-temporary t) + (when undef-all + (cider-undef-all (cider-current-ns))) (cider--clear-compilation-highlights) (cider--quit-error-window) (let ((filename (buffer-file-name buffer)) @@ -1391,25 +1539,30 @@ Optional argument CALLBACK will override the default ‘cider-load-file-handler callback))) (message "Loading %s..." filename)))))) -(defun cider-load-file (filename) +(defun cider-load-file (filename &optional undef-all) "Load (eval) the Clojure file FILENAME in nREPL. If the file is a cljc file, and both a Clojure and ClojureScript REPL exists for the project, it is evaluated in both REPLs. The heavy lifting -is done by `cider-load-buffer'." +is done by `cider-load-buffer'. +When UNDEF-ALL is non-nil or called with \\[universal-argument], removes +all ns aliases and var mappings from the namespace before reloading it." (interactive (list (read-file-name "Load file: " nil nil nil (when (buffer-file-name) (file-name-nondirectory - (buffer-file-name)))))) + (buffer-file-name)))) + (equal current-prefix-arg '(4)))) (if-let* ((buffer (find-buffer-visiting filename))) - (cider-load-buffer buffer) - (cider-load-buffer (find-file-noselect filename)))) + (cider-load-buffer buffer nil undef-all) + (cider-load-buffer (find-file-noselect filename) nil undef-all))) -(defun cider-load-all-files (directory) +(defun cider-load-all-files (directory undef-all) "Load all files in DIRECTORY (recursively). -Useful when the running nREPL on remote host." - (interactive "DLoad files beneath directory: ") - (mapcar #'cider-load-file +Useful when the running nREPL on remote host. +When UNDEF-ALL is non-nil or called with \\[universal-argument], removes +all ns aliases and var mappings from the namespaces being reloaded" + (interactive "DLoad files beneath directory: \nP") + (mapcar (lambda (file) (cider-load-file file undef-all)) (directory-files-recursively directory "\\.clj[cs]?$"))) (defalias 'cider-eval-file #'cider-load-file diff --git a/elpa/cider-20220417.951/cider-find.el b/elpa/cider-20230707.640/cider-find.el similarity index 98% rename from elpa/cider-20220417.951/cider-find.el rename to elpa/cider-20230707.640/cider-find.el index 82525056..6e882ae3 100644 --- a/elpa/cider-20220417.951/cider-find.el +++ b/elpa/cider-20230707.640/cider-find.el @@ -1,6 +1,6 @@ ;;; cider-find.el --- Functionality for finding things -*- lexical-binding: t -*- -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Bozhidar Batsov ;; Artur Malabarba @@ -109,7 +109,7 @@ Show results in a different window if OTHER-WINDOW is true." (defun cider-find-dwim (symbol-file) "Find and display the SYMBOL-FILE at point. SYMBOL-FILE could be a var or a resource. If thing at point is empty then -show dired on project. If var is not found, try to jump to resource of the +show Dired on project. If var is not found, try to jump to resource of the same name. When called interactively, a prompt is given according to the variable `cider-prompt-for-symbol'. A single or double prefix argument inverts the meaning. A prefix of `-' or a double prefix argument causes diff --git a/elpa/cider-20220417.951/cider-format.el b/elpa/cider-20230707.640/cider-format.el similarity index 96% rename from elpa/cider-20220417.951/cider-format.el rename to elpa/cider-20230707.640/cider-format.el index a33aecbb..eeb3562c 100644 --- a/elpa/cider-20220417.951/cider-format.el +++ b/elpa/cider-20230707.640/cider-format.el @@ -1,6 +1,6 @@ ;;; cider-format.el --- Code and EDN formatting functionality -*- lexical-binding: t -*- -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Bozhidar Batsov ;; Artur Malabarba @@ -68,8 +68,9 @@ Uses the following heuristic to try to maintain point position: (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)) + (snippet (thread-last + (buffer-substring-no-properties + pos (min (+ pos l) pos-max)) (regexp-quote) (replace-regexp-in-string "[[:space:]\t\n\r]+" "[[:space:]\t\n\r]*")))) (delete-region start end) diff --git a/elpa/cider-20220417.951/cider-inspector.el b/elpa/cider-20230707.640/cider-inspector.el similarity index 92% rename from elpa/cider-20220417.951/cider-inspector.el rename to elpa/cider-20230707.640/cider-inspector.el index 5355b36a..085e4026 100644 --- a/elpa/cider-20220417.951/cider-inspector.el +++ b/elpa/cider-20230707.640/cider-inspector.el @@ -1,7 +1,7 @@ ;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*- -;; Copyright © 2013-2022 Vital Reactor, LLC -;; Copyright © 2014-2022 Bozhidar Batsov and CIDER contributors +;; Copyright © 2013-2014 Vital Reactor, LLC +;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors ;; Author: Ian Eslick ;; Bozhidar Batsov @@ -108,7 +108,11 @@ by clicking or navigating to them by other means." (define-key map "d" #'cider-inspector-def-current-val) (define-key map [tab] #'cider-inspector-next-inspectable-object) (define-key map "\C-i" #'cider-inspector-next-inspectable-object) + (define-key map "n" #'cider-inspector-next-inspectable-object) (define-key map [(shift tab)] #'cider-inspector-previous-inspectable-object) + (define-key map "p" #'cider-inspector-previous-inspectable-object) + (define-key map "f" #'forward-char) + (define-key map "b" #'backward-char) ;; Emacs translates S-TAB to BACKTAB on X. (define-key map [backtab] #'cider-inspector-previous-inspectable-object) (easy-menu-define cider-inspector-mode-menu map @@ -287,63 +291,63 @@ current-namespace." (defun cider-sync-request:inspect-pop () "Move one level up in the inspector stack." (thread-first '("op" "inspect-pop") - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-push (idx) "Inspect the inside value specified by IDX." (thread-first `("op" "inspect-push" "idx" ,idx) - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-refresh () "Re-render the currently inspected value." (thread-first '("op" "inspect-refresh") - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-next-page () "Jump to the next page in paginated collection view." (thread-first '("op" "inspect-next-page") - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-prev-page () "Jump to the previous page in paginated collection view." (thread-first '("op" "inspect-prev-page") - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-set-page-size (page-size) "Set the page size in paginated view to PAGE-SIZE." (thread-first `("op" "inspect-set-page-size" "page-size" ,page-size) - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-set-max-atom-length (max-length) "Set the max length of nested atoms to MAX-LENGTH." (thread-first `("op" "inspect-set-max-atom-length" "max-atom-length" ,max-length) - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-set-max-coll-size (max-size) "Set the number of nested collection members to display before truncating. MAX-SIZE is the new value." (thread-first `("op" "inspect-set-max-coll-size" "max-coll-size" ,max-size) - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-def-current-val (ns var-name) "Defines a var with VAR-NAME in NS with the current inspector value." (thread-first `("op" "inspect-def-current-value" "ns" ,ns "var-name" ,var-name) - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-expr (expr ns page-size max-atom-length max-coll-size) "Evaluate EXPR in context of NS and inspect its result. @@ -358,8 +362,8 @@ MAX-COLL-SIZE if non nil." `("max-atom-length" ,max-atom-length)) ,@(when max-coll-size `("max-coll-size" ,max-coll-size)))) - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) ;; Render Inspector from Structured Values (defun cider-inspector--render-value (value) @@ -368,6 +372,7 @@ MAX-COLL-SIZE if non nil." (cider-inspector-render cider-inspector-buffer value) (cider-popup-buffer-display cider-inspector-buffer cider-inspector-auto-select-buffer) (when cider-inspector-fill-frame (delete-other-windows)) + (ignore-errors (cider-inspector-next-inspectable-object 1)) (with-current-buffer cider-inspector-buffer (when (eq cider-inspector-last-command 'cider-inspector-pop) (setq cider-inspector-last-command nil) diff --git a/elpa/cider-20220417.951/cider-jar.el b/elpa/cider-20230707.640/cider-jar.el similarity index 100% rename from elpa/cider-20220417.951/cider-jar.el rename to elpa/cider-20230707.640/cider-jar.el diff --git a/elpa/cider-20230707.640/cider-log.el b/elpa/cider-20230707.640/cider-log.el new file mode 100644 index 00000000..fbe0106b --- /dev/null +++ b/elpa/cider-20230707.640/cider-log.el @@ -0,0 +1,1428 @@ +;;; cider-log.el --- Log inspection functionality for Clojure -*- lexical-binding: t -*- + +;; Copyright © 2023 Bozhidar Batsov and CIDER contributors + +;; Author: r0man + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Log inspection functionality for Clojure. +;; +;; Please, refer to the online documentation for more details +;; https://docs.cider.mx/cider/debugging/logging.html. + +;;; Code: + +(require 'cider-inspector) +(require 'cider-stacktrace) +(require 'cl-lib) +(require 'logview nil t) +(require 'org) +(require 'seq) +(require 'transient) + +(defcustom cider-log-framework-name nil + "The name of the current log framework." + :group 'cider + :package-version '(cider . "1.8.0") + :safe #'stringp + :type 'string) + +(defcustom cider-log-appender-id "cider-log" + "The name of the default log appender." + :group 'cider + :package-version '(cider . "1.8.0") + :safe #'stringp + :type 'string) + +(defcustom cider-log-buffer "*cider-log*" + "The name of the log buffer." + :group 'cider + :package-version '(cider . "1.8.0") + :safe #'stringp + :type 'string) + +(defcustom cider-log-event-buffer "*cider-log-event*" + "The name of the log event buffer." + :group 'cider + :package-version '(cider . "1.8.0") + :safe #'stringp + :type 'string) + +(defcustom cider-log-max-message-length 500 + "The maximum length of the log message to display." + :group 'cider + :package-version '(cider . "1.8.0") + :safe #'integerp + :type 'integer) + +(defcustom cider-log-pagination-limit 250 + "The maximum number of log events to return when searching events." + :group 'cider + :package-version '(cider . "1.8.0") + :safe #'integerp + :type 'integer) + +(defcustom cider-log-pagination-offset 0 + "The offset from which to return results when searching events." + :group 'cider + :package-version '(cider . "1.8.0") + :safe #'integerp + :type 'integer) + +(defcustom cider-log-use-logview (fboundp 'logview-mode) + "Whether to use `logview-mode' or not." + :group 'cider + :package-version '(cider . "1.8.0") + :safe #'booleanp + :type 'boolean) + +(defvar logview-mode-map) +(declare-function logview--guess-submode "logview" () t) +(declare-function logview-initialized-p "logview" () t) +(declare-function logview-mode "logview" () t) + +(defvar cider-log--initialized-once-p nil + "Set to t if log framework and appender have been initialized once.") + +(defvar cider-log-framework nil + "The current log framework to use.") + +(defvar cider-log-appender nil + "The current log appender.") + +(defvar cider-log-appender-size 100000 + "The size of the log appender.") + +(defvar cider-log-appender-threshold 10 + "The threshold in percent of the log appender.") + +(defvar-local cider-log-consumer nil + "The current log consumer.") + +;; Filters + +(defvar cider-log--end-time-filter nil) +(defvar cider-log--exceptions-filter nil) +(defvar cider-log--level-filter nil) +(defvar cider-log--loggers-filter nil) +(defvar cider-log--pattern-filter nil) +(defvar cider-log--start-time-filter nil) +(defvar cider-log--threads-filter nil) + +(defun cider-log--bold (s) + "Return S with a bold face." + (when s (propertize (format "%s" s) 'face 'bold))) + +(defun cider-log-buffer-clear-p (&optional buffer) + "Return non-nil if BUFFER is not empty, otherwise nil." + (when-let (buffer (get-buffer (or buffer cider-log-buffer))) + (> (buffer-size buffer) 0))) + +(defun cider-log--description-clear-events-buffer () + "Return the description for the set framework action." + (format "Clear %s buffer" + (if cider-log-buffer + (cider-log--format-value cider-log-buffer) + (propertize "n/a" 'face 'font-lock-comment-face)))) + +(defun cider-log--description-set-framework () + "Return the description for the set framework action." + (format "Select framework %s" + (if cider-log-framework-name + (cider-log--format-value cider-log-framework-name) + (propertize "n/a" 'face 'font-lock-comment-face)))) + +(defun cider-log--description-set-buffer () + "Return the description for the set buffer action." + (format "Select buffer %s" + (if cider-log-buffer + (cider-log--format-value cider-log-buffer) + (propertize "n/a" 'face 'font-lock-comment-face)))) + +(defun cider-log--buffers-in-major-mode (expected) + "Return all buffers which are in the EXPECTED major mode." + (seq-filter (lambda (buffer) + (with-current-buffer buffer + (equal expected major-mode))) + (buffer-list))) + +(defun cider-log--format-time (time) + "Format TIME in ISO8601 format." + (format-time-string "%FT%T%z" time)) + +(defun cider-log--format-value (value) + "Format the VALUE for display in a transient menu." + (cond ((null value) "") + ((or (listp value) (vectorp value)) + (string-join (seq-map #'cider-log--format-value value) + (propertize ", " 'face 'font-lock-comment-face))) + (t (propertize (format "%s" value) 'face 'transient-value)))) + +(defun cider-log--strip-whitespace (s) + "Replace multiple white space characters in S with a single one." + (replace-regexp-in-string "[\n ]+" " " s)) + +;; NREPL + +(defun cider-request:log-add-consumer (framework appender consumer &optional callback) + "Add CONSUMER to the APPENDER of FRAMEWORK and call CALLBACK on log events." + (cider-ensure-op-supported "cider/log-add-consumer") + (thread-first `("op" "cider/log-add-consumer" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender) + "filters" ,(cider-log-consumer-filters consumer)) + (cider-nrepl-send-request callback))) + +(defun cider-request:log-analyze-stacktrace (framework appender event &optional callback) + "Analyze the EVENT stacktrace of the APPENDER of FRAMEWORK and call CALLBACK." + (cider-ensure-op-supported "cider/log-analyze-stacktrace") + (thread-first `("op" "cider/log-analyze-stacktrace" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender) + "event" ,(cider-log-event-id event)) + (cider-nrepl-send-request callback))) + +(defun cider-sync-request:log-update-consumer (framework appender consumer) + "Add CONSUMER to the APPENDER of FRAMEWORK and call CALLBACK on log events." + (cider-ensure-op-supported "cider/log-update-consumer") + (thread-first `("op" "cider/log-update-consumer" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender) + "consumer" ,(cider-log-consumer-id consumer) + "filters" ,(cider-log-consumer-filters consumer)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-update-consumer"))) + +(defun cider-sync-request:log-add-appender (framework appender) + "Add the APPENDER to the log FRAMEWORK." + (cider-ensure-op-supported "cider/log-add-appender") + (thread-first `("op" "cider/log-add-appender" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender) + "filters" ,(cider-log-appender-filters appender) + "size" ,(cider-log-appender-size appender) + "threshold" ,(cider-log-appender-threshold appender)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-add-appender"))) + +(defun cider-sync-request:log-update-appender (framework appender) + "Update the APPENDER of the log FRAMEWORK." + (cider-ensure-op-supported "cider/log-update-appender") + (thread-first `("op" "cider/log-update-appender" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender) + "filters" ,(cider-log-appender-filters appender) + "size" ,(cider-log-appender-size appender) + "threshold" ,(cider-log-appender-threshold appender)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-update-appender"))) + +(defun cider-sync-request:log-clear (framework appender) + "Clear the log events for FRAMEWORK and APPENDER." + (cider-ensure-op-supported "cider/log-clear-appender") + (thread-first `("op" "cider/log-clear-appender" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-clear-appender"))) + +(defun cider-sync-request:log-inspect-event (framework appender event) + "Inspect the log event with the ID in the APPENDER of the log FRAMEWORK." + (cider-ensure-op-supported "cider/log-inspect-event") + (thread-first `("op" "cider/log-inspect-event" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender) + "event" ,(cider-log-event-id event)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "value"))) + +(defun cider-sync-request:log-format-event (framework appender event) + "Format the log EVENT from the APPENDER of the log FRAMEWORK." + (cider-ensure-op-supported "cider/log-format-event") + (thread-first + (seq-mapcat #'identity + (map-merge 'list + (cider--nrepl-print-request-map fill-column) + `(("op" "cider/log-format-event") + ("framework" ,(cider-log-framework-id framework)) + ("appender" ,(cider-log-appender-id appender)) + ("event" ,(cider-log-event-id event))))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-format-event"))) + +(defun cider-sync-request:log-frameworks () + "Return the available log frameworks." + (cider-ensure-op-supported "cider/log-frameworks") + (thread-first `("op" "cider/log-frameworks") + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-frameworks"))) + +(cl-defun cider-sync-request:log-search (framework appender &key filters limit offset) + "Search log events of FRAMEWORK and APPENDER using FILTERS, LIMIT and OFFSET." + (cider-ensure-op-supported "cider/log-search") + (thread-first `("op" "cider/log-search" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender) + "filters" ,filters + "limit" ,limit + "offset" ,offset) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-search"))) + +(defun cider-sync-request:log-exceptions (framework appender) + "Return the Cider log exceptions for FRAMEWORK and APPENDER." + (cider-ensure-op-supported "cider/log-exceptions") + (thread-first `("op" "cider/log-exceptions" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-exceptions"))) + +(defun cider-sync-request:log-levels (framework appender) + "Return the Cider log levels for FRAMEWORK and APPENDER." + (cider-ensure-op-supported "cider/log-levels") + (thread-first `("op" "cider/log-levels" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-levels"))) + +(defun cider-sync-request:log-loggers (framework appender) + "Return the Cider loggers for FRAMEWORK and APPENDER." + (cider-ensure-op-supported "cider/log-loggers") + (thread-first `("op" "cider/log-loggers" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-loggers"))) + +(defun cider-sync-request:log-remove-appender (framework appender) + "Remove the APPENDER from the log FRAMEWORK." + (cider-ensure-op-supported "cider/log-remove-appender") + (thread-first `("op" "cider/log-remove-appender" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-remove-appender"))) + +(defun cider-sync-request:log-remove-consumer (framework appender consumer) + "Remove the CONSUMER from the APPENDER of the log FRAMEWORK." + (cider-ensure-op-supported "cider/log-remove-consumer") + (thread-first `("op" "cider/log-remove-consumer" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender) + "consumer" ,(cider-log-consumer-id consumer)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-remove-consumer"))) + +(defun cider-sync-request:log-threads (framework appender) + "Return the threads for FRAMEWORK and APPENDER." + (cider-ensure-op-supported "cider/log-threads") + (thread-first `("op" "cider/log-threads" + "framework" ,(cider-log-framework-id framework) + "appender" ,(cider-log-appender-id appender)) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "cider/log-threads"))) + +(defun cider-log--completion-extra-properties (keys &optional separator) + "Return the completion properties for NREPL dictionaries. + +The KEYS are used to lookup the values and are joined by SEPARATOR." + `(:annotation-function + ,(lambda (identifier) + (when-let (dict (cadr (assoc identifier minibuffer-completion-table))) + (let ((annotation (string-join (seq-map (lambda (key) (nrepl-dict-get dict key)) keys) + (or separator " ")))) + (unless (string-blank-p annotation) + (propertize (format " - %s" (cider-log--strip-whitespace annotation)) + 'face 'font-lock-comment-face))))))) + +(defun cider-log--read-appender-id (prompt initial-input history) + "Read a appender from the minibuffer using PROMPT, INITIAL-INPUT and HISTORY." + (let ((table (when cider-log-framework + (when-let (framework (cider-log-framework-reload cider-log-framework)) + (seq-map #'cider-log-appender-id (cider-log-framework-appenders framework)))))) + (completing-read (or prompt "Log appender: ") table nil nil + (or initial-input cider-log-appender-id) + history cider-log-appender-id))) + +(defun cider-log--read-buffer (&optional prompt initial-input history) + "Read the log buffer name using PROMPT, INITIAL-INPUT and HISTORY." + (let ((table (seq-map #'buffer-name (cider-log--buffers-in-major-mode 'cider-log-mode)))) + (completing-read (or prompt "Buffer: ") table nil nil + (or initial-input cider-log-buffer) + history cider-log-buffer))) + +(defun cider-log--read-exceptions (&optional prompt initial-input history) + "Read a list of exceptions using PROMPT, INITIAL-INPUT and HISTORY." + (let ((table (when (cider-log-appender-attached-p) + (nrepl-dict-keys (cider-sync-request:log-exceptions + cider-log-framework cider-log-appender))))) + (completing-read-multiple (or prompt "Exceptions: ") table nil nil initial-input history))) + +(defun cider-log--read-framework-name (&optional prompt initial-input history) + "Read a framework name using PROMPT, INITIAL-INPUT and HISTORY." + (let ((completion-extra-properties (cider-log--completion-extra-properties '("name"))) + (frameworks (cider-sync-request:log-frameworks))) + (completing-read (or prompt "Log framework: ") + (seq-map (lambda (framework) + (list (cider-log-framework-name framework) framework)) + frameworks) + nil nil initial-input history))) + +(defun cider-log--read-level (&optional prompt initial-input history) + "Read a log level using PROMPT, INITIAL-INPUT and HISTORY." + (let ((table (when cider-log-framework (cider-log-framework-level-names cider-log-framework)))) + (completing-read (or prompt "Level: ") table nil nil initial-input history))) + +(defun cider-log--read-loggers (&optional prompt initial-input history) + "Read a list of loggers using PROMPT, INITIAL-INPUT and HISTORY." + (let ((table (when (cider-log-appender-attached-p) + (nrepl-dict-keys (cider-sync-request:log-loggers + cider-log-framework cider-log-appender))))) + (completing-read-multiple (or "Loggers: " prompt) table nil nil initial-input history))) + +(defun cider-log--read-number-N0 (&optional prompt initial-input history) + "Read a natural number (including zero) using PROMPT, INITIAL-INPUT and HISTORY." + (when-let (value (transient-read-number-N0 (or prompt "Number: ") initial-input history)) + (string-to-number value))) + +(defun cider-log--read-number-N+ (&optional prompt initial-input history) + "Read a natural number (excluding zero) using PROMPT, INITIAL-INPUT and HISTORY." + (when-let (value (transient-read-number-N+ (or prompt "Number: ") initial-input history)) + (string-to-number value))) + +(defun cider-log--read-threads (&optional prompt initial-input history) + "Read a list of threads using PROMPT, INITIAL-INPUT and HISTORY." + (let ((table (when (cider-log-appender-attached-p) + (nrepl-dict-keys (cider-sync-request:log-threads + cider-log-framework cider-log-appender))))) + (completing-read-multiple (or prompt "Threads: ") table nil nil initial-input history))) + +(defun cider-log--read-time (&optional prompt initial-input _) + "Read a time from the minibuffer using PROMPT and INITIAL-INPUT." + (cider-log--format-time (org-read-date t 'to-time nil prompt nil initial-input))) + +;; Log Framework + +(defun cider-log-framework-appender (framework id) + "Return the appender of the log FRAMEWORK with the given ID." + (seq-find (lambda (appender) (equal id (cider-log-appender-id appender))) + (cider-log-framework-appenders framework))) + +(defun cider-log-framework-appenders (framework) + "Return the appenders of the log FRAMEWORK." + (nrepl-dict-get framework "appenders")) + +(defun cider-log-framework-id (framework) + "Return the id of the log FRAMEWORK." + (nrepl-dict-get framework "id")) + +(defun cider-log-framework-javadoc-url (framework) + "Return the Javadoc URL of the log FRAMEWORK." + (nrepl-dict-get framework "javadoc-url")) + +(defun cider-log-framework-name (framework) + "Return the name of the log FRAMEWORK." + (nrepl-dict-get framework "name")) + +(defun cider-log-framework-level-names (framework) + "Return the log level names of the log FRAMEWORK." + (seq-map (lambda (level) (nrepl-dict-get level "name")) + (nrepl-dict-get framework "levels"))) + +(defun cider-log-framework-website-url (framework) + "Return the website URL of the log FRAMEWORK." + (nrepl-dict-get framework "website-url")) + +(defun cider-log-framework-display-name (framework) + "Return the display name of the log FRAMEWORK." + (cider-log--bold (cider-log-framework-name framework))) + +(defun cider-log-framework-add-appender (framework appender) + "Add the APPENDER to the log FRAMEWORK." + (cider-sync-request:log-add-appender framework appender)) + +(defun cider-log-framework-by-id (frameworks id) + "Find the log framework in FRAMEWORKS by ID." + (seq-find (lambda (framework) (equal id (cider-log-framework-id framework))) frameworks)) + +(defun cider-log-framework-by-name (frameworks name) + "Find the log framework in FRAMEWORKS by NAME." + (seq-find (lambda (framework) (equal name (cider-log-framework-name framework))) frameworks)) + +(defun cider-log-framework-reload (framework) + "Reload the log FRAMEWORK." + (cider-log-framework-by-id + (cider-sync-request:log-frameworks) + (cider-log-framework-id framework))) + +;; Log Appender + +(defun cider-log-appender-attached-p (&optional framework appender) + "Return non-nil if the log APPENDER is attached to FRAMEWORK, otherwise nil." + (when-let ((framework (or framework + (cider-log-framework-by-name + (cider-sync-request:log-frameworks) + cider-log-framework-name))) + (appender-id (if appender + (cider-log-appender-id appender) + cider-log-appender-id))) + (cider-log-framework-appender framework appender-id))) + +(defun cider-log-appender-consumers (appender) + "Return the consumers of the log APPENDER." + (nrepl-dict-get appender "consumers")) + +(defun cider-log-appender-id (appender) + "Return the id of the log APPENDER." + (nrepl-dict-get appender "id")) + +(defun cider-log-appender-size (appender) + "Return the size of the log APPENDER." + (nrepl-dict-get appender "size")) + +(defun cider-log-appender-threshold (appender) + "Return the threshold of the log APPENDER." + (nrepl-dict-get appender "threshold")) + +(defun cider-log-appender-filters (appender) + "Return the filters of the log APPENDER." + (nrepl-dict-get appender "filters")) + +(defun cider-log-appender-display-name (appender) + "Return the display name of the log APPENDER." + (cider-log--bold (cider-log-appender-id appender))) + +(defun cider-log-appender-consumer (appender consumer) + "Find the consumer in the log APPENDER by the id slot of CONSUMER." + (let ((id (cider-log-consumer-id consumer))) + (seq-find (lambda (consumer) (equal id (cider-log-consumer-id consumer))) + (cider-log-appender-consumers appender)))) + +(defun cider-log-appender-reload (framework appender) + "Reload the APPENDER of the log FRAMEWORK." + (when-let (framework (cider-log-framework-reload framework)) + (cider-log-framework-appender framework (cider-log-appender-id appender)))) + +;; Log Consumer + +(defun cider-log-consumer-attached-p (&optional framework appender consumer) + "Return non-nil if the CONSUMER is attached to the APPENDER of FRAMEWORK." + (when-let ((framework (or framework cider-log-framework)) + (appender (or appender cider-log-appender)) + (consumer (or consumer cider-log-consumer))) + (cider-log-consumer-reload framework appender consumer))) + +(defun cider-log-consumer-id (consumer) + "Return the id of the log CONSUMER." + (nrepl-dict-get consumer "id")) + +(defun cider-log-consumer-filters (consumer) + "Return the filters of the log CONSUMER." + (nrepl-dict-get consumer "filters")) + +(defun cider-log-consumer-buffers (consumer) + "Find all buffers in which `cider-log-consumer' is bound to CONSUMER." + (seq-filter (lambda (buffer) + (with-current-buffer buffer + (and (nrepl-dict-p cider-log-consumer) + (equal (cider-log-consumer-id consumer) + (cider-log-consumer-id cider-log-consumer))))) + (buffer-list))) + +(defun cider-log-consumer-display-name (consumer) + "Return the display name of the log CONSUMER." + (cider-log--bold (cider-log-consumer-id consumer))) + +(defun cider-log-consumer-reload (framework appender consumer) + "Reload the CONSUMER attached to APPENDER of the log FRAMEWORK." + (when-let (appender (cider-log-appender-reload framework appender)) + (cider-log-appender-consumer appender consumer))) + +(defun cider-log--consumer-add (framework appender consumer buffer) + "Add the CONSUMER to the APPENDER of FRAMEWORK and write events to BUFFER." + (cider-request:log-add-consumer + framework appender consumer + (lambda (msg) + (nrepl-dbind-response msg (cider/log-add-consumer cider/log-consumer cider/log-event status) + (cond ((member "done" status) + (with-current-buffer (get-buffer-create buffer) + (setq-local cider-log-framework framework) + (setq-local cider-log-appender appender) + (setq cider-log-consumer cider/log-add-consumer) + (switch-to-buffer buffer))) + ((member "cider/log-event" status) + (let* ((consumer (nrepl-dict "id" cider/log-consumer)) + (buffers (cider-log-consumer-buffers consumer))) + (when (seq-empty-p buffers) + (message "WARNING: No buffers found for %s log consumer %s of appender %s." + (cider-log-framework-display-name framework) + (cider-log-consumer-display-name consumer) + (cider-log-appender-display-name appender)) + (cider-sync-request:log-remove-consumer framework appender consumer)) + (seq-doseq (buffer buffers) + (with-current-buffer buffer + (cider-log--insert-events buffer (list cider/log-event)) + (when (and cider-log-use-logview (not (logview-initialized-p))) + (let ((framework cider-log-framework) + (appender cider-log-appender) + (consumer cider-log-consumer)) + (logview--guess-submode) + (cider-log-mode) + ;; Restore buffer local vars reset by calling major mode. + (setq-local cider-log-framework framework + cider-log-appender appender + cider-log-consumer consumer)))))))))))) + +(defun cider-log--remove-current-buffer-consumer () + "Cleanup the log consumer of the current buffer." + (when-let ((framework cider-log-framework) + (appender cider-log-appender) + (consumer cider-log-consumer)) + (setq-local cider-log-consumer nil) + (when-let (consumer (cider-log-consumer-reload framework appender consumer)) + (cider-sync-request:log-remove-consumer framework appender consumer) + consumer))) + +;; Event + +(defun cider-log-event-id (event) + "Return the id of the log EVENT." + (nrepl-dict-get event "id")) + +(defun cider-log-event-exception (event) + "Return the exception of the log EVENT." + (nrepl-dict-get event "exception")) + +(defun cider-log-event--format-logback (event) + "Format the log EVENT in logview's Logback format." + (nrepl-dbind-response event (_exception level logger message thread timestamp) + (propertize (format "%s [%s] %s %s - %s\n" + (if (numberp timestamp) + (format-time-string "%F %T.%3N" (/ timestamp 1000)) + (format "%s" timestamp)) + thread + (upcase level) + logger + (if (and (stringp message) + (numberp cider-log-max-message-length)) + (substring message 0 (min (length message) cider-log-max-message-length)) + "")) + :cider-log-event event))) + +(defun cider-log-event--pretty-print (framework appender event) + "Format the log EVENT of FRAMEWORK and APPENDER." + (when-let (event (cider-sync-request:log-format-event framework appender event)) + (cider-popup-buffer cider-log-event-buffer cider-auto-select-error-buffer + 'clojure-mode 'ancillary) + (with-current-buffer cider-log-event-buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert event) + (goto-char (point-min)))))) + +(defun cider-log-event--inspect (framework appender event) + "Inspect the log EVENT of FRAMEWORK and APPENDER." + (thread-last (cider-sync-request:log-inspect-event framework appender event) + (cider-inspector--render-value))) + +(defun cider-log--insert-events (buffer events) + "Insert the log EVENTS into BUFFER." + (with-current-buffer (get-buffer-create buffer) + (let ((windows (seq-filter (lambda (window) (= (window-point window) (point-max))) + (get-buffer-window-list buffer)))) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (seq-doseq (event events) + (insert (cider-log-event--format-logback event))))) + (seq-doseq (window windows) + (set-window-point window (point-max)))))) + +(defun cider-log-event--show-stacktrace (framework appender event) + "Show the stacktrace of the log EVENT of FRAMEWORK and APPENDER." + (when (and framework appender event (cider-log-event-exception event)) + (let ((auto-select-buffer cider-auto-select-error-buffer) + (causes nil)) + (cider-request:log-analyze-stacktrace + framework appender event + (lambda (response) + (nrepl-dbind-response response (class status) + (cond (class (setq causes (cons response causes))) + (status (when causes + (cider-stacktrace-render + (cider-popup-buffer cider-error-buffer + auto-select-buffer + #'cider-stacktrace-mode + 'ancillary) + (reverse causes))))))))))) + +(defun cider-log-event-next-line (&optional n) + "Move N lines forward." + (interactive "p") + (let ((n (or n 1))) + (forward-line n) + (beginning-of-line) + (when-let ((framework cider-log-framework) + (appender cider-log-appender) + (event (cider-log-event-at-point))) + (let ((cider-auto-select-error-buffer nil)) + (save-window-excursion + (when (get-buffer-window cider-error-buffer) + (cider-log-event--show-stacktrace framework appender event)) + (when (get-buffer-window cider-inspector-buffer) + (cider-log-event--inspect framework appender event)) + (when (get-buffer-window cider-log-event-buffer) + (cider-log-event--pretty-print framework appender event))))))) + +(defun cider-log-event-previous-line (&optional n) + "Move N lines backward." + (interactive "p") + (cider-log-event-next-line (- (or n 1)))) + +(defun cider-log--set-filters (filters) + "Set the filter variables from the NREPL dict FILTERS." + (when filters + (setq cider-log--end-time-filter (nrepl-dict-get filters "end-time") + cider-log--exceptions-filter (nrepl-dict-get filters "exceptions") + cider-log--level-filter (nrepl-dict-get filters "level") + cider-log--loggers-filter (nrepl-dict-get filters "loggers") + cider-log--pattern-filter (nrepl-dict-get filters "pattern") + cider-log--start-time-filter (nrepl-dict-get filters "start-time") + cider-log--threads-filter (nrepl-dict-get filters "threads")))) + +(defun cider-log--ensure-initialized (framework &optional appender consumer) + "Ensure that the given FRAMEWORK, APPENDER and CONSUMER are initialized." + (setq cider-log-framework framework + cider-log-framework-name (cider-log-framework-name framework)) + (when appender + (setq cider-log-appender appender + cider-log-appender-id (cider-log-appender-id appender) + cider-log-appender-size (cider-log-appender-size appender) + cider-log-appender-threshold (cider-log-appender-threshold appender)) + (cider-log--set-filters (cider-log-appender-filters appender))) + (when consumer + (setq cider-log-consumer consumer) + (cider-log--set-filters (cider-log-consumer-filters appender))) + (when (and appender (not cider-log--initialized-once-p)) + (unless (cider-log-appender-reload framework appender) + (setq cider-log-appender (cider-sync-request:log-add-appender framework appender)) + (setq cider-log--initialized-once-p t)))) + +(defun cider-log-kill-buffer-hook-handler () + "Called from `kill-buffer-hook' to remove the consumer." + (when (eq 'cider-log-mode major-mode) + (when-let ((framework cider-log-framework) + (appender cider-log-appender) + (consumer cider-log-consumer)) + (cider-log--remove-current-buffer-consumer) + (message "Removed %s event consumer %s from appender %s." + (cider-log-framework-display-name framework) + (cider-log-consumer-display-name consumer) + (cider-log-appender-display-name appender))))) + +(defun cider-log-select-framework () + "Select the log framework." + (let ((frameworks (cider-sync-request:log-frameworks))) + (cond ((= 1 (length frameworks)) + (car frameworks)) + (t (let ((name (cider-log--read-framework-name))) + (cider-log-framework-by-name frameworks name)))))) + +(defun cider-log--current-framework () + "Return the log framework by the name bound to `cider-log-framework-name'." + (when cider-log-framework-name + (let ((frameworks (cider-sync-request:log-frameworks))) + (cider-log-framework-by-name frameworks cider-log-framework-name)))) + +(defun cider-log--framework () + "Return the current log framework, or select it." + (or (cider-log--current-framework) (cider-log-select-framework))) + +(defun cider-log--appender () + "Return the current log appender." + (when cider-log-appender-id + (nrepl-dict "id" cider-log-appender-id + "filters" (cider-log--filters) + "size" cider-log-appender-size + "threshold" cider-log-appender-threshold))) + +(defun cider-log--consumer () + "Return the current log consumer." + (let ((consumer (nrepl-dict "filters" (cider-log--filters)))) + (when cider-log-consumer + (nrepl-dict-put consumer "id" (cider-log-consumer-id cider-log-consumer))) + consumer)) + +(defun cider-log--event-options () + "Return the current log consumer." + (nrepl-dict "filters" (cider-log--filters) + "limit" cider-log-pagination-limit + "offset" cider-log-pagination-offset)) + +(defun cider-log--filters () + "Return the log event filters." + (nrepl-dict + "end-time" cider-log--end-time-filter + "exceptions" cider-log--exceptions-filter + "level" cider-log--level-filter + "loggers" cider-log--loggers-filter + "pattern" cider-log--pattern-filter + "start-time" cider-log--start-time-filter + "threads" cider-log--threads-filter)) + +(defun cider-log-event-at-point () + "Return the log event at point." + (get-text-property (point) :cider-log-event)) + +(defun cider-log-info () + "Show the current log buffer, framework, appender and consumer." + (interactive) + (message "%s" + (string-join + (list (when cider-log-buffer + (format "Buffer: %s" (cider-log--bold cider-log-buffer))) + (when cider-log-framework-name + (format "Framework: %s" (cider-log--bold cider-log-framework-name))) + (when cider-log-appender-id + (format "Appender: %s" (cider-log--bold cider-log-appender-id))) + (when-let (id (and cider-log-consumer (cider-log-consumer-id cider-log-consumer))) + (format "Consumer: %s" (cider-log--bold id)))) + " "))) + +;; Major mode + +(defvar cider-log-mode-map + (let ((map (make-sparse-keymap)) + (parent (if cider-log-use-logview logview-mode-map special-mode-map))) + (set-keymap-parent map parent) + (define-key map (kbd "C-c M-l a") #'cider-log-appender) + (define-key map (kbd "C-c M-l c") #'cider-log-consumer) + (define-key map (kbd "C-c M-l e") #'cider-log-event) + (define-key map (kbd "C-c M-l f") #'cider-log-framework) + (define-key map (kbd "C-c M-l i") #'cider-log-info) + (define-key map (kbd "C-c M-l l") #'cider-log) + (define-key map (kbd "E") 'cider-log-show-stacktrace) + (define-key map (kbd "F") 'cider-log-print-event) + (define-key map (kbd "I") 'cider-log-inspect-event) + (define-key map (kbd "RET") 'cider-log-inspect-event) + (define-key map (kbd "n") 'cider-log-event-next-line) + (define-key map (kbd "p") 'cider-log-event-previous-line) + map) + "The Cider log stream mode key map.") + +(defun cider-log--setup-mode () + "Setup CIDER log mode." + (use-local-map cider-log-mode-map) + (setq-local electric-indent-chars nil) + (setq-local logview-show-ellipses nil) + (setq-local sesman-system 'CIDER) + (setq-local truncate-lines t) + (when (fboundp 'evil-set-initial-state) + (evil-set-initial-state 'cider-log-mode 'emacs))) + +(defvar cider-log--mode-doc + "Major mode for inspecting Clojure log events. + +CIDER Log Mode allows you to capture, debug, inspect and view log events +emitted by Java logging frameworks. The captured log events can be +searched, streamed to the client, pretty printed and are integrated with +the CIDER Inspector and the CIDER stacktrace mode. + +\\{cider-log-mode-map}") + +(if cider-log-use-logview + (define-derived-mode cider-log-mode logview-mode "Cider Log" cider-log--mode-doc + (cider-log--setup-mode)) + (define-derived-mode cider-log-mode special-mode "Cider Log" cider-log--mode-doc + (cider-log--setup-mode))) + +;; Transient Lisp Variable + +(defclass cider-log--lisp-variable (transient-lisp-variable) ()) + +(cl-defmethod transient-init-value ((obj cider-log--lisp-variable)) + "Set the initial value of the object OBJ." + (let* ((prefix-value (oref transient--prefix value)) + (value (cdr (assoc (oref obj variable) prefix-value))) + (new-value (if (assoc (oref obj variable) prefix-value) + value + (symbol-value (oref obj variable))))) + (funcall (oref obj set-value) + (oref obj variable) + (oset obj value new-value)))) + +(cl-defmethod transient-infix-set ((obj cider-log--lisp-variable) value) + "Set the value of infix object OBJ to VALUE." + (funcall (oref obj set-value) + (oref obj variable) + (oset obj value value))) + +(cl-defmethod transient-infix-value ((obj cider-log--lisp-variable)) + "Return the value of the suffix object OBJ." + (cons (oref obj variable) (oref obj value))) + +(cl-defmethod transient-format-value ((obj cider-log--lisp-variable)) + "Format OBJ's value for display and return the result." + (propertize (prin1-to-string (oref obj value)) + 'face 'transient-value)) + +(cl-defmethod transient-format-value ((obj cider-log--lisp-variable)) + "Format OBJ's value for display and return the result." + (cider-log--format-value (oref obj value))) + +;; Transient options + +(transient-define-infix cider-log--appender-size-option () + :always-read t + :argument "--size=" + :class 'cider-log--lisp-variable + :description "Appender size" + :key "=s" + :prompt "Size: " + :reader #'cider-log--read-number-N+ + :variable 'cider-log-appender-size) + +(transient-define-infix cider-log--appender-threshold-option () + :always-read t + :argument "--threshold=" + :class 'cider-log--lisp-variable + :description "Appender threshold" + :key "=t" + :prompt "Threshold: " + :reader #'cider-log--read-number-N+ + :variable 'cider-log-appender-threshold) + +(transient-define-infix cider-log--buffer-option () + :always-read t + :class 'cider-log--lisp-variable + :description "Buffer" + :key "=b" + :prompt "Log buffer: " + :reader #'cider-log--read-buffer + :variable 'cider-log-buffer) + +(transient-define-infix cider-log--end-time-option () + :argument "--end-time=" + :class 'cider-log--lisp-variable + :description "Filter by end time" + :key "-e" + :prompt "End time: " + :reader #'cider-log--read-time + :variable 'cider-log--end-time-filter) + +(transient-define-infix cider-log--exceptions-option () + :argument "--exceptions=" + :class 'cider-log--lisp-variable + :description "Filter by exceptions" + :key "-E" + :multi-value t + :prompt "Exceptions: " + :reader #'cider-log--read-exceptions + :variable 'cider-log--exceptions-filter) + +(transient-define-infix cider-log--level-option () + :argument "--level=" + :class 'cider-log--lisp-variable + :description "Filter by level" + :key "-l" + :prompt "Log Level: " + :reader #'cider-log--read-level + :variable 'cider-log--level-filter) + +(transient-define-infix cider-log--limit-option () + :always-read t + :argument "--limit=" + :class 'cider-log--lisp-variable + :description "Limit" + :key "=l" + :prompt "Limit: " + :reader #'cider-log--read-number-N+ + :variable 'cider-log-pagination-limit) + +(transient-define-infix cider-log--logger-option () + :argument "--loggers=" + :class 'cider-log--lisp-variable + :description "Filter by loggers" + :key "-L" + :multi-value t + :prompt "Loggers: " + :reader #'cider-log--read-loggers + :variable 'cider-log--loggers-filter) + +(transient-define-infix cider-log--offset-option () + :always-read t + :argument "--offset=" + :class 'cider-log--lisp-variable + :description "Offset" + :key "=o" + :prompt "Offset: " + :reader #'cider-log--read-number-N0 + :variable 'cider-log-pagination-offset) + +(transient-define-infix cider-log--pattern-option () + :argument "--pattern=" + :class 'cider-log--lisp-variable + :description "Filter by regex pattern" + :key "-r" + :prompt "Regex pattern: " + :reader #'read-string + :variable 'cider-log--pattern-filter) + +(transient-define-infix cider-log--start-time-option () + :argument "--start-time=" + :class 'cider-log--lisp-variable + :description "Filter by start time" + :key "-s" + :prompt "Start time: " + :reader #'cider-log--read-time + :variable 'cider-log--start-time-filter) + +(transient-define-infix cider-log--threads-option () + :argument "--threads=" + :class 'cider-log--lisp-variable + :description "Filter by threads" + :key "-t" + :multi-value t + :prompt "Threads: " + :reader #'cider-log--read-threads + :variable 'cider-log--threads-filter) + +;; Framework actions + +(transient-define-suffix cider-log-browse-javadocs (framework) + "Browse the Javadoc of the log FRAMEWORK." + :description "Browse Java documentation" + (interactive (list (cider-log--framework))) + (browse-url (or (cider-log-framework-javadoc-url framework) + (user-error (format "The %s framework does not have Javadocs." + (cider-log-framework-name framework)))))) + +(transient-define-suffix cider-log-browse-website (framework) + "Browse the website of the log FRAMEWORK." + :description "Browse website" + (interactive (list (cider-log--framework))) + (browse-url (or (cider-log-framework-website-url framework) + (user-error (format "The %s framework does not have a website." + (cider-log-framework-name framework)))))) + +(transient-define-suffix cider-log-set-framework (framework-name) + "Set the current log framework to FRAMEWORK-NAME." + :description #'cider-log--description-set-framework + (interactive (list (cider-log--read-framework-name))) + (setq cider-log-framework-name framework-name)) + +(transient-define-suffix cider-log-set-buffer (buffer) + "Set the current log buffer to BUFFER." + :description #'cider-log--description-set-buffer + (interactive (list (cider-log--read-buffer))) + (setq cider-log-buffer buffer)) + +;; Appender actions + +(transient-define-suffix cider-log-clear-appender (framework appender) + "Clear the log events of the APPENDER of FRAMEWORK." + :description "Clear log appender" + :inapt-if-not #'cider-log-appender-attached-p + (interactive (list (cider-log--framework) (cider-log--appender))) + (cider-sync-request:log-clear framework appender) + (message "Cleared the %s log appender of the %s framework." + (cider-log-appender-display-name appender) + (cider-log-framework-display-name framework))) + +(transient-define-suffix cider-log-kill-appender (framework appender) + "Remove the log APPENDER from FRAMEWORK." + :description "Kill log appender" + :inapt-if-not #'cider-log-appender-attached-p + (interactive (list (cider-log--framework) (cider-log--appender))) + (cider-sync-request:log-remove-appender framework appender) + (setq-local cider-log-consumer nil) + (message "Log appender %s removed from the %s framework." + (cider-log-framework-display-name framework) + (cider-log-appender-display-name appender))) + +(transient-define-suffix cider-log--do-add-appender (framework appender) + "Add the APPENDER to the log FRAMEWORK." + :description "Add log appender" + :inapt-if #'cider-log-appender-attached-p + (interactive (list (cider-log--framework) (cider-log--appender))) + (setq cider-log-appender (cider-sync-request:log-add-appender framework appender)) + (message "Log appender %s added to the %s framework." + (cider-log-appender-display-name appender) + (cider-log-framework-display-name framework))) + +(transient-define-suffix cider-log--do-update-appender (framework appender) + "Update the APPENDER of the log FRAMEWORK." + :description "Update log appender" + :inapt-if-not #'cider-log-appender-attached-p + (interactive (list (cider-log--framework) (cider-log--appender))) + (setq cider-log-appender (cider-sync-request:log-update-appender framework appender)) + (message "Updated log appender %s of the %s framework." + (cider-log-appender-display-name appender) + (cider-log-framework-display-name framework))) + +;; Consumer actions + +(transient-define-suffix cider-log--do-add-consumer (framework appender consumer buffer) + "Add the CONSUMER to the APPENDER of the log FRAMEWORK and write events to BUFFER." + :description "Add log consumer" + :inapt-if #'cider-log-consumer-attached-p + (interactive (list (cider-log--framework) + (cider-log--appender) + (cider-log--consumer) + (current-buffer))) + (cider-log--consumer-add framework appender consumer buffer)) + +(transient-define-suffix cider-log-kill-consumer (framework appender consumer) + "Remove the CONSUMER listening to the APPENDER of the log FRAMEWORK." + :description "Kill log consumer" + :inapt-if-not #'cider-log-consumer-attached-p + (interactive (list (cider-log--framework) (cider-log--appender) (cider-log--consumer))) + (cider-sync-request:log-remove-consumer framework appender consumer) + (setq-local cider-log-consumer nil) + (message "Removed %s log consumer %s for appender %s." + (cider-log-framework-display-name framework) + (cider-log-consumer-display-name consumer) + (cider-log-appender-display-name appender))) + +(transient-define-suffix cider-log--do-update-consumer (framework appender consumer) + "Update the CONSUMER listening to the APPENDER of the log FRAMEWORK." + :description "Update log consumer" + :inapt-if-not #'cider-log-consumer-attached-p + (interactive (list (cider-log--framework) + (cider-log--appender) + (cider-log--consumer))) + (setq cider-log-consumer (cider-sync-request:log-update-consumer framework appender consumer)) + (message "Updated %s log consumer %s for appender %s." + (cider-log-framework-display-name framework) + (cider-log-consumer-display-name consumer) + (cider-log-appender-display-name appender))) + +;; Event actions + +(transient-define-suffix cider-log-show-stacktrace (framework appender event) + "Show the stacktrace of the log EVENT of FRAMEWORK and APPENDER." + :description "Show log event stacktrace" + :if #'cider-log-event-at-point + :inapt-if-not (lambda () + (when-let (event (cider-log-event-at-point)) + (cider-log-event-exception event))) + (interactive (list (cider-log--framework) (cider-log--appender) (cider-log-event-at-point))) + (cider-log-event--show-stacktrace framework appender event)) + +(transient-define-suffix cider-log-print-event (framework appender event) + "Format the log EVENT of FRAMEWORK and APPENDER." + :description "Pretty print log event at point" + :if #'cider-log-event-at-point + (interactive (list (cider-log--framework) (cider-log--appender) (cider-log-event-at-point))) + (if event + (cider-log-event--pretty-print framework appender event) + (user-error "No log event found at point"))) + +(transient-define-suffix cider-log-inspect-event (framework appender event) + "Inspect the log EVENT of FRAMEWORK and APPENDER." + :description "Inspect log event at point" + :if #'cider-log-event-at-point + (interactive (list (cider-log--framework) (cider-log--appender) (cider-log-event-at-point))) + (cider-log-event--inspect framework appender event)) + +(transient-define-suffix cider-log-clear-event-buffer (buffer) + "Clear the Cider log events in BUFFER." + :description #'cider-log--description-clear-events-buffer + :inapt-if-not #'cider-log-buffer-clear-p + (interactive (list cider-log-buffer)) + (when (get-buffer buffer) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer))))) + +(transient-define-suffix cider-log-switch-to-buffer (buffer) + "Switch to the Cider log event BUFFER." + :description "Switch to the log event buffer" + (interactive (list cider-log-buffer)) + (when (get-buffer-create buffer) + (switch-to-buffer-other-window buffer))) + +(transient-define-suffix cider-log--do-search-events (framework appender filters) + "Search the log events of FRAMEWORK and APPENDER which match FILTERS." + :description "Search log events" + :inapt-if-not #'cider-log-appender-attached-p + (interactive (list (cider-log--framework) (cider-log--appender) (cider-log--filters))) + (with-current-buffer (get-buffer-create cider-log-buffer) + (let ((consumer (nrepl-dict "filters" (cider-log--filters))) + (inhibit-read-only t)) + (cider-log--remove-current-buffer-consumer) + (erase-buffer) + (let ((events (cider-sync-request:log-search + framework appender + :filters filters + :limit cider-log-pagination-limit + :offset cider-log-pagination-offset))) + (seq-doseq (event (nreverse events)) + (insert (cider-log-event--format-logback event))) + (cider-log-mode) + (setq-local cider-log-framework framework) + (setq-local cider-log-appender appender) + (when (seq-empty-p events) + (message "No log events found.")) + (cider-log--consumer-add framework appender consumer (current-buffer)))))) + +;; Log Framework Transient + +;;;###autoload (autoload 'cider-log-framework "cider-log" "Show the Cider log framework menu." t) +(transient-define-prefix cider-log-framework (framework) + "Show the Cider log framework menu." + [["Cider Log Framework\n\nActions:" + ("b" cider-log-set-buffer) + ("j" cider-log-browse-javadocs) + ("s" cider-log-set-framework) + ("w" cider-log-browse-website)]] + (interactive (list (cider-log--framework))) + (cider-log--ensure-initialized framework) + (transient-setup 'cider-log-framework)) + +;; Log Appender Transients + +(defun cider-log--appender-interactive-list () + "Return the interactive arguments for a appender transient." + (let ((framework (cider-log--current-framework))) + (list framework (cider-log-framework-appender framework cider-log-appender-id)))) + +(transient-define-prefix cider-log-add-appender (framework appender) + "Show the menu to add a Cider log appender." + :history-key 'cider-log-appender + ["Cider Log Appender\n\nSettings:" + (cider-log--appender-size-option) + (cider-log--appender-threshold-option)] + ["Filters:" + (cider-log--end-time-option) + (cider-log--exceptions-option) + (cider-log--level-option) + (cider-log--logger-option) + (cider-log--pattern-option) + (cider-log--start-time-option) + (cider-log--threads-option)] + ["Actions" + ("a" cider-log--do-add-appender)] + (interactive (cider-log--appender-interactive-list)) + (cider-log--ensure-initialized framework appender) + (transient-setup 'cider-log-add-appender)) + +(transient-define-prefix cider-log-update-appender (framework appender) + "Show the menu to update a Cider log appender." + :history-key 'cider-log-appender + ["Cider Log Appender\n\nSettings:" + (cider-log--appender-size-option) + (cider-log--appender-threshold-option)] + ["Filters:" + (cider-log--end-time-option) + (cider-log--exceptions-option) + (cider-log--level-option) + (cider-log--logger-option) + (cider-log--pattern-option) + (cider-log--start-time-option) + (cider-log--threads-option)] + ["Actions" + ("u" cider-log--do-update-appender)] + (interactive (cider-log--appender-interactive-list)) + (cider-log--ensure-initialized framework appender) + (transient-setup 'cider-log-update-appender)) + +;;;###autoload (autoload 'cider-log-appender "cider-log" "Show the Cider log appender menu." t) +(transient-define-prefix cider-log-appender (framework appender) + "Show the Cider log appender menu." + :history-key 'cider-log-appender + ["Cider Log Appender\n\nSettings:" + (cider-log--appender-size-option) + (cider-log--appender-threshold-option)] + ["Filters:" + (cider-log--end-time-option) + (cider-log--exceptions-option) + (cider-log--level-option) + (cider-log--logger-option) + (cider-log--pattern-option) + (cider-log--start-time-option) + (cider-log--threads-option)] + ["Actions" + ("a" cider-log--do-add-appender) + ("c" cider-log-clear-appender) + ("k" cider-log-kill-appender) + ("u" cider-log--do-update-appender)] + (interactive (cider-log--appender-interactive-list)) + (cider-log--ensure-initialized framework appender) + (transient-setup 'cider-log-appender)) + +;; Log Consumer Transient Menu + +(defun cider-log--consumer-interactive-list () + "Return the interactive arguments for a consumer transient." + (let* ((framework (cider-log--current-framework)) + (appender (cider-log-framework-appender framework cider-log-appender-id))) + (list framework appender + (if (and appender cider-log-consumer) + (seq-find (lambda (consumer) + (equal (cider-log-consumer-id cider-log-consumer) + (cider-log-consumer-id consumer))) + (cider-log-appender-consumers appender)) + (nrepl-dict "filters" (cider-log--filters)))))) + +(transient-define-prefix cider-log-add-consumer (framework appender consumer) + "Show the menu to add a Cider log consumer." + :history-key 'cider-log-consumer + ["Cider Log Consumer\n\nFilters:" + (cider-log--end-time-option) + (cider-log--exceptions-option) + (cider-log--level-option) + (cider-log--logger-option) + (cider-log--pattern-option) + (cider-log--start-time-option) + (cider-log--threads-option)] + ["Actions" + ("a" cider-log--do-add-consumer)] + (interactive (cider-log--consumer-interactive-list)) + (cider-log--ensure-initialized framework appender consumer) + (transient-setup 'cider-log-add-consumer)) + +(transient-define-prefix cider-log-update-consumer (framework appender consumer) + "Show the menu to update a Cider log consumer." + :history-key 'cider-log-consumer + ["Cider Log Consumer\n\nFilters:" + (cider-log--end-time-option) + (cider-log--exceptions-option) + (cider-log--level-option) + (cider-log--logger-option) + (cider-log--pattern-option) + (cider-log--start-time-option) + (cider-log--threads-option)] + ["Actions" + ("u" cider-log--do-update-consumer)] + (interactive (cider-log--consumer-interactive-list)) + (cider-log--ensure-initialized framework appender consumer) + (transient-setup 'cider-log-update-consumer)) + +;;;###autoload (autoload 'cider-log-consumer "cider-log" "Show the Cider log consumer menu." t) +(transient-define-prefix cider-log-consumer (framework appender consumer) + "Show the Cider log consumer menu." + :history-key 'cider-log-consumer + ["Cider Log Consumer\n\nFilters:" + (cider-log--end-time-option) + (cider-log--exceptions-option) + (cider-log--level-option) + (cider-log--logger-option) + (cider-log--pattern-option) + (cider-log--start-time-option) + (cider-log--threads-option)] + ["Actions" + ("a" cider-log--do-add-consumer) + ("k" cider-log-kill-consumer) + ("u" cider-log--do-update-consumer)] + (interactive (cider-log--consumer-interactive-list)) + (cider-log--ensure-initialized framework appender consumer) + (transient-setup 'cider-log-consumer)) + +;; Log Event Transient Menu + +(transient-define-prefix cider-log-event-search (framework appender) + "Search the search log events menu." + :history-key 'cider-log-event + ["Cider Log Event\n\nPagination:" + (cider-log--limit-option) + (cider-log--offset-option)] + ["Filters:" + (cider-log--end-time-option) + (cider-log--exceptions-option) + (cider-log--level-option) + (cider-log--logger-option) + (cider-log--pattern-option) + (cider-log--start-time-option) + (cider-log--threads-option)] + ["Actions" + ("s" cider-log--do-search-events)] + (interactive (list (cider-log--framework) (cider-log--appender))) + (cider-log--ensure-initialized framework appender) + (transient-setup 'cider-log-event-search)) + +;;;###autoload (autoload 'cider-log-event "cider-log" "Show the Cider log event menu." t) +(transient-define-prefix cider-log-event (framework appender) + "Show the Cider log event menu." + :history-key 'cider-log-event + ["Cider Log Event\n\nPagination:" + (cider-log--limit-option) + (cider-log--offset-option)] + ["Filters:" + (cider-log--end-time-option) + (cider-log--exceptions-option) + (cider-log--level-option) + (cider-log--logger-option) + (cider-log--pattern-option) + (cider-log--start-time-option) + (cider-log--threads-option)] + ["Actions" + ("c" cider-log-clear-event-buffer) + ("e" cider-log-show-stacktrace) + ("i" cider-log-inspect-event) + ("p" cider-log-print-event) + ("s" cider-log--do-search-events)] + (interactive (list (cider-log--framework) (cider-log--appender))) + (cider-log--ensure-initialized framework appender) + (transient-setup 'cider-log-event)) + +;; Main Transient Menu + +;;;###autoload (autoload 'cider-log "cider-log" "Show the Cider log menu." t) +(transient-define-prefix cider-log (framework appender) + "Show the Cider log menu." + [["Framework Actions" + ("fs" cider-log-set-framework) + ("fb" cider-log-set-buffer) + ("fj" cider-log-browse-javadocs) + ("fw" cider-log-browse-website)] + ["Appender Actions" + ("aa" "Add log appender" cider-log-add-appender + :inapt-if cider-log-appender-attached-p) + ("ac" cider-log-clear-appender) + ("ak" cider-log-kill-appender) + ("am" "Manage appender" cider-log-appender) + ("au" "Update log appender" cider-log-update-appender + :inapt-if-not cider-log-appender-attached-p)] + ["Consumer Actions" + ("ca" "Add log consumer" cider-log-add-consumer + :inapt-if cider-log-consumer-attached-p) + ("ck" cider-log-kill-consumer) + ("cm" "Manage consumer" cider-log-consumer) + ("cu" "Update log consumer" cider-log-update-consumer + :inapt-if-not cider-log-consumer-attached-p)] + ["Event Actions" + ("eb" cider-log-switch-to-buffer) + ("ec" cider-log-clear-event-buffer) + ("ee" cider-log-show-stacktrace) + ("ei" cider-log-inspect-event) + ("ep" cider-log-print-event) + ("es" "Search log events" cider-log-event-search + :inapt-if-not cider-log-appender-attached-p)]] + (interactive (list (cider-log--framework) (cider-log--appender))) + (cider-log--ensure-initialized framework appender) + (transient-setup 'cider-log)) + +(add-hook 'kill-buffer-hook #'cider-log-kill-buffer-hook-handler) + +(provide 'cider-log) + +;;; cider-log.el ends here diff --git a/elpa/cider-20220417.951/cider-macroexpansion.el b/elpa/cider-20230707.640/cider-macroexpansion.el similarity index 96% rename from elpa/cider-20220417.951/cider-macroexpansion.el rename to elpa/cider-20230707.640/cider-macroexpansion.el index fbe74b66..6e4c52a8 100644 --- a/elpa/cider-20220417.951/cider-macroexpansion.el +++ b/elpa/cider-20230707.640/cider-macroexpansion.el @@ -1,7 +1,7 @@ ;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -69,10 +69,10 @@ The default for DISPLAY-NAMESPACES is taken from "ns" ,(cider-current-ns) "display-namespaces" ,(or display-namespaces (symbol-name cider-macroexpansion-display-namespaces))) - (nconc (when cider-macroexpansion-print-metadata - '("print-meta" "true"))) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "expansion"))) + (nconc (when cider-macroexpansion-print-metadata + '("print-meta" "true"))) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "expansion"))) (defun cider-macroexpand-undo (&optional arg) "Undo the last macroexpansion, using `undo-only'. diff --git a/elpa/cider-20220417.951/cider-mode.el b/elpa/cider-20230707.640/cider-mode.el similarity index 98% rename from elpa/cider-20220417.951/cider-mode.el rename to elpa/cider-20230707.640/cider-mode.el index ba6bbfc3..bfedce90 100644 --- a/elpa/cider-20220417.951/cider-mode.el +++ b/elpa/cider-20230707.640/cider-mode.el @@ -1,7 +1,7 @@ ;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -33,6 +33,7 @@ (require 'clojure-mode) (require 'cider-eval) +(require 'cider-log) (require 'cider-test) ; required only for the menu (require 'cider-eldoc) (require 'cider-resolve) @@ -158,19 +159,6 @@ the related commands `cider-repl-clear-buffer' and (cider-repl-clear-output)) (switch-to-buffer origin-buffer))) -(defun cider-undef () - "Undefine a symbol from the current ns." - (interactive) - (cider-ensure-op-supported "undef") - (cider-read-symbol-name - "Undefine symbol: " - (lambda (sym) - (cider-nrepl-send-request - `("op" "undef" - "ns" ,(cider-current-ns) - "sym" ,sym) - (cider-interactive-eval-handler (current-buffer)))))) - ;;; cider-run (defvar cider--namespace-history nil "History of user input for namespace prompts.") @@ -242,7 +230,7 @@ If EVAL is non-nil the form will also be evaluated. Use (when cider-switch-to-repl-on-insert (cider-switch-to-repl-buffer)) (let ((repl (cider-current-repl))) - (with-selected-window (or (get-buffer-window repl) + (with-selected-window (or (get-buffer-window repl t) (selected-window)) (with-current-buffer repl (goto-char (point-max)) @@ -333,10 +321,12 @@ If invoked with a prefix ARG eval the expression after inserting it." "--" ["Eval current list" cider-eval-list-at-point] ["Eval current sexp" cider-eval-sexp-at-point] + ["Eval and tap current sexp" cider-tap-sexp-at-point] ["Eval current sexp to point" cider-eval-sexp-up-to-point] ["Eval current sexp in context" cider-eval-sexp-at-point-in-context] "--" ["Eval last sexp" cider-eval-last-sexp] + ["Eval and tap last sexp" cider-tap-last-sexp] ["Eval last sexp in context" cider-eval-last-sexp-in-context] ["Eval last sexp and insert" cider-eval-print-last-sexp :keys "\\[universal-argument] \\[cider-eval-last-sexp]"] @@ -515,6 +505,7 @@ higher precedence." (define-key map (kbd "C-c M-p") #'cider-insert-last-sexp-in-repl) (define-key map (kbd "C-c M-:") #'cider-read-and-eval) (define-key map (kbd "C-c C-u") #'cider-undef) + (define-key map (kbd "C-c C-M-u") #'cider-undef-all) (define-key map (kbd "C-c C-m") #'cider-macroexpand-1) (define-key map (kbd "C-c M-m") #'cider-macroexpand-all) (define-key map (kbd "C-c M-n") 'cider-ns-map) @@ -539,6 +530,12 @@ higher precedence." (define-key map (kbd "C-c C-? C-d") #'cider-xref-fn-deps-select) (define-key map (kbd "C-c C-q") #'cider-quit) (define-key map (kbd "C-c M-r") #'cider-restart) + (define-key map (kbd "C-c M-l a") #'cider-log-appender) + (define-key map (kbd "C-c M-l c") #'cider-log-consumer) + (define-key map (kbd "C-c M-l e") #'cider-log-event) + (define-key map (kbd "C-c M-l f") #'cider-log-framework) + (define-key map (kbd "C-c M-l i") #'cider-log-info) + (define-key map (kbd "C-c M-l l") #'cider-log) (dolist (variable '(cider-mode-interactions-menu cider-mode-eval-menu cider-mode-menu)) @@ -634,7 +631,8 @@ The value can also be t, which means to font-lock as much as possible." :package-version '(cider . "0.10.0")) (defcustom cider-font-lock-reader-conditionals t - "Apply font-locking to unused reader conditional expressions depending on the buffer CIDER connection type." + "Apply font-locking to unused reader conditional expressions. +The result depends on the buffer CIDER connection type." :type 'boolean :group 'cider :package-version '(cider . "0.15.0")) @@ -990,7 +988,8 @@ SYM and INFO is passed to `cider-docview-render'" (buffer-substring-no-properties (point-min) (1- (point)))))) (defcustom cider-use-tooltips t - "If non-nil, CIDER displays mouse-over tooltips, as well as the `help-echo' mechanism." + "If non-nil, CIDER displays mouse-over tooltips. +It does this as well as the `help-echo' mechanism." :group 'cider :type 'boolean :package-version '(cider "0.12.0")) @@ -1004,7 +1003,8 @@ See \(info \"(elisp) Special Properties\")" (while-no-input (when (and (bufferp obj) (cider-connected-p) - cider-use-tooltips (not help-at-pt-display-when-idle)) + cider-use-tooltips + (not (eq help-at-pt-display-when-idle t))) (with-current-buffer obj (ignore-errors (save-excursion diff --git a/elpa/cider-20220417.951/cider-ns.el b/elpa/cider-20230707.640/cider-ns.el similarity index 95% rename from elpa/cider-20220417.951/cider-ns.el rename to elpa/cider-20230707.640/cider-ns.el index 781fb9ee..ee31bce5 100644 --- a/elpa/cider-20220417.951/cider-ns.el +++ b/elpa/cider-20230707.640/cider-ns.el @@ -1,6 +1,6 @@ ;;; cider-ns.el --- Namespace manipulation functionality -*- lexical-binding: t -*- -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Bozhidar Batsov ;; Artur Malabarba @@ -256,13 +256,13 @@ refresh functions (defined in `cider-ns-refresh-before-fn' and (cider-nrepl-send-sync-request '("op" "refresh-clear") conn)) (cider-nrepl-send-request (thread-last - (map-merge 'list - `(("op" ,(if refresh-all? "refresh-all" "refresh"))) - (cider--nrepl-print-request-map fill-column) - (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn) - `(("before" ,cider-ns-refresh-before-fn))) - (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn) - `(("after" ,cider-ns-refresh-after-fn)))) + (map-merge 'list + `(("op" ,(if refresh-all? "refresh-all" "refresh"))) + (cider--nrepl-print-request-map fill-column) + (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn) + `(("before" ,cider-ns-refresh-before-fn))) + (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn) + `(("after" ,cider-ns-refresh-after-fn)))) (seq-mapcat #'identity)) (lambda (response) (cider-ns-refresh--handle-response response log-buffer)) diff --git a/elpa/cider-20220417.951/cider-overlays.el b/elpa/cider-20230707.640/cider-overlays.el similarity index 96% rename from elpa/cider-20220417.951/cider-overlays.el rename to elpa/cider-20230707.640/cider-overlays.el index 95788ad0..c9f565a4 100644 --- a/elpa/cider-20220417.951/cider-overlays.el +++ b/elpa/cider-20230707.640/cider-overlays.el @@ -1,6 +1,6 @@ ;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*- -;; Copyright © 2015-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; Author: Artur Malabarba @@ -231,6 +231,8 @@ overlay." ;; inherit the face of the following text. (display-string (format (propertize format 'face 'default) value)) (o nil)) + ;; Remove any overlay at the position we're creating a new one, if it + ;; exists. (remove-overlays beg end 'category type) (funcall (if cider-overlays-use-font-lock #'font-lock-prepend-text-property @@ -260,6 +262,11 @@ overlay." (pcase duration ((pred numberp) (run-at-time duration nil #'cider--delete-overlay o)) (`command + ;; Since the previous overlay was already removed above, we should + ;; remove the hook to remove all overlays after this function + ;; ends. Otherwise, we would inadvertently remove the newly created + ;; overlay too. + (remove-hook 'post-command-hook 'cider--remove-result-overlay 'local) ;; If inside a command-loop, tell `cider--remove-result-overlay' ;; to only remove after the *next* command. (if this-command @@ -296,6 +303,7 @@ focused." (let* ((font-value (if cider-result-use-clojure-font-lock (cider-font-lock-as-clojure value) value)) + (font-value (string-trim-right font-value)) (used-overlay (when (and point cider-use-overlays) (cider--make-result-overlay font-value :where point diff --git a/elpa/cider-20220417.951/cider-pkg.el b/elpa/cider-20230707.640/cider-pkg.el similarity index 70% rename from elpa/cider-20220417.951/cider-pkg.el rename to elpa/cider-20230707.640/cider-pkg.el index 29e0fb28..083de8d0 100644 --- a/elpa/cider-20220417.951/cider-pkg.el +++ b/elpa/cider-20230707.640/cider-pkg.el @@ -1,18 +1,21 @@ -(define-package "cider" "20220417.951" "Clojure Interactive Development Environment that Rocks" +(define-package "cider" "20230707.640" "Clojure Interactive Development Environment that Rocks" '((emacs "26") - (clojure-mode "5.14") + (clojure-mode "5.16.0") (parseedn "1.0.6") (queue "0.2") (spinner "1.7") (seq "2.22") - (sesman "0.3.2")) - :commit "9130c6493f339edf3aa24da928d1f1c4edef6582" :authors + (sesman "0.3.2") + (transient "0.4.1")) + :commit "bc8903b0c85cf0891f106337eabfc6f747d262a1" :authors '(("Tim King" . "kingtim@gmail.com") ("Phil Hagelberg" . "technomancy@gmail.com") ("Bozhidar Batsov" . "bozhidar@batsov.dev") ("Artur Malabarba" . "bruce.connor.am@gmail.com") ("Hugo Duncan" . "hugo@hugoduncan.org") ("Steve Purcell" . "steve@sanityinc.com")) + :maintainers + '(("Bozhidar Batsov" . "bozhidar@batsov.dev")) :maintainer '("Bozhidar Batsov" . "bozhidar@batsov.dev") :keywords diff --git a/elpa/cider-20220417.951/cider-popup.el b/elpa/cider-20230707.640/cider-popup.el similarity index 97% rename from elpa/cider-20220417.951/cider-popup.el rename to elpa/cider-20230707.640/cider-popup.el index 368909f3..a7fb26d6 100644 --- a/elpa/cider-20220417.951/cider-popup.el +++ b/elpa/cider-20230707.640/cider-popup.el @@ -1,6 +1,6 @@ ;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- -;; Copyright © 2015-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; Author: Artur Malabarba @@ -46,7 +46,7 @@ If major MODE is non-nil, enable it for the popup buffer. If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' and automatically removed when killed." (thread-first (cider-make-popup-buffer name mode ancillary) - (cider-popup-buffer-display select))) + (cider-popup-buffer-display select))) (defun cider-popup-buffer-display (buffer &optional select) "Display BUFFER. diff --git a/elpa/cider-20220417.951/cider-profile.el b/elpa/cider-20230707.640/cider-profile.el similarity index 99% rename from elpa/cider-20220417.951/cider-profile.el rename to elpa/cider-20230707.640/cider-profile.el index ad33fad7..e2dd6fc6 100644 --- a/elpa/cider-20220417.951/cider-profile.el +++ b/elpa/cider-20230707.640/cider-profile.el @@ -1,6 +1,6 @@ ;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*- -;; Copyright © 2014-2022 Edwin Watkeys and CIDER contributors +;; Copyright © 2014-2023 Edwin Watkeys and CIDER contributors ;; Author: Edwin Watkeys ;; Juan E. Maya diff --git a/elpa/cider-20220417.951/cider-repl-history.el b/elpa/cider-20230707.640/cider-repl-history.el similarity index 99% rename from elpa/cider-20220417.951/cider-repl-history.el rename to elpa/cider-20230707.640/cider-repl-history.el index 566beec0..e5044bf6 100644 --- a/elpa/cider-20220417.951/cider-repl-history.el +++ b/elpa/cider-20230707.640/cider-repl-history.el @@ -1,6 +1,6 @@ ;;; cider-repl-history.el --- REPL input history browser -*- lexical-binding: t; -*- -;; Copyright (c) 2017-2022 John Valente and browse-kill-ring authors +;; Copyright (c) 2017-2023 John Valente and browse-kill-ring authors ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -180,7 +180,8 @@ Setting this variable to nil means no limit." :package-version '(cider . "0.15.0")) (defcustom cider-repl-history-display-duplicate-highest t - "When `cider-repl-history-display-duplicates' is nil, then display highest (most recent) duplicate items in the command history." + "If non-nil, then display most recent duplicate items in the command history. +Only takes effect when `cider-repl-history-display-duplicates' is nil." :type 'boolean :package-version '(cider . "0.15.0")) diff --git a/elpa/cider-20220417.951/cider-repl.el b/elpa/cider-20230707.640/cider-repl.el similarity index 96% rename from elpa/cider-20220417.951/cider-repl.el rename to elpa/cider-20230707.640/cider-repl.el index 496058a3..3245690f 100644 --- a/elpa/cider-20220417.951/cider-repl.el +++ b/elpa/cider-20230707.640/cider-repl.el @@ -1,7 +1,7 @@ ;;; cider-repl.el --- CIDER REPL mode interactions -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -153,12 +153,15 @@ you'd like to use the default Emacs behavior use (make-obsolete-variable 'cider-repl-print-level 'cider-print-options "0.21") (defvar cider-repl-require-repl-utils-code - '((clj . "(clojure.core/apply clojure.core/require clojure.main/repl-requires)") + '((clj . "(when-let [requires (resolve 'clojure.main/repl-requires)] + (clojure.core/apply clojure.core/require @requires))") (cljs . "(require '[cljs.repl :refer [apropos dir doc find-doc print-doc pst source]])"))) (defcustom cider-repl-init-code (list (cdr (assoc 'clj cider-repl-require-repl-utils-code))) "Clojure code to evaluate when starting a REPL. -Will be evaluated with bindings for set!-able vars in place." +Will be evaluated with bindings for set!-able vars in place. + +See also `cider-repl-eval-init-code'." :type '(list string) :package-version '(cider . "0.21.0")) @@ -167,6 +170,19 @@ Will be evaluated with bindings for set!-able vars in place." :type 'boolean :package-version '(cider . "0.11.0")) +;; See https://github.com/clojure-emacs/cider/issues/3219 for more details +(defcustom cider-repl-display-output-before-window-boundaries nil + "Controls whether to display output emitted before the REPL window boundaries. + +If the prompt is on the first line of the window, then scroll the window +down by a single line to make the emitted output visible. + +That behavior is desirable, but rarely needed and it slows down printing +output a lot (e.g. 10x) that's why it's disable by default starting with +CIDER 1.7." + :type 'boolean + :package-version '(cider . "1.7.0")) + ;;;; REPL buffer local variables (defvar-local cider-repl-input-start-mark nil) @@ -223,6 +239,8 @@ This cache is stored in the connection buffer.") (nrepl-dbind-response response (repl-type changed-namespaces) (when (and repl-type cider-repl-auto-detect-type) (cider-set-repl-type repl-type)) + (when (eq (cider-maybe-intern repl-type) 'cljs) + (setq cider-repl-cljs-upgrade-pending nil)) (unless (nrepl-dict-empty-p changed-namespaces) (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces)) (dolist (b (buffer-list)) @@ -272,12 +290,13 @@ Run CALLBACK once the evaluation is complete." (cider-nrepl-request:eval ;; Ensure we evaluate _something_ so the initial namespace is correctly set (thread-first (or cider-repl-init-code '("nil")) - (string-join "\n")) + (string-join "\n")) (cider-repl-init-eval-handler callback) nil (line-number-at-pos (point)) (cider-column-number-at-pos (point)) - (thread-last request + (thread-last + request (map-pairs) (seq-mapcat #'identity))))) @@ -774,14 +793,16 @@ Before inserting, run `cider-repl-preoutput-hook' on STRING." (not (bolp))) (insert-before-markers "\n") (set-marker cider-repl-output-end (1- (point)))))) - (when-let* ((window (get-buffer-window buffer t))) - ;; If the prompt is on the first line of the window, then scroll the window - ;; down by a single line to make the emitted output visible. - (when (and (pos-visible-in-window-p cider-repl-prompt-start-mark window) - (< 1 cider-repl-prompt-start-mark) - (not (pos-visible-in-window-p (1- cider-repl-prompt-start-mark) window))) - (with-selected-window window - (scroll-down 1))))) + (when cider-repl-display-output-before-window-boundaries + ;; FIXME: The code below is super slow, that's why it's disabled by default. + (when-let* ((window (get-buffer-window buffer t))) + ;; If the prompt is on the first line of the window, then scroll the window + ;; down by a single line to make the emitted output visible. + (when (and (pos-visible-in-window-p cider-repl-prompt-start-mark window) + (< 1 cider-repl-prompt-start-mark) + (not (pos-visible-in-window-p (1- cider-repl-prompt-start-mark) window))) + (with-selected-window window + (scroll-down 1)))))) (defun cider-repl--emit-interactive-output (string face) "Emit STRING as interactive output using FACE." @@ -1039,7 +1060,7 @@ If NEWLINE is true then add a newline at the end of the input." (line-number-at-pos input-start) (cider-column-number-at-pos input-start) (thread-last - (cider--repl-request-map fill-column) + (cider--repl-request-map fill-column) (map-pairs) (seq-mapcat #'identity))))))) @@ -1229,9 +1250,9 @@ command will prompt for the name of the namespace to switch to." ;; NOTE: `require' and `in-ns' are special forms in ClojureScript. ;; That's why we eval them separately instead of combining them with `do'. (when cider-repl-require-ns-on-set - (cider-nrepl-sync-request:eval (format "(require '%s)" ns) connection)) - (cider-nrepl-request:eval (format "(in-ns '%s)" ns) - (cider-repl-switch-ns-handler connection))))) + (cider-sync-tooling-eval (format "(require '%s)" ns) nil connection)) + (cider-tooling-eval (format "(in-ns '%s)" ns) + (cider-repl-switch-ns-handler connection))))) ;;; Location References @@ -1575,7 +1596,7 @@ constructs." (puthash name handler cider-repl-shortcuts)) (declare-function cider-toggle-trace-ns "cider-tracing") -(declare-function cider-undef "cider-mode") +(declare-function cider-undef "cider-eval") (declare-function cider-browse-ns "cider-browse-ns") (declare-function cider-classpath "cider-classpath") (declare-function cider-repl-history "cider-repl-history") @@ -1818,6 +1839,15 @@ constructs." (declare-function cider-complete-at-point "cider-completion") (defvar cider--static-font-lock-keywords) +(defun cider-repl-setup-paredit () + "Override the paredit-RET binding in cider-repl-mode." + (let ((oldmap (cdr (assoc 'paredit-mode minor-mode-map-alist))) + (newmap (make-sparse-keymap))) + (set-keymap-parent newmap oldmap) + (define-key newmap (kbd "RET") nil) + (make-local-variable 'minor-mode-overriding-map-alist) + (push `(paredit-mode . ,newmap) minor-mode-overriding-map-alist))) + (define-derived-mode cider-repl-mode fundamental-mode "REPL" "Major mode for Clojure REPL interactions. @@ -1845,7 +1875,8 @@ constructs." (add-hook 'kill-buffer-hook #'cider-repl-history-just-save t t) (add-hook 'kill-emacs-hook #'cider-repl-history-just-save)) (add-hook 'completion-at-point-functions #'cider-complete-at-point nil t) - (add-hook 'paredit-mode-hook (lambda () (clojure-paredit-setup cider-repl-mode-map)))) + (add-hook 'paredit-mode-hook (lambda () (clojure-paredit-setup cider-repl-mode-map))) + (cider-repl-setup-paredit)) (provide 'cider-repl) diff --git a/elpa/cider-20220417.951/cider-resolve.el b/elpa/cider-20230707.640/cider-resolve.el similarity index 98% rename from elpa/cider-20220417.951/cider-resolve.el rename to elpa/cider-20230707.640/cider-resolve.el index d63fc294..783ddbf0 100644 --- a/elpa/cider-20220417.951/cider-resolve.el +++ b/elpa/cider-20230707.640/cider-resolve.el @@ -1,6 +1,6 @@ ;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection -*- lexical-binding: t; -*- -;; Copyright © 2015-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; Author: Artur Malabarba diff --git a/elpa/cider-20220417.951/cider-scratch.el b/elpa/cider-20230707.640/cider-scratch.el similarity index 98% rename from elpa/cider-20220417.951/cider-scratch.el rename to elpa/cider-20230707.640/cider-scratch.el index 759d2ed5..6366abb7 100644 --- a/elpa/cider-20220417.951/cider-scratch.el +++ b/elpa/cider-20230707.640/cider-scratch.el @@ -1,6 +1,6 @@ ;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*- -;; Copyright © 2014-2022 Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg diff --git a/elpa/cider-20220417.951/cider-selector.el b/elpa/cider-20230707.640/cider-selector.el similarity index 99% rename from elpa/cider-20220417.951/cider-selector.el rename to elpa/cider-20230707.640/cider-selector.el index 7117d405..afe0b567 100644 --- a/elpa/cider-20220417.951/cider-selector.el +++ b/elpa/cider-20230707.640/cider-selector.el @@ -1,7 +1,7 @@ ;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg diff --git a/elpa/cider-20220417.951/cider-stacktrace.el b/elpa/cider-20230707.640/cider-stacktrace.el similarity index 90% rename from elpa/cider-20220417.951/cider-stacktrace.el rename to elpa/cider-20230707.640/cider-stacktrace.el index 519a2f55..75db9c15 100644 --- a/elpa/cider-20220417.951/cider-stacktrace.el +++ b/elpa/cider-20230707.640/cider-stacktrace.el @@ -1,6 +1,6 @@ ;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*- -;; Copyright © 2014-2022 Jeff Valk, Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2023 Jeff Valk, Bozhidar Batsov and CIDER contributors ;; Author: Jeff Valk @@ -203,7 +203,8 @@ The error types are represented as strings." (setq-local electric-indent-chars nil) (setq-local cider-stacktrace-hidden-frame-count 0) (setq-local cider-stacktrace-filters cider-stacktrace-default-filters) - (setq-local cider-stacktrace-cause-visibility (make-vector 10 0))) + (setq-local cider-stacktrace-cause-visibility (make-vector 10 0)) + (buffer-disable-undo)) ;; Stacktrace filtering @@ -669,29 +670,30 @@ This associates text properties to enable filtering and source navigation." 'follow-link t 'action (lambda (x) (browse-url (button-get x 'url))))) (nrepl-dbind-response frame (file line flags class method name var ns fn) - (let ((flags (mapcar #'intern flags))) ; strings -> symbols - (insert-text-button (format "%26s:%5d %s/%s" - (if (member 'repl flags) "REPL" file) line - (if (member 'clj flags) ns class) - (if (member 'clj flags) fn method)) - 'var var 'class class 'method method - 'name name 'file file 'line line - 'flags flags 'follow-link t - 'action #'cider-stacktrace-navigate - 'help-echo (cider-stacktrace-tooltip - "View source at this location") - 'font-lock-face 'cider-stacktrace-face - 'type 'cider-plain-button) - (save-excursion - (let ((p4 (point)) - (p1 (search-backward " ")) - (p2 (search-forward "/")) - (p3 (search-forward-regexp "[^/$]+"))) - (put-text-property p1 p4 'font-lock-face 'cider-stacktrace-ns-face) - (put-text-property p2 p3 'font-lock-face 'cider-stacktrace-fn-face) - (put-text-property (line-beginning-position) (line-end-position) - 'cider-stacktrace-frame t))) - (insert "\n")))))) + (when (or class file fn method ns name) + (let ((flags (mapcar #'intern flags))) ; strings -> symbols + (insert-text-button (format "%26s:%5d %s/%s" + (if (member 'repl flags) "REPL" file) (or line -1) + (if (member 'clj flags) ns class) + (if (member 'clj flags) fn method)) + 'var var 'class class 'method method + 'name name 'file file 'line line + 'flags flags 'follow-link t + 'action #'cider-stacktrace-navigate + 'help-echo (cider-stacktrace-tooltip + "View source at this location") + 'font-lock-face 'cider-stacktrace-face + 'type 'cider-plain-button) + (save-excursion + (let ((p4 (point)) + (p1 (search-backward " ")) + (p2 (search-forward "/")) + (p3 (search-forward-regexp "[^/$]+"))) + (put-text-property p1 p4 'font-lock-face 'cider-stacktrace-ns-face) + (put-text-property p2 p3 'font-lock-face 'cider-stacktrace-fn-face) + (put-text-property (line-beginning-position) (line-end-position) + 'cider-stacktrace-frame t))) + (insert "\n"))))))) (defun cider-stacktrace-render-compile-error (buffer cause) "Emit into BUFFER the compile error CAUSE, and enable jumping to it." @@ -843,7 +845,8 @@ the NAME. The whole group is prefixed by string INDENT." (goto-char (next-single-property-change (point) 'compile-error)) (progn (while (cider-stacktrace-next-cause)) - (goto-char (next-single-property-change (point) 'flags))))))))) + (when-let (position (next-single-property-change (point) 'flags)) + (goto-char position))))))))) (defun cider-stacktrace-render (buffer causes &optional error-types) "Emit into BUFFER useful stacktrace information for the CAUSES. @@ -875,6 +878,54 @@ through the `cider-stacktrace-suppressed-errors' variable." (cider-stacktrace-initialize causes) (font-lock-refresh-defaults))) +(defun cider-stacktrace--analyze-stacktrace-op (stacktrace) + "Return the Cider NREPL op to analyze STACKTRACE." + (list "op" "analyze-stacktrace" "stacktrace" stacktrace)) + +(defun cider-stacktrace--stacktrace-request (stacktrace) + "Return the Cider NREPL request to analyze STACKTRACE." + (thread-last + (map-merge 'list + (list (cider-stacktrace--analyze-stacktrace-op stacktrace)) + (cider--nrepl-print-request-map fill-column)) + (seq-mapcat #'identity))) + +(defun cider-stacktrace--analyze-render (causes) + "Render the CAUSES of the stacktrace analysis result." + (let ((buffer (get-buffer-create cider-error-buffer))) + (with-current-buffer buffer + (cider-stacktrace-mode) + (cider-stacktrace-render buffer (reverse causes)) + (display-buffer buffer cider-jump-to-pop-to-buffer-actions)))) + +(defun cider-stacktrace-analyze-string (stacktrace) + "Analyze the STACKTRACE string and show the result." + (when (stringp stacktrace) + (set-text-properties 0 (length stacktrace) nil stacktrace)) + (let (causes) + (cider-nrepl-send-request + (cider-stacktrace--stacktrace-request stacktrace) + (lambda (response) + (setq causes (nrepl-dbind-response response (class status) + (cond (class (cons response causes)) + ((and (member "done" status) causes) + (cider-stacktrace--analyze-render causes))))))))) + +(defun cider-stacktrace-analyze-at-point () + "Analyze the stacktrace at point." + (interactive) + (cond ((thing-at-point 'sentence) + (cider-stacktrace-analyze-string (thing-at-point 'sentence))) + ((thing-at-point 'paragraph) + (cider-stacktrace-analyze-string (thing-at-point 'paragraph))) + (t (cider-stacktrace-analyze-in-region (region-beginning) (region-end))))) + +(defun cider-stacktrace-analyze-in-region (beg end) + "Analyze the stacktrace in the region between BEG and END." + (interactive (list (region-beginning) (region-end))) + (let ((stacktrace (buffer-substring beg end))) + (cider-stacktrace-analyze-string stacktrace))) + (provide 'cider-stacktrace) ;;; cider-stacktrace.el ends here diff --git a/elpa/cider-20220417.951/cider-test.el b/elpa/cider-20230707.640/cider-test.el similarity index 98% rename from elpa/cider-20220417.951/cider-test.el rename to elpa/cider-20230707.640/cider-test.el index e7024986..50ff75f2 100644 --- a/elpa/cider-20220417.951/cider-test.el +++ b/elpa/cider-20230707.640/cider-test.el @@ -1,6 +1,6 @@ ;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*- -;; Copyright © 2014-2022 Jeff Valk, Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2023 Jeff Valk, Bozhidar Batsov and CIDER contributors ;; Author: Jeff Valk @@ -217,7 +217,8 @@ Add to this list to have CIDER recognize additional test defining macros." (when cider-special-mode-truncate-lines (setq-local truncate-lines t)) (setq-local sesman-system 'CIDER) - (setq-local electric-indent-chars nil)) + (setq-local electric-indent-chars nil) + (buffer-disable-undo)) ;; Report navigation @@ -271,12 +272,12 @@ prompt and whether to use a new window. Similar to `cider-find-var'." (let (causes) (cider-nrepl-send-request (thread-last - (map-merge 'list - `(("op" "test-stacktrace") - ("ns" ,ns) - ("var" ,var) - ("index" ,index)) - (cider--nrepl-print-request-map fill-column)) + (map-merge 'list + `(("op" "test-stacktrace") + ("ns" ,ns) + ("var" ,var) + ("index" ,index)) + (cider--nrepl-print-request-map fill-column)) (seq-mapcat #'identity)) (lambda (response) (nrepl-dbind-response response (class status) @@ -397,7 +398,8 @@ With the actual value, the outermost '(not ...)' s-expression is removed." (insert (format "%12s" s))) (insert-rect (s) (let ((start (point))) - (insert-rectangle (thread-first s + (insert-rectangle (thread-first + s cider-font-lock-as-clojure (split-string "\n"))) (ansi-color-apply-on-region start (point))) @@ -476,6 +478,12 @@ With the actual value, the outermost '(not ...)' s-expression is removed." (cider-test-render-assertion buffer test))))) vars)) results))) + ;; Replace any newline chars with actual newlines to make long error + ;; messages more readable + (goto-char (point-min)) + (while (search-forward "\\n" nil t) + (replace-match " +")) (goto-char (point-min)) (current-buffer)))) diff --git a/elpa/cider-20220417.951/cider-tracing.el b/elpa/cider-20230707.640/cider-tracing.el similarity index 95% rename from elpa/cider-20220417.951/cider-tracing.el rename to elpa/cider-20230707.640/cider-tracing.el index 76959415..f7a312e6 100644 --- a/elpa/cider-20220417.951/cider-tracing.el +++ b/elpa/cider-20230707.640/cider-tracing.el @@ -1,6 +1,6 @@ ;;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*- -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Bozhidar Batsov ;; Artur Malabarba @@ -37,7 +37,7 @@ (thread-first `("op" "toggle-trace-var" "ns" ,(cider-current-ns) "sym" ,sym) - (cider-nrepl-send-sync-request))) + (cider-nrepl-send-sync-request))) (defun cider--toggle-trace-var (sym) "Toggle var tracing for SYM." @@ -65,7 +65,7 @@ opposite of what that option dictates." "Toggle namespace tracing for NS." (thread-first `("op" "toggle-trace-ns" "ns" ,ns) - (cider-nrepl-send-sync-request))) + (cider-nrepl-send-sync-request))) ;;;###autoload (defun cider-toggle-trace-ns (query) diff --git a/elpa/cider-20220417.951/cider-util.el b/elpa/cider-20230707.640/cider-util.el similarity index 98% rename from elpa/cider-20220417.951/cider-util.el rename to elpa/cider-20230707.640/cider-util.el index e42988c6..315eca3e 100644 --- a/elpa/cider-20220417.951/cider-util.el +++ b/elpa/cider-20230707.640/cider-util.el @@ -1,7 +1,7 @@ ;; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -134,7 +134,8 @@ keywords." (if (member str '("." "..")) str ;; Remove prefix quotes, and trailing . from constructors like Record. - (thread-last str + (thread-last + str ;; constructors (Foo.) (string-remove-suffix ".") ;; quoted symbols ('sym) @@ -690,6 +691,7 @@ through a stack of help buffers. Variables `help-back-label' and "One REPL to rule them all, One REPL to find them, One REPL to bring them all, and in parentheses bind them!" "A blank REPL promotes creativity." "A blank REPL is infinitely better than a blank cheque." + "May your functions be pure, your code concise and your programs a joy to behold!" ,(format "%s, I've a feeling we're not in Kansas anymore." (cider-user-first-name)) ,(format "%s, this could be the start of a beautiful program." @@ -698,10 +700,13 @@ through a stack of help buffers. Variables `help-back-label' and (defun cider-random-words-of-inspiration () "Select a random entry from `cider-words-of-inspiration'." - ;; FIXME: Consider removing this eval. - (eval (nth (random (length cider-words-of-inspiration)) - cider-words-of-inspiration) - t)) + (nth (random (length cider-words-of-inspiration)) + cider-words-of-inspiration)) + +(defun cider-inspire-me () + "Display a random inspiration message." + (interactive) + (message (cider-random-words-of-inspiration))) (defvar cider-tips '("Press <\\[cider-connect]> to connect to a running nREPL server." diff --git a/elpa/cider-20220417.951/cider-xref.el b/elpa/cider-20230707.640/cider-xref.el similarity index 99% rename from elpa/cider-20220417.951/cider-xref.el rename to elpa/cider-20230707.640/cider-xref.el index 5ec99c4e..b25f9091 100644 --- a/elpa/cider-20220417.951/cider-xref.el +++ b/elpa/cider-20230707.640/cider-xref.el @@ -1,6 +1,6 @@ ;;; cider-xref.el --- Xref functionality for Clojure -*- lexical-binding: t -*- -;; Copyright © 2019-2022 Bozhidar Batsov and CIDER contributors +;; Copyright © 2019-2023 Bozhidar Batsov and CIDER contributors ;; ;; Author: Bozhidar Batsov diff --git a/elpa/cider-20220417.951/cider.el b/elpa/cider-20230707.640/cider.el similarity index 76% rename from elpa/cider-20220417.951/cider.el rename to elpa/cider-20230707.640/cider.el index 2afa9c38..12d0bdba 100644 --- a/elpa/cider-20220417.951/cider.el +++ b/elpa/cider-20230707.640/cider.el @@ -1,7 +1,7 @@ ;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -11,8 +11,8 @@ ;; Steve Purcell ;; Maintainer: Bozhidar Batsov ;; URL: http://www.github.com/clojure-emacs/cider -;; Version: 1.3.0 -;; Package-Requires: ((emacs "26") (clojure-mode "5.14") (parseedn "1.0.6") (queue "0.2") (spinner "1.7") (seq "2.22") (sesman "0.3.2")) +;; Version: 1.8.0-snapshot +;; Package-Requires: ((emacs "26") (clojure-mode "5.16.0") (parseedn "1.0.6") (queue "0.2") (spinner "1.7") (seq "2.22") (sesman "0.3.2") (transient "0.4.1")) ;; Keywords: languages, clojure, cider ;; This program is free software: you can redistribute it and/or modify @@ -86,16 +86,17 @@ (require 'cider-debug) (require 'cider-util) +(require 'cl-lib) (require 'tramp-sh) (require 'subr-x) (require 'seq) (require 'sesman) (require 'package) -(defconst cider-version "1.3.0" +(defconst cider-version "1.8.0-snapshot" "The current version of CIDER.") -(defconst cider-codename "Ukraine" +(defconst cider-codename "Geneva" "Codename used to denote stable releases.") (defcustom cider-lein-command @@ -155,10 +156,17 @@ default to \"powershell\"." :safe #'stringp :package-version '(cider . "0.17.0")) +(defcustom cider-clojure-cli-parameters + nil + "Params passed to clojure cli to start an nREPL server via `cider-jack-in'." + :type 'string + :safe #'stringp + :package-version '(cider . "1.8.0")) + (defcustom cider-clojure-cli-aliases nil "A list of aliases to include when using the clojure cli. -Alias names should be of the form `:foo:bar`. +Alias names should be of the form \":foo:bar\". Leading \"-A\" \"-M\" \"-T\" or \"-X\" are stripped from aliases then concatenated into the \"-M[your-aliases]:cider/nrepl\" form." :type 'string @@ -189,14 +197,14 @@ By default we favor the project-specific shadow-cljs over the system-wide." :package-version '(cider . "0.17.0")) (defcustom cider-gradle-command - "gradle" + "./gradlew" "The command used to execute Gradle." :type 'string :safe #'stringp :package-version '(cider . "0.10.0")) (defcustom cider-gradle-global-options - "--no-daemon" + "" "Command line options used to execute Gradle (e.g.: -m for dry run)." :type 'string :safe #'stringp @@ -224,13 +232,43 @@ By default we favor the project-specific shadow-cljs over the system-wide." :package-version '(cider . "1.2.0")) (defcustom cider-babashka-parameters - "nrepl-server" + "nrepl-server localhost:0" "Params passed to babashka to start an nREPL server via `cider-jack-in'." :type 'string :safe #'stringp :package-version '(cider . "1.2.0")) -(defcustom cider-jack-in-default (if (executable-find "clojure") 'clojure-cli 'lein) +(defcustom cider-nbb-command + "nbb" + "The command used to execute nbb." + :type 'string + :safe #'stringp + :package-version '(cider . "1.6.0")) + +(defcustom cider-nbb-global-options + nil + "Command line options used to execute nbb." + :type 'string + :safe #'stringp + :package-version '(cider . "1.6.0")) + +(defcustom cider-nbb-parameters + "nrepl-server" + "Params passed to nbb to start an nREPL server via `cider-jack-in'." + :type 'string + :safe #'stringp + :package-version '(cider . "1.6.0")) + +(make-obsolete-variable 'cider-lein-global-options 'cider-lein-parameters "1.8.0") +(make-obsolete-variable 'cider-boot-global-options 'cider-boot-parameters "1.8.0") +(make-obsolete-variable 'cider-clojure-cli-global-options 'cider-clojure-cli-parameters "1.8.0") +(make-obsolete-variable 'cider-shadow-cljs-global-options 'cider-shadow-cljs-parameters "1.8.0") +(make-obsolete-variable 'cider-gradle-global-options 'cider-gradle-parameters "1.8.0") +(make-obsolete-variable 'cider-babashka-global-options 'cider-babashka-parameters "1.8.0") +(make-obsolete-variable 'cider-nbb-global-options 'cider-nbb-parameters "1.8.0") + +(defcustom cider-jack-in-default + (if (executable-find "clojure") 'clojure-cli 'lein) "The default tool to use when doing `cider-jack-in' outside a project. This value will only be consulted when no identifying file types, i.e. project.clj for leiningen or build.boot for boot, could be found. @@ -243,7 +281,8 @@ to Leiningen." (const clojure-cli) (const shadow-cljs) (const gradle) - (const babashka)) + (const babashka) + (const nbb)) :safe #'symbolp :package-version '(cider . "0.9.0")) @@ -262,6 +301,7 @@ command when there is no ambiguity." (const shadow-cljs) (const gradle) (const babashka) + (const nbb) (const :tag "Always ask" nil)) :safe #'symbolp :package-version '(cider . "0.13.0")) @@ -297,7 +337,8 @@ This variable is used by `cider-connect'." :package-version '(cider . "0.9.0")) (defcustom cider-inject-dependencies-at-jack-in t - "When nil, do not inject repl dependencies (most likely nREPL middlewares) at `cider-jack-in' time." + "When nil, do not inject repl dependencies at `cider-jack-in' time. +The repl dependendcies are most likely to be nREPL middlewares." :type 'boolean :safe #'booleanp :version '(cider . "0.11.0")) @@ -321,6 +362,26 @@ Sub-match 1 must be the project path.") (defvar cider-host-history nil "Completion history for connection hosts.") +(defvar cider-jack-in-universal-options + '((clojure-cli (:prefix-arg 1 :cmd (:jack-in-type clj :project-type clojure-cli :edit-project-dir t))) + (lein (:prefix-arg 2 :cmd (:jack-in-type clj :project-type lein :edit-project-dir t))) + (babashka (:prefix-arg 3 :cmd (:jack-in-type clj :project-type babashka :edit-project-dir t))) + (nbb (:prefix-arg 4 :cmd (:jack-in-type cljs :project-type nbb :cljs-repl-type nbb :edit-project-dir t)))) + "The list of project tools that are supported by the universal jack in command. + +Each item in the list consists of the tool name and its plist options. + +The plist supports the following keys + +- :prefix-arg the numerical prefix arg to use to jack in to the tool. + +- :cmd a plist of instructions how to invoke the jack in command, with keys + + - :jack-in-type 'clj to start a clj repl and 'cljs for a cljs repl. + + - &rest the same set of params supported by the `cider-jack-in-clj' and + `cider-jack-in-cljs' commands.") + ;;;###autoload (defun cider-version () "Display CIDER's version." @@ -336,6 +397,7 @@ Sub-match 1 must be the project path.") ('babashka cider-babashka-command) ('shadow-cljs cider-shadow-cljs-command) ('gradle cider-gradle-command) + ('nbb cider-nbb-command) (_ (user-error "Unsupported project type `%S'" project-type)))) (defun cider-jack-in-resolve-command (project-type) @@ -351,7 +413,17 @@ Throws an error if PROJECT-TYPE is unknown." ('shadow-cljs (let ((parts (split-string cider-shadow-cljs-command))) (when-let* ((command (cider--resolve-command (car parts)))) (mapconcat #'identity (cons command (cdr parts)) " ")))) - ('gradle (cider--resolve-command cider-gradle-command)) + ;; TODO: Address the duplicated code below. + ;; here we have to account for the possibility that the command is either + ;; "nbb" (default) or "npx nbb". + ('nbb (let ((parts (split-string cider-nbb-command))) + (when-let* ((command (cider--resolve-command (car parts)))) + (mapconcat #'identity (cons command (cdr parts)) " ")))) + ;; here we have to account for use of the Gradle wrapper which is + ;; a shell script within their project, so if they have a clearly + ;; relative path like "./gradlew" use locate file instead of checking + ;; the exec-path + ('gradle (cider--resolve-project-command cider-gradle-command)) (_ (user-error "Unsupported project type `%S'" project-type)))) (defun cider-jack-in-global-options (project-type) @@ -363,6 +435,7 @@ Throws an error if PROJECT-TYPE is unknown." ('babashka cider-babashka-global-options) ('shadow-cljs cider-shadow-cljs-global-options) ('gradle cider-gradle-global-options) + ('nbb cider-nbb-global-options) (_ (user-error "Unsupported project type `%S'" project-type)))) (defun cider-jack-in-params (project-type) @@ -374,10 +447,11 @@ Throws an error if PROJECT-TYPE is unknown." (pcase project-type ('lein cider-lein-parameters) ('boot cider-boot-parameters) - ('clojure-cli nil) + ('clojure-cli cider-clojure-cli-parameters) ('babashka cider-babashka-parameters) ('shadow-cljs cider-shadow-cljs-parameters) ('gradle cider-gradle-parameters) + ('nbb cider-nbb-parameters) (_ (user-error "Unsupported project type `%S'" project-type)))) @@ -386,7 +460,7 @@ Throws an error if PROJECT-TYPE is unknown." "List of dependencies where elements are lists of artifact name and version.") (put 'cider-jack-in-dependencies 'risky-local-variable t) -(defcustom cider-injected-nrepl-version "0.9.0" +(defcustom cider-injected-nrepl-version "1.0.0" "The version of nREPL injected on jack-in. We inject the newest known version of nREPL just in case your version of Boot or Leiningen is bundling an older one." @@ -415,7 +489,7 @@ the artifact.") (defconst cider-latest-clojure-version "1.10.1" "Latest supported version of Clojure.") -(defconst cider-required-middleware-version "0.28.3" +(defconst cider-required-middleware-version "0.32.0-alpha1" "The CIDER nREPL version that's known to work properly with CIDER.") (defcustom cider-injected-middleware-version cider-required-middleware-version @@ -444,13 +518,26 @@ which will be the lowest version CIDER supports. If a string, use this as the version number. If it is a list, the first element should be a string, specifying the artifact ID, and the second element the version number." :type '(choice (const :tag "None" nil) - (const :tag "Latest" 'latest) - (const :tag "Minimal" 'minimal) + (const :tag "Latest" latest) + (const :tag "Minimal" minimal) (string :tag "Specific Version") (list :tag "Artifact ID and Version" (string :tag "Artifact ID") (string :tag "Version")))) +(defvar-local cider-jack-in-cmd nil + "The custom command used to start a nrepl server. +This is used by `cider-jack-in`. + +If this variable is set, its value will be +used as the command to start the nrepl server +instead of the default command inferred from +the project type. + +This allows for fine-grained control over the jack-in process. +The value should be a string representing the command to start +the nrepl server, such as \"nbb nrepl-server\".") + (defvar cider-jack-in-lein-plugins nil "List of Leiningen plugins to be injected at jack-in. Each element is a list of artifact name and version, followed optionally by @@ -486,7 +573,8 @@ returned by this function does not include keyword arguments." ("mx.cider/enrich-classpath" "1.9.0"))) (append cider-jack-in-lein-plugins `(("cider/cider-nrepl" ,cider-injected-middleware-version)))))) - (thread-last plugins + (thread-last + plugins (seq-filter (lambda (spec) (if-let* ((pred (plist-get (seq-drop spec 2) :predicate))) @@ -518,7 +606,8 @@ Added to `cider-jack-in-nrepl-middlewares' (which see) when doing "Return a normalized list of middleware variable names. See `cider-jack-in-nrepl-middlewares' for the format, except that the list returned by this function only contains strings." - (thread-last cider-jack-in-nrepl-middlewares + (thread-last + cider-jack-in-nrepl-middlewares (seq-filter (lambda (spec) (or (not (listp spec)) @@ -570,6 +659,49 @@ and MIDDLEWARES. PARAMS and MIDDLEWARES are passed on to (cider-boot-dependencies (append (cider--jack-in-required-dependencies) dependencies)) (cider-boot-middleware-task params middlewares))) +(defun cider--gradle-dependency-notation (dependency) + "Returns Gradle's GAV dependency syntax. +For a \"group/artifact\" \"version\") DEPENDENCY list +return as group:artifact:version notation." + (let ((group-artifact (replace-regexp-in-string "/" ":" (car dependency))) + (version (cadr dependency))) + (format "%s:%s" group-artifact version))) + +(defun cider--gradle-jack-in-property (dependencies) + "Returns Clojurephant's dependency jack-in property. +For DEPENDENCIES, translates to Gradle's dependency notation +using `cider--gradle-dependency-notation`.''" + (if (seq-empty-p dependencies) + "" + (shell-quote-argument + (concat "-Pdev.clojurephant.jack-in.nrepl=" + (mapconcat #'cider--gradle-dependency-notation dependencies ","))))) + +(defun cider--gradle-middleware-params (middlewares) + "Returns Gradle-formatted middleware params. +Given a list of MIDDLEWARES symbols, this returns +the Gradle parameters expected by Clojurephant's +ClojureNRepl task." + (mapconcat (lambda (middleware) + (shell-quote-argument (concat "--middleware=" middleware))) + middlewares + " ")) + +(defun cider-gradle-jack-in-dependencies (global-opts params dependencies middlewares) + "Create gradle jack in dependencies. +Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, +and MIDDLEWARES. GLOBAL-OPTS and PARAMS are taken as-is. +DEPENDENCIES are translated into Gradle's typical +group:artifact:version notation and MIDDLEWARES are +prepared as arguments to Clojurephant's ClojureNRepl task." + (concat global-opts + (unless (seq-empty-p global-opts) " ") + (cider--gradle-jack-in-property (append (cider--jack-in-required-dependencies) dependencies)) + " " + params + (unless (seq-empty-p params) " ") + (cider--gradle-middleware-params middlewares))) + (defun cider--lein-artifact-exclusions (exclusions) "Return an exclusions vector described by the elements of EXCLUSIONS." (if exclusions @@ -612,33 +744,69 @@ removed, LEIN-PLUGINS, LEIN-MIDDLEWARES and finally PARAMS." "Removes the duplicates in DEPS." (cl-delete-duplicates deps :test 'equal)) -(defun cider-clojure-cli-jack-in-dependencies (global-options _params dependencies) +(defun cider--jack-in-cmd-powershell-p (command) + "Returns whether COMMAND is PowerShell." + (or (string-equal command "powershell") + (string-equal command "pwsh"))) + +(defun cider--shell-quote-argument (argument &optional command) + "Quotes ARGUMENT like `shell-quote-argument', suitable for use with COMMAND. + +Uses `shell-quote-argument' to quote the ARGUMENT, unless COMMAND is given +and refers to PowerShell, in which case it uses (some limited) PowerShell +rules to quote it." + (if (cider--jack-in-cmd-powershell-p command) + ;; please add more PowerShell quoting rules as necessary. + (format "'%s'" (replace-regexp-in-string "\"" "\"\"" argument)) + (shell-quote-argument argument))) + +(defun cider--powershell-encode-command (cmd-params) + "Base64 encode the powershell command and jack-in CMD-PARAMS for clojure-cli." + (let* ((quoted-params cmd-params) + (command (format "clojure %s" quoted-params)) + (utf-16le-command (encode-coding-string command 'utf-16le))) + (format "-encodedCommand %s" (base64-encode-string utf-16le-command t)))) + +(defun cider-clojure-cli-jack-in-dependencies (global-options params dependencies &optional command) "Create Clojure tools.deps jack-in dependencies. -Does so by concatenating DEPENDENCIES and GLOBAL-OPTIONS into a suitable -`clojure` invocation. The main is placed in an inline alias :cider/nrepl -so that if your aliases contain any mains, the cider/nrepl one will be the -one used." - (let* ((all-deps (thread-last dependencies +Does so by concatenating DEPENDENCIES, PARAMS and GLOBAL-OPTIONS into a +suitable `clojure` invocation and quoting, also accounting for COMMAND if +provided. The main is placed in an inline alias :cider/nrepl so that if +your aliases contain any mains, the cider/nrepl one will be the one used." + (let* ((all-deps (thread-last + dependencies (append (cider--jack-in-required-dependencies)) ;; Duplicates are never OK since they would result in ;; `java.lang.IllegalArgumentException: Duplicate key [...]`: (cider--dedupe-deps) (seq-map (lambda (dep) - (format "%s {:mvn/version \"%s\"}" (car dep) (cadr dep)))))) + (if (listp (cadr dep)) + (format "%s {%s}" + (car dep) + (seq-reduce + (lambda (acc v) + (concat acc (format " :%s \"%s\" " (car v) (cdr v)))) + (cadr dep) + "")) + (format "%s {:mvn/version \"%s\"}" (car dep) (cadr dep))))))) (middleware (mapconcat (apply-partially #'format "%s") (cider-jack-in-normalized-nrepl-middlewares) ",")) - (main-opts (format "\"-m\" \"nrepl.cmdline\" \"--middleware\" \"[%s]\"" middleware))) - (format "%s-Sdeps '{:deps {%s} :aliases {:cider/nrepl {:main-opts [%s]}}}' -M%s:cider/nrepl" + (main-opts (format "\"-m\" \"nrepl.cmdline\" \"--middleware\" \"[%s]\"" middleware)) + (deps (format "{:deps {%s} :aliases {:cider/nrepl {:main-opts [%s]}}}" + (string-join all-deps " ") main-opts)) + (deps-quoted (cider--shell-quote-argument deps command))) + (format "%s-Sdeps %s -M%s:cider/nrepl%s" + ;; TODO: global-options are deprecated and should be removed in CIDER 2.0 (if global-options (format "%s " global-options) "") - (string-join all-deps " ") - main-opts + deps-quoted (if cider-clojure-cli-aliases ;; remove exec-opts flags -A -M -T or -X from cider-clojure-cli-aliases ;; concatenated with :cider/nrepl to ensure :cider/nrepl comes last (format "%s" (replace-regexp-in-string "^-\\(A\\|M\\|T\\|X\\)" "" cider-clojure-cli-aliases)) - "")))) + "") + (if params (format " %s" params) "")))) (defun cider-shadow-cljs-jack-in-dependencies (global-opts params dependencies) "Create shadow-cljs jack-in deps. @@ -670,13 +838,13 @@ See also `cider-jack-in-auto-inject-clojure'." dependencies)) dependencies)) -(defun cider-inject-jack-in-dependencies (global-opts params project-type) +(defun cider-inject-jack-in-dependencies (global-opts params project-type &optional command) "Return GLOBAL-OPTS and PARAMS with injected REPL dependencies. -These are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' and -`cider-jack-in-nrepl-middlewares' are injected from the CLI according to -the used PROJECT-TYPE. Eliminates the need for hacking profiles.clj or the -boot script for supporting CIDER with its nREPL middleware and -dependencies." +These are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' +and `cider-jack-in-nrepl-middlewares' are injected from the CLI according +to the used PROJECT-TYPE, and COMMAND if provided. Eliminates the need for +hacking profiles.clj or the boot script for supporting CIDER with its nREPL +middleware and dependencies." (pcase project-type ('lein (cider-lein-jack-in-dependencies global-opts @@ -699,7 +867,8 @@ dependencies." global-opts params (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies))) + cider-jack-in-dependencies) + command)) ('babashka (concat global-opts (unless (seq-empty-p global-opts) " ") @@ -709,10 +878,16 @@ dependencies." params (cider-add-clojure-dependencies-maybe cider-jack-in-dependencies))) - ('gradle (concat + ('gradle (cider-gradle-jack-in-dependencies global-opts - (unless (seq-empty-p global-opts) " ") - params)) + params + (cider-add-clojure-dependencies-maybe + cider-jack-in-dependencies) + (cider-jack-in-normalized-nrepl-middlewares))) + ('nbb (concat + global-opts + (unless (seq-empty-p global-opts) " ") + params)) (_ (error "Unsupported project type `%S'" project-type)))) @@ -725,9 +900,18 @@ Generally you should not disable this unless you run into some faulty check." :safe #'booleanp :package-version '(cider . "0.17.0")) +(defun cider-clojurescript-present-p () + "Return non nil when ClojureScript is present." + (or + ;; This is nil for example for nbb. + (cider-library-present-p "cljs.core") + ;; demunge is not defined currently for normal cljs repls. + ;; So we end up making the two checks + (nrepl-dict-get (cider-sync-tooling-eval "cljs.core/demunge") "value"))) + (defun cider-verify-clojurescript-is-present () "Check whether ClojureScript is present." - (unless (cider-library-present-p "cljs.core") + (unless (cider-clojurescript-present-p) (user-error "ClojureScript is not available. See https://docs.cider.mx/cider/basics/clojurescript for details"))) (defun cider-verify-piggieback-is-present () @@ -931,21 +1115,26 @@ The supplied string will be wrapped in a do form if needed." (def config (edn/read-string (slurp (io/file \"build.edn\")))) (apply cider.piggieback/cljs-repl (krell.repl/repl-env) (mapcat identity config))" cider-check-krell-requirements) + ;; native cljs repl, no form required. + (nbb) (custom cider-custom-cljs-repl-init-form nil)) "A list of supported ClojureScript REPLs. -For each one we have its name, the form we need to evaluate in a Clojure -REPL to start the ClojureScript REPL and functions to verify their requirements. +For each one we have its name, and then, if the repl is not a native +ClojureScript REPL, the form we need to evaluate in a Clojure REPL to +switch to the ClojureScript REPL and functions to verify their +requirements. -The form should be either a string or a function producing a string.") +The form, if any, should be either a string or a function producing a +string.") -(defun cider-register-cljs-repl-type (type init-form &optional requirements-fn) +(defun cider-register-cljs-repl-type (type &optional init-form requirements-fn) "Register a new ClojureScript REPL type. Types are defined by the following: - TYPE - symbol identifier that will be used to refer to the REPL type -- INIT-FORM - string or function (symbol) producing string +- INIT-FORM - (optional) string or function (symbol) producing string - REQUIREMENTS-FN - function to check whether the REPL can be started. This param is optional. @@ -953,8 +1142,8 @@ All this function does is modifying `cider-cljs-repl-types'. It's intended to be used in your Emacs config." (unless (symbolp type) (user-error "The REPL type must be a symbol")) - (unless (or (stringp init-form) (symbolp init-form)) - (user-error "The init form must be a string or a symbol referring to a function")) + (unless (or (null init-form) (stringp init-form) (symbolp init-form)) + (user-error "The init form must be a string or a symbol referring to a function or nil")) (unless (or (null requirements-fn) (symbolp requirements-fn)) (user-error "The requirements-fn must be a symbol referring to a function")) (add-to-list 'cider-cljs-repl-types (list type init-form requirements-fn))) @@ -974,6 +1163,7 @@ you're working on." (const :tag "Shadow" shadow) (const :tag "Shadow w/o Server" shadow-select) (const :tag "Krell" krell) + (const :tag "Nbb" nbb) (const :tag "Custom" custom)) :safe #'symbolp :package-version '(cider . "0.17.0")) @@ -992,15 +1182,16 @@ DEFAULT is the default ClojureScript REPL to offer in completion." (or default (car cider--select-cljs-repl-history)))))) (defun cider-cljs-repl-form (repl-type) - "Get the cljs REPL form for REPL-TYPE." - (if-let* ((repl-form (cadr (seq-find - (lambda (entry) - (eq (car entry) repl-type)) - cider-cljs-repl-types)))) - ;; repl-form can be either a string or a function producing a string - (if (symbolp repl-form) - (funcall repl-form) - repl-form) + "Get the cljs REPL form for REPL-TYPE, if any." + (if-let* ((repl-type-info (seq-find + (lambda (entry) + (eq (car entry) repl-type)) + cider-cljs-repl-types))) + (when-let ((repl-form (cadr repl-type-info))) + ;; repl-form can be either a string or a function producing a string + (if (symbolp repl-form) + (funcall repl-form) + repl-form)) (user-error "No ClojureScript REPL type %s found. Please make sure that `cider-cljs-repl-types' has an entry for it" repl-type))) (defun cider-verify-cljs-repl-requirements (&optional repl-type) @@ -1055,6 +1246,7 @@ nil." (define-key map (kbd "j j") #'cider-jack-in-clj) (define-key map (kbd "j s") #'cider-jack-in-cljs) (define-key map (kbd "j m") #'cider-jack-in-clj&cljs) + (define-key map (kbd "j u") #'cider-jack-in-universal) (define-key map (kbd "C-j j") #'cider-jack-in-clj) (define-key map (kbd "C-j s") #'cider-jack-in-cljs) (define-key map (kbd "C-j m") #'cider-jack-in-clj&cljs) @@ -1086,7 +1278,8 @@ PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. With the prefix argument, allow editing of the jack in command; with a double prefix prompt for all these parameters." (interactive "P") - (let ((params (thread-first params + (let ((params (thread-first + params (cider--update-project-dir) (cider--check-existing-session) (cider--update-jack-in-cmd)))) @@ -1109,7 +1302,8 @@ these parameters." (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) (orig-buffer (current-buffer))) ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars - (let ((params (thread-first params + (let ((params (thread-first + params (cider--update-project-dir) (cider--check-existing-session) (cider--update-jack-in-cmd)))) @@ -1134,7 +1328,8 @@ only when the ClojureScript dependencies are met." (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) (orig-buffer (current-buffer))) ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars - (let ((params (thread-first params + (let ((params (thread-first + params (cider--update-project-dir) (cider--check-existing-session) (cider--update-jack-in-cmd) @@ -1165,7 +1360,8 @@ server is created." (other-params (cider--gather-connect-params nil other-repl)) (ses-name (unless (nrepl-server-p other-repl) (sesman-session-name-for-object 'CIDER other-repl)))) - (thread-first params + (thread-first + params (cider--update-do-prompt) (append other-params) (plist-put :repl-init-function nil) @@ -1185,13 +1381,14 @@ server buffer, in which case a new session for that server is created." (ses-name (unless (nrepl-server-p other-repl) (sesman-session-name-for-object 'CIDER other-repl)))) (cider-nrepl-connect - (thread-first params + (thread-first + params (cider--update-do-prompt) (append other-params) (cider--update-cljs-type) (cider--update-cljs-init-function) (plist-put :session-name ses-name) - (plist-put :repl-type 'pending-cljs))))) + (plist-put :repl-type 'cljs))))) ;;;###autoload (defun cider-connect-clj (&optional params) @@ -1200,7 +1397,8 @@ PARAMS is a plist optionally containing :host, :port and :project-dir. On prefix argument, prompt for all the parameters." (interactive "P") (cider-nrepl-connect - (thread-first params + (thread-first + params (cider--update-project-dir) (cider--update-host-port) (cider--check-existing-session) @@ -1216,14 +1414,15 @@ PARAMS is a plist optionally containing :host, :port, :project-dir and parameters regardless of their supplied or default values." (interactive "P") (cider-nrepl-connect - (thread-first params + (thread-first + params (cider--update-project-dir) (cider--update-host-port) (cider--check-existing-session) (cider--update-cljs-type) (cider--update-cljs-init-function) (plist-put :session-name nil) - (plist-put :repl-type 'pending-cljs)))) + (plist-put :repl-type 'cljs)))) ;;;###autoload (defun cider-connect-clj&cljs (params &optional soft-cljs-start) @@ -1232,7 +1431,8 @@ PARAMS is a plist optionally containing :host, :port, :project-dir and :cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is non-nil, don't start if ClojureScript requirements are not met." (interactive "P") - (let* ((params (thread-first params + (let* ((params (thread-first + params (cider--update-project-dir) (cider--update-host-port) (cider--check-existing-session) @@ -1271,9 +1471,15 @@ non-nil, don't start if ClojureScript requirements are not met." (t params))) (defun cider--update-project-dir (params) - "Update :project-dir in PARAMS." + "Update :project-dir in PARAMS. + +Params is a plist with the following keys (non-exhaustive) + + :edit-project-dir prompt (optional) ask user to confirm the project root + directory." (let* ((params (cider--update-do-prompt params)) - (proj-dir (if (plist-get params :do-prompt) + (proj-dir (if (or (plist-get params :do-prompt) + (plist-get params :edit-project-dir)) (read-directory-name "Project: " (clojure-project-dir (cider-current-dir))) (plist-get params :project-dir))) @@ -1300,7 +1506,8 @@ non-nil, don't start if ClojureScript requirements are not met." (setq-local buffer-file-name nil)) (let ((default-directory proj-dir)) (hack-dir-local-variables-non-file-buffer) - (thread-first params + (thread-first + params (plist-put :project-dir proj-dir) (plist-put :--context-buffer (current-buffer))))))))) @@ -1329,49 +1536,55 @@ non-nil, don't start if ClojureScript requirements are not met." (defvar cider--jack-in-cmd-history nil "History list for user-specified jack-in commands.") -(defun cider--powershell-encode-command (cmd-params) - "Base64 encode the powershell command and jack-in CMD-PARAMS for clojure-cli." - (let* ((quoted-params (replace-regexp-in-string "\"" "\"\"" cmd-params)) - (command (format "clojure %s" quoted-params)) - (utf-16le-command (encode-coding-string command 'utf-16le))) - (format "-encodedCommand %s" (base64-encode-string utf-16le-command t)))) - (defun cider--update-jack-in-cmd (params) - "Update :jack-in-cmd key in PARAMS." - (let* ((params (cider--update-do-prompt params)) - (project-dir (plist-get params :project-dir)) - (project-type (cider-project-type project-dir)) - (command (cider-jack-in-command project-type)) - (command-resolved (cider-jack-in-resolve-command project-type)) - (command-global-opts (cider-jack-in-global-options project-type)) - (command-params (cider-jack-in-params project-type))) - (if command-resolved - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let* ((command-params (if (plist-get params :do-prompt) - (read-string "nREPL server command: " - command-params - 'cider--jack-in-nrepl-params-history) - command-params)) - (cmd-params (if cider-inject-dependencies-at-jack-in - (cider-inject-jack-in-dependencies command-global-opts command-params project-type) - command-params))) - (if (or project-dir cider-allow-jack-in-without-project) - (when (or project-dir - (eq cider-allow-jack-in-without-project t) - (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? "))) - (let ((cmd (format "%s %s" command-resolved (if (or (string-equal command "powershell") - (string-equal command "pwsh")) - (cider--powershell-encode-command cmd-params) - cmd-params)))) - (plist-put params :jack-in-cmd (if (or cider-edit-jack-in-command - (plist-get params :edit-jack-in-command)) - (read-string "jack-in command: " cmd 'cider--jack-in-cmd-history) - cmd)))) - (user-error "`cider-jack-in' is not allowed without a Clojure project")))) - (user-error "The %s executable isn't on your `exec-path'" command)))) + "Update :jack-in-cmd key in PARAMS. + +PARAMS is a plist with the following keys (non-exhaustive list) + +:project-type optional, the project type to create the command for; see +`cider-jack-in-command' for the list of valid types)." + (cond + ((plist-get params :jack-in-cmd) params) + (cider-jack-in-cmd (plist-put params :jack-in-cmd cider-jack-in-cmd)) + (t (let* ((params (cider--update-do-prompt params)) + (project-dir (plist-get params :project-dir)) + (params-project-type (plist-get params :project-type)) + (project-type (or params-project-type + (cider-project-type project-dir))) + (command (cider-jack-in-command project-type)) + (command-resolved (cider-jack-in-resolve-command project-type)) + ;; TODO: global-options are deprecated and should be removed in CIDER 2.0 + (command-global-opts (cider-jack-in-global-options project-type)) + (command-params (cider-jack-in-params project-type))) + (if command-resolved + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let* ((command-params (if (plist-get params :do-prompt) + (read-string "nREPL server command: " + command-params + 'cider--jack-in-nrepl-params-history) + command-params)) + (cmd-params (if cider-inject-dependencies-at-jack-in + (cider-inject-jack-in-dependencies command-global-opts command-params + project-type command) + command-params))) + (if (or project-dir cider-allow-jack-in-without-project) + (when (or project-dir + (eq cider-allow-jack-in-without-project t) + (and (null project-dir) + (eq cider-allow-jack-in-without-project 'warn) + (or params-project-type + (y-or-n-p "Are you sure you want to run `cider-jack-in' without a Clojure project? ")))) + (let ((cmd (format "%s %s" command-resolved + (if (cider--jack-in-cmd-powershell-p command) + (cider--powershell-encode-command cmd-params) + cmd-params)))) + (plist-put params :jack-in-cmd (if (or cider-edit-jack-in-command + (plist-get params :edit-jack-in-command)) + (read-string "jack-in command: " cmd 'cider--jack-in-cmd-history) + cmd)))) + (user-error "`cider-jack-in' is not allowed without a Clojure project")))) + (user-error "The %s executable isn't on your `exec-path'" command)))))) (defun cider--update-host-port (params) "Update :host and :port; or :socket-file in PARAMS." @@ -1387,31 +1600,47 @@ non-nil, don't start if ClojureScript requirements are not met." (cider-select-endpoint))))) (if (equal "local-unix-domain-socket" (car endpoint)) (plist-put params :socket-file (cdr endpoint)) - (thread-first params + (thread-first + params (plist-put :host (car endpoint)) (plist-put :port (cdr endpoint))))))) (defun cider--update-cljs-init-function (params) - "Update PARAMS :repl-init-function for cljs connections." + "Update repl type and any init PARAMS for cljs connections. + +The updated params are: + +:cider-repl-cljs-upgrade-pending nil if it is a cljs REPL, or t +when the init form is required to be sent to the REPL to switch +over to cljs. + +:repl-init-form The form that can switch the REPL over to cljs. + +:repl-init-function The fn that switches the REPL over to cljs." (with-current-buffer (or (plist-get params :--context-buffer) (current-buffer)) (let* ((cljs-type (plist-get params :cljs-repl-type)) (repl-init-form (cider-cljs-repl-form cljs-type))) - (thread-first params - (plist-put :repl-init-function - (lambda () - (cider--check-cljs cljs-type) - ;; FIXME: ideally this should be done in the state handler - (setq-local cider-cljs-repl-type cljs-type) - (cider-nrepl-send-request - (list "op" "eval" - "ns" (cider-current-ns) - "code" repl-init-form) - (cider-repl-handler (current-buffer))) - (when (and (buffer-live-p nrepl-server-buffer) - cider-offer-to-open-cljs-app-in-browser) - (cider--offer-to-open-app-in-browser nrepl-server-buffer)))) - (plist-put :repl-init-form repl-init-form))))) + (if (null repl-init-form) + (plist-put params :cider-repl-cljs-upgrade-pending nil) + + (thread-first + params + (plist-put :cider-repl-cljs-upgrade-pending t) + (plist-put :repl-init-function + (lambda () + (cider--check-cljs cljs-type) + ;; FIXME: ideally this should be done in the state handler + (setq-local cider-cljs-repl-type cljs-type) + (cider-nrepl-send-request + (list "op" "eval" + "ns" (cider-current-ns) + "code" repl-init-form) + (cider-repl-handler (current-buffer))) + (when (and (buffer-live-p nrepl-server-buffer) + cider-offer-to-open-cljs-app-in-browser) + (cider--offer-to-open-app-in-browser nrepl-server-buffer)))) + (plist-put :repl-init-form repl-init-form)))))) (defun cider--check-existing-session (params) "Ask for confirmation if a session with similar PARAMS already exists. @@ -1561,10 +1790,11 @@ of remote SSH hosts." 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))))) - (list (file-name-nondirectory (directory-file-name d)) port))) - (cons (clojure-project-dir dir) paths)))) + (proj-ports (apply #'append + (mapcar (lambda (d) + (mapcar (lambda (p) (list (file-name-nondirectory (directory-file-name d)) p)) + (and d (nrepl-extract-ports (cider--file-path d))))) + (cons (clojure-project-dir dir) paths))))) (seq-uniq (delq nil proj-ports)))) (defun cider--running-nrepl-paths () @@ -1590,7 +1820,8 @@ PROJECT-DIR defaults to current project." (babashka . "bb.edn") (shadow-cljs . "shadow-cljs.edn") (gradle . "build.gradle") - (gradle . "build.gradle.kts")))) + (gradle . "build.gradle.kts") + (nbb . "nbb.edn")))) (delq nil (mapcar (lambda (candidate) (when (file-exists-p (cdr candidate)) @@ -1626,6 +1857,55 @@ PROJECT-DIR defaults to the current project." ;; 0.18, therefore the need for `cider-maybe-intern' (t (cider-maybe-intern cider-jack-in-default))))) +;;;###autoload +(defun cider-jack-in-universal (arg) + "Start and connect to an nREPL server for the current project or ARG project id. + +If a project is found in current dir, call `cider-jack-in' passing ARG as +first parameter, of which see. Otherwise, ask user which project type to +start an nREPL server and connect to without a project. + +But if invoked with a numeric prefix ARG, then start an nREPL server for +the project type denoted by ARG number and connect to it, even if there is +no project for it in the current dir. + +The supported project tools and their assigned numeric prefix ids are +sourced from `cider-jack-in-universal-options', of which see. + +You can pass a numeric prefix argument n with `M-n` or `C-u n`. + +For example, to jack in to leiningen which is assigned to prefix arg 2 type + +M-2 \\[cider-jack-in-universal]." + (interactive "P") + (let ((cpt (clojure-project-dir (cider-current-dir)))) + (if (or (integerp arg) (null cpt)) + (let* ((project-types-available (mapcar #'car cider-jack-in-universal-options)) + (project-type (if (null arg) + (intern (completing-read + "No project found in current dir, select project type to jack in: " + project-types-available + nil t)) + + (or (seq-some (lambda (elt) + (cl-destructuring-bind + (project-type (&key prefix-arg &allow-other-keys)) elt + (when (= arg prefix-arg) + project-type))) + cider-jack-in-universal-options) + (error ":cider-jack-in-universal :unsupported-prefix-argument %S :no-such-project" + arg)))) + (project-options (cadr (seq-find (lambda (elt) (equal project-type (car elt))) + cider-jack-in-universal-options))) + (jack-in-opts (plist-get project-options :cmd)) + (jack-in-type (plist-get jack-in-opts :jack-in-type))) + (pcase jack-in-type + ('clj (cider-jack-in-clj jack-in-opts)) + ('cljs (cider-jack-in-cljs jack-in-opts)) + (_ (error ":cider-jack-in-universal :jack-in-type-unsupported %S" jack-in-type)))) + + (cider-jack-in-clj arg)))) + ;; TODO: Implement a check for command presence over tramp (defun cider--resolve-command (command) @@ -1637,6 +1917,29 @@ assume the command is available." (executable-find (concat command ".bat"))))) (shell-quote-argument command))) +(defun cider--resolve-project-command (command) + "Find COMMAND in project dir or exec path (see variable `exec-path'). +If COMMAND starts with ./ or ../ resolve relative to `clojure-project-dir', +otherwise resolve via `cider--resolve-command'." + (if (string-match-p "\\`\\.\\{1,2\\}/" command) + (locate-file command (list (clojure-project-dir)) '("" ".bat") 'executable) + (cider--resolve-command command))) + +(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration + "The function to use to generate the message displayed on connect. +When set to nil no additional message will be displayed. A good +alternative to the default is `cider-random-tip'." + :type 'function + :group 'cider + :package-version '(cider . "0.11.0")) + +(defun cider--maybe-inspire-on-connect () + "Display an inspiration connection message." + (when cider-connection-message-fn + (message "Connected! %s" (funcall cider-connection-message-fn)))) + +(add-hook 'cider-connected-hook #'cider--maybe-inspire-on-connect) + ;;;###autoload (with-eval-after-load 'clojure-mode (define-key clojure-mode-map (kbd "C-c M-x") #'cider) diff --git a/elpa/cider-20220417.951/nrepl-client.el b/elpa/cider-20230707.640/nrepl-client.el similarity index 90% rename from elpa/cider-20220417.951/nrepl-client.el rename to elpa/cider-20230707.640/nrepl-client.el index 7eb1642a..beb9b32d 100644 --- a/elpa/cider-20220417.951/nrepl-client.el +++ b/elpa/cider-20230707.640/nrepl-client.el @@ -1,7 +1,7 @@ ;;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -111,7 +111,9 @@ :type 'boolean) (defcustom nrepl-use-ssh-fallback-for-remote-hosts nil - "If non-nil, attempt to connect via ssh to remote hosts when unable to connect directly." + "If non-nil, Use ssh as a fallback to connect to remote hosts. +It will attempt to connect via ssh to remote hosts when unable to connect +directly." :type 'boolean) (defcustom nrepl-sync-request-timeout 10 @@ -235,6 +237,16 @@ PARAMS is as in `nrepl-make-buffer-name'." (nrepl--port-from-file (expand-file-name "target/repl-port" dir)) (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir)))) +(defun nrepl-extract-ports (dir) + "Read ports from applicable repl-port files in directory DIR." + (delq nil + (list (nrepl--port-from-file (expand-file-name "repl-port" dir)) + (nrepl--port-from-file (expand-file-name ".nrepl-port" dir)) + (nrepl--port-from-file (expand-file-name "target/repl-port" dir)) + (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir))))) + +(make-obsolete 'nrepl-extract-port 'nrepl-extract-ports "1.5.0") + (defun nrepl--port-from-file (file) "Attempts to read port from a file named by FILE." (when (file-exists-p file) @@ -558,7 +570,18 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." (defun nrepl--ssh-tunnel-connect (host port) "Connect to a remote machine identified by HOST and PORT through SSH tunnel." (message "[nREPL] Establishing SSH tunneled connection to %s:%s ..." host port) - (let* ((remote-dir (if host (format "/ssh:%s:" host) default-directory)) + (let* ((current-buf (buffer-file-name)) + (tramp-file-regexp "/ssh:\\(.+@\\)?\\(.+?\\)\\(:\\|#\\).+") + (remote-dir (cond + ;; If current buffer is a TRAMP buffer and its host is + ;; the same as HOST, reuse its connection parameters for + ;; SSH tunnel. + ((and (string-match tramp-file-regexp current-buf) + (string= host (match-string 2 current-buf))) current-buf) + ;; Otherwise, if HOST was provided, use it for connection. + (host (format "/ssh:%s:" host)) + ;; Use default directory as fallback. + (t default-directory))) (ssh (or (executable-find "ssh") (error "[nREPL] Cannot locate 'ssh' executable"))) (cmd (nrepl--ssh-tunnel-command ssh remote-dir port)) @@ -574,7 +597,8 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." (error "[nREPL] SSH port forwarding failed. Check the '%s' buffer" tunnel-buf) (message "[nREPL] SSH port forwarding established to localhost:%s" port) (let ((endpoint (nrepl--direct-connect "localhost" port))) - (thread-first endpoint + (thread-first + endpoint (plist-put :tunnel tunnel) (plist-put :remote-host host)))))) @@ -585,11 +609,12 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." ;; forwarding is set up, which is used to synchronise on, so that ;; the port forwarding is up when we try to connect. (format-spec - "%s -v -N -L %p:localhost:%p %u'%h'" + "%s -v -N -L %p:localhost:%p %u'%h' %n" `((?s . ,ssh) (?p . ,port) (?h . ,v-host) - (?u . ,(if v-user (format "-l '%s' " v-user) "")))))) + (?u . ,(if v-user (format "-l '%s' " v-user) "")) + (?n . ,(if v-port (format "-p '%s' " v-port) "")))))) (autoload 'comint-watch-for-password-prompt "comint" "(autoload).") @@ -614,12 +639,33 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." ;;; Client: Process Handling (defun nrepl--kill-process (proc) - "Kill PROC using the appropriate, os specific way. -Implement a workaround to clean up an orphaned JVM process left around -after exiting the REPL on some windows machines." - (if (memq system-type '(cygwin windows-nt)) - (interrupt-process proc) - (kill-process proc))) + "Attempt to kill PROC tree. +On MS-Windows, using the standard API is highly likely to leave the child +processes still running in the background as orphans. As a workaround, an +attempt is made to delegate the task to the `taskkill` program, which comes +with windows since at least Windows XP, and fallback to the Emacs API if it +can't be found. + +It is expected that the `(process-status PROC)` return value after PROC is +killed is `exit` when `taskkill` is used and `signal` otherwise." + (cond + ((and (eq system-type 'windows-nt) + (process-live-p proc) + (executable-find "taskkill")) + ;; try to use `taskkill` if available + (with-temp-buffer + (call-process-shell-command (format "taskkill /PID %s /T /F" (process-id proc)) + nil (buffer-name) ) + ;; useful for debugging. + ;;(message ":PROCESS-KILL-OUPUT %s" (buffer-string)) + )) + + ((memq system-type '(cygwin windows-nt)) + ;; fallback, this is considered to work better than `kill-process` on + ;; MS-Windows. + (interrupt-process proc)) + + (t (kill-process proc)))) (defun nrepl-kill-server-buffer (server-buf) "Kill SERVER-BUF and its process." @@ -902,9 +948,10 @@ If TOOLING, use the tooling session rather than the standard session." (setq time0 (current-time))) ;; break out in case we don't receive a response for a while (when (and nrepl-sync-request-timeout - (> (cadr (time-subtract (current-time) time0)) - nrepl-sync-request-timeout)) - (error "Sync nREPL request timed out %s" request))) + (time-less-p + nrepl-sync-request-timeout + (time-subtract nil time0))) + (error "Sync nREPL request timed out %s after %s secs" request nrepl-sync-request-timeout))) ;; Clean up the response, otherwise we might repeatedly ask for input. (nrepl-dict-put response "status" (remove "need-input" status)) (accept-process-output nil 0.01)) @@ -1062,7 +1109,12 @@ been determined." (propertize cmd 'face 'font-lock-keyword-face)) serv-proc))) -(defconst nrepl-listening-address-regexp +(defconst nrepl-listening-unix-address-regexp + (rx + (and "nREPL server listening on" (+ " ") + "nrepl+unix:" (group-n 1 (+ not-newline))))) + +(defconst nrepl-listening-inet-address-regexp (rx (or ;; standard (and "nREPL server started on port " (group-n 1 (+ (any "0-9")))) @@ -1076,8 +1128,22 @@ match groups: 1 for the port, and 2 for the host (babashka only).") +(defun cider--process-plist-put (proc prop val) + "Change value in PROC's plist of PROP to VAL. +Value is changed using `plist-put`, of which see." + (thread-first + proc + (process-plist) + (plist-put prop val) + (thread-last (set-process-plist proc)))) + (defun nrepl-server-filter (process output) - "Process nREPL server output from PROCESS contained in OUTPUT." + "Process nREPL server output from PROCESS contained in OUTPUT. + +The PROCESS plist is updated as (non-exhaustive list): + +:cider--nrepl-server-ready set to t when the server is successfully brought +up." ;; In Windows this can be false: (let ((server-buffer (process-buffer process))) (when (buffer-live-p server-buffer) @@ -1094,17 +1160,26 @@ match groups: (when-let* ((win (get-buffer-window))) (set-window-point win (point))))) ;; detect the port the server is listening on from its output - (when (and (null nrepl-endpoint) - (string-match nrepl-listening-address-regexp output)) - (let ((host (or (match-string 2 output) - (file-remote-p default-directory 'host) - "localhost")) - (port (string-to-number (match-string 1 output)))) - (setq nrepl-endpoint (list :host host - :port port)) - (message "[nREPL] server started on %s" port) - (when nrepl-on-port-callback - (funcall nrepl-on-port-callback (process-buffer process))))))))) + (when (null nrepl-endpoint) + (let ((end (cond + ((string-match nrepl-listening-unix-address-regexp output) + (let ((path (match-string 1 output))) + (message "[nREPL] server started on nrepl+unix:%s" path) + (list :host "local-unix-domain-socket" + :port path + :socket-file path))) + ((string-match nrepl-listening-inet-address-regexp output) + (let ((host (or (match-string 2 output) + (file-remote-p default-directory 'host) + "localhost")) + (port (string-to-number (match-string 1 output)))) + (message "[nREPL] server started on %s" port) + (list :host host :port port)))))) + (when end + (setq nrepl-endpoint end) + (cider--process-plist-put process :cider--nrepl-server-ready t) + (when nrepl-on-port-callback + (funcall nrepl-on-port-callback (process-buffer process)))))))))) (defmacro emacs-bug-46284/when-27.1-windows-nt (&rest body) "Only evaluate BODY when Emacs bug #46284 has been detected." @@ -1115,16 +1190,12 @@ match groups: (declare-function cider--close-connection "cider-connection") (defun nrepl-server-sentinel (process event) - "Handle nREPL server PROCESS EVENT." - (let* ((server-buffer (process-buffer process)) - (clients (seq-filter (lambda (b) - (eq (buffer-local-value 'nrepl-server-buffer b) - server-buffer)) - (buffer-list))) - (problem (if (and server-buffer (buffer-live-p server-buffer)) - (with-current-buffer server-buffer - (buffer-substring (point-min) (point-max))) - ""))) + "Handle nREPL server PROCESS EVENT. +If the nREPL PROCESS failed to initiate and encountered a fatal EVENT +signal, raise an 'error'. Additionally, if the EVENT signal is SIGHUP, +close any existing client connections." + ;; only interested on fatal signals. + (when (not (process-live-p process)) (emacs-bug-46284/when-27.1-windows-nt ;; There is a bug in emacs 27.1 (since fixed) that sets all EVENT ;; descriptions for signals to "unknown signal". We correct this by @@ -1137,17 +1208,24 @@ match groups: (2 (setq event "Interrupt")) ;; SIGKILL==9 emacs nt/inc/ms-w32.h (9 (setq event "Killed"))))) - - (when server-buffer - (kill-buffer server-buffer)) - (cond - ((string-match-p "^killed\\|^interrupt" event) - nil) - ((string-match-p "^hangup" event) - (mapc #'cider--close-connection clients)) - ;; On Windows, a failed start sends the "finished" event. On Linux it sends - ;; "exited abnormally with code 1". - (t (error "Could not start nREPL server: %s" problem))))) + (let* ((server-buffer (process-buffer process)) + (clients (seq-filter (lambda (b) + (eq (buffer-local-value 'nrepl-server-buffer b) + server-buffer)) + (buffer-list)))) + + ;; see https://github.com/clojure-emacs/cider/pull/3333 + (when (string-match-p "^hangup" event) + (mapc #'cider--close-connection clients)) + + (if (process-get process :cider--nrepl-server-ready) + (progn + (when server-buffer (kill-buffer server-buffer)) + (message "nREPL server exited.")) + (let ((problem (when (and server-buffer (buffer-live-p server-buffer)) + (with-current-buffer server-buffer + (buffer-substring (point-min) (point-max)))))) + (error "Could not start nREPL server: %s (%S)" problem (string-trim event))))))) ;;; Messages @@ -1298,7 +1376,8 @@ EVENT gives the button position on window." "Return the color to use when pretty-printing the nREPL message with ID. If ID is nil, return nil." (when id - (thread-first (string-to-number id) + (thread-first + (string-to-number id) (mod (length nrepl-message-colors)) (nth nrepl-message-colors)))) diff --git a/elpa/cider-20220417.951/nrepl-dict.el b/elpa/cider-20230707.640/nrepl-dict.el similarity index 93% rename from elpa/cider-20220417.951/nrepl-dict.el rename to elpa/cider-20230707.640/nrepl-dict.el index 2d82c2ea..b6b2e980 100644 --- a/elpa/cider-20220417.951/nrepl-dict.el +++ b/elpa/cider-20230707.640/nrepl-dict.el @@ -1,7 +1,7 @@ ;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2022 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -128,6 +128,18 @@ also always return a sequence (since the result will be flattened)." (when dict (apply #'append (nrepl-dict-map function dict)))) +(defun nrepl-dict-filter (function dict) + "For all key-values of DICT, return new dict where FUNCTION returns non-nil. + +FUNCTION should be a function taking two arguments, key and value." + (let ((new-map (nrepl-dict)) + (keys (nrepl-dict-keys dict))) + (dolist (key keys) + (let ((val (nrepl-dict-get dict key))) + (when (funcall function key val) + (nrepl-dict-put new-map key val)))) + new-map)) + ;;; More specific functions (defun nrepl--cons (car list-or-dict) -- 2.47.3