diff options
-rw-r--r-- | cider-apropos.el | 6 | ||||
-rw-r--r-- | cider-browse-ns.el | 2 | ||||
-rw-r--r-- | cider-common.el | 2 | ||||
-rw-r--r-- | cider-debug.el | 3 | ||||
-rw-r--r-- | cider-doc.el | 2 | ||||
-rw-r--r-- | cider-grimoire.el | 2 | ||||
-rw-r--r-- | cider-popup.el | 1 | ||||
-rw-r--r-- | cider-resolve.el | 2 | ||||
-rw-r--r-- | nrepl-client.el | 147 | ||||
-rw-r--r-- | nrepl-dict.el | 187 | ||||
-rw-r--r-- | test/nrepl-dict-tests.el | 2 |
11 files changed, 198 insertions, 158 deletions
diff --git a/cider-apropos.el b/cider-apropos.el index 9a87f452..01a6abc6 100644 --- a/cider-apropos.el +++ b/cider-apropos.el @@ -31,7 +31,7 @@ (require 'cider-client) (require 'cider-popup) -(require 'nrepl-client) +(require 'nrepl-dict) (require 'clojure-mode) (require 'apropos) @@ -78,8 +78,8 @@ and be case-sensitive (based on CASE-SENSITIVE-P)." (let* ((label (capitalize (if (string= type "variable") "var" type))) (help (concat "Display doc for this " (downcase label)))) (cider-propertize-region (list 'apropos-symbol name - 'action 'cider-apropos-doc - 'help-echo help) + 'action 'cider-apropos-doc + 'help-echo help) (insert-text-button name 'type 'apropos-symbol) (insert "\n ") (insert-text-button label 'type (intern (concat "apropos-" type))) diff --git a/cider-browse-ns.el b/cider-browse-ns.el index 592a1cce..14c81c64 100644 --- a/cider-browse-ns.el +++ b/cider-browse-ns.el @@ -39,7 +39,7 @@ (require 'cider-client) (require 'cider-compat) (require 'cider-util) -(require 'nrepl-client) +(require 'nrepl-dict) (defconst cider-browse-ns-buffer "*cider-ns-browser*") diff --git a/cider-common.el b/cider-common.el index e074316f..4d99e7b6 100644 --- a/cider-common.el +++ b/cider-common.el @@ -25,7 +25,7 @@ ;;; Code: (require 'cider-compat) -(require 'nrepl-client) +(require 'nrepl-dict) (require 'cider-util) (defcustom cider-prompt-for-symbol t diff --git a/cider-debug.el b/cider-debug.el index 0cc808af..a3da0e09 100644 --- a/cider-debug.el +++ b/cider-debug.el @@ -25,7 +25,8 @@ ;;; Code: -(require 'nrepl-client) +(require 'nrepl-dict) +(require 'nrepl-client) ; `nrepl--mark-id-completed' (require 'cider-interaction) (require 'cider-client) (require 'cider-util) diff --git a/cider-doc.el b/cider-doc.el index 8527fe02..9228c3f7 100644 --- a/cider-doc.el +++ b/cider-doc.el @@ -31,7 +31,7 @@ (require 'cider-popup) (require 'cider-client) (require 'cider-grimoire) -(require 'nrepl-client) +(require 'nrepl-dict) (require 'org-table) (require 'button) (require 'easymenu) diff --git a/cider-grimoire.el b/cider-grimoire.el index 3e9f1160..0616b207 100644 --- a/cider-grimoire.el +++ b/cider-grimoire.el @@ -30,7 +30,7 @@ (require 'cider-compat) (require 'cider-popup) -(require 'nrepl-client) +(require 'nrepl-dict) (require 'url-vars) diff --git a/cider-popup.el b/cider-popup.el index 46e18104..7c235f8b 100644 --- a/cider-popup.el +++ b/cider-popup.el @@ -23,7 +23,6 @@ ;;; Code: -(require 'nrepl-client) (require 'cider-compat) (define-minor-mode cider-popup-buffer-mode diff --git a/cider-resolve.el b/cider-resolve.el index 5da11383..b8094a90 100644 --- a/cider-resolve.el +++ b/cider-resolve.el @@ -65,7 +65,7 @@ ;;; Code: (require 'cider-client) -(require 'nrepl-client) +(require 'nrepl-dict) (require 'cider-util) (defvar cider-repl-ns-cache) diff --git a/nrepl-client.el b/nrepl-client.el index c93f5d04..2792212c 100644 --- a/nrepl-client.el +++ b/nrepl-client.el @@ -249,15 +249,6 @@ PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." ;;; Utilities -(defmacro nrepl-dbind-response (response keys &rest body) - "Destructure an nREPL RESPONSE dict. -Bind the value of the provided KEYS and execute BODY." - (declare (debug (form (&rest symbolp) body))) - `(let ,(cl-loop for key in keys - collect `(,key (nrepl-dict-get ,response ,(format "%s" key)))) - ,@body)) -(put 'nrepl-dbind-response 'lisp-indent-function 2) - (defun nrepl-op-supported-p (op connection) "Return t iff the given operation OP is supported by the nREPL CONNECTION." (with-current-buffer connection @@ -286,144 +277,6 @@ Bind the value of the provided KEYS and execute BODY." (buffer-string)))) -;;; nREPL dict - -(defun nrepl-dict (&rest key-vals) - "Create nREPL dict from KEY-VALS." - (cons 'dict key-vals)) - -(defun nrepl-dict-p (object) - "Return t if OBJECT is an nREPL dict." - (and (listp object) - (eq (car object) 'dict))) - -(defun nrepl-dict-empty-p (dict) - "Return t if nREPL dict DICT is empty." - (null (cdr dict))) - -(defun nrepl-dict-contains (dict key) - "Return nil if nREPL dict DICT doesn't contain KEY. -If DICT does contain KEY, then a non-nil value is returned. Due to the -current implementation, this return value is the tail of DICT's key-list -whose car is KEY. Comparison is done with `equal'." - (member key (nrepl-dict-keys dict))) - -(defun nrepl-dict-get (dict key &optional default) - "Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT. -If dict is nil, return nil. If DEFAULT not provided, and KEY not in DICT, -return nil. If DICT is not an nREPL dict object, an error is thrown." - (when dict - (if (nrepl-dict-p dict) - (if (nrepl-dict-contains dict key) - (lax-plist-get (cdr dict) key) - default) - (error "Not an nREPL dict object: %s" dict)))) - -(defun nrepl-dict-put (dict key value) - "Associate in DICT, KEY to VALUE. -Return new dict. Dict is modified by side effects." - (if (null dict) - (list 'dict key value) - (if (not (nrepl-dict-p dict)) - (error "Not an nREPL dict object: %s" dict) - (setcdr dict (lax-plist-put (cdr dict) key value)) - dict))) - -(defun nrepl-dict-keys (dict) - "Return all the keys in the nREPL DICT." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (car l)) - (error "Not an nREPL dict"))) - -(defun nrepl-dict-vals (dict) - "Return all the values in the nREPL DICT." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (cadr l)) - (error "Not an nREPL dict"))) - -(defun nrepl-dict-map (fn dict) - "Map FN on nREPL DICT. -FN must accept two arguments key and value." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (funcall fn (car l) (cadr l))) - (error "Not an nREPL dict"))) - -(defun nrepl-dict-merge (dict1 dict2) - "Destructively merge DICT2 into DICT1. -Keys in DICT2 override those in DICT1." - (let ((base (or dict1 '(dict)))) - (nrepl-dict-map (lambda (k v) - (nrepl-dict-put base k v)) - (or dict2 '(dict))) - base)) - -(defun nrepl-dict-get-in (dict keys) - "Return the value in a nested DICT. -KEYS is a list of keys. Return nil if any of the keys is not present or if -any of the values is nil." - (let ((out dict)) - (while (and keys out) - (setq out (nrepl-dict-get out (pop keys)))) - out)) - -(defun nrepl-dict-flat-map (function dict) - "Map FUNCTION over DICT and flatten the result. -FUNCTION follows the same restrictions as in `nrepl-dict-map', and it must -also alway return a sequence (since the result will be flattened)." - (when dict - (apply #'append (nrepl-dict-map function dict)))) - -(defun nrepl--cons (car list-or-dict) - "Generic cons of CAR to LIST-OR-DICT." - (if (eq (car list-or-dict) 'dict) - (cons 'dict (cons car (cdr list-or-dict))) - (cons car list-or-dict))) - -(defun nrepl--nreverse (list-or-dict) - "Generic `nreverse' which works on LIST-OR-DICT." - (if (eq (car list-or-dict) 'dict) - (cons 'dict (nreverse (cdr list-or-dict))) - (nreverse list-or-dict))) - -(defun nrepl--push (obj stack) - "Cons OBJ to the top element of the STACK." - ;; stack is assumed to be a list - (if (eq (caar stack) 'dict) - (cons (cons 'dict (cons obj (cdar stack))) - (cdr stack)) - (cons (if (null stack) - obj - (cons obj (car stack))) - (cdr stack)))) - -(defun nrepl--merge (dict1 dict2 &optional no-join) - "Join nREPL dicts DICT1 and DICT2 in a meaningful way. -String values for non \"id\" and \"session\" keys are concatenated. Lists -are appended. nREPL dicts merged recursively. All other objects are -accumulated into a list. DICT1 is modified destructively and -then returned. -If NO-JOIN is given, return the first non nil dict." - (if no-join - (or dict1 dict2) - (cond ((null dict1) dict2) - ((null dict2) dict1) - ((stringp dict1) (concat dict1 dict2)) - ((nrepl-dict-p dict1) - (nrepl-dict-map - (lambda (k2 v2) - (nrepl-dict-put dict1 k2 - (nrepl--merge (nrepl-dict-get dict1 k2) v2 - (member k2 '("id" "session"))))) - dict2) - dict1) - ((and (listp dict2) (listp dict1)) (append dict1 dict2)) - ((listp dict1) (append dict1 (list dict2))) - (t (list dict1 dict2))))) - - ;;; Bencode (cl-defstruct (nrepl-response-queue diff --git a/nrepl-dict.el b/nrepl-dict.el new file mode 100644 index 00000000..b6c77bbf --- /dev/null +++ b/nrepl-dict.el @@ -0,0 +1,187 @@ +;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*- + +;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov +;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King <kingtim@gmail.com> +;; Phil Hagelberg <technomancy@gmail.com> +;; Bozhidar Batsov <bozhidar@batsov.com> +;; Artur Malabarba <bruce.connor.am@gmail.com> +;; Hugo Duncan <hugo@hugoduncan.org> +;; Steve Purcell <steve@sanityinc.com> +;; +;; 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 <http://www.gnu.org/licenses/>. +;; +;; This file is not part of GNU Emacs. +;; +;;; Commentary: +;; +;; Provides functions to interact with and create `nrepl-dict's. These are +;; simply plists with an extra element at the head. + +;;; Code: +(require 'cl-lib) + + +(defun nrepl-dict (&rest key-vals) + "Create nREPL dict from KEY-VALS." + (cons 'dict key-vals)) + +(defun nrepl-dict-p (object) + "Return t if OBJECT is an nREPL dict." + (and (listp object) + (eq (car object) 'dict))) + +(defun nrepl-dict-empty-p (dict) + "Return t if nREPL dict DICT is empty." + (null (cdr dict))) + +(defun nrepl-dict-contains (dict key) + "Return nil if nREPL dict DICT doesn't contain KEY. +If DICT does contain KEY, then a non-nil value is returned. Due to the +current implementation, this return value is the tail of DICT's key-list +whose car is KEY. Comparison is done with `equal'." + (member key (nrepl-dict-keys dict))) + +(defun nrepl-dict-get (dict key &optional default) + "Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT. +If dict is nil, return nil. If DEFAULT not provided, and KEY not in DICT, +return nil. If DICT is not an nREPL dict object, an error is thrown." + (when dict + (if (nrepl-dict-p dict) + (if (nrepl-dict-contains dict key) + (lax-plist-get (cdr dict) key) + default) + (error "Not an nREPL dict object: %s" dict)))) + +(defun nrepl-dict-put (dict key value) + "Associate in DICT, KEY to VALUE. +Return new dict. Dict is modified by side effects." + (if (null dict) + (list 'dict key value) + (if (not (nrepl-dict-p dict)) + (error "Not an nREPL dict object: %s" dict) + (setcdr dict (lax-plist-put (cdr dict) key value)) + dict))) + +(defun nrepl-dict-keys (dict) + "Return all the keys in the nREPL DICT." + (if (nrepl-dict-p dict) + (cl-loop for l on (cdr dict) by #'cddr + collect (car l)) + (error "Not an nREPL dict"))) + +(defun nrepl-dict-vals (dict) + "Return all the values in the nREPL DICT." + (if (nrepl-dict-p dict) + (cl-loop for l on (cdr dict) by #'cddr + collect (cadr l)) + (error "Not an nREPL dict"))) + +(defun nrepl-dict-map (fn dict) + "Map FN on nREPL DICT. +FN must accept two arguments key and value." + (if (nrepl-dict-p dict) + (cl-loop for l on (cdr dict) by #'cddr + collect (funcall fn (car l) (cadr l))) + (error "Not an nREPL dict"))) + +(defun nrepl-dict-merge (dict1 dict2) + "Destructively merge DICT2 into DICT1. +Keys in DICT2 override those in DICT1." + (let ((base (or dict1 '(dict)))) + (nrepl-dict-map (lambda (k v) + (nrepl-dict-put base k v)) + (or dict2 '(dict))) + base)) + +(defun nrepl-dict-get-in (dict keys) + "Return the value in a nested DICT. +KEYS is a list of keys. Return nil if any of the keys is not present or if +any of the values is nil." + (let ((out dict)) + (while (and keys out) + (setq out (nrepl-dict-get out (pop keys)))) + out)) + +(defun nrepl-dict-flat-map (function dict) + "Map FUNCTION over DICT and flatten the result. +FUNCTION follows the same restrictions as in `nrepl-dict-map', and it must +also alway return a sequence (since the result will be flattened)." + (when dict + (apply #'append (nrepl-dict-map function dict)))) + + +;;; More specific functions +(defun nrepl--cons (car list-or-dict) + "Generic cons of CAR to LIST-OR-DICT." + (if (eq (car list-or-dict) 'dict) + (cons 'dict (cons car (cdr list-or-dict))) + (cons car list-or-dict))) + +(defun nrepl--nreverse (list-or-dict) + "Generic `nreverse' which works on LIST-OR-DICT." + (if (eq (car list-or-dict) 'dict) + (cons 'dict (nreverse (cdr list-or-dict))) + (nreverse list-or-dict))) + +(defun nrepl--push (obj stack) + "Cons OBJ to the top element of the STACK." + ;; stack is assumed to be a list + (if (eq (caar stack) 'dict) + (cons (cons 'dict (cons obj (cdar stack))) + (cdr stack)) + (cons (if (null stack) + obj + (cons obj (car stack))) + (cdr stack)))) + +(defun nrepl--merge (dict1 dict2 &optional no-join) + "Join nREPL dicts DICT1 and DICT2 in a meaningful way. +String values for non \"id\" and \"session\" keys are concatenated. Lists +are appended. nREPL dicts merged recursively. All other objects are +accumulated into a list. DICT1 is modified destructively and +then returned. +If NO-JOIN is given, return the first non nil dict." + (if no-join + (or dict1 dict2) + (cond ((null dict1) dict2) + ((null dict2) dict1) + ((stringp dict1) (concat dict1 dict2)) + ((nrepl-dict-p dict1) + (nrepl-dict-map + (lambda (k2 v2) + (nrepl-dict-put dict1 k2 + (nrepl--merge (nrepl-dict-get dict1 k2) v2 + (member k2 '("id" "session"))))) + dict2) + dict1) + ((and (listp dict2) (listp dict1)) (append dict1 dict2)) + ((listp dict1) (append dict1 (list dict2))) + (t (list dict1 dict2))))) + + +;;; Dbind +(defmacro nrepl-dbind-response (response keys &rest body) + "Destructure an nREPL RESPONSE dict. +Bind the value of the provided KEYS and execute BODY." + (declare (debug (form (&rest symbolp) body))) + `(let ,(cl-loop for key in keys + collect `(,key (nrepl-dict-get ,response ,(format "%s" key)))) + ,@body)) +(put 'nrepl-dbind-response 'lisp-indent-function 2) + +(provide 'nrepl-dict) + +;;; nrepl-dict.el ends here diff --git a/test/nrepl-dict-tests.el b/test/nrepl-dict-tests.el index 5b0a5c3a..787dbe9a 100644 --- a/test/nrepl-dict-tests.el +++ b/test/nrepl-dict-tests.el @@ -28,7 +28,7 @@ ;;; Code: (require 'buttercup) -(require 'nrepl-client) +(require 'nrepl-dict) (describe "nrepl-dict-merge" :var (input) |