From 6a323d590d65472a0539c2eb658020e32dc3927f Mon Sep 17 00:00:00 2001 From: Daniel Higginbotham Date: Mon, 30 Dec 2013 19:06:45 -0500 Subject: [PATCH] remove old/irrelevant packages --- elpa/dash-2.3.0/dash-autoloads.el | 18 - elpa/dash-2.3.0/dash-pkg.el | 1 - elpa/dash-2.3.0/dash-pkg.elc | Bin 586 -> 0 bytes elpa/dash-2.3.0/dash.el | 1268 ------ elpa/dash-2.3.0/dash.elc | Bin 43337 -> 0 bytes .../ido-ubiquitous-autoloads.el | 70 - .../ido-ubiquitous-autoloads.el~ | 13 - elpa/ido-ubiquitous-0.7/ido-ubiquitous-pkg.el | 1 - elpa/ido-ubiquitous-0.7/ido-ubiquitous.el | 199 - elpa/nrepl-0.2.0/nrepl-autoloads.el | 59 - elpa/nrepl-0.2.0/nrepl-pkg.el | 1 - elpa/nrepl-0.2.0/nrepl-pkg.elc | Bin 651 -> 0 bytes elpa/nrepl-0.2.0/nrepl.el | 3456 ----------------- 13 files changed, 5086 deletions(-) delete mode 100644 elpa/dash-2.3.0/dash-autoloads.el delete mode 100644 elpa/dash-2.3.0/dash-pkg.el delete mode 100644 elpa/dash-2.3.0/dash-pkg.elc delete mode 100644 elpa/dash-2.3.0/dash.el delete mode 100644 elpa/dash-2.3.0/dash.elc delete mode 100644 elpa/ido-ubiquitous-0.7/ido-ubiquitous-autoloads.el delete mode 100644 elpa/ido-ubiquitous-0.7/ido-ubiquitous-autoloads.el~ delete mode 100644 elpa/ido-ubiquitous-0.7/ido-ubiquitous-pkg.el delete mode 100644 elpa/ido-ubiquitous-0.7/ido-ubiquitous.el delete mode 100644 elpa/nrepl-0.2.0/nrepl-autoloads.el delete mode 100644 elpa/nrepl-0.2.0/nrepl-pkg.el delete mode 100644 elpa/nrepl-0.2.0/nrepl-pkg.elc delete mode 100644 elpa/nrepl-0.2.0/nrepl.el diff --git a/elpa/dash-2.3.0/dash-autoloads.el b/elpa/dash-2.3.0/dash-autoloads.el deleted file mode 100644 index c3d534382..000000000 --- a/elpa/dash-2.3.0/dash-autoloads.el +++ /dev/null @@ -1,18 +0,0 @@ -;;; dash-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - - -;;;### (autoloads nil nil ("dash-pkg.el" "dash.el") (21124 57417 -;;;;;; 597369)) - -;;;*** - -(provide 'dash-autoloads) -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; dash-autoloads.el ends here diff --git a/elpa/dash-2.3.0/dash-pkg.el b/elpa/dash-2.3.0/dash-pkg.el deleted file mode 100644 index 19e521726..000000000 --- a/elpa/dash-2.3.0/dash-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "dash" "2.3.0" "A modern list library for Emacs" (quote nil)) diff --git a/elpa/dash-2.3.0/dash-pkg.elc b/elpa/dash-2.3.0/dash-pkg.elc deleted file mode 100644 index 04b1d379aebb06b97715374882a9a0cefda9bb68..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 586 zcmbtRJ8!};5N6IF=z7Z3O2m1<0Awjb3`kX%(jRcx4msi2k!?Wq*Y`-ON>xX0v32)7 z?on^wHcykuB&q8fHm>W*Xa$EGD72)_>lK^E=m5^bzCFXcyFfXIV!4_vRz(R_QO*Wx z<6Q?0lOg{M+J}7P=R$WVgHX9PJ#sR%StVwo7{C4LD6|;_$insxg$uKZ?W(ybMLE>2 z6k9-J!1a+j`ohS7Ad;cDZz+t<=fI7so5hYKC?`YoWRGFWRUaatQaswPPq`G;@}Gus ztYKXQ>1;#>pJS6PIAgQ*$7Z(!*`h}oxyk8Zk5)l&Ako4>gK_xB -;; Version: 2.3.0 -;; Keywords: lists - -;; 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 . - -;;; Commentary: - -;; A modern list api for Emacs. -;; -;; See documentation on https://github.com/magnars/dash.el#functions - -;;; Code: - -(defmacro !cons (car cdr) - "Destructive: Sets CDR to the cons of CAR and CDR." - `(setq ,cdr (cons ,car ,cdr))) - -(defmacro !cdr (list) - "Destructive: Sets LIST to the cdr of LIST." - `(setq ,list (cdr ,list))) - -(defmacro --each (list &rest body) - "Anaphoric form of `-each'." - (declare (debug t)) - (let ((l (make-symbol "list"))) - `(let ((,l ,list) - (it-index 0)) - (while ,l - (let ((it (car ,l))) - ,@body) - (setq it-index (1+ it-index)) - (!cdr ,l))))) - -(put '--each 'lisp-indent-function 1) - -(defun -each (list fn) - "Calls FN with every item in LIST. Returns nil, used for side-effects only." - (--each list (funcall fn it))) - -(defmacro --each-while (list pred &rest body) - "Anaphoric form of `-each-while'." - (let ((l (make-symbol "list")) - (c (make-symbol "continue"))) - `(let ((,l ,list) - (,c t)) - (while (and ,l ,c) - (let ((it (car ,l))) - (if (not ,pred) (setq ,c nil) ,@body)) - (!cdr ,l))))) - -(put '--each-while 'lisp-indent-function 2) - -(defun -each-while (list pred fn) - "Calls FN with every item in LIST while (PRED item) is non-nil. -Returns nil, used for side-effects only." - (--each-while list (funcall pred it) (funcall fn it))) - -(defmacro --dotimes (num &rest body) - "Repeatedly executes BODY (presumably for side-effects) with `it` bound to integers from 0 through n-1." - `(let ((it 0)) - (while (< it ,num) - ,@body - (setq it (1+ it))))) - -(put '--dotimes 'lisp-indent-function 1) - -(defun -dotimes (num fn) - "Repeatedly calls FN (presumably for side-effects) passing in integers from 0 through n-1." - (--dotimes num (funcall fn it))) - -(defun -map (fn list) - "Returns a new list consisting of the result of applying FN to the items in LIST." - (mapcar fn list)) - -(defmacro --map (form list) - "Anaphoric form of `-map'." - (declare (debug t)) - `(mapcar (lambda (it) ,form) ,list)) - -(defmacro --reduce-from (form initial-value list) - "Anaphoric form of `-reduce-from'." - `(let ((acc ,initial-value)) - (--each ,list (setq acc ,form)) - acc)) - -(defun -reduce-from (fn initial-value list) - "Returns the result of applying FN to INITIAL-VALUE and the -first item in LIST, then applying FN to that result and the 2nd -item, etc. If LIST contains no items, returns INITIAL-VALUE and -FN is not called. - -In the anaphoric form `--reduce-from', the accumulated value is -exposed as `acc`." - (--reduce-from (funcall fn acc it) initial-value list)) - -(defmacro --reduce (form list) - "Anaphoric form of `-reduce'." - (let ((lv (make-symbol "list-value"))) - `(let ((,lv ,list)) - (if ,lv - (--reduce-from ,form (car ,lv) (cdr ,lv)) - (let (acc it) ,form))))) - -(defun -reduce (fn list) - "Returns the result of applying FN to the first 2 items in LIST, -then applying FN to that result and the 3rd item, etc. If LIST -contains no items, FN must accept no arguments as well, and -reduce returns the result of calling FN with no arguments. If -LIST has only 1 item, it is returned and FN is not called. - -In the anaphoric form `--reduce', the accumulated value is -exposed as `acc`." - (if list - (-reduce-from fn (car list) (cdr list)) - (funcall fn))) - -(defun -reduce-r-from (fn initial-value list) - "Replace conses with FN, nil with INITIAL-VALUE and evaluate -the resulting expression. If LIST is empty, INITIAL-VALUE is -returned and FN is not called. - -Note: this function works the same as `-reduce-from' but the -operation associates from right instead of from left." - (if (not list) initial-value - (funcall fn (car list) (-reduce-r-from fn initial-value (cdr list))))) - -(defmacro --reduce-r-from (form initial-value list) - "Anaphoric version of `-reduce-r-from'." - `(-reduce-r-from (lambda (&optional it acc) ,form) ,initial-value ,list)) - -(defun -reduce-r (fn list) - "Replace conses with FN and evaluate the resulting expression. -The final nil is ignored. If LIST contains no items, FN must -accept no arguments as well, and reduce returns the result of -calling FN with no arguments. If LIST has only 1 item, it is -returned and FN is not called. - -The first argument of FN is the new item, the second is the -accumulated value. - -Note: this function works the same as `-reduce' but the operation -associates from right instead of from left." - (cond - ((not list) (funcall fn)) - ((not (cdr list)) (car list)) - (t (funcall fn (car list) (-reduce-r fn (cdr list)))))) - -(defmacro --reduce-r (form list) - "Anaphoric version of `-reduce-r'." - `(-reduce-r (lambda (&optional it acc) ,form) ,list)) - -(defmacro --filter (form list) - "Anaphoric form of `-filter'." - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list (when ,form (!cons it ,r))) - (nreverse ,r)))) - -(defun -filter (pred list) - "Returns a new list of the items in LIST for which PRED returns a non-nil value. - -Alias: `-select'" - (--filter (funcall pred it) list)) - -(defalias '-select '-filter) -(defalias '--select '--filter) - -(defmacro --remove (form list) - "Anaphoric form of `-remove'." - (declare (debug t)) - `(--filter (not ,form) ,list)) - -(defun -remove (pred list) - "Returns a new list of the items in LIST for which PRED returns nil. - -Alias: `-reject'" - (--remove (funcall pred it) list)) - -(defalias '-reject '-remove) -(defalias '--reject '--remove) - -(defmacro --keep (form list) - "Anaphoric form of `-keep'." - (let ((r (make-symbol "result")) - (m (make-symbol "mapped"))) - `(let (,r) - (--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r)))) - (nreverse ,r)))) - -(defun -keep (fn list) - "Returns a new list of the non-nil results of applying FN to the items in LIST." - (--keep (funcall fn it) list)) - -(defmacro --map-when (pred rep list) - "Anaphoric form of `-map-when'." - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list (!cons (if ,pred ,rep it) ,r)) - (nreverse ,r)))) - -(defmacro --map-indexed (form list) - "Anaphoric form of `-map-indexed'." - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list - (!cons ,form ,r)) - (nreverse ,r)))) - -(defun -map-indexed (fn list) - "Returns a new list consisting of the result of (FN index item) for each item in LIST. - -In the anaphoric form `--map-indexed', the index is exposed as `it-index`." - (--map-indexed (funcall fn it-index it) list)) - -(defun -map-when (pred rep list) - "Returns a new list where the elements in LIST that does not match the PRED function -are unchanged, and where the elements in LIST that do match the PRED function are mapped -through the REP function." - (--map-when (funcall pred it) (funcall rep it) list)) - -(defalias '--replace-where '--map-when) -(defalias '-replace-where '-map-when) - -(defun -flatten (l) - "Takes a nested list L and returns its contents as a single, flat list." - (if (and (listp l) (listp (cdr l))) - (-mapcat '-flatten l) - (list l))) - -(defun -concat (&rest lists) - "Returns a new list with the concatenation of the elements in the supplied LISTS." - (apply 'append lists)) - -(defmacro --mapcat (form list) - "Anaphoric form of `-mapcat'." - (declare (debug t)) - `(apply 'append (--map ,form ,list))) - -(defun -mapcat (fn list) - "Returns the concatenation of the result of mapping FN over LIST. -Thus function FN should return a list." - (--mapcat (funcall fn it) list)) - -(defun -cons* (&rest args) - "Makes a new list from the elements of ARGS. - -The last 2 members of ARGS are used as the final cons of the -result so if the final member of ARGS is not a list the result is -a dotted list." - (let (res) - (--each - args - (cond - ((not res) - (setq res it)) - ((consp res) - (setcdr res (cons (cdr res) it))) - (t - (setq res (cons res it))))) - res)) - -(defmacro --first (form list) - "Anaphoric form of `-first'." - (let ((n (make-symbol "needle"))) - `(let (,n) - (--each-while ,list (not ,n) - (when ,form (setq ,n it))) - ,n))) - -(defun -first (pred list) - "Returns the first x in LIST where (PRED x) is non-nil, else nil. - -To get the first item in the list no questions asked, use `car'." - (--first (funcall pred it) list)) - -(defmacro --last (form list) - "Anaphoric form of `-last'." - (let ((n (make-symbol "needle"))) - `(let (,n) - (--each ,list - (when ,form (setq ,n it))) - ,n))) - -(defun -last (pred list) - "Return the last x in LIST where (PRED x) is non-nil, else nil." - (--last (funcall pred it) list)) - -(defalias '-first-item 'car - "Returns the first item of LIST, or nil on an empty list.") - -(defun -last-item (list) - "Returns the first item of LIST, or nil on an empty list." - (car (last list))) - -(defmacro --count (pred list) - "Anaphoric form of `-count'." - (let ((r (make-symbol "result"))) - `(let ((,r 0)) - (--each ,list (when ,pred (setq ,r (1+ ,r)))) - ,r))) - -(defun -count (pred list) - "Counts the number of items in LIST where (PRED item) is non-nil." - (--count (funcall pred it) list)) - -(defun ---truthy? (val) - (not (null val))) - -(defmacro --any? (form list) - "Anaphoric form of `-any?'." - `(---truthy? (--first ,form ,list))) - -(defun -any? (pred list) - "Returns t if (PRED x) is non-nil for any x in LIST, else nil. - -Alias: `-some?'" - (--any? (funcall pred it) list)) - -(defalias '-some? '-any?) -(defalias '--some? '--any?) - -(defalias '-any-p '-any?) -(defalias '--any-p '--any?) -(defalias '-some-p '-any?) -(defalias '--some-p '--any?) - -(defmacro --all? (form list) - "Anaphoric form of `-all?'." - (let ((a (make-symbol "all"))) - `(let ((,a t)) - (--each-while ,list ,a (setq ,a ,form)) - (---truthy? ,a)))) - -(defun -all? (pred list) - "Returns t if (PRED x) is non-nil for all x in LIST, else nil. - -Alias: `-every?'" - (--all? (funcall pred it) list)) - -(defalias '-every? '-all?) -(defalias '--every? '--all?) - -(defalias '-all-p '-all?) -(defalias '--all-p '--all?) -(defalias '-every-p '-all?) -(defalias '--every-p '--all?) - -(defmacro --none? (form list) - "Anaphoric form of `-none?'." - `(--all? (not ,form) ,list)) - -(defun -none? (pred list) - "Returns t if (PRED x) is nil for all x in LIST, else nil." - (--none? (funcall pred it) list)) - -(defalias '-none-p '-none?) -(defalias '--none-p '--none?) - -(defmacro --only-some? (form list) - "Anaphoric form of `-only-some?'." - (let ((y (make-symbol "yes")) - (n (make-symbol "no"))) - `(let (,y ,n) - (--each-while ,list (not (and ,y ,n)) - (if ,form (setq ,y t) (setq ,n t))) - (---truthy? (and ,y ,n))))) - -(defun -only-some? (pred list) - "Returns `t` if there is a mix of items in LIST that matches and does not match PRED. -Returns `nil` both if all items match the predicate, and if none of the items match the predicate." - (--only-some? (funcall pred it) list)) - -(defalias '-only-some-p '-only-some?) -(defalias '--only-some-p '--only-some?) - -(defun -slice (list from &optional to) - "Return copy of LIST, starting from index FROM to index TO. -FROM or TO may be negative." - (let ((length (length list)) - (new-list nil) - (index 0)) - ;; to defaults to the end of the list - (setq to (or to length)) - ;; handle negative indices - (when (< from 0) - (setq from (mod from length))) - (when (< to 0) - (setq to (mod to length))) - - ;; iterate through the list, keeping the elements we want - (while (< index to) - (when (>= index from) - (!cons (car list) new-list)) - (!cdr list) - (setq index (1+ index))) - (nreverse new-list))) - -(defun -take (n list) - "Returns a new list of the first N items in LIST, or all items if there are fewer than N." - (let (result) - (--dotimes n - (when list - (!cons (car list) result) - (!cdr list))) - (nreverse result))) - -(defun -drop (n list) - "Returns the tail of LIST without the first N items." - (--dotimes n (!cdr list)) - list) - -(defmacro --take-while (form list) - "Anaphoric form of `-take-while'." - (let ((r (make-symbol "result"))) - `(let (,r) - (--each-while ,list ,form (!cons it ,r)) - (nreverse ,r)))) - -(defun -take-while (pred list) - "Returns a new list of successive items from LIST while (PRED item) returns a non-nil value." - (--take-while (funcall pred it) list)) - -(defmacro --drop-while (form list) - "Anaphoric form of `-drop-while'." - (let ((l (make-symbol "list"))) - `(let ((,l ,list)) - (while (and ,l (let ((it (car ,l))) ,form)) - (!cdr ,l)) - ,l))) - -(defun -drop-while (pred list) - "Returns the tail of LIST starting from the first item for which (PRED item) returns nil." - (--drop-while (funcall pred it) list)) - -(defun -split-at (n list) - "Returns a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list." - (let (result) - (--dotimes n - (when list - (!cons (car list) result) - (!cdr list))) - (list (nreverse result) list))) - -(defun -rotate (n list) - "Rotate LIST N places to the right. With N negative, rotate to the left. -The time complexity is O(n)." - (if (> n 0) - (append (last list n) (butlast list n)) - (append (-drop (- n) list) (-take (- n) list)))) - -(defun -insert-at (n x list) - "Returns a list with X inserted into LIST at position N." - (let ((split-list (-split-at n list))) - (nconc (car split-list) (cons x (cadr split-list))))) - -(defmacro --split-with (pred list) - "Anaphoric form of `-split-with'." - (let ((l (make-symbol "list")) - (r (make-symbol "result")) - (c (make-symbol "continue"))) - `(let ((,l ,list) - (,r nil) - (,c t)) - (while (and ,l ,c) - (let ((it (car ,l))) - (if (not ,pred) - (setq ,c nil) - (!cons it ,r) - (!cdr ,l)))) - (list (nreverse ,r) ,l)))) - -(defun -split-with (pred list) - "Returns a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list." - (--split-with (funcall pred it) list)) - -(defmacro --separate (form list) - "Anaphoric form of `-separate'." - (let ((y (make-symbol "yes")) - (n (make-symbol "no"))) - `(let (,y ,n) - (--each ,list (if ,form (!cons it ,y) (!cons it ,n))) - (list (nreverse ,y) (nreverse ,n))))) - -(defun -separate (pred list) - "Returns a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list." - (--separate (funcall pred it) list)) - -(defun ---partition-all-in-steps-reversed (n step list) - "Private: Used by -partition-all-in-steps and -partition-in-steps." - (when (< step 1) - (error "Step must be a positive number, or you're looking at some juicy infinite loops.")) - (let ((result nil) - (len 0)) - (while list - (!cons (-take n list) result) - (setq list (-drop step list))) - result)) - -(defun -partition-all-in-steps (n step list) - "Returns a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. -The last groups may contain less than N items." - (nreverse (---partition-all-in-steps-reversed n step list))) - -(defun -partition-in-steps (n step list) - "Returns a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. -If there are not enough items to make the last group N-sized, -those items are discarded." - (let ((result (---partition-all-in-steps-reversed n step list))) - (while (and result (< (length (car result)) n)) - (!cdr result)) - (nreverse result))) - -(defun -partition-all (n list) - "Returns a new list with the items in LIST grouped into N-sized sublists. -The last group may contain less than N items." - (-partition-all-in-steps n n list)) - -(defun -partition (n list) - "Returns a new list with the items in LIST grouped into N-sized sublists. -If there are not enough items to make the last group N-sized, -those items are discarded." - (-partition-in-steps n n list)) - -(defmacro --partition-by (form list) - "Anaphoric form of `-partition-by'." - (let ((r (make-symbol "result")) - (s (make-symbol "sublist")) - (v (make-symbol "value")) - (n (make-symbol "new-value")) - (l (make-symbol "list"))) - `(let ((,l ,list)) - (when ,l - (let* ((,r nil) - (it (car ,l)) - (,s (list it)) - (,v ,form) - (,l (cdr ,l))) - (while ,l - (let* ((it (car ,l)) - (,n ,form)) - (unless (equal ,v ,n) - (!cons (nreverse ,s) ,r) - (setq ,s nil) - (setq ,v ,n)) - (!cons it ,s) - (!cdr ,l))) - (!cons (nreverse ,s) ,r) - (nreverse ,r)))))) - -(defun -partition-by (fn list) - "Applies FN to each item in LIST, splitting it each time FN returns a new value." - (--partition-by (funcall fn it) list)) - -(defmacro --partition-by-header (form list) - "Anaphoric form of `-partition-by-header'." - (let ((r (make-symbol "result")) - (s (make-symbol "sublist")) - (h (make-symbol "header-value")) - (b (make-symbol "seen-body?")) - (n (make-symbol "new-value")) - (l (make-symbol "list"))) - `(let ((,l ,list)) - (when ,l - (let* ((,r nil) - (it (car ,l)) - (,s (list it)) - (,h ,form) - (,b nil) - (,l (cdr ,l))) - (while ,l - (let* ((it (car ,l)) - (,n ,form)) - (if (equal ,h ,n) - (when ,b - (!cons (nreverse ,s) ,r) - (setq ,s nil) - (setq ,b nil)) - (setq ,b t)) - (!cons it ,s) - (!cdr ,l))) - (!cons (nreverse ,s) ,r) - (nreverse ,r)))))) - -(defun -partition-by-header (fn list) - "Applies FN to the first item in LIST. That is the header - value. Applies FN to each item in LIST, splitting it each time - FN returns the header value, but only after seeing at least one - other value (the body)." - (--partition-by-header (funcall fn it) list)) - -(defmacro --group-by (form list) - "Anaphoric form of `-group-by'." - (let ((l (make-symbol "list")) - (v (make-symbol "value")) - (k (make-symbol "key")) - (r (make-symbol "result"))) - `(let ((,l ,list) - ,r) - ;; Convert `list' to an alist and store it in `r'. - (while ,l - (let* ((,v (car ,l)) - (it ,v) - (,k ,form) - (kv (assoc ,k ,r))) - (if kv - (setcdr kv (cons ,v (cdr kv))) - (push (list ,k ,v) ,r)) - (setq ,l (cdr ,l)))) - ;; Reverse lists in each group. - (let ((rest ,r)) - (while rest - (let ((kv (car rest))) - (setcdr kv (nreverse (cdr kv)))) - (setq rest (cdr rest)))) - ;; Reverse order of keys. - (nreverse ,r)))) - -(defun -group-by (fn list) - "Separate LIST into an alist whose keys are FN applied to the -elements of LIST. Keys are compared by `equal'." - (--group-by (funcall fn it) list)) - -(defun -interpose (sep list) - "Returns a new list of all elements in LIST separated by SEP." - (let (result) - (when list - (!cons (car list) result) - (!cdr list)) - (while list - (setq result (cons (car list) (cons sep result))) - (!cdr list)) - (nreverse result))) - -(defun -interleave (&rest lists) - "Returns a new list of the first item in each list, then the second etc." - (let (result) - (while (-none? 'null lists) - (--each lists (!cons (car it) result)) - (setq lists (-map 'cdr lists))) - (nreverse result))) - -(defmacro --zip-with (form list1 list2) - "Anaphoric form of `-zip-with'. - -The elements in list1 is bound as `it`, the elements in list2 as `other`." - (let ((r (make-symbol "result")) - (l1 (make-symbol "list1")) - (l2 (make-symbol "list2"))) - `(let ((,r nil) - (,l1 ,list1) - (,l2 ,list2)) - (while (and ,l1 ,l2) - (let ((it (car ,l1)) - (other (car ,l2))) - (!cons ,form ,r) - (!cdr ,l1) - (!cdr ,l2))) - (nreverse ,r)))) - -(defun -zip-with (fn list1 list2) - "Zip the two lists LIST1 and LIST2 using a function FN. This -function is applied pairwise taking as first argument element of -LIST1 and as second argument element of LIST2 at corresponding -position. - -The anaphoric form `--zip-with' binds the elements from LIST1 as `it`, -and the elements from LIST2 as `other`." - (--zip-with (funcall fn it other) list1 list2)) - -(defun -zip (list1 list2) - "Zip the two lists together. Return the list where elements -are cons pairs with car being element from LIST1 and cdr being -element from LIST2. The length of the returned list is the -length of the shorter one." - (-zip-with 'cons list1 list2)) - -(defun -partial (fn &rest args) - "Takes a function FN and fewer than the normal arguments to FN, -and returns a fn that takes a variable number of additional ARGS. -When called, the returned function calls FN with ARGS first and -then additional args." - (apply 'apply-partially fn args)) - -(defun -elem-index (elem list) - "Return the index of the first element in the given LIST which -is equal to the query element ELEM, or nil if there is no -such element." - (car (-elem-indices elem list))) - -(defun -elem-indices (elem list) - "Return the indices of all elements in LIST equal to the query -element ELEM, in ascending order." - (-find-indices (-partial 'equal elem) list)) - -(defun -find-indices (pred list) - "Return the indices of all elements in LIST satisfying the -predicate PRED, in ascending order." - (let ((i 0)) - (apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list)))) - -(defmacro --find-indices (form list) - "Anaphoric version of `-find-indices'." - `(-find-indices (lambda (it) ,form) ,list)) - -(defun -find-index (pred list) - "Take a predicate PRED and a LIST and return the index of the -first element in the list satisfying the predicate, or nil if -there is no such element." - (car (-find-indices pred list))) - -(defmacro --find-index (form list) - "Anaphoric version of `-find-index'." - `(-find-index (lambda (it) ,form) ,list)) - -(defun -select-by-indices (indices list) - "Return a list whose elements are elements from LIST selected -as `(nth i list)` for all i from INDICES." - (let (r) - (--each indices - (!cons (nth it list) r)) - (nreverse r))) - -(defun -grade-up (comparator list) - "Grades elements of LIST using COMPARATOR relation, yielding a -permutation vector such that applying this permutation to LIST -sorts it in ascending order." - ;; ugly hack to "fix" lack of lexical scope - (let ((comp `(lambda (it other) (funcall ',comparator (car it) (car other))))) - (->> (--map-indexed (cons it it-index) list) - (-sort comp) - (-map 'cdr)))) - -(defun -grade-down (comparator list) - "Grades elements of LIST using COMPARATOR relation, yielding a -permutation vector such that applying this permutation to LIST -sorts it in descending order." - ;; ugly hack to "fix" lack of lexical scope - (let ((comp `(lambda (it other) (funcall ',comparator (car other) (car it))))) - (->> (--map-indexed (cons it it-index) list) - (-sort comp) - (-map 'cdr)))) - -(defmacro -> (x &optional form &rest more) - "Threads the expr through the forms. Inserts X as the second -item in the first form, making a list of it if it is not a list -already. If there are more forms, inserts the first form as the -second item in second form, etc." - (cond - ((null form) x) - ((null more) (if (listp form) - `(,(car form) ,x ,@(cdr form)) - (list form x))) - (:else `(-> (-> ,x ,form) ,@more)))) - -(defmacro ->> (x form &rest more) - "Threads the expr through the forms. Inserts X as the last item -in the first form, making a list of it if it is not a list -already. If there are more forms, inserts the first form as the -last item in second form, etc." - (if (null more) - (if (listp form) - `(,(car form) ,@(cdr form) ,x) - (list form x)) - `(->> (->> ,x ,form) ,@more))) - -(defmacro --> (x form &rest more) - "Threads the expr through the forms. Inserts X at the position -signified by the token `it' in the first form. If there are more -forms, inserts the first form at the position signified by `it' -in in second form, etc." - (if (null more) - (if (listp form) - (--map-when (eq it 'it) x form) - (list form x)) - `(--> (--> ,x ,form) ,@more))) - -(put '-> 'lisp-indent-function 1) -(put '->> 'lisp-indent-function 1) -(put '--> 'lisp-indent-function 1) - -(defmacro -when-let (var-val &rest body) - "If VAL evaluates to non-nil, bind it to VAR and execute body. -VAR-VAL should be a (VAR VAL) pair." - (declare (debug ((symbolp form) body))) - (let ((var (car var-val)) - (val (cadr var-val))) - `(let ((,var ,val)) - (when ,var - ,@body)))) - -(defmacro -when-let* (vars-vals &rest body) - "If all VALS evaluate to true, bind them to their corresponding - VARS and execute body. VARS-VALS should be a list of (VAR VAL) - pairs (corresponding to bindings of `let*')." - (declare (debug ((&rest (symbolp form)) body))) - (if (= (length vars-vals) 1) - `(-when-let ,(car vars-vals) - ,@body) - `(-when-let ,(car vars-vals) - (-when-let* ,(cdr vars-vals) - ,@body)))) - -(defmacro --when-let (val &rest body) - "If VAL evaluates to non-nil, bind it to `it' and execute -body." - (declare (debug (form body))) - `(let ((it ,val)) - (when it - ,@body))) - -(defmacro -if-let (var-val then &rest else) - "If VAL evaluates to non-nil, bind it to VAR and do THEN, -otherwise do ELSE. VAR-VAL should be a (VAR VAL) pair." - (declare (debug ((symbolp form) form body))) - (let ((var (car var-val)) - (val (cadr var-val))) - `(let ((,var ,val)) - (if ,var ,then ,@else)))) - -(defmacro -if-let* (vars-vals then &rest else) - "If all VALS evaluate to true, bind them to their corresponding - VARS and do THEN, otherwise do ELSE. VARS-VALS should be a list - of (VAR VAL) pairs (corresponding to the bindings of `let*')." - (declare (debug ((&rest (symbolp form)) form body))) - (let ((first-pair (car vars-vals)) - (rest (cdr vars-vals))) - (if (= (length vars-vals) 1) - `(-if-let ,first-pair ,then ,@else) - `(-if-let ,first-pair - (-if-let* ,rest ,then ,@else) - ,@else)))) - -(defmacro --if-let (val then &rest else) - "If VAL evaluates to non-nil, bind it to `it' and do THEN, -otherwise do ELSE." - (declare (debug (form form body))) - `(let ((it ,val)) - (if it ,then ,@else))) - -(put '-when-let 'lisp-indent-function 1) -(put '-when-let* 'lisp-indent-function 1) -(put '--when-let 'lisp-indent-function 1) -(put '-if-let 'lisp-indent-function 2) -(put '-if-let* 'lisp-indent-function 2) -(put '--if-let 'lisp-indent-function 2) - -(defun -distinct (list) - "Return a new list with all duplicates removed. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil. - -Alias: `-uniq'" - (let (result) - (--each list (unless (-contains? result it) (!cons it result))) - (nreverse result))) - -(defun -union (list list2) - "Return a new list containing the elements of LIST1 and elements of LIST2 that are not in LIST1. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - (let (result) - (--each list (!cons it result)) - (--each list2 (unless (-contains? result it) (!cons it result))) - (nreverse result))) - -(defalias '-uniq '-distinct) - -(defun -intersection (list list2) - "Return a new list containing only the elements that are members of both LIST and LIST2. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - (--filter (-contains? list2 it) list)) - -(defun -difference (list list2) - "Return a new list with only the members of LIST that are not in LIST2. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - (--filter (not (-contains? list2 it)) list)) - -(defvar -compare-fn nil - "Tests for equality use this function or `equal' if this is nil. -It should only be set using dynamic scope with a let, like: -(let ((-compare-fn =)) (-union numbers1 numbers2 numbers3)") - -(defun -contains? (list element) - "Return whether LIST contains ELEMENT. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - (not - (null - (cond - ((null -compare-fn) (member element list)) - ((eq -compare-fn 'eq) (memq element list)) - ((eq -compare-fn 'eql) (memql element list)) - (t - (let ((lst list)) - (while (and lst - (not (funcall -compare-fn element (car lst)))) - (setq lst (cdr lst))) - lst)))))) - -(defalias '-contains-p '-contains?) - -(defun -sort (comparator list) - "Sort LIST, stably, comparing elements using COMPARATOR. -Returns the sorted list. LIST is NOT modified by side effects. -COMPARATOR is called with two elements of LIST, and should return non-nil -if the first element should sort before the second." - (sort (copy-sequence list) comparator)) - -(defmacro --sort (form list) - "Anaphoric form of `-sort'." - (declare (debug t)) - `(-sort (lambda (it other) ,form) ,list)) - -(defun -repeat (n x) - "Return a list with X repeated N times. -Returns nil if N is less than 1." - (let (ret) - (--dotimes n (!cons x ret)) - ret)) - -(defun -sum (list) - "Return the sum of LIST." - (apply '+ list)) - -(defun -product (list) - "Return the product of LIST." - (apply '* list)) - -(defun -max (list) - "Return the largest value from LIST of numbers or markers." - (apply 'max list)) - -(defun -min (list) - "Return the smallest value from LIST of numbers or markers." - (apply 'min list)) - -(defun -max-by (comparator list) - "Take a comparison function COMPARATOR and a LIST and return -the greatest element of the list by the comparison function. - -See also combinator `-on' which can transform the values before -comparing them." - (--reduce (if (funcall comparator it acc) it acc) list)) - -(defun -min-by (comparator list) - "Take a comparison function COMPARATOR and a LIST and return -the least element of the list by the comparison function. - -See also combinator `-on' which can transform the values before -comparing them." - (--reduce (if (funcall comparator it acc) acc it) list)) - -(defmacro --max-by (form list) - "Anaphoric version of `-max-by'. - -The items for the comparator form are exposed as \"it\" and \"other\"." - `(-max-by (lambda (it other) ,form) ,list)) - -(defmacro --min-by (form list) - "Anaphoric version of `-min-by'. - -The items for the comparator form are exposed as \"it\" and \"other\"." - `(-min-by (lambda (it other) ,form) ,list)) - -(defun -cons-pair? (con) - "Return non-nil if CON is true cons pair. -That is (A . B) where B is not a list." - (and (listp con) - (not (listp (cdr con))))) - -(defun -cons-to-list (con) - "Convert a cons pair to a list with `car' and `cdr' of the pair respectively." - (list (car con) (cdr con))) - -(defun -value-to-list (val) - "Convert a value to a list. - -If the value is a cons pair, make a list with two elements, `car' -and `cdr' of the pair respectively. - -If the value is anything else, wrap it in a list." - (cond - ((-cons-pair? val) (-cons-to-list val)) - (t (list val)))) - -(defun -tree-mapreduce-from (fn folder init-value tree) - "Apply FN to each element of TREE, and make a list of the results. -If elements of TREE are lists themselves, apply FN recursively to -elements of these nested lists. - -Then reduce the resulting lists using FOLDER and initial value -INIT-VALUE. See `-reduce-r-from'. - -This is the same as calling `-tree-reduce-from' after `-tree-map' -but is twice as fast as it only traverse the structure once." - (cond - ((not tree) nil) - ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) - (-reduce-r-from folder init-value (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree))) - (t (funcall fn tree)))) - -(defmacro --tree-mapreduce-from (form folder init-value tree) - "Anaphoric form of `-tree-mapreduce-from'." - `(-tree-mapreduce-from (lambda (it) ,form) (lambda (it acc) ,folder) ,init-value ,tree)) - -(defun -tree-mapreduce (fn folder tree) - "Apply FN to each element of TREE, and make a list of the results. -If elements of TREE are lists themselves, apply FN recursively to -elements of these nested lists. - -Then reduce the resulting lists using FOLDER and initial value -INIT-VALUE. See `-reduce-r-from'. - -This is the same as calling `-tree-reduce' after `-tree-map' -but is twice as fast as it only traverse the structure once." - (cond - ((not tree) nil) - ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) - (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree))) - (t (funcall fn tree)))) - -(defmacro --tree-mapreduce (form folder tree) - "Anaphoric form of `-tree-mapreduce'." - `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree)) - -(defun -tree-map (fn tree) - "Apply FN to each element of TREE while preserving the tree structure." - (cond - ((not tree) nil) - ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) - (mapcar (lambda (x) (-tree-map fn x)) tree)) - (t (funcall fn tree)))) - -(defmacro --tree-map (form tree) - "Anaphoric form of `-tree-map'." - `(-tree-map (lambda (it) ,form) ,tree)) - -(defun -tree-reduce-from (fn init-value tree) - "Use FN to reduce elements of list TREE. -If elements of TREE are lists themselves, apply the reduction recursively. - -FN is first applied to INIT-VALUE and first element of the list, -then on this result and second element from the list etc. - -The initial value is ignored on cons pairs as they always contain -two elements." - (cond - ((not tree) nil) - ((-cons-pair? tree) tree) - ((listp tree) - (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree))) - (t tree))) - -(defmacro --tree-reduce-from (form init-value tree) - "Anaphoric form of `-tree-reduce-from'." - `(-tree-reduce-from (lambda (it acc) ,form) ,init-value ,tree)) - -(defun -tree-reduce (fn tree) - "Use FN to reduce elements of list TREE. -If elements of TREE are lists themselves, apply the reduction recursively. - -FN is first applied to first element of the list and second -element, then on this result and third element from the list etc. - -See `-reduce-r' for how exactly are lists of zero or one element handled." - (cond - ((not tree) nil) - ((-cons-pair? tree) tree) - ((listp tree) - (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree))) - (t tree))) - -(defmacro --tree-reduce (form tree) - "Anaphoric form of `-tree-reduce'." - `(-tree-reduce (lambda (it acc) ,form) ,tree)) - -(defun -clone (list) - "Create a deep copy of LIST. -The new list has the same elements and structure but all cons are -replaced with new ones. This is useful when you need to clone a -structure such as plist or alist." - (-tree-map 'identity list)) - -(defun dash-enable-font-lock () - "Add syntax highlighting to dash functions, macros and magic values." - (eval-after-load "lisp-mode" - '(progn - (let ((new-keywords '( - "--each" - "-each" - "--each-while" - "-each-while" - "--dotimes" - "-dotimes" - "-map" - "--map" - "--reduce-from" - "-reduce-from" - "--reduce" - "-reduce" - "--reduce-r-from" - "-reduce-r-from" - "--reduce-r" - "-reduce-r" - "--filter" - "-filter" - "-select" - "--select" - "--remove" - "-remove" - "-reject" - "--reject" - "--keep" - "-keep" - "-flatten" - "-concat" - "--mapcat" - "-mapcat" - "--first" - "-first" - "--any?" - "-any?" - "-some?" - "--some?" - "-any-p" - "--any-p" - "-some-p" - "--some-p" - "--all?" - "-all?" - "-every?" - "--every?" - "-all-p" - "--all-p" - "-every-p" - "--every-p" - "--none?" - "-none?" - "-none-p" - "--none-p" - "-only-some?" - "--only-some?" - "-only-some-p" - "--only-some-p" - "-take" - "-drop" - "--take-while" - "-take-while" - "--drop-while" - "-drop-while" - "-split-at" - "-rotate" - "-insert-at" - "--split-with" - "-split-with" - "-partition" - "-partition-in-steps" - "-partition-all" - "-partition-all-in-steps" - "-interpose" - "-interleave" - "--zip-with" - "-zip-with" - "-zip" - "--map-indexed" - "-map-indexed" - "--map-when" - "-map-when" - "--replace-where" - "-replace-where" - "-partial" - "-rpartial" - "-juxt" - "-applify" - "-on" - "-flip" - "-const" - "-cut" - "-orfn" - "-andfn" - "-elem-index" - "-elem-indices" - "-find-indices" - "--find-indices" - "-find-index" - "--find-index" - "-select-by-indices" - "-grade-up" - "-grade-down" - "->" - "->>" - "-->" - "-when-let" - "-when-let*" - "--when-let" - "-if-let" - "-if-let*" - "--if-let" - "-union" - "-distinct" - "-intersection" - "-difference" - "-contains?" - "-contains-p" - "-repeat" - "-cons*" - "-sum" - "-product" - "-min" - "-min-by" - "--min-by" - "-max" - "-max-by" - "--max-by" - "-cons-to-list" - "-value-to-list" - "-tree-mapreduce-from" - "--tree-mapreduce-from" - "-tree-mapreduce" - "--tree-mapreduce" - "-tree-map" - "--tree-map" - "-tree-reduce-from" - "--tree-reduce-from" - "-tree-reduce" - "--tree-reduce" - "-clone" - )) - (special-variables '( - "it" - "it-index" - "acc" - "other" - ))) - (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\<" (regexp-opt special-variables 'paren) "\\>") - 1 font-lock-variable-name-face)) 'append) - (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "(\\s-*" (regexp-opt new-keywords 'paren) "\\>") - 1 font-lock-keyword-face)) 'append)) - (--each (buffer-list) - (with-current-buffer it - (when (and (eq major-mode 'emacs-lisp-mode) - (boundp 'font-lock-mode) - font-lock-mode) - (font-lock-refresh-defaults))))))) - -(provide 'dash) -;;; dash.el ends here diff --git a/elpa/dash-2.3.0/dash.elc b/elpa/dash-2.3.0/dash.elc deleted file mode 100644 index caf14e37218a41bc69b37c4a330bf34fca492bad..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 43337 zcmeHw33D6A*(PguzZd{Z+W3eQ%ST#NHUwpX!OY;IlE@+@DxYc{IVCa2x1p;95d#qs z2+%krF~5GF=Y6|pdJd4(5m#z!U6wSMv%BB>?BDKxd++CKYiqUN{`R-#-t^>jG>!-6 z*_j#iC!=_L_f>y59LIArotT5;rFk@cX@Zt%?%a-gx0`_pn?WRx4rkL7GsMH@H-DbT zv-xlI`QL2EC;g-O_TV@1__U9c^W#Ri9c?$|a62B$!=s7W=WXUCo*dy*VQV|s4&>Ua z(c;+j$73@+U5rjf|LiYt!+g6Y7Y~j{bN%XajzJF2CjFDqkr_;n=8M^A@_c>^S7-Bu z=??~&R`Q)-XFJ>}ykjuMJ0{bGIhsxuecZfU3>!V1nKX8v+f zJLqnGzqN&7wOS>^`u5?IgJfKI3x>s0`SIXNW;o-~e4%3rIF_(--wlOV>^KIq?@h}N zqtoee81>Q6$gCQJ_-G8+6Zaa!q%e*`4%HkEb)B@o+jj;S`_B!<*Sz>KlvmG{2q!n&#PbaHdm^Fyq$s zU*PX{rFtL#boTI9mkZH8jDjZq1eN>u?;TF|a3KisC#u{(4BOrR*x#}c8yi_Dz7&&v z5jW;%C(ov1v%%9FW*jd}y*^qrMw3DO+BCPe%&TMaf)Qv5fUXOqlk4^1Yh2NraqD&9 z!}q3VmwqQ`2?o?pmkYD$W{K~d$^(-{y8Z!ItlKg70E4-C@W=?Sh(UK}cz=9CdKdIC zkK@I11~i_G#+lJ=_|G)%y?j-2xmLi$yYqRj9N< z-aDEsV~bUwTSXRG2~-lm6o&DJ%dTK7X-2)|mpV$rdH zi(Ll_K|Dc0x7y}L=pm&2xLM?|vezVAl$C0MrcUGjA|8y-O#C`NS}q_w_rAOTU#5=7 z=gX7+GhE4&8K6md{&ci>3Kq2lOd(}PlSTX-Le+>8(S+2QO_$G)&7=|JD6%n_LJ7c! zGVFb_JSpHb*jQ6IpGE5qakts60$H1f8$?f)MSNCp(eW^kd;N|G*FQatG0eK-VMe(Z z*!B0OYw-=l-^t)xGR#tB6TY<*_$x>;A}s9u#XIfK=TK|N*e<_lZZJSC&Q_30RtJpg z7uCNKn?43MRfLIE4#>ZLN=*9iYmWV68T3ihOnFq;3N1GD!i2&0%_M%M!h%`>cpirf z8AeTlXfa;!7Z!DV#w%djR?Q&8o+lhTqhK^n`lsZ>;FH8$r&UxBH!KkC1&F3oh#PN+ zohSfY-lrJHCoUnyyQNGU&lb2fr zggZ@@q!1$Q((ynRERW&_sje_C?^?>nLjZOJltobX5u?-SJwOepN_BzSi&dOdvf@ZjO@w~fE- ze*5Qr(P43WO$`HIPq;-aofMI?zi_BaA;eFGlR=G7-ZJsxXxltgHPqP+lm{XkV1CT3 z=1~|!4X7`YgDTP(Mi<&0J7+-wZq}vFRy-3y>htm;nw=W$A?2vb3VaE zfOqX?HQ^K)#2_q*99Rsi8fNsKCU{YbuTj{c(5BAQJO^D@U}_1H=Fl=xfr*_RYI0r9 zGiXBD6&3gaPEjKcfv^u!)%T@NL5QxP`zi&ft^&0r11V8`Y3tOv4nmtdR$xTks4W5m zlkIgchsDG@#o17i%Q4GawacPyG@}lcN81{e0GPWz+5$OGmH-?^9-o5yPfdUJe0dU2 zpeX~pUd3Z5(x8T#;#7j>9AwJoiP)CQi`e&HL#nBXJ$H;3Qu{W69UR0BC_^cS*bJh3 zb7FaCI>}0$3hCf*NIfg8R_<1IZ;+Q&4gZEoD_9OOvY^dQo|am zjI7LqN4KbJ>5l@hFfmCSv`$Fd_2s&P-m%#9n4~-iD;J-fF3xV5>}$XtE?Ut?uvBk@ z1K|~kjr(dkdodTTH1D6p!dd(|ZklH>(=e*q^fXrc828MlM zZ)`g0k3m2rSx*aS^?GUwVQMRJPe{z+m;hU8IEQ1k17Sh@4sjJ|GI~ClVqH?~Tg^&p z7qJrHHPsPI_lk1~E2&+?O2p7N<*ejF#MgO=pU`qSqN(y6QXF+!<(vF9k1o4S#N7pnCe;VfubG zQ7NeKT9rZ+ihZiR0i2BwoOXmUQyVI(5{l=lMp&2EE2^UETBZ3lqg!hpe{Y-$(e9~_ z58?MKBJcfU4Gi#99 z<$+Bmu7Xt4>ij}h0p777fc^-!ys@@^_lqlsLs*y1=;u%*D|jJL6;n$&TH?0tHhZD9ih9k&C@LbC<5kKaBslek4kcNlyho|PyMCRr zt|0hIEP&6~u2#UnZoVf51`#Xl%iM_Ie$@p_iLDC{x@x6SSZWdD0l1ChNrCd+g)ABf zubu%pQhu$dz~E4)LLp`yq_Bq%C+mbhoHh*HNlYj&$CCGD%;FMRX2sZ0JX9sJtlQpk zO6m$%6(=OYrFc*}S$i!zUy-xvTvrKfogdr)`T1Q+PV3xKY<523ZZCA4GU!BQ*nFOY zv`*zyf@zfBTOzk59L1l`@ITLEF$UlwWE8@mJN%A%~A#dVn9%pY7ev)^;XyzAWp)Kmqhqa`U~hlyixQZXYSVe zcpO1p1nQs11MzSm;B(PC;f5`J8+;})U9{kWFx)k!!B0Nk|5IXM=S*O(yJ&t+;AP3R zu=HCgi)u#Kz?@Xk3K5z7*C<*r&rVYg)r-12muZ@xC>S& zc0+T3U^F~Zu+ZRL7^r&vt(db;wH?7@MXS`guKEc3PM(irWQM?dDo^BK!1K7Bc#qKH zM&)G{GhCt2TQ~WMBKno@rHOJ zsRk}^;v+L}nlBMQ8DYNkpFPP9U*EvdYn+!1aIP^Ef7sS(g~ekm#)i4l0q-=s3~9Yj zHCh+vA~kxY`&S2f@kL|qk{)yz;)x;aXMk86)`jkNpb#my2zN>q zKZyerNI|0m=TSnr3M2s#QT>q#q)OlZgG!a_sdX4(%yBvMRM zG$iy9G+lB=GiW6=1;y5}W z(*uV*@u#$=agq1WHwG3nua0AJZh%BB-9yFt_(~8Qo$4Ha;SvG`F z-yBzL$P8G5M4$crx5APFZaAM-(Cj8L>kczan6)KvmC?Q#USvI1@`6hM)%Xh4&jfH~ zw%$tMrSyG~qbg|bXgUpY09`62d@jJ>hT!ieGv_vn)FBtaS1J2%8KkihACQfR+)@er zs0i7huF>w5P}k+2FRq@B3QI_2wE9Hly7-V?0E~+aY2pYy2qSC1u3%$F$N(y0rku?R z^c*SrY>X7Q=b5ey=~~CdefTX>1hozedDTjTwcgx<3LutN%D{rJzc(rS3Zf2~GuO9+ z+(S-5Wg1dsAoD1yxWuW?Rn^)R8DrUX)~T;TQ%_1=_tEszwaUTy;^$5Lsh%%22--dR z&;4xQMx%jT;l=UU;Ww102uxC=_~sihJ!%yAjl~j8cZJWYKRNrRz>RPc?>mnjsi(5K zkIYn6U6>pze9<2fy_TS$)MN~To^VG|y;GYJG6LQRvHdb~MGS2W#w5HZBWY5v`1BFDA;H*>Z_zn@OZuU$-Xz_}=es{vLU{m1wRBBW%pEzCehEt|{E%_P0BM^Nmwb zs{NOj<+mPK`*0Nkj>jbkI38bsfGd~|6(%IUB4tDvPwGUnI%?60grtZxxwRq8#_CO? zE_pCYv!a8r9Wa$m(3qKnn$LVb8Y46P0yLIf=>i_hQk39vURD0J#bNQ2ips2csDi`D zLxnG*p!UdWUC)S5tjFaPA4x|A&=UrfnyW$B4XISVp(o;BguSw?g1)kpfH5pUGB_Zt zp20tgzxuCSmlO8LVQ{(n4+l87PtL??@azRRd|tRmN0y291W4z0PRw>1WGrGGG!Wpq zlS+&{DlpHMFA_>-aYBt{fO-Ow?@pw~_~;Zr1( ztK$GJM0g4M=4AA`sEdggSlqQV$l>qFd4#DEq*?q=AtRZmj*NA@n|w+&yVT!HZE{41 zo%)J#7vX4q8msTlk**KC60)Gv0Yw>1%Iu~|nVq$D(nbdw!rd>cJT&xA@E_dRVPHMn zUb|YoB9Zr7qFqRZz_uJhVf2$Yhif+hPgH#%8~pccmFq6hrz*x&>jMBq%c&WzN=?+3 zS34kTg%3P2T0KtPY6kC4N6Ctjc9I{$VUu4%R>`l!Z!B%Wt7Q$#qv`1xL8X?|e9@mt zwz{~uG+OfD@ppgJ3I*0R9elT4lQUp-2j9V~cE+;5N&Fnn+Lv(-rt|R#$xMKz=&16} zG*M+SrPBNd!ihlr>>7%Qu<{)w7_NVEg{PR7AN>N53Yu5e4>x{>>+URcLYzg_(c#7? z)x)9Od1tM9<-hnyi)lTRy^kupKdnkCzkvK#!bqd;*SIA~SJWvYx2YjR9LJOAKy;+z z%U}t|ra74oJYBlg?veJGa+0dj#rUjxP!PcK%^)#VQxZyOwGVn7#;;s?%0Mz>K$KKrkV{Hp$k>-{-hat2HMP`|)kDxnEK~UJw zY21#kBqYhg(zdzY^w>`|_tB>1+6m_-FqloHc)_1QBor;B7tu!m&F)9JvI|N*!ikwb zI!NCtYr_OpFszUhTr}mb1tlT9bgs4KE4wziN!SlDuToHTFU$pCVt+={ElF&01%N?2 z+;K|BP6~i5n$4F;Oh)D_QYIA31ZO3kSY435xjnPmGG39%a>}YD-pZ8l;C#%pZdH@I zXNb4HAZJzoADFNN;PPHS9}^2!`I~zF+HH}ApvM)6K;&D22)S*x7n zFhTtPsKsL@TlMa>^}~snGW;dkY-F}fOm_B-FjfJx99a*p$7?!G@r9G4rn-!^9KmVo z^@cFOMP*q>Xs=qQJ8`vgh2aFfCVNace?V)&KDoB8eB6z7N^E*glNy%*NH zzU90!7c$pQC~1qBF#Oi$@pJ**NhW6=8Hoa8=vsF!Y2(|*{FMcRj}kG9k{W%;-X?kE z5_)1~AVNwfr{nnbXn_*ox%sX>*~-n_KJCw&$Q=HKQ2meuEWEGEh#ISylE|99(y9EN zg=Y}Pdf=jNj!)Z2ss_T4950S%1)IP!jkE=wHj0KtoVL>%5DR<>2>%W6MKcA)v{3Fh z)pY{UQ00UAEBJi#(o%0v;QCr*hx%$;6{(j)yiEd|i$yLY!3$Z9!kwNp^s5QKeg z8V*xDHK5a#B*4{dN1x#o3i2ntlw~_P4{xp{nUJ99L9W_0{LAE|`!q|!Jz69Yi;cA= z8PxzhMr>5;l2OD=rWGRhG7JuftWst>f-s^z6T%n@I>>#D!ZvQyl6U+f2812d%EPJS zG^Qgays0QIdXTwRFmDw3ao{v#>*fK6QIn>??8IKkRWdU~MJDLwNd<{Zy|dFvte?Oa zjsmWfV_5bj4o*r%$2tn<-s@RH=qD9MU$J?-&6_%o&(#uJu6^a{iG5m>D zSJ%IGd_|@wjMS~IS|pa=Ncx=Ivnoi|jaujD(#_*jHh3sz(Ygy+d=;6-FIws%h89vP zeY0A!>40w$@y&KwK$#hygHr}ZHtp>e8dJQjHBAe(M5{{U7Tr$UCE4wyQP+&DvDwEN ztg(ry={d!iOA8vitQ0gk8t;_bwXjrKY*uXn-T$Zmsgy9OKH9|iN z{B_geOS##a2IpwMI($(}hlBG3b9X1O_|oZ`Kg~ujff~2XpIKdr<~R-D%0gH$9eT)2 zY#{yUR6PpbHFrKIf*Rf}{^Lk@k|h6uN@c#%F>ukh#MD8qJa9&oFc|i9V9KB1GiW1_ zU<@`By=Wbhr0^rE@E8nVa_wnvIOATwfK(?-MzSIk)ZxXm8FZ$NCmey)0m9DhTd@O` zTO(a!(Vb0~n@~Q+)9DLlyFfV61#kYb934RdPmt#U{hXIi=i3`L*;REKk%^vE>4kwU zED2gZXG;poh0{>A%h;9XITRga*r|kk)R>R{i68UjGfoB&VZHefj`g{Da)7+MJ|VZA zrmD!(bFt;gS=jXl?T)BFL7OVK=vKg9GzuSP6eJM36I2RDUBHG0-NYn!&_`1Ksss=G z)v=K{=uMv2%QK4J=juF^3><)!#yOKY;)yh5(1nL0!uV+#mzOm(cIjD-iXvnSB)(uU znj@5r)<`)rNGI>;q=@%eLn4D7QHXC;I0u- z(9^gf71glR+3_|Do=3d5$Gg1Z4y^_&RF$e!!84)d6$s|x)lL}MRHGGH%5OK#9~pz* zcr_fx`76u{!L%d#kvKN-(tPu!E9W>b`K~ zM@=;F8RAD2;B67I{&^_Z*#}B*3Y+V^BWVtme-tiBr$aX^yF;O^VkDA1P?diLmkbhb8h1 zvpM?t#zB(VhNK0TxgVff+g0cH0<$Z*w$hvhoUf3Cf6ItTBc5Z7NUn<|isVku@q`Le znbArf2(1DV1PPg(FulX1XSy2N|0x3hS{11_;DPtPK!2aFKB(?~2DPUd-Gv|GbDpVO z{Q%kD$hg7TR+|bnrH*I-&CVxRE1!O_jx5Dbs=FUj`iD$zw0H2eh^R%~hBE|(ccg9$ zaZ6bqiYbb+ZGpz#Rn(tuFa#hIG&kBfOdy!5RQPDyW|l&}mvuSwX{d3GV)2r~%#wTF z6S-MRM5{E?-It)UcIB!O%44^PpbNiz*d*b>x`Y)8Isz%el3c%f9i}1Qwxz$H z;8-8TfqSHidr5yvb7BgB429T0b|9cDLSlS#)DkL0VLOf)e^W|~^aP`D`WWq6KGcP^ zAx+!#bo#dNiX+SIp8)jY{|8+@Gsi-i7ZIfbBB95598VhTnDouN5UNseO0FlQX27^9tI+kZts}gp#P$+(su`GnQC$Z@4t^ z;{_i1^TYaLeeEr2n!w1E=?_tT42Be2<#`-4e;URW-hi+pt|?K~`3|mn-knuO4=eb{ zUrP805VqO*s_MAOA00P=G^t#rn@IRc^bO*O(%oHnH&#Q&0!D(U z`tZKE23m9q!1aW`JL}{N2&zx+S3$2+97-~D z`T|dVBAH*rXCQl(1x_kc+=^JH zG=_Y5@lsoW&?5oEi$o67Y7Rlo!xt|hr%#u2Fdu3EiBotT`$wwa)*lQQ)$4eZv=Zex zG+dKDlKKv)0M=N>9rmsEh9B(vc-lU=<@?fHk42=mBo2`P`2|m$r$VAg;%|ish#sdH z+$%9@FnJi1uxLQrsP2#o9Q8ui{Avh355M*Qc6ZYyji3${Dxdkd+zgpd;Q#Sy;HA$CE6otWA3Lgr>j0Af4KiD`0 z1+DtxCu^W{c{5+a>ISh^^#xnFCMMRWa&zm>+7@ntpT#0iswiNk+1o8`BPd#eGB4nS zRTHGGh0-tz}Cf6A#@ zY?e1;Z!GFqxYsFJSi}gCJ#eE_uLg~Ao#3II_83)#;vcoE=&QbIPx0VI6|Au}@q7aTyjYF-adHefyKHSbIM4y#hcE-J@*yQ0?eXYr3#Zo{JVbM0r>WpU%~3T z`T_d#(YQnWgj`+>Jj77M!28-`)ecz_(=JRIcA$2hWon8EwCsd=dsbZ3(XJQNu!9ol zFQ%x)g5nAg+cYaKhcHPkgm5b(wbr5-5aPBE8dZpAq6|AA`-_aVrBs(2oXFK|CBZbo zD(WJV$YdF;+TaijG6YrgYuQ^+gNYa`DmNziBrX7kFi{r6zb*ZPhUwdN-Zt;LN%;up z=5e_ea+EdN8wQ=Ea5

>J*rtmkPyoLwl_gI4~SaOK=>$;sni7?*gQ&BsMZv02&Hx zhS>=1cb%i21b_zk60g9^v|978>@TF9CzV$w3zZCsSJS@Qe9TcI8vkK*(2ml#vbr%R zpu{%82UV+40ma*thvwE0bKteKa22Vp_66fJe;He@2S9*c5gv+ZI$K7pIvj$Qz{Pxy zbRq2suIV5(V1rtns>QKJ5Us=AQ~TfU|50KbLI%zyj%Oy*8uE{h-Ho|f^KsYh^6z#2 z64bMkrp5-LD^_@N%{1IY$QcCABr0mF>-y5|xC{ZA3FgW>1+Zo6P;piXx#+C0BK`Rh z3ZBVfr*O{CR?I>^0{|vt^?(N=fP-;E)eE{6lAGAbXfog`$ny@6y4oHv+fCO@EJ=U4 z)coeixSS8AgD?PFW9&|{aHX4rWW}66yUge?yL@DlsuS~@8C_$NA%1%8P{D&4p*);O zh_ZccZT%kf>wIMLstrtT9d2w{fRD8AyRSH=AxXbpu$htpi_(dJ8lQCGiLf0yZW8%5 z0*oIrF$84rGy{XY$&tCZLgmSWx~v0n_C2m4p;Y|3%A&B{ZY4FYfbCewoXCM1jy;Yt#A=z-4`kpm5p zQW8!OCyVhO3AejiRt0Uz*KJDy6~A5yCJg1m>NugtbAg1ntN_uD*XJOqymh%qV*T1R zR|`1#k%(t#Uu+bIRwvYj>J#S7E8}~b)P{^ySU-Gp|KYv;eBTOv9^RLPZD8#k2O)$N z9Sbc`zH(N~m0pP%Q)n#*7lq|YDe3v8_<~C$I4|Qi>;#e2K_VE~Zks>M;F^Z$a4lwl zn&LB1Mfcu!fBe(#89J&h4E#m(9Ozt^{*;tAOqdtf}Kjtl^&*j7+g}~1~cYlD_C}<&} z0NyDyfDVE$X(E5Uc18UJAF=@gA`7S>IQZm>*vCJ^4QQBvzF2A@Gp`DfEEb7`&FeQD z1N4T$!%MNl6k*jPie^Z5+ZDT)inxf_*g_6ObA>CYap#UpH{g;bb|;oD?fV*bT5h9_ zpxycR0W8q#JmIX69ZX+IlNxVP|KEhIf>gmPVZKYkwkKW1V5h>Z1bcIah?2G7&^H-^ zBh8Ry9ASV>rVKH-714Q!{Dg! zXnC!a`Q!67?RfNaRFa@8ECWx-b%jR)|A1jg?E*a++%8DqYGO~O@$JKrsM ziwu~dcz7f2f=j-)U3Ewd>05Lsv+!N1Rn#~bjLkR0eQl-Ud?U3vx;&4DBlWG4Di+fh zu%n)i7Mn$)D8ca>M~bZwR^fQ|b7;@yeU2X?;4fbG#$}iNwq16_$f4C=gHP12s%uiW zSCNN|&fjCfqw5;{(v~h1d$|-v|&T1X*Ht z%^94IC+3ib2I+g$H+3mo*qeeeDRLh5+B4^q34ky zLvi}c?qjhp>^?;@{_Psha!U}`f=f~y>%0{w5u$=qDrXbBb;|NrI9nJT&+b5k9Rdja z&yZrzm|wGvoO=f0njOYR_mWMq+{3RK=cV69#>Q|OTof^O$8a6$L-@$Wi24`6{pLA< zSFcSL{uu;-N{lVo013uruyRila7ZD?Y>CoX0R=e6iLLDzF(T;uVGTj_qzEH9O&~qV zK*@>Q1X?vC@Is6+^Im?A--eJDU&&L3DL3;WbO+X(1-Q-$*m(}JtlA9!OvZ4P93+C2 zRK~17@OP`Si&L)C9Dr)yBl}DR208djZ|TuZkHB|eFEfYXJpwxU;%Y#PG?4@YrE3J> zT9>9T5e4*KS^}%_MLFV0#*km-9OZCzWhI4N$Tp(PVvbV^0dXslBwmr7Zuq{}ZZv!& z)>vG}0CgH~%BTiYbMT-0@bil5E71^~+W+>+{x(VC&DfUCAiwO&v_O;-i{EUhMujlP zxxlcLb0M!_c!eALx!`Y+cgfqNF&i1!XqfJh1|iUvPWx#;5{klXJBD4AQFzYlAlolyO^ihwJ8AIa-veO?|yboO48fH+|WQB(u!T6xtk-{ zU5FxbIfK8ulIDZcyyoG9eLd6~g#4wI8O10~DKsZz!#;37i;nhRa6TvEz&K@_ocGH4 z^lKOJy&^_*dzYr!g!wtRmk@0>aPO8NM->?Din3J&oZ6rVt}U{lz9Nf4duKy0^h{GWsFcE(~Q6NE$|~f4DiR z(5QQ}(2w*6+?&V(=Z3v#uMMcT&=ulRy`9U$48E_^S{SzQWzH5E&S?+-U&|E+BrS{m z)wB=M{{gfuI72lkpLdalvP4N)39LH$G=qQ5@@I(-5P-wguC+KpT`otywEqj|P+s9q zmi`=)MWbm~d$11)BDMjuAY%Ttdm0H@GzBC}vi0lSMkg1;h^P@dPi6|KG;r_3tSg&6 zW!m)-^RSPy!!}w@LAT`sryhBD0F~6#3{=%QO{Z1b*jM`Eh~t~89}mJG1CWyT1Rsnz z&@Tf|OF?L)V!^|{DhYV9B}8wv4b2J=d4LH+*|m~upOkw0#3bw_S#@uXWqFguXDODY znIC1T2P15bJ&Pw^BO96Pibzahp)bvSJ!X+%50k` z-0AH|j(ZR$gbe8jg4H(TOt;ky9U1K3e{}F;kfr-36R>U5Bg_4rml>fr=q`v4wW&?s zMlvC^8S$`v$_sbWv+8$apQC1nk5KI40X}T20DEhdDv}pP9`^h)Kx~Mxl{6#u*Ut_{ zIKLSK#o{0E|CkKz2QP0EY0{eC175PeO_z| zPE?tttN{_ed{aAlz7Xm3BuJ~-b$xJ>d}2rtSxJ!|e}gWo8?vKpSvE;e5sbV8AVxVe z`nM(3&H2sM^?6e7#Gone21i@ywDq&KbtpEu_F68yi=+*DT=BRnEFKhFVdR>WXR@}i zQ9SKlB77dDaK&;G9gNrzY{#NeCz-m$%MJQ7yOgP@)p9+N&~(~M4?CSrvAv}1K3?)M zclDAVgw>jUu&td((Jn0W!7)8 zaWd+Xg*+f8?x4^=rp*Si#S${GYqUC!8Xhg%2nh(NX}38Q0J#!##appWesAHyugJ z;w1ULTE)jLVpnKbO(EQLB0dK~skqHw#pX-z3QR3@`!|Cms>0tNB&n?kD6hN?B=zb2 zwJZMuNVX$ani4co-<<3=pUFuBUy({UEx6Fm57eYnDibmiieWZ`x2xF32o>9;;|+0N zZ{!FDyCm_|S>NQFiA(#2^8_aPWvJT=HrF|`6p(M){QvhmOU0&lPzu0IxlZTJveWFk zS)x?kiaXck5F-EHcOvxBv0wKa*RUqMU0U*5--SJ~x5Y3DK)9!wk#2jP9N3`u&XLGF znyH45pH%Fb!O*U9b1b(504|^;*V!r^Y?h^511{Bj(+O~l@8`>8EDX{4YRpqq0Bj2K zJVmPircL|QTj4A@rQQEB9_OP=d|zWR)lR0uie+@zr(M!0kee*Sa(%R-PD`SxG|1uI zO2?(bIvEr2;-Lx|y#W2m8@uG6P^1Zy6)ntHyl?6DGLox*!DLE4GdY8qD)z%15!6?+ z{wY-}NMik54mdJAe*tj9YE6~v01@hkC^JI&(M`52!(B8oQ^4vEyO8Nt9@quTHRp+T zv?anBt01vZQnKdp@q@?v`)X=PlNh@=R#dCIYYxjA_1<3kBp(v5AXiedpiYnu`Z7k= zh-!HF)+|0+BDtBs$9G*myW2ksX1%uu9KJx0E*l%kp5kO$`fV<$enjoD2j6{re_yi$ z?0)Mi`)dy$Jv?Bf=FbSZQGa-ft~`8~-QrzY2Jiv@^X>CKx*j2Gj8+)G@f1z!W8AFI zQ2PT`OR=}Tf?d5fYv>OsFL;GCc|JX4^*8|N2 zzJ_;tAEZixs*2%sjP!nB4ty$##k`la3%o$HN~-xdVs2Mkapk9LRf{K*pY)a3;j$m7 zCdESsm&zA=7l?~*WQ}L>TQohg7?xQ^=)c%8Z^ofIlY{Mk)_=tj;l-uzL|4L+=^})V zZOoFeM`y>?DXr)>QSyp{SyysTiP$R6n$IcuNxyY0ZHIjcC4kdK*9Sz^q??1CB(w6$ zUs5_#Pa?pf1YChWx0PlPMBPr4^^|l^L_PGfVNUV?r&bmmUW!_OOhV1ls70HUFp+F2 zgxM-3%r8lp(mp`@!6mIqR}$uGYAh0>>s^+k!vgWaMDVr`jJiFycU@HOKgrV61thnc z+ENme0I6^LP0DwRR+P0o2sJSoG1NMByFyFcNxSQW8)) z$am+Cf3INO78mTqQY2tUAIZEeMFQD!MYxQ0jTC`jfO>)HN==JfFS>6M1`BH*&`m6Q zG)1$85Gz_}aP-^;btPO&AZlj}z^(L>$pR*W@yJPc4Dc0X+p=MpKljxiD)MN>Zv!h-$0XJ*A1SzF$bnKoHcanR`FbCY)X^`?G$t0xHi45;KN=PvXypnpJO)Js#cC?=vzv`o>1+Fk& zQ1i9dG9)c37w2geIp%eh-2)KD7M(&mrMKzZ2esl4qT8xd$UUA$;eDWh#!kDMHDoyo zSe@r!-n$%zdoxl#mgo;VL1Yb=R@1YQ#ZHAb`?RRv(Yc zZ^_h~ghv@xD@X$RJKdy{I!gHeov33aIe3`w^nKeHql7|0F*9T!THjz9fn?SAO$iJh zPhY`x(LY+S852}%wG9B^f5x*Z9kfjUa4$tqP;7Xb?_((}PhoIL7M>vm+4qf`?1*-V zj$w8u-#jI(M*pJhUct|Gkjm0s&SbQ+6WT-%)KjOp9Lmm#QL?lZ`F6IUa zlLR7QKVoS|KhS_0-vvxSjgU01AZK097Xchfcc$) zvA;IQqvywC{E;Sw5J!VP+AlfhJ8bNe{?TlzD{|6*j-a;KiMgNzA8KG@a`Y8w3?VQY zY|dC$f!S@-KTg%L(0O%wB5fGRj_yJf)i~^2k2~ z_2|3ozp|5^zAQb&P3~>($nJP2uk(-L#niE64(!uBr-$^Dq@zvuf|4&M7wu!Y-|Uyc z?{ZTO`94piXqEjXccmB8{Zsg)+a-a=y2AvIlI}T3=@WDs@|SeFpgx)Tffs0F z@$6YFV&O#Q)}-APZ%f-m@mJEGgg;#08G9_(fiQRk+g-&2{?7fB-^|2x*W59vNBAYv zG-nonb0=&!4?a2bj{mWIEm$e)@{sN207U*h9FGJlWXW>J(Ng}I&W3Uw3|tS$(sj&y z%>82L33&}>!>jIhrelGBL;RY*lFRzDP?gSmTxE57%vxOjx+8zd-+IjTVF3ZpyW^Yu zk^JHh&0bB9^p5nb^=^c2Zx#czXY7>6p7LW6m>wV5aL73SKDa}jvd)9sQh{^2|_}Qc(Hx& z-g|dGZ??PoY&M%Eo6QDl*Y(;c3HuXBv|5?#=-oj&56;310e9{lcm=$;y5LtU4rRfs zk=l6IK|^H7pM&xtpZGab9g4tYu1t@)^{O{n!Ae$qpZm81Q)ZOV7Pdn&yc1uOVYy-z z<0JN=V+&{uxIXGme`2JBz>*PsYIT^rk3j{HCySjHAe{)&YkLSwLVbvUQc@2;K77r} z^&buCNW;1a!r6$Fe2h(YNfDdfJl40jAX@Y&A{DtD?a@jI4g^}*D=-d!nS3`BK%qBU zd5A3~meu4-ul}z!6!71bB*|Q=Mq8EjDBkd(ARPylLOPC$_L@q!5gPglwQ;XUufRTR w?{_Jj&*x%_WSx^lrP;C~T>ynMqxXYGHC!czc0l=r(%>^~8#mxQT`U&K7gff+3jhEB diff --git a/elpa/nrepl-0.2.0/nrepl.el b/elpa/nrepl-0.2.0/nrepl.el deleted file mode 100644 index ba4518566..000000000 --- a/elpa/nrepl-0.2.0/nrepl.el +++ /dev/null @@ -1,3456 +0,0 @@ -;;; nrepl.el --- Client for Clojure nREPL - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg -;; Copyright © 2013 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell -;; URL: http://www.github.com/clojure-emacs/nrepl.el -;; Version: 0.2.0 -;; Keywords: languages, clojure, nrepl -;; Package-Requires: ((clojure-mode "2.0.0") (cl-lib "0.3") (dash "2.1.0") (pkg-info "0.1")) - -;; 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: - -;; Provides an elisp client to connect to Clojure nREPL servers. - -;;; Installation: - -;; Available as a package in marmalade-repo.org and melpa.milkbox.net. - -;; (add-to-list 'package-archives -;; '("marmalade" . "http://marmalade-repo.org/packages/")) -;; -;; or -;; -;; (add-to-list 'package-archives -;; '("melpa" . "http://melpa.milkbox.net/packages/") t) -;; -;; M-x package-install nrepl - -;;; Usage: - -;; M-x nrepl-jack-in - -;;; Code: - -(require 'clojure-mode) -(require 'dash) -(require 'pkg-info) -(require 'thingatpt) -(require 'etags) -(require 'arc-mode) -(require 'ansi-color) -(require 'eldoc) -(require 'ewoc) -(require 'cl-lib) -(require 'easymenu) -(require 'compile) -(require 'tramp) - -(eval-when-compile - (defvar paredit-version) - (defvar paredit-space-for-delimiter-predicates)) - - -;;; Compatibility -(eval-and-compile - ;; `setq-local' for Emacs 24.2 and below - (unless (fboundp 'setq-local) - (defmacro setq-local (var val) - "Set variable VAR to value VAL in current buffer." - `(set (make-local-variable ',var) ,val)))) - - -(defgroup nrepl nil - "Interaction with the Clojure nREPL Server." - :prefix "nrepl-" - :group 'applications) - - -;;; Version information -(defun nrepl-library-version () - "Get the version in the nrepl library header." - (-when-let (version (pkg-info-defining-library-version 'nrepl-repl-mode)) - (pkg-info-format-version version))) - -(defun nrepl-package-version () - "Get the package version of nrepl. - -This is the version number of the installed nrepl package." - (-when-let (version (pkg-info-package-version 'nrepl)) - (pkg-info-format-version version))) - -(defun nrepl-version (&optional show-version) - "Get the nrepl version as string. - -If called interactively or if SHOW-VERSION is non-nil, show the -version in the echo area and the messages buffer. - -The returned string includes both, the version from package.el -and the library version, if both a present and different. - -If the version number could not be determined, signal an error, -if called interactively, or if SHOW-VERSION is non-nil, otherwise -just return nil." - (interactive (list (not (or executing-kbd-macro noninteractive)))) - (let* ((lib-version (nrepl-library-version)) - (pkg-version (nrepl-package-version)) - (version (cond - ((and lib-version pkg-version - (not (string= lib-version pkg-version))) - (format "%s (package: %s)" lib-version pkg-version)) - ((or pkg-version lib-version) - (format "%s" (or pkg-version lib-version)))))) - (when show-version - (unless version - (error "Could not find out nrepl version")) - (message "nrepl version: %s" version)) - version)) - -(defcustom nrepl-connected-hook nil - "List of functions to call when connecting to the nREPL server." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-disconnected-hook nil - "List of functions to call when disconnected from the nREPL server." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-file-loaded-hook nil - "List of functions to call when a load file has completed." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-host "127.0.0.1" - "The default hostname (or IP address) to connect to." - :type 'string - :group 'nrepl) - -(defcustom nrepl-port nil - "The default port to connect to." - :type 'string - :group 'nrepl) - -(defvar nrepl-repl-requires-sexp "(apply require '[[clojure.repl :refer (source apropos dir pst doc find-doc)] [clojure.java.javadoc :refer (javadoc)] [clojure.pprint :refer (pp pprint)]])" - "Things to require in the tooling session and the REPL buffer.") - -(defvar nrepl-connection-buffer nil) -(defvar nrepl-server-buffer nil) -(defvar nrepl-repl-buffer nil) -(defvar nrepl-endpoint nil) -(defvar nrepl-project-dir nil) -(defconst nrepl-error-buffer "*nrepl-error*") -(defconst nrepl-doc-buffer "*nrepl-doc*") -(defconst nrepl-src-buffer "*nrepl-src*") -(defconst nrepl-macroexpansion-buffer "*nrepl-macroexpansion*") -(defconst nrepl-result-buffer "*nrepl-result*") -(defconst nrepl-repl-buffer-name-template "*nrepl%s*") -(defconst nrepl-connection-buffer-name-template "*nrepl-connection%s*") -(defconst nrepl-server-buffer-name-template "*nrepl-server%s*") - -(defcustom nrepl-hide-special-buffers nil - "Control the display of some special buffers in buffer switching commands. -When true some special buffers like the connection and the server -buffer will be hidden.") - -(defun nrepl-apply-hide-special-buffers (buffer-name) - "Apply a prefix to BUFFER-NAME that will hide the buffer." - (concat (if nrepl-hide-special-buffers " " "") buffer-name)) - -(defun nrepl-buffer-name (buffer-name-template) - "Generate a buffer name using BUFFER-NAME-TEMPLATE. - -The name will include the project name if available. The name will -also include the connection port if `nrepl-buffer-name-show-port' is true." - (generate-new-buffer-name - (let ((project-name (nrepl--project-name nrepl-project-dir)) - (nrepl-proj-port (cadr nrepl-endpoint))) - (format - buffer-name-template - (concat (if project-name - (format "%s%s" nrepl-buffer-name-separator project-name) "") - (if (and nrepl-proj-port nrepl-buffer-name-show-port) - (format ":%s" nrepl-proj-port) "")))))) - -(defun nrepl-connection-buffer-name () - "Return the name of the connection buffer." - (nrepl-apply-hide-special-buffers - (nrepl-buffer-name nrepl-connection-buffer-name-template))) - -(defun nrepl-server-buffer-name () - "Return the name of the server buffer." - (nrepl-apply-hide-special-buffers - (nrepl-buffer-name nrepl-server-buffer-name-template))) - -(defface nrepl-prompt-face - '((t (:inherit font-lock-keyword-face))) - "Face for the prompt in the nREPL client." - :group 'nrepl) - -(defface nrepl-output-face - '((t (:inherit font-lock-string-face))) - "Face for output in the nREPL client." - :group 'nrepl) - -(defface nrepl-error-face - '((t (:inherit font-lock-string-face))) - "Face for errors in the nREPL client." - :group 'nrepl) - -(defface nrepl-input-face - '((t (:bold t))) - "Face for previous input in the nREPL client." - :group 'nrepl) - -(defface nrepl-result-face - '((t ())) - "Face for the result of an evaluation in the nREPL client." - :group 'nrepl) - -(defface nrepl-error-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "red") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline t))) - "Face used to highlight compilation errors in Clojure buffers." - :group 'nrepl) - -(defface nrepl-warning-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "yellow") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline (:color "yellow")))) - "Face used to highlight compilation warnings in Clojure buffers." - :group 'nrepl) - -(defmacro nrepl-propertize-region (props &rest body) - "Add PROPS to all text inserted by executing BODY. -More precisely, PROPS are added to the region between the point's -positions before and after executing BODY." - (let ((start (make-symbol "start-pos"))) - `(let ((,start (point))) - (prog1 (progn ,@body) - (add-text-properties ,start (point) ,props))))) - -(put 'nrepl-propertize-region 'lisp-indent-function 1) - -;; buffer local declarations -(defvar nrepl-session nil - "Current nREPL session id.") - -(defvar nrepl-tooling-session nil - "Current nREPL tooling session id. -To be used for tooling calls (i.e. completion, eldoc, etc)") - -(defvar nrepl-input-start-mark) - -(defvar nrepl-prompt-start-mark) - -(defvar nrepl-request-counter 0 - "Continuation serial number counter.") - -(defvar nrepl-old-input-counter 0 - "Counter used to generate unique `nrepl-old-input' properties. -This property value must be unique to avoid having adjacent inputs be -joined together.") - -(defvar nrepl-requests (make-hash-table :test 'equal)) - -(defvar nrepl-buffer-ns "user" - "Current Clojure namespace of this buffer.") - -(defvar nrepl-input-history '() - "History list of strings read from the nREPL buffer.") - -(defvar nrepl-input-history-items-added 0 - "Variable counting the items added in the current session.") - -(defvar nrepl-output-start nil - "Marker for the start of output.") - -(defvar nrepl-output-end nil - "Marker for the end of output.") - -(defvar nrepl-sync-response nil - "Result of the last sync request.") - -(defvar nrepl-err-handler 'nrepl-default-err-handler - "Evaluation error handler.") - -(defvar nrepl-extra-eldoc-commands '("nrepl-complete" "yas/expand") - "Extra commands to be added to eldoc's safe commands list.") - -(defvar nrepl-ops nil - "Available nREPL server ops (from describe).") - -(defcustom nrepl-popup-stacktraces t - "Non-nil means pop-up error stacktraces for evaluation errors. -Nil means show only an error message in the minibuffer. See also -`nrepl-popup-stacktraces-in-repl', which overrides this setting -for REPL buffers." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-popup-stacktraces-in-repl nil - "Non-nil means pop-up error stacktraces in the REPL buffer. -Nil means show only an error message in the minibuffer. This variable -overrides `nrepl-popup-stacktraces' in REPL buffers." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-popup-on-error t - "When `nrepl-popup-on-error' is set to t, stacktraces will be displayed. -When set to nil, stactraces will not be displayed, but will be available -in the `nrepl-error-buffer', which defaults to *nrepl-error*." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-pop-to-repl-buffer-on-connect t - "Controls whether to pop to the REPL buffer on connect. - -When set to nil the buffer will only be created." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-auto-select-error-buffer nil - "Controls whether to auto-select the error popup buffer." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-tab-command 'nrepl-indent-and-complete-symbol - "Select the command to be invoked by the TAB key. -The default option is `nrepl-indent-and-complete-symbol'. If -you'd like to use the default Emacs behavior use -`indent-for-tab-command'." - :type 'symbol - :group 'nrepl) - -(defcustom nrepl-use-pretty-printing nil - "Control whether the results in REPL are pretty-printed or not. -The `nrepl-toggle-pretty-printing' command can be used to interactively -change the setting's value." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-buffer-name-separator " " - "Used in constructing the REPL buffer name. -The `nrepl-buffer-name-separator' separates `nrepl' from the project name." - :type '(string) - :group 'nrepl) - -(defcustom nrepl-buffer-name-show-port nil - "Show the connection port in the nrepl REPL buffer name, if set to t." - :type 'boolean - :group 'nrepl) - -(defun nrepl-make-variables-buffer-local (&rest variables) - "Make all VARIABLES buffer local." - (mapcar #'make-variable-buffer-local variables)) - -(nrepl-make-variables-buffer-local - 'nrepl-connection-buffer - 'nrepl-repl-buffer - 'nrepl-server-buffer - 'nrepl-endpoint - 'nrepl-project-dir - 'nrepl-ops - 'nrepl-session - 'nrepl-tooling-session - 'nrepl-input-start-mark - 'nrepl-prompt-start-mark - 'nrepl-request-counter - 'nrepl-requests - 'nrepl-old-input-counter - 'nrepl-buffer-ns - 'nrepl-input-history - 'nrepl-input-history-items-added - 'nrepl-current-input-history-index - 'nrepl-output-start - 'nrepl-output-end - 'nrepl-sync-response) - -(defun nrepl-reset-markers () - "Reset all REPL markers." - (dolist (markname '(nrepl-output-start - nrepl-output-end - nrepl-prompt-start-mark - nrepl-input-start-mark)) - (set markname (make-marker)) - (set-marker (symbol-value markname) (point)))) - -;;; Bencode -;;; Adapted from http://www.emacswiki.org/emacs-en/bencode.el -;;; and modified to work with utf-8 -(defun nrepl-bdecode-buffer () - "Decode a bencoded string in the current buffer starting at point." - (cond ((looking-at "i\\([0-9]+\\)e") - (goto-char (match-end 0)) - (string-to-number (match-string 1))) - ((looking-at "\\([0-9]+\\):") - (goto-char (match-end 0)) - (let ((start (point)) - (end (byte-to-position (+ (position-bytes (point)) - (string-to-number (match-string 1)))))) - (goto-char end) - (buffer-substring-no-properties start end))) - ((looking-at "l") - (goto-char (match-end 0)) - (let (result item) - (while (setq item (nrepl-bdecode-buffer)) - (setq result (cons item result))) - (nreverse result))) - ((looking-at "d") - (goto-char (match-end 0)) - (let (dict key item) - (while (setq item (nrepl-bdecode-buffer)) - (if key - (setq dict (cons (cons key item) dict) - key nil) - (unless (stringp item) - (error "Dictionary keys have to be strings: %s" item)) - (setq key item))) - (cons 'dict (nreverse dict)))) - ((looking-at "e") - (goto-char (match-end 0)) - nil) - (t - (error "Cannot decode object: %d" (point))))) - -(defun nrepl-decode (str) - "Decode bencoded STR." - (with-temp-buffer - (save-excursion - (insert str)) - (let ((result '())) - (while (not (eobp)) - (setq result (cons (nrepl-bdecode-buffer) result))) - (nreverse result)))) - -(defun nrepl-netstring (string) - "Encode STRING in bencode." - (let ((size (string-bytes string))) - (format "%s:%s" size string))) - -(defun nrepl-bencode (message) - "Encode with bencode MESSAGE." - (concat "d" (apply 'concat (mapcar 'nrepl-netstring message)) "e")) - -(defun nrepl-eval-region (start end) - "Evaluate the region. -The two arguments START and END are character positions; -they can be in either order." - (interactive "r") - (nrepl-interactive-eval (buffer-substring-no-properties start end))) - -(defun nrepl-eval-buffer () - "Evaluate the current buffer." - (interactive) - (nrepl-eval-region (point-min) (point-max))) - -(defun nrepl-expression-at-point () - "Return the text of the expr at point." - (apply #'buffer-substring-no-properties - (nrepl-region-for-expression-at-point))) - -(defun nrepl-region-for-expression-at-point () - "Return the start and end position of defun at point." - (save-excursion - (save-match-data - (end-of-defun) - (let ((end (point))) - (beginning-of-defun) - (list (point) end))))) - -(defun nrepl-eval-expression-at-point (&optional prefix) - "Evaluate the current toplevel form, and print result in the mini-buffer. -With a PREFIX argument, print the result in the current buffer." - (interactive "P") - (let ((form (nrepl-expression-at-point))) - (if prefix - (nrepl-interactive-eval-print form) - (nrepl-interactive-eval form)))) - -(defun nrepl-eval-ns-form () - "Evaluate the current buffer's namespace form." - (interactive) - (when (clojure-find-ns) - (save-excursion - (goto-char (match-beginning 0)) - (nrepl-eval-expression-at-point)))) - -(defun nrepl-bounds-of-sexp-at-point () - "Return the bounds sexp at point as a pair (or nil)." - (or (and (equal (char-after) ?\() - (member (char-before) '(?\' ?\, ?\@)) - ;; hide stuff before ( to avoid quirks with '( etc. - (save-restriction - (narrow-to-region (point) (point-max)) - (bounds-of-thing-at-point 'sexp))) - (bounds-of-thing-at-point 'sexp))) - -(defun nrepl-sexp-at-point () - "Return the sexp at point as a string, otherwise nil." - (let ((bounds (nrepl-bounds-of-sexp-at-point))) - (if bounds - (buffer-substring-no-properties (car bounds) - (cdr bounds))))) - -(defun nrepl-sexp-at-point-with-bounds () - "Return a list containing the sexp at point and its bounds." - (let ((bounds (nrepl-bounds-of-sexp-at-point))) - (if bounds - (let ((start (car bounds)) - (end (cdr bounds))) - (list (buffer-substring-no-properties start end) - (cons (set-marker (make-marker) start) - (set-marker (make-marker) end))))))) - -(defun nrepl-last-expression () - "Return the last sexp." - (buffer-substring-no-properties - (save-excursion (backward-sexp) (point)) - (point))) - -(defcustom nrepl-use-local-resources t - "Use local resources under HOME if possible." - :type 'boolean - :group 'nrepl) - -(defun nrepl-tramp-prefix () - "Top element on `find-tag-marker-ring` used to determine Clojure host." - (let ((jump-origin (buffer-file-name - (marker-buffer - (ring-ref find-tag-marker-ring 0))))) - (when (tramp-tramp-file-p jump-origin) - (let ((vec (tramp-dissect-file-name jump-origin))) - (tramp-make-tramp-file-name (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - nil))))) - -(defun nrepl-home-prefix-adjustment (resource) - "System-dependent HOME location will be adjusted in RESOURCE. -Removes any leading slash if on Windows." - (save-match-data - (cond ((string-match "^\\/\\(Users\\|home\\)\\/\\w+\\(\\/.+\\)" resource) - (concat (getenv "HOME") (match-string 2 resource))) - ((and (eq system-type 'windows-nt) - (string-match "^/" resource) - (not (tramp-tramp-file-p resource))) - (substring resource 1)) - (t - resource)))) - -(defun nrepl-emacs-or-clojure-side-adjustment (resource) - "Fix the RESOURCE path depending on `nrepl-use-local-resources`." - (let ((resource (nrepl-home-prefix-adjustment resource)) - (clojure-side-res (concat (nrepl-tramp-prefix) resource)) - (emacs-side-res resource)) - (cond ((equal resource "") resource) - ((and nrepl-use-local-resources - (file-exists-p emacs-side-res)) - emacs-side-res) - ((file-exists-p clojure-side-res) - clojure-side-res) - (t - resource)))) - -(defun nrepl-find-file (filename) - "Switch to a buffer visiting FILENAME. -Adjusts for HOME location using `nrepl-home-prefix-adjustment'. Uses `find-file'." - (find-file (nrepl-emacs-or-clojure-side-adjustment filename))) - -(defun nrepl-find-resource (resource) - "Find and display RESOURCE." - (cond ((string-match "^file:\\(.+\\)" resource) - (nrepl-find-file (match-string 1 resource))) - ((string-match "^\\(jar\\|zip\\):file:\\(.+\\)!/\\(.+\\)" resource) - (let* ((jar (match-string 2 resource)) - (path (match-string 3 resource)) - (buffer-already-open (get-buffer (file-name-nondirectory jar)))) - (nrepl-find-file jar) - (goto-char (point-min)) - (search-forward path) - (let ((opened-buffer (current-buffer))) - (archive-extract) - (when (not buffer-already-open) - (kill-buffer opened-buffer))))) - (t (error "Unknown resource path %s" resource)))) - -(defun nrepl-jump-to-def-for (location) - "Jump to LOCATION's definition in the source code." - ;; ugh; elisp destructuring doesn't work for vectors - (let ((resource (aref location 0)) - (path (aref location 1)) - (line (aref location 2))) - (if (and path (file-exists-p path)) - (find-file path) - (nrepl-find-resource resource)) - (goto-char (point-min)) - (forward-line (1- line)))) - -(defun nrepl-jump-to-def-handler (buffer) - "Create a handler for jump-to-def in BUFFER." - ;; TODO: got to be a simpler way to do this - (nrepl-make-response-handler buffer - (lambda (buffer value) - (with-current-buffer buffer - (ring-insert find-tag-marker-ring (point-marker))) - (nrepl-jump-to-def-for - (car (read-from-string value)))) - (lambda (buffer out) (message out)) - (lambda (buffer err) (message err)) - nil)) - -(defun nrepl-jump-to-def (var) - "Jump to the definition of the VAR at point." - (let ((form (format "(let [ns-symbol '%s - ns-var '%s - ns-file (clojure.core/comp :file - clojure.core/meta - clojure.core/second - clojure.core/first - clojure.core/ns-publics) - resource-str (clojure.core/comp clojure.core/str - clojure.java.io/resource - ns-file) - file-str (clojure.core/comp clojure.core/str - clojure.java.io/file - ns-file)] - (cond ((clojure.core/ns-aliases ns-symbol) ns-var) - (let [resolved-ns ((clojure.core/ns-aliases ns-symbol) ns-var)] - [(resource-str resolved-ns) - (file-str resolved-ns) - 1]) - - (find-ns ns-var) - [(resource-str ns-var) - (file-str ns-var) - 1] - - (clojure.core/ns-resolve ns-symbol ns-var) - ((clojure.core/juxt - (clojure.core/comp clojure.core/str - clojure.java.io/resource - :file) - (clojure.core/comp clojure.core/str - clojure.java.io/file - :file) - :line) - (clojure.core/meta (clojure.core/ns-resolve ns-symbol ns-var)))))" - (nrepl-current-ns) var))) - (nrepl-send-string form - (nrepl-jump-to-def-handler (current-buffer)) - nrepl-buffer-ns - (nrepl-current-tooling-session)))) - -(defun nrepl-jump (query) - "Jump to the definition of QUERY." - (interactive "P") - (nrepl-read-symbol-name "Symbol: " 'nrepl-jump-to-def query)) - -(defalias 'nrepl-jump-back 'pop-tag-mark) - -(defun nrepl-completion-complete-core-fn (str) - "Return a list of completions for STR using complete.core/completions." - (let ((strlst (plist-get - (nrepl-send-string-sync - (format "(require 'complete.core) (complete.core/completions \"%s\" *ns*)" str) - nrepl-buffer-ns - (nrepl-current-tooling-session)) - :value))) - (when strlst - (car (read-from-string strlst))))) - -(defun nrepl-completion-complete-op-fn (str) - "Return a list of completions for STR using the nREPL \"complete\" op." - (lexical-let ((strlst (plist-get - (nrepl-send-request-sync - (list "op" "complete" - "session" (nrepl-current-tooling-session) - "ns" nrepl-buffer-ns - "symbol" str)) - :value))) - (when strlst - (car strlst)))) - -(defun nrepl-dispatch-complete-symbol (str) - "Return a list of completions for STR. -Dispatch to the nREPL \"complete\" op if supported, -otherwise dispatch to internal completion function." - (if (nrepl-op-supported-p "complete") - (nrepl-completion-complete-op-fn str) - (nrepl-completion-complete-core-fn str))) - -(defun nrepl-complete-at-point () - "Complete the symbol at point." - (let ((sap (symbol-at-point))) - (when (and sap (not (in-string-p))) - (let ((bounds (bounds-of-thing-at-point 'symbol))) - (list (car bounds) (cdr bounds) - (completion-table-dynamic #'nrepl-dispatch-complete-symbol)))))) - -(defun nrepl-eldoc-format-thing (thing) - "Format the eldoc THING." - (propertize thing 'face 'font-lock-function-name-face)) - -(defun nrepl-highlight-args (arglist pos) - "Format the the function ARGLIST for eldoc. -POS is the index of the currently highlighted argument." - (let* ((rest-pos (nrepl--find-rest-args-position arglist)) - (i 0)) - (mapconcat - (lambda (arg) - (let ((argstr (format "%s" arg))) - (if (eq arg '&) - argstr - (prog1 - (if (or (= (1+ i) pos) - (and rest-pos (> (+ 1 i) rest-pos) - (> pos rest-pos))) - (propertize argstr 'face - 'eldoc-highlight-function-argument) - argstr) - (setq i (1+ i)))))) arglist " "))) - -(defun nrepl--find-rest-args-position (arglist) - "Find the position of & in the ARGLIST vector." - (-elem-index '& (append arglist ()))) - -(defun nrepl-highlight-arglist (arglist pos) - "Format the ARGLIST for eldoc. -POS is the index of the argument to highlight." - (concat "[" (nrepl-highlight-args arglist pos) "]")) - -(defun nrepl-eldoc-format-arglist (arglist pos) - "Format all the ARGLIST for eldoc. -POS is the index of current argument." - (concat "(" - (mapconcat (lambda (args) (nrepl-highlight-arglist args pos)) - (read arglist) " ") ")")) - -(defun nrepl-eldoc-info-in-current-sexp () - "Return a list of the current sexp and the current argument index." - (save-excursion - (let ((argument-index (1- (eldoc-beginning-of-sexp)))) - ;; If we are at the beginning of function name, this will be -1. - (when (< argument-index 0) - (setq argument-index 0)) - ;; Don't do anything if current word is inside a string. - (if (= (or (char-after (1- (point))) 0) ?\") - nil - (list (nrepl-symbol-at-point) argument-index))))) - -(defun nrepl-eldoc () - "Backend function for eldoc to show argument list in the echo area." - (when (nrepl-current-connection-buffer) - (let* ((info (nrepl-eldoc-info-in-current-sexp)) - (thing (car info)) - (pos (cadr info)) - (form (format "(try - (:arglists - (clojure.core/meta - (clojure.core/resolve - (clojure.core/read-string \"%s\")))) - (catch Throwable t nil))" thing)) - (result (when thing - (nrepl-send-string-sync form - nrepl-buffer-ns - (nrepl-current-tooling-session)))) - (value (plist-get result :value))) - (unless (string= value "nil") - (format "%s: %s" - (nrepl-eldoc-format-thing thing) - (nrepl-eldoc-format-arglist value pos)))))) - -(defun nrepl-turn-on-eldoc-mode () - "Turn on eldoc mode in the current buffer." - (setq-local eldoc-documentation-function 'nrepl-eldoc) - (apply 'eldoc-add-command nrepl-extra-eldoc-commands) - (turn-on-eldoc-mode)) - -;;; JavaDoc Browsing -;;; Assumes local-paths are accessible in the VM. -(defvar nrepl-javadoc-local-paths nil - "List of paths to directories with Javadoc.") - -(defun nrepl-javadoc-op (symbol-name) - "Invoke the nREPL \"javadoc\" op on SYMBOL-NAME." - (nrepl-send-op - "javadoc" - `("symbol" ,symbol-name "ns" ,nrepl-buffer-ns - "local-paths" ,(mapconcat #'identity nrepl-javadoc-local-paths " ")) - (nrepl-make-response-handler - (current-buffer) - (lambda (buffer url) - (if url - (browse-url url) - (error "No javadoc url for %s" symbol-name))) - nil nil nil))) - -(defun nrepl-javadoc-handler (symbol-name) - "Invoke the nREPL \"javadoc\" op on SYMBOL-NAME if available." - (when symbol-name - (let ((bounds (bounds-of-thing-at-point 'symbol))) - (if (nrepl-op-supported-p "javadoc") - (nrepl-javadoc-op symbol-name) - (message "No Javadoc middleware available"))))) - -(defun nrepl-javadoc (query) - "Browse Javadoc on the Java class QUERY at point." - (interactive "P") - (nrepl-read-symbol-name "Javadoc for: " 'nrepl-javadoc-handler query)) - -;;; Response handlers -(defmacro nrepl-dbind-response (response keys &rest body) - "Destructure an nREPL RESPONSE dict. -Bind the value of the provided KEYS and execute BODY." - `(let ,(loop for key in keys - collect `(,key (cdr (assoc ,(format "%s" key) ,response)))) - ,@body)) - -(put 'nrepl-dbind-response 'lisp-indent-function 2) - -(defun nrepl-make-response-handler - (buffer value-handler stdout-handler stderr-handler done-handler - &optional eval-error-handler) - "Make a response handler for BUFFER. -Uses the specified VALUE-HANDLER, STDOUT-HANDLER, STDERR-HANDLER, -DONE-HANDLER, and EVAL-ERROR-HANDLER as appropriate." - (lexical-let ((buffer buffer) - (value-handler value-handler) - (stdout-handler stdout-handler) - (stderr-handler stderr-handler) - (done-handler done-handler) - (eval-error-handler eval-error-handler)) - (lambda (response) - (nrepl-dbind-response response (value ns out err status id ex root-ex - session) - (cond (value - (with-current-buffer buffer - (if ns - (setq nrepl-buffer-ns ns))) - (if value-handler - (funcall value-handler buffer value))) - (out - (if stdout-handler - (funcall stdout-handler buffer out))) - (err - (if stderr-handler - (funcall stderr-handler buffer err))) - (status - (if (member "interrupted" status) - (message "Evaluation interrupted.")) - (if (member "eval-error" status) - (funcall (or eval-error-handler nrepl-err-handler) - buffer ex root-ex session)) - (if (member "namespace-not-found" status) - (message "Namespace not found.")) - (if (member "need-input" status) - (nrepl-need-input buffer)) - (if (member "done" status) - (progn (remhash id nrepl-requests) - (if done-handler - (funcall done-handler buffer)))))))))) - -(defun nrepl-stdin-handler (buffer) - "Make a stdin response handler for BUFFER." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (nrepl-emit-result buffer value t)) - (lambda (buffer out) - (nrepl-emit-output buffer out t)) - (lambda (buffer err) - (nrepl-emit-output buffer err t)) - nil)) - -(defun nrepl-handler (buffer) - "Make a nrepl evaluation handler for BUFFER." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (nrepl-emit-result buffer value t)) - (lambda (buffer out) - (nrepl-emit-output buffer out t)) - (lambda (buffer err) - (nrepl-emit-output buffer err t)) - (lambda (buffer) - (nrepl-emit-prompt buffer)))) - -(defun nrepl-interactive-eval-handler (buffer) - "Make an interactive eval handler for BUFFER." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (message "%s" value)) - (lambda (buffer value) - (nrepl-emit-interactive-output value)) - (lambda (buffer err) - (message "%s" err) - (nrepl-highlight-compilation-errors - buffer err)) - '())) - -(defun nrepl-load-file-handler (buffer) - "Make a load file handler for BUFFER." - (let (current-ns (nrepl-current-ns)) - (nrepl-make-response-handler buffer - (lambda (buffer value) - (message "%s" value) - (with-current-buffer buffer - (setq nrepl-buffer-ns (clojure-find-ns)) - (run-hooks 'nrepl-file-loaded-hook))) - (lambda (buffer value) - (nrepl-emit-interactive-output value)) - (lambda (buffer err) - (message "%s" err) - (nrepl-highlight-compilation-errors - buffer err)) - '() - (lambda (buffer ex root-ex session) - (let ((nrepl-popup-on-error nil)) - (funcall nrepl-err-handler - buffer ex root-ex session)))))) - -(defun nrepl-interactive-eval-print-handler (buffer) - "Make a handler for evaluating and printing result in BUFFER." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (with-current-buffer buffer - (insert (format "%s" value)))) - '() - (lambda (buffer err) - (message "%s" err)) - '())) - -(defun nrepl-popup-eval-print-handler (buffer) - "Make a handler for evaluating and printing result in popup BUFFER." - (nrepl-make-response-handler buffer - (lambda (buffer str) - (nrepl-emit-into-popup-buffer buffer str)) - '() - (lambda (buffer str) - (nrepl-emit-into-popup-buffer buffer str)) - '())) - -(defun nrepl-popup-eval-out-handler (buffer) - "Make a handler for evaluating and printing stdout/stderr in popup BUFFER." - (nrepl-make-response-handler buffer - '() - (lambda (buffer str) - (nrepl-emit-into-popup-buffer buffer str)) - (lambda (buffer str) - (nrepl-emit-into-popup-buffer buffer str)) - '())) - -(defun nrepl-visit-error-buffer () - "Visit the `nrepl-error-buffer' (usually *nrepl-error*) if it exists." - (interactive) - (let ((buffer (get-buffer nrepl-error-buffer))) - (when buffer - (nrepl-popup-buffer-display buffer)))) - -(defun nrepl-find-property (property &optional backward) - "Find the next text region which has the specified PROPERTY. -If BACKWARD is t, then search backward. -Returns the position at which PROPERTY was found, or nil if not found." - (let ((p (if backward - (previous-single-char-property-change (point) property) - (next-single-char-property-change (point) property)))) - (when (and (not (= p (point-min))) (not (= p (point-max)))) - p))) - -(defun nrepl-jump-to-compilation-error (&optional arg reset) - "Jump to the line causing the current compilation error. - -ARG and RESET are ignored, as there is only ever one compilation error. -They exist for compatibility with `next-error'." - (interactive) - (cl-labels ((goto-next-note-boundary - () - (let ((p (or (nrepl-find-property 'nrepl-note-p) - (nrepl-find-property 'nrepl-note-p t)))) - (when p - (goto-char p) - (message (get-char-property p 'nrepl-note)))))) - ;; if we're already on a compilation error, first jump to the end of - ;; it, so that we find the next error. - (when (get-char-property (point) 'nrepl-note-p) - (goto-next-note-boundary)) - (goto-next-note-boundary))) - -(defun nrepl-default-err-handler (buffer ex root-ex session) - "Make an error handler for BUFFER, EX, ROOT-EX and SESSION." - ;; TODO: use ex and root-ex as fallback values to display when pst/print-stack-trace-not-found - (let ((replp (equal 'nrepl-repl-mode (buffer-local-value 'major-mode buffer)))) - (if (or (and nrepl-popup-stacktraces-in-repl replp) - (and nrepl-popup-stacktraces (not replp))) - (lexical-let ((nrepl-popup-on-error nrepl-popup-on-error)) - (with-current-buffer buffer - (nrepl-send-string "(if-let [pst+ (clojure.core/resolve 'clj-stacktrace.repl/pst+)] - (pst+ *e) (clojure.stacktrace/print-stack-trace *e))" - (nrepl-make-response-handler - (nrepl-make-popup-buffer nrepl-error-buffer) - nil - (lambda (buffer value) - (nrepl-emit-into-color-buffer buffer value) - (when nrepl-popup-on-error - (nrepl-popup-buffer-display buffer nrepl-auto-select-error-buffer))) - nil nil) nil session)) - (with-current-buffer nrepl-error-buffer - (compilation-minor-mode +1)))))) - -(defvar nrepl-compilation-regexp - '("\\(?:.*\\(warning, \\)\\|.*?\\(, compiling\\):(\\)\\([^:]*\\):\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\(\\(?: - \\(.*\\)\\)\\|)\\)" 3 4 5 (1)) - "Specifications for matching errors and warnings in Clojure stacktraces. -See `compilation-error-regexp-alist' for help on their format.") - -(add-to-list 'compilation-error-regexp-alist-alist - (cons 'nrepl nrepl-compilation-regexp)) -(add-to-list 'compilation-error-regexp-alist 'nrepl) - -(defun nrepl-extract-error-info (regexp message) - "Extract error information with REGEXP against MESSAGE." - (let ((file (nth 1 regexp)) - (line (nth 2 regexp)) - (col (nth 3 regexp)) - (type (nth 4 regexp)) - (pat (car regexp))) - (when (string-match pat message) - ;; special processing for type (1.2) style - (setq type (if (consp type) - (or (and (car type) (match-end (car type)) 1) - (and (cdr type) (match-end (cdr type)) 0) - 2))) - (list - (when file - (let ((val (match-string-no-properties file message))) - (unless (string= val "NO_SOURCE_PATH") val))) - (when line (string-to-number (match-string-no-properties line message))) - (when col - (let ((val (match-string-no-properties col message))) - (when val (string-to-number val)))) - (aref [nrepl-warning-highlight-face - nrepl-warning-highlight-face - nrepl-error-highlight-face] - (or type 2)) - message)))) - -(defun nrepl-highlight-compilation-errors (buffer message) - "Highlight compilation error line in BUFFER, using MESSAGE." - (with-current-buffer buffer - (let ((info (nrepl-extract-error-info nrepl-compilation-regexp message))) - (when info - (let ((file (nth 0 info)) - (line (nth 1 info)) - (col (nth 2 info)) - (face (nth 3 info)) - (note (nth 4 info))) - (save-excursion - ;; when we don't have a filename the line number - ;; is relative to form start - (if file - (goto-char (point-min)) ; start of file - (beginning-of-defun)) - (forward-line (1- line)) - ;; if have column, highlight sexp at that point otherwise whole line. - (move-to-column (or col 0)) - (let ((begin (progn (if col (backward-up-list) (back-to-indentation)) (point))) - (end (progn (if col (forward-sexp) (move-end-of-line nil)) (point)))) - (let ((overlay (make-overlay begin end))) - (overlay-put overlay 'nrepl-note-p t) - (overlay-put overlay 'face face) - (overlay-put overlay 'nrepl-note note) - (overlay-put overlay 'help-echo note))))))))) - -(defun nrepl-need-input (buffer) - "Handle an need-input request from BUFFER." - (with-current-buffer buffer - (nrepl-send-stdin (concat (read-from-minibuffer "Stdin: ") "\n") - (nrepl-stdin-handler buffer)))) - - -;;;; Popup buffers -(define-minor-mode nrepl-popup-buffer-mode - "Mode for nrepl popup buffers" - nil - (" nREPL-tmp") - '(("q" . nrepl-popup-buffer-quit-function))) - -(make-variable-buffer-local - (defvar nrepl-popup-buffer-quit-function 'nrepl-popup-buffer-quit - "The function that is used to quit a temporary popup buffer.")) - -(defun nrepl-popup-buffer-quit-function (&optional kill-buffer-p) - "Wrapper to invoke the function `nrepl-popup-buffer-quit-function'. -KILL-BUFFER-P is passed along." - (interactive) - (funcall nrepl-popup-buffer-quit-function kill-buffer-p)) - -(defun nrepl-popup-buffer (name &optional select) - "Create new popup buffer called NAME. -If SELECT is non-nil, select the newly created window" - (with-current-buffer (nrepl-make-popup-buffer name) - (setq buffer-read-only t) - (nrepl-popup-buffer-display (current-buffer) select))) - -(defun nrepl-popup-buffer-display (popup-buffer &optional select) - "Display POPUP-BUFFER. -If SELECT is non-nil, select the newly created window" - (with-current-buffer popup-buffer - (let ((new-window (display-buffer (current-buffer)))) - (set-window-point new-window (point)) - (when select - (select-window new-window)) - (current-buffer)))) - -(defun nrepl-popup-buffer-quit (&optional kill-buffer-p) - "Quit the current (temp) window and bury its buffer using `quit-window'. -If prefix argument KILL-BUFFER-P is non-nil, kill the buffer instead of burying it." - (interactive) - (quit-window kill-buffer-p (selected-window))) - -(defun nrepl-make-popup-buffer (name) - "Create a temporary buffer called NAME." - (with-current-buffer (get-buffer-create name) - (kill-all-local-variables) - (setq buffer-read-only nil) - (erase-buffer) - (set-syntax-table clojure-mode-syntax-table) - (nrepl-popup-buffer-mode 1) - (current-buffer))) - -(defun nrepl-emit-into-popup-buffer (buffer value) - "Emit into BUFFER the provided VALUE." - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (insert (format "%s" value)) - (indent-sexp) - (font-lock-fontify-buffer)))) - -(defun nrepl-emit-into-color-buffer (buffer value) - "Emit into color BUFFER the provided VALUE." - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (goto-char (point-max)) - (insert (format "%s" value)) - (ansi-color-apply-on-region (point-min) (point-max))) - (goto-char (point-min)))) - - -;;;; Macroexpansion -(defun nrepl-macroexpand-undo (&optional arg) - "Undo the last macroexpansion, using `undo-only'. -ARG is passed along to `undo-only'." - (interactive) - (let ((inhibit-read-only t)) - (undo-only arg))) - -(defvar nrepl-last-macroexpand-expression nil - "Specify the last macroexpansion preformed. -This variable specifies both what was expanded and the expander.") - -(defun nrepl-macroexpand-form (expander expr) - "Macroexpand, using EXPANDER, the given EXPR." - (format - "(clojure.pprint/write (%s '%s) :suppress-namespaces false :dispatch clojure.pprint/code-dispatch)" - expander expr)) - -(defun nrepl-macroexpand-expr (expander expr &optional buffer) - "Macroexpand, use EXPANDER, the given EXPR from BUFFER." - (let* ((form (nrepl-macroexpand-form expander expr)) - (expansion (plist-get (nrepl-send-string-sync form nrepl-buffer-ns) :stdout))) - (setq nrepl-last-macroexpand-expression form) - (nrepl-initialize-macroexpansion-buffer expansion nrepl-buffer-ns))) - -(defun nrepl-macroexpand-expr-inplace (expander) - "Substitute the current form at point with its macroexpansion using EXPANDER." - (interactive) - (let ((form-with-bounds (nrepl-sexp-at-point-with-bounds))) - (if form-with-bounds - (destructuring-bind (expr bounds) form-with-bounds - (let* ((form (nrepl-macroexpand-form expander expr)) - (expansion (plist-get (nrepl-send-string-sync form nrepl-buffer-ns) :stdout))) - (nrepl-redraw-macroexpansion-buffer - expansion (current-buffer) (car bounds) (cdr bounds) (point))))))) - -(defun nrepl-macroexpand-again () - "Repeat the last macroexpansion." - (interactive) - (let ((expansion - (plist-get (nrepl-send-string-sync nrepl-last-macroexpand-expression nrepl-buffer-ns) :stdout))) - (nrepl-initialize-macroexpansion-buffer expansion nrepl-buffer-ns))) - -(defun nrepl-macroexpand-1 (&optional prefix) - "Invoke 'macroexpand-1' on the expression at point. -If invoked with a PREFIX argument, use 'macroexpand' instead of -'macroexpand-1'." - (interactive "P") - (let ((expander (if prefix 'macroexpand 'macroexpand-1))) - (nrepl-macroexpand-expr expander (nrepl-sexp-at-point)))) - -(defun nrepl-macroexpand-1-inplace (&optional prefix) - "Perform inplace 'macroexpand-1' on the expression at point. -If invoked with a PREFIX argument, use 'macroexpand' instead of -'macroexpand-1'." - (interactive "P") - (let ((expander (if prefix 'macroexpand 'macroexpand-1))) - (nrepl-macroexpand-expr-inplace expander))) - -(defun nrepl-macroexpand-all () - "Invoke 'clojure.walk/macroexpand-all' on the expression at point." - (interactive) - (nrepl-macroexpand-expr - 'clojure.walk/macroexpand-all (nrepl-sexp-at-point))) - -(defun nrepl-macroexpand-all-inplace () - "Perform inplace 'clojure.walk/macroexpand-all' on the expression at point." - (interactive) - (nrepl-macroexpand-expr-inplace 'clojure.walk/macroexpand-all)) - -(defun nrepl-initialize-macroexpansion-buffer (expansion ns) - "Create a new Macroexpansion buffer with EXPANSION and namespace NS." - (pop-to-buffer (nrepl-create-macroexpansion-buffer)) - (setq nrepl-buffer-ns ns) - (setq buffer-undo-list nil) - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (erase-buffer) - (insert (format "%s" expansion)) - (goto-char (point-min)) - (font-lock-fontify-buffer))) - -(defun nrepl-redraw-macroexpansion-buffer (expansion buffer start end current-point) - "Redraw the macroexpansion with new EXPANSION. -Text in BUFFER from START to END is replaced with new expansion, -and point is placed at CURRENT-POINT." - (with-current-buffer buffer - (let ((buffer-read-only nil)) - (goto-char start) - (delete-region start end) - (insert (format "%s" expansion)) - (goto-char start) - (indent-sexp) - (goto-char current-point)))) - - -(defun nrepl-popup-eval-print (form) - "Evaluate the given FORM and print value in current buffer." - (let ((buffer (current-buffer))) - (nrepl-send-string form - (nrepl-popup-eval-print-handler buffer) - (nrepl-current-ns)))) - -(defun nrepl-interactive-eval-print (form) - "Evaluate the given FORM and print value in current buffer." - (let ((buffer (current-buffer))) - (nrepl-send-string form - (nrepl-interactive-eval-print-handler buffer) - (nrepl-current-ns)))) - -(defun nrepl-interactive-eval (form) - "Evaluate the given FORM and print value in minibuffer." - (remove-overlays (point-min) (point-max) 'nrepl-note-p t) - (let ((buffer (current-buffer))) - (nrepl-send-string form - (nrepl-interactive-eval-handler buffer) - (nrepl-current-ns)))) - -(defun nrepl-send-op (op attributes handler) - "Send the specified OP with ATTRIBUTES and response HANDLER." - (let ((buffer (current-buffer))) - (nrepl-send-request (append - (list "op" op - "session" (nrepl-current-session) - "ns" nrepl-buffer-ns) - attributes) - handler))) - -(defun nrepl-send-load-file (file-contents file-path file-name) - "Perform the nREPL \"load-file\" op. -FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be -loaded." - (let ((buffer (current-buffer))) - (nrepl-send-request (list "op" "load-file" - "session" (nrepl-current-session) - "file" file-contents - "file-path" file-path - "file-name" file-name) - (nrepl-load-file-handler buffer)))) - -(defun nrepl-eval-last-expression (&optional prefix) - "Evaluate the expression preceding point. -If invoked with a PREFIX argument, print the result in the current buffer." - (interactive "P") - (if prefix - (nrepl-interactive-eval-print (nrepl-last-expression)) - (nrepl-interactive-eval (nrepl-last-expression)))) - -(defun nrepl-eval-print-last-expression () - "Evaluate the expression preceding point. -Print its value into the current buffer" - (interactive) - (nrepl-interactive-eval-print (nrepl-last-expression))) - -(defun nrepl-pprint-eval-last-expression () - "Evaluate the expression preceding point and pprint its value in a popup buffer." - (interactive) - (let ((form (nrepl-last-expression)) - (result-buffer (nrepl-popup-buffer nrepl-result-buffer nil))) - (nrepl-send-string (format "(clojure.pprint/pprint %s)" form) - (nrepl-popup-eval-out-handler result-buffer) - (nrepl-current-ns) - (nrepl-current-tooling-session)))) - -;;;;; History - -(defcustom nrepl-wrap-history nil - "T to wrap history around when the end is reached." - :type 'boolean - :group 'nrepl) - -;; These two vars contain the state of the last history search. We -;; only use them if `last-command' was 'nrepl-history-replace, -;; otherwise we reinitialize them. - -(defvar nrepl-input-history-position -1 - "Newer items have smaller indices.") - -(defvar nrepl-history-pattern nil - "The regexp most recently used for finding input history.") - -(defun nrepl-add-to-input-history (string) - "Add STRING to the input history. -Empty strings and duplicates are ignored." - (unless (or (equal string "") - (equal string (car nrepl-input-history))) - (push string nrepl-input-history) - (incf nrepl-input-history-items-added))) - -(defun nrepl-delete-current-input () - "Delete all text after the prompt." - (interactive) - (goto-char (point-max)) - (delete-region nrepl-input-start-mark (point-max))) - -(defun nrepl-replace-input (string) - "Replace the current REPL input with STRING." - (nrepl-delete-current-input) - (insert-and-inherit string)) - -(defun nrepl-position-in-history (start-pos direction regexp) - "Return the position of the history item starting at START-POS. -Search in DIRECTION for REGEXP. -Return -1 resp the length of the history if no item matches." - ;; Loop through the history list looking for a matching line - (let* ((step (ecase direction - (forward -1) - (backward 1))) - (history nrepl-input-history) - (len (length history))) - (loop for pos = (+ start-pos step) then (+ pos step) - if (< pos 0) return -1 - if (<= len pos) return len - if (string-match regexp (nth pos history)) return pos))) - -(defun nrepl-history-replace (direction &optional regexp) - "Replace the current input with the next line in DIRECTION. -DIRECTION is 'forward' or 'backward' (in the history list). -If REGEXP is non-nil, only lines matching REGEXP are considered." - (setq nrepl-history-pattern regexp) - (let* ((min-pos -1) - (max-pos (length nrepl-input-history)) - (pos0 (cond ((nrepl-history-search-in-progress-p) - nrepl-input-history-position) - (t min-pos))) - (pos (nrepl-position-in-history pos0 direction (or regexp ""))) - (msg nil)) - (cond ((and (< min-pos pos) (< pos max-pos)) - (nrepl-replace-input (nth pos nrepl-input-history)) - (setq msg (format "History item: %d" pos))) - ((not nrepl-wrap-history) - (setq msg (cond ((= pos min-pos) "End of history") - ((= pos max-pos) "Beginning of history")))) - (nrepl-wrap-history - (setq pos (if (= pos min-pos) max-pos min-pos)) - (setq msg "Wrapped history"))) - (when (or (<= pos min-pos) (<= max-pos pos)) - (when regexp - (setq msg (concat msg "; no matching item")))) - (message "%s%s" msg (cond ((not regexp) "") - (t (format "; current regexp: %s" regexp)))) - (setq nrepl-input-history-position pos) - (setq this-command 'nrepl-history-replace))) - -(defun nrepl-history-search-in-progress-p () - "Return t if a current history search is in progress." - (eq last-command 'nrepl-history-replace)) - -(defun nrepl-terminate-history-search () - "Terminate the current history search." - (setq last-command this-command)) - -(defun nrepl-previous-input () - "Cycle backwards through input history. -If the `last-command' was a history navigation command use the -same search pattern for this command. -Otherwise use the current input as search pattern." - (interactive) - (nrepl-history-replace 'backward (nrepl-history-pattern t))) - -(defun nrepl-next-input () - "Cycle forwards through input history. -See `nrepl-previous-input'." - (interactive) - (nrepl-history-replace 'forward (nrepl-history-pattern t))) - -(defun nrepl-forward-input () - "Cycle forwards through input history." - (interactive) - (nrepl-history-replace 'forward (nrepl-history-pattern))) - -(defun nrepl-backward-input () - "Cycle backwards through input history." - (interactive) - (nrepl-history-replace 'backward (nrepl-history-pattern))) - -(defun nrepl-previous-matching-input (regexp) - "Find the previous input matching REGEXP." - (interactive "sPrevious element matching (regexp): ") - (nrepl-terminate-history-search) - (nrepl-history-replace 'backward regexp)) - -(defun nrepl-next-matching-input (regexp) - "Find then next input matching REGEXP." - (interactive "sNext element matching (regexp): ") - (nrepl-terminate-history-search) - (nrepl-history-replace 'forward regexp)) - -(defun nrepl-history-pattern (&optional use-current-input) - "Return the regexp for the navigation commands. -If USE-CURRENT-INPUT is non-nil, use the current input." - (cond ((nrepl-history-search-in-progress-p) - nrepl-history-pattern) - (use-current-input - (assert (<= nrepl-input-start-mark (point))) - (let ((str (nrepl-current-input t))) - (cond ((string-match "^[ \n]*$" str) nil) - (t (concat "^" (regexp-quote str)))))) - (t nil))) - -;;; persistent history -(defcustom nrepl-history-size 500 - "The maximum number of items to keep in the REPL history." - :type 'integer - :safe 'integerp - :group 'nrepl-repl-mode) - -(defcustom nrepl-history-file nil - "File to save the persistent REPL history to." - :type 'string - :safe 'stringp - :group 'nrepl-repl-mode) - -(defun nrepl-history-read-filename () - "Ask the user which file to use, defaulting `nrepl-history-file'." - (read-file-name "Use nREPL history file: " - nrepl-history-file)) - -(defun nrepl-history-read (filename) - "Read history from FILENAME and return it. -It does not yet set the input history." - (if (file-readable-p filename) - (with-temp-buffer - (insert-file-contents filename) - (read (current-buffer))) - '())) - -(defun nrepl-history-load (&optional filename) - "Load history from FILENAME into current session. -FILENAME defaults to the value of `nrepl-history-file' but user -defined filenames can be used to read special history files. - -The value of `nrepl-input-history' is set by this function." - (interactive (list (nrepl-history-read-filename))) - (let ((f (or filename nrepl-history-file))) - ;; TODO: probably need to set nrepl-input-history-position as well. - ;; in a fresh connection the newest item in the list is currently - ;; not available. After sending one input, everything seems to work. - (setq nrepl-input-history (nrepl-history-read f)))) - -(defun nrepl-history-write (filename) - "Write history to FILENAME. -Currently coding system for writing the contents is hardwired to -utf-8-unix." - (let* ((mhist (nrepl-histories-merge nrepl-input-history - nrepl-input-history-items-added - (nrepl-history-read filename))) - ;; newest items are at the beginning of the list, thus 0 - (hist (cl-subseq mhist 0 (min (length mhist) nrepl-history-size)))) - (unless (file-writable-p filename) - (error (format "History file not writable: %s" filename))) - (let ((print-length nil) (print-level nil)) - (with-temp-file filename - ;; TODO: really set cs for output - ;; TODO: does cs need to be customizable? - (insert ";; -*- coding: utf-8-unix -*-\n") - (insert ";; Automatically written history of nREPL session\n") - (insert ";; Edit at your own risk\n\n") - (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))) - -(defun nrepl-history-save (&optional filename) - "Save the current nREPL input history to FILENAME. -FILENAME defaults to the value of `nrepl-history-file'." - (interactive (list (nrepl-history-read-filename))) - (let* ((file (or filename nrepl-history-file))) - (nrepl-history-write file))) - -(defun nrepl-history-just-save () - "Just save the history to `nrepl-history-file'. -This function is meant to be used in hooks to avoid lambda -constructs." - (nrepl-history-save nrepl-history-file)) - -;; SLIME has different semantics and will not save any duplicates. -;; we keep track of how many items were added to the history in the -;; current session in nrepl-add-to-input-history and merge only the -;; new items with the current history found in the file, which may -;; have been changed in the meantime by another session -(defun nrepl-histories-merge (session-hist n-added-items file-hist) - "Merge histories from SESSION-HIST adding N-ADDED-ITEMS into FILE-HIST." - (append (cl-subseq session-hist 0 n-added-items) - file-hist)) - -;;; -(defun nrepl-same-line-p (pos1 pos2) - "Return t if buffer positions POS1 and POS2 are on the same line." - (save-excursion (goto-char (min pos1 pos2)) - (<= (max pos1 pos2) (line-end-position)))) - -(defun nrepl-bol-internal () - "Go to the beginning of line or the prompt." - (cond ((and (>= (point) nrepl-input-start-mark) - (nrepl-same-line-p (point) nrepl-input-start-mark)) - (goto-char nrepl-input-start-mark)) - (t (beginning-of-line 1)))) - -(defun nrepl-bol () - "Go to the beginning of line or the prompt." - (interactive) - (deactivate-mark) - (nrepl-bol-internal)) - -(defun nrepl-bol-mark () - "Set the mark and go to the beginning of line or the prompt." - (interactive) - (unless mark-active - (set-mark (point))) - (nrepl-bol-internal)) - -(defun nrepl-at-prompt-start-p () - "Return t if point is at the start of prompt. -This will not work on non-current prompts." - (= (point) nrepl-input-start-mark)) - -;;; mode book-keeping -(defvar nrepl-repl-mode-hook nil - "Hook executed when entering `nrepl-repl-mode'.") - -(defvar nrepl-repl-mode-syntax-table - (copy-syntax-table clojure-mode-syntax-table)) - -(defvar nrepl-interaction-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-.") 'nrepl-jump) - (define-key map (kbd "M-,") 'nrepl-jump-back) - (define-key map (kbd "M-TAB") 'complete-symbol) - (define-key map (kbd "C-M-x") 'nrepl-eval-expression-at-point) - (define-key map (kbd "C-c C-c") 'nrepl-eval-expression-at-point) - (define-key map (kbd "C-x C-e") 'nrepl-eval-last-expression) - (define-key map (kbd "C-c C-e") 'nrepl-eval-last-expression) - (define-key map (kbd "C-c C-p") 'nrepl-pprint-eval-last-expression) - (define-key map (kbd "C-c C-r") 'nrepl-eval-region) - (define-key map (kbd "C-c C-n") 'nrepl-eval-ns-form) - (define-key map (kbd "C-c C-m") 'nrepl-macroexpand-1) - (define-key map (kbd "C-c M-m") 'nrepl-macroexpand-all) - (define-key map (kbd "C-c M-n") 'nrepl-set-ns) - (define-key map (kbd "C-c C-d") 'nrepl-doc) - (define-key map (kbd "C-c C-s") 'nrepl-src) - (define-key map (kbd "C-c C-z") 'nrepl-switch-to-repl-buffer) - (define-key map (kbd "C-c C-Z") 'nrepl-switch-to-relevant-repl-buffer) - (define-key map (kbd "C-c M-o") 'nrepl-find-and-clear-repl-buffer) - (define-key map (kbd "C-c C-k") 'nrepl-load-current-buffer) - (define-key map (kbd "C-c C-l") 'nrepl-load-file) - (define-key map (kbd "C-c C-b") 'nrepl-interrupt) - (define-key map (kbd "C-c C-j") 'nrepl-javadoc) - (define-key map (kbd "C-c M-s") 'nrepl-selector) - (define-key map (kbd "C-c M-r") 'nrepl-rotate-connection) - (define-key map (kbd "C-c M-d") 'nrepl-display-current-connection-info) - (define-key map (kbd "C-c C-q") 'nrepl-quit) - map)) - -(easy-menu-define nrepl-interaction-mode-menu nrepl-interaction-mode-map - "Menu for nREPL interaction mode" - '("nREPL" - ["Jump" nrepl-jump] - ["Jump back" nrepl-jump-back] - "--" - ["Complete symbol" complete-symbol] - "--" - ["Eval expression at point" nrepl-eval-expression-at-point] - ["Eval last expression" nrepl-eval-last-expression] - ["Eval last expression in popup buffer" nrepl-pprint-eval-last-expression] - ["Eval region" nrepl-eval-region] - ["Eval ns form" nrepl-eval-ns-form] - "--" - ["Load current buffer" nrepl-load-current-buffer] - ["Load file" nrepl-load-file] - "--" - ["Macroexpand-1 last expression" nrepl-macroexpand-1] - ["Macroexpand-all last expression" nrepl-macroexpand-all] - "--" - ["Display documentation" nrepl-doc] - ["Display Source" nrepl-src] - ["Display JavaDoc" nrepl-javadoc] - "--" - ["Set ns" nrepl-set-ns] - ["Switch to REPL" nrepl-switch-to-repl-buffer] - ["Switch to Relevant REPL" nrepl-switch-to-relevant-repl-buffer] - ["Toggle REPL Pretty Print" nrepl-pretty-toggle] - ["Clear REPL" nrepl-find-and-clear-repl-buffer] - ["Interrupt" nrepl-interrupt] - ["Quit" nrepl-quit] - ["Restart" nrepl-restart] - "--" - ["Display current nrepl connection" nrepl-display-current-connection-info] - ["Rotate current nrepl connection" nrepl-rotate-connection] - "--" - ["Version info" nrepl-version])) - -(defvar nrepl-macroexpansion-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "g") 'nrepl-macroexpand-again) - (define-key map (kbd "q") 'nrepl-popup-buffer-quit-function) - (cl-labels ((redefine-key (from to) - (dolist (mapping (where-is-internal from nrepl-interaction-mode-map)) - (define-key map mapping to)))) - (redefine-key 'nrepl-macroexpand-1 'nrepl-macroexpand-1-inplace) - (redefine-key 'nrepl-macroexpand-all 'nrepl-macroexpand-all-inplace) - (redefine-key 'advertised-undo 'nrepl-macroexpand-undo) - (redefine-key 'undo 'nrepl-macroexpand-undo)) - map)) - -(define-minor-mode nrepl-macroexpansion-minor-mode - "Minor mode for nrepl macroexpansion. - -\\{nrepl-macroexpansion-minor-mode-map}" - nil - " Macroexpand" - nrepl-macroexpansion-minor-mode-map) - -(defun nrepl-create-macroexpansion-buffer () - "Create a new macroexpansion buffer." - (with-current-buffer (nrepl-popup-buffer nrepl-macroexpansion-buffer t) - (clojure-mode) - (clojure-disable-nrepl) - (nrepl-macroexpansion-minor-mode 1) - (current-buffer))) - -(defun nrepl-tab () - "Invoked on TAB keystrokes in `nrepl-repl-mode' buffers." - (interactive) - (funcall nrepl-tab-command)) - -(defvar nrepl-repl-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map clojure-mode-map) - (define-key map (kbd "M-.") 'nrepl-jump) - (define-key map (kbd "M-,") 'nrepl-jump-back) - (define-key map (kbd "RET") 'nrepl-return) - (define-key map (kbd "TAB") 'nrepl-tab) - (define-key map (kbd "C-") 'nrepl-closing-return) - (define-key map (kbd "C-j") 'nrepl-newline-and-indent) - (define-key map (kbd "C-c C-d") 'nrepl-doc) - (define-key map (kbd "C-c C-s") 'nrepl-src) - (define-key map (kbd "C-c C-o") 'nrepl-clear-output) - (define-key map (kbd "C-c M-o") 'nrepl-clear-buffer) - (define-key map (kbd "C-c C-u") 'nrepl-kill-input) - (define-key map (kbd "C-a") 'nrepl-bol) - (define-key map (kbd "C-S-a") 'nrepl-bol-mark) - (define-key map [home] 'nrepl-bol) - (define-key map [S-home] 'nrepl-bol-mark) - (define-key map (kbd "C-") 'nrepl-backward-input) - (define-key map (kbd "C-") 'nrepl-forward-input) - (define-key map (kbd "M-p") 'nrepl-previous-input) - (define-key map (kbd "M-n") 'nrepl-next-input) - (define-key map (kbd "M-r") 'nrepl-previous-matching-input) - (define-key map (kbd "M-s") 'nrepl-next-matching-input) - (define-key map (kbd "C-c C-n") 'nrepl-next-prompt) - (define-key map (kbd "C-c C-p") 'nrepl-previous-prompt) - (define-key map (kbd "C-c C-b") 'nrepl-interrupt) - (define-key map (kbd "C-c C-c") 'nrepl-interrupt) - (define-key map (kbd "C-c C-j") 'nrepl-javadoc) - (define-key map (kbd "C-c C-m") 'nrepl-macroexpand-1) - (define-key map (kbd "C-c M-m") 'nrepl-macroexpand-all) - (define-key map (kbd "C-c C-z") 'nrepl-switch-to-last-clojure-buffer) - (define-key map (kbd "C-c M-s") 'nrepl-selector) - (define-key map (kbd "C-c M-r") 'nrepl-rotate-connection) - (define-key map (kbd "C-c M-d") 'nrepl-display-current-connection-info) - (define-key map (kbd "C-c C-q") 'nrepl-quit) - map)) - -(easy-menu-define nrepl-repl-mode-menu nrepl-repl-mode-map - "Menu for nREPL mode" - '("nREPL" - ["Jump" nrepl-jump] - ["Jump back" nrepl-jump-back] - "--" - ["Complete symbol" complete-symbol] - "--" - ["Display documentation" nrepl-doc] - ["Display source" nrepl-src] - ["Display JavaDoc" nrepl-javadoc] - "--" - ["Toggle pretty printing of results" nrepl-toggle-pretty-printing] - ["Clear output" nrepl-clear-output] - ["Clear buffer" nrepl-clear-buffer] - ["Kill input" nrepl-kill-input] - ["Interrupt" nrepl-interrupt] - ["Quit" nrepl-quit] - ["Restart" nrepl-restart] - "--" - ["Version info" nrepl-version])) - -(defun clojure-enable-nrepl () - "Turn on nrepl interaction mode (see command `nrepl-interaction-mode'). -Useful in hooks." - (nrepl-interaction-mode 1) - (setq next-error-function 'nrepl-jump-to-compilation-error)) - -(defun clojure-disable-nrepl () - "Turn off nrepl interaction mode (see command `nrepl-interaction-mode'). -Useful in hooks." - (nrepl-interaction-mode -1)) - -;;; Prevent paredit from inserting some inappropriate spaces. -;;; C.f. clojure-mode.el -(defun nrepl-space-for-delimiter-p (endp delim) - "Hook for paredit's `paredit-space-for-delimiter-predicates`. - -Decides if paredit should insert a space after/before (if/unless -ENDP) DELIM." - (if (eq major-mode 'nrepl-repl-mode) - (save-excursion - (backward-char) - (if (and (or (char-equal delim ?\() - (char-equal delim ?\") - (char-equal delim ?{)) - (not endp)) - (if (char-equal (char-after) ?#) - (and (not (bobp)) - (or (char-equal ?w (char-syntax (char-before))) - (char-equal ?_ (char-syntax (char-before))))) - t) - t)) - t)) - -;;;###autoload -(define-minor-mode nrepl-interaction-mode - "Minor mode for nrepl interaction from a Clojure buffer. - -\\{nrepl-interaction-mode-map}" - nil - " nREPL/i" - nrepl-interaction-mode-map - (make-local-variable 'completion-at-point-functions) - (add-to-list 'completion-at-point-functions - 'nrepl-complete-at-point)) - -(define-derived-mode nrepl-repl-mode fundamental-mode "nREPL/r" - "Major mode for nREPL interactions. - -\\{nrepl-repl-mode-map}" - (setq-local lisp-indent-function 'clojure-indent-function) - (setq-local indent-line-function 'lisp-indent-line) - (make-local-variable 'completion-at-point-functions) - (add-to-list 'completion-at-point-functions - 'nrepl-complete-at-point) - (set-syntax-table nrepl-repl-mode-syntax-table) - (nrepl-turn-on-eldoc-mode) - (if (fboundp 'hack-dir-local-variables-non-file-buffer) - (hack-dir-local-variables-non-file-buffer)) - (when nrepl-history-file - (nrepl-history-load nrepl-history-file) - (add-hook 'kill-buffer-hook 'nrepl-history-just-save t t) - (add-hook 'kill-emacs-hook 'nrepl-history-just-save)) - (add-hook 'paredit-mode-hook - (lambda () - (when (>= paredit-version 21) - (define-key nrepl-repl-mode-map "{" 'paredit-open-curly) - (define-key nrepl-repl-mode-map "}" 'paredit-close-curly) - (add-to-list 'paredit-space-for-delimiter-predicates - 'nrepl-space-for-delimiter-p))))) - -;;; communication -(defcustom nrepl-lein-command - "lein" - "The command used to execute leiningen 2.x." - :type 'string - :group 'nrepl-repl-mode) - -(defcustom nrepl-server-command - (if (or (locate-file nrepl-lein-command exec-path) - (locate-file (format "%s.bat" nrepl-lein-command) exec-path)) - (format "%s repl :headless" nrepl-lein-command) - (format "echo \"%s repl :headless\" | eval $SHELL -l" nrepl-lein-command)) - "The command used to start the nREPL via command `nrepl-jack-in'. -For a remote nREPL server lein must be in your PATH. The remote -proc is launched via sh rather than bash, so it might be necessary -to specific the full path to it. Localhost is assumed." - :type 'string - :group 'nrepl-repl-mode) - - -(defun nrepl-show-maximum-output () - "Put the end of the buffer at the bottom of the window." - (when (eobp) - (let ((win (get-buffer-window (current-buffer)))) - (when win - (with-selected-window win - (set-window-point win (point-max)) - (recenter -1)))))) - -(defmacro nrepl-save-marker (marker &rest body) - "Save MARKER and execute BODY." - (let ((pos (make-symbol "pos"))) - `(let ((,pos (marker-position ,marker))) - (prog1 (progn . ,body) - (set-marker ,marker ,pos))))) - -(put 'nrepl-save-marker 'lisp-indent-function 1) - -(defun nrepl-insert-prompt (namespace) - "Insert the prompt (before markers!), taking into account NAMESPACE. -Set point after the prompt. -Return the position of the prompt beginning." - (goto-char nrepl-input-start-mark) - (nrepl-save-marker nrepl-output-start - (nrepl-save-marker nrepl-output-end - (unless (bolp) (insert-before-markers "\n")) - (let ((prompt-start (point)) - (prompt (format "%s> " namespace))) - (nrepl-propertize-region - '(face nrepl-prompt-face read-only t intangible t - nrepl-prompt t - rear-nonsticky (nrepl-prompt read-only face intangible)) - (insert-before-markers prompt)) - (set-marker nrepl-prompt-start-mark prompt-start) - prompt-start)))) - -(defun nrepl-emit-output-at-pos (buffer string position &optional bol) - "Using BUFFER, insert STRING at POSITION and mark it as output. -If BOL is non-nil insert at the beginning of line." - (with-current-buffer buffer - (save-excursion - (nrepl-save-marker nrepl-output-start - (nrepl-save-marker nrepl-output-end - (goto-char position) - (when (and bol (not (bolp))) (insert-before-markers "\n")) - (nrepl-propertize-region `(face nrepl-output-face - rear-nonsticky (face)) - (insert-before-markers string) - (when (and (= (point) nrepl-prompt-start-mark) - (not (bolp))) - (insert-before-markers "\n") - (set-marker nrepl-output-end (1- (point)))))))) - (nrepl-show-maximum-output))) - -(defun nrepl-emit-interactive-output (string) - "Emit STRING as interactive output." - (with-current-buffer (nrepl-current-repl-buffer) - (let ((pos (1- (nrepl-input-line-beginning-position)))) - (nrepl-emit-output-at-pos (current-buffer) string pos t) - (ansi-color-apply-on-region pos (point-max)) - ))) - -(defun nrepl-emit-output (buffer string &optional bol) - "Using BUFFER, emit STRING. -If BOL is non-nil, emit at the beginning of the line." - (with-current-buffer buffer - (nrepl-emit-output-at-pos buffer string nrepl-input-start-mark bol))) - -(defun nrepl-emit-prompt (buffer) - "Emit the REPL prompt into BUFFER." - (with-current-buffer buffer - (save-excursion - (nrepl-save-marker nrepl-output-start - (nrepl-save-marker nrepl-output-end - (nrepl-insert-prompt nrepl-buffer-ns)))) - (nrepl-show-maximum-output))) - -(defun nrepl-emit-result (buffer string &optional bol) - "Emit into BUFFER the result STRING and mark it as an evaluation result. -If BOL is non-nil insert at the beginning of the line." - (with-current-buffer buffer - (save-excursion - (nrepl-save-marker nrepl-output-start - (nrepl-save-marker nrepl-output-end - (goto-char nrepl-input-start-mark) - (when (and bol (not (bolp))) (insert-before-markers "\n")) - (nrepl-propertize-region `(face nrepl-result-face - rear-nonsticky (face)) - (insert-before-markers string))))) - (nrepl-show-maximum-output))) - -(defun nrepl-default-handler (response) - "Default handler which is invoked when no handler is found. -Handles message contained in RESPONSE." - (nrepl-dbind-response response (out value) - (cond - (out - (nrepl-emit-interactive-output out))))) - -(defun nrepl-dispatch (response) - "Dispatch the RESPONSE to associated callback." - (nrepl-log-event response) - (nrepl-dbind-response response (id) - (let ((callback (gethash id nrepl-requests))) - (if callback - (funcall callback response) - (nrepl-default-handler response))))) - -(defun nrepl-net-decode () - "Decode the data in the current buffer. -Remove the processed data from the buffer if the decode successful." - (let* ((start (point-min)) - (end (point-max)) - (data (buffer-substring start end))) - (prog1 - (nrepl-decode data) - (delete-region start end)))) - -(defun nrepl-net-process-input (process) - "Handle all complete messages from PROCESS. -Assume that any error during decoding indicates an incomplete message." - (with-current-buffer (process-buffer process) - (let ((nrepl-connection-dispatch (current-buffer))) - (ignore-errors - (while (> (buffer-size) 1) - (let ((responses (nrepl-net-decode))) - (dolist (response responses) - (nrepl-dispatch response)))))))) - -(defun nrepl-net-filter (process string) - "Decode the message(s) from PROCESS contained in STRING and dispatch." - (with-current-buffer (process-buffer process) - (goto-char (point-max)) - (insert string)) - (nrepl-net-process-input process)) - -(defun nrepl-sentinel (process message) - "Handle sentinel events from PROCESS. -Display MESSAGE and if the process is closed kill the -process buffer and run the hook `nrepl-disconnected-hook'." - (message "nrepl connection closed: %s" message) - (if (equal (process-status process) 'closed) - (progn - (with-current-buffer (process-buffer process) - (when (get-buffer nrepl-repl-buffer) - (kill-buffer nrepl-repl-buffer)) - (kill-buffer (current-buffer))) - (run-hooks 'nrepl-disconnected-hook)))) - -(defun nrepl-write-message (process message) - "Send the PROCESS the MESSAGE." - (process-send-string process message)) - -;;; Log nrepl events - -(defcustom nrepl-log-events nil - "Log protocol events to the *nrepl-events* buffer." - :type 'boolean - :group 'nrepl) - -(defconst nrepl-event-buffer-name "*nrepl-events*" - "Event buffer for nREPL message logging.") - -(defconst nrepl-event-buffer-max-size 50000 - "Maximum size for the nREPL event buffer. -Defaults to 50000 characters, which should be an insignificant -memory burdon, while providing reasonable history.") - -(defconst nrepl-event-buffer-reduce-denominator 4 - "Divisor by which to reduce event buffer size. -When the maximum size for the nREPL event buffer is exceed, the -size of the buffer is reduced by one over this value. Defaults -to 4, so that 1/4 of the buffer is removed, which should ensure -the buffer's maximum is reasonably utilised, while limiting the -number of buffer shrinking operations.") - -(defun nrepl-log-event (msg) - "Log the given MSG to the buffer given by `nrepl-event-buffer-name'. -The default buffer name is *nrepl-events*." - (when nrepl-log-events - (with-current-buffer (nrepl-events-buffer) - (when (> (buffer-size) nrepl-event-buffer-max-size) - (goto-char (/ (buffer-size) nrepl-event-buffer-reduce-denominator)) - (re-search-forward "^(" nil t) - (delete-region (point-min) (- (point) 1))) - (goto-char (point-max)) - (pp msg (current-buffer))))) - -(defun nrepl-events-buffer () - "Return or create the buffer given by `nrepl-event-buffer-name'. -The default buffer name is *nrepl-events*." - (or (get-buffer nrepl-event-buffer-name) - (let ((buffer (get-buffer-create nrepl-event-buffer-name))) - (with-current-buffer buffer - (buffer-disable-undo) - (setq-local comment-start ";") - (setq-local comment-end "")) - buffer))) - -(defun nrepl-log-events (&optional disable) - "Turn on event logging to *nrepl-events*. -With a prefix argument DISABLE, turn it off." - (interactive "P") - (setq nrepl-log-events (not disable))) - -;;; REPL interaction -(defun nrepl-property-bounds (prop) - "Return the the positions of the previous and next change to PROP. -PROP is the name of a text property." - (assert (get-text-property (point) prop)) - (let ((end (next-single-char-property-change (point) prop))) - (list (previous-single-char-property-change end prop) end))) - -(defun nrepl-in-input-area-p () - "Return t if in input area." - (<= nrepl-input-start-mark (point))) - -(defun nrepl-current-input (&optional until-point-p) - "Return the current input as string. -The input is the region from after the last prompt to the end of -buffer. If UNTIL-POINT-P is non-nil, the input is until the current -point." - (buffer-substring-no-properties nrepl-input-start-mark - (if until-point-p - (point) - (point-max)))) - -(defun nrepl-previous-prompt () - "Move backward to the previous prompt." - (interactive) - (nrepl-find-prompt t)) - -(defun nrepl-next-prompt () - "Move forward to the next prompt." - (interactive) - (nrepl-find-prompt)) - -(defun nrepl-find-prompt (&optional backward) - "Find the next prompt. -If BACKWARD is non-nil look backward." - (let ((origin (point)) - (prop 'nrepl-prompt)) - (while (progn - (nrepl-search-property-change prop backward) - (not (or (nrepl-end-of-proprange-p prop) (bobp) (eobp))))) - (unless (nrepl-end-of-proprange-p prop) - (goto-char origin)))) - -(defun nrepl-search-property-change (prop &optional backward) - "Search forward for a property change to PROP. -If BACKWARD is non-nil search backward." - (cond (backward - (goto-char (previous-single-char-property-change (point) prop))) - (t - (goto-char (next-single-char-property-change (point) prop))))) - -(defun nrepl-end-of-proprange-p (property) - "Return t if at the the end of a property range for PROPERTY." - (and (get-char-property (max 1 (1- (point))) property) - (not (get-char-property (point) property)))) - -(defun nrepl-mark-input-start () - "Mark the input start." - (set-marker nrepl-input-start-mark (point) (current-buffer))) - -(defun nrepl-mark-output-start () - "Mark the output start." - (set-marker nrepl-output-start (point)) - (set-marker nrepl-output-end (point))) - -(defun nrepl-mark-output-end () - "Marke the output end." - (add-text-properties nrepl-output-start nrepl-output-end - '(face nrepl-output-face - rear-nonsticky (face)))) - -;;; Connections - -;;; A connection is the communication between the nrepl.el client and an nrepl -;;; server. - -(defvar nrepl-connection-dispatch nil - "Bound to the connection a message was received on. -This is bound for the duration of the handling of that message") - -(defvar nrepl-connection-list nil - "A list of connections.") - -(defun nrepl-make-connection-buffer () - "Create an nREPL connection buffer." - (let ((buffer (generate-new-buffer (nrepl-connection-buffer-name)))) - (with-current-buffer buffer - (buffer-disable-undo) - (setq-local kill-buffer-query-functions nil)) - buffer)) - -(defun nrepl-current-connection-buffer () - "The connection to use for nREPL interaction." - (or nrepl-connection-dispatch - nrepl-connection-buffer - (car (nrepl-connection-buffers)))) - -(defun nrepl-connection-buffers () - "Clean up dead buffers from the `nrepl-connection-list'. -Return the connection list." - (nrepl--connection-list-purge) - nrepl-connection-list) - -(defun nrepl--connection-list-purge () - "Clean up dead buffers from the `nrepl-connection-list'." - (setq nrepl-connection-list - (-remove (lambda (buffer) - (not (buffer-live-p (get-buffer buffer)))) - nrepl-connection-list))) - -(defun nrepl-make-repl-connection-default (connection-buffer) - "Make the nREPL CONNECTION-BUFFER the default connection. -Moves CONNECITON-BUFFER to the front of `nrepl-connection-list'." - (interactive (list nrepl-connection-buffer)) - (if connection-buffer - ;; maintain the connection list in most recently used order - (lexical-let ((buf-name (buffer-name (get-buffer connection-buffer)))) - (setq nrepl-connection-list - (cons buf-name (delq buf-name nrepl-connection-list))) - (nrepl--connections-refresh)) - (message "Not in an nREPL REPL buffer."))) - -(defun nrepl--close-connection-buffer (connection-buffer) - "Closes CONNECTION-BUFFER, removing it from `nrepl-connection-list'. -Also closes associated REPL and server buffers." - (let ((nrepl-connection-dispatch connection-buffer)) - (lexical-let ((buffer (get-buffer connection-buffer))) - (setq nrepl-connection-list - (delq (buffer-name buffer) nrepl-connection-list)) - (when (buffer-live-p buffer) - (dolist (buf-name `(,(buffer-local-value 'nrepl-repl-buffer buffer) - ,(buffer-local-value 'nrepl-server-buffer buffer) - ,buffer)) - (when buf-name - (nrepl--close-buffer buf-name))))))) - -(defun nrepl-current-repl-buffer () - "The current nrepl buffer." - (when (nrepl-current-connection-buffer) - (buffer-local-value 'nrepl-repl-buffer - (get-buffer (nrepl-current-connection-buffer))))) - -;;; Connection browser -(defvar nrepl-connections-buffer-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "d" 'nrepl-connections-make-default) - (define-key map "g" 'nrepl-connection-browser) - (define-key map (kbd "C-k") 'nrepl-connections-close-connection) - (define-key map (kbd "RET") 'nrepl-connections-goto-connection) - map)) - -(define-derived-mode nrepl-connections-buffer-mode nrepl-popup-buffer-mode - "nREPL-Connections" - "nREPL Connections Buffer Mode. -\\{nrepl-connections-buffer-mode-map} -\\{nrepl-popup-buffer-mode-map}" - (setq-local truncate-lines t)) - -(defvar nrepl--connection-ewoc) -(defconst nrepl--connection-browser-buffer-name "*nrepl-connections*") - -(defun nrepl-connection-browser () - "Open a browser buffer for nREPL connections." - (interactive) - (lexical-let ((buffer (get-buffer nrepl--connection-browser-buffer-name))) - (if buffer - (progn - (nrepl--connections-refresh-buffer buffer) - (unless (get-buffer-window buffer) - (select-window (display-buffer buffer)))) - (nrepl--setup-connection-browser)))) - -(defun nrepl--connections-refresh () - "Refresh the connections buffer, if the buffer exists. -The connections buffer is determined by -`nrepl--connection-browser-buffer-name'" - (lexical-let ((buffer (get-buffer nrepl--connection-browser-buffer-name))) - (when buffer - (nrepl--connections-refresh-buffer buffer)))) - -(defun nrepl--connections-refresh-buffer (buffer) - "Refresh the connections BUFFER." - (nrepl--update-connections-display - (buffer-local-value 'nrepl--connection-ewoc buffer) - nrepl-connection-list)) - -(defun nrepl--setup-connection-browser () - "Create a browser buffer for nREPL connections." - (with-current-buffer (get-buffer-create nrepl--connection-browser-buffer-name) - (lexical-let ((ewoc (ewoc-create - 'nrepl--connection-pp - " Host Port Project\n"))) - (setq-local nrepl--connection-ewoc ewoc) - (nrepl--update-connections-display ewoc nrepl-connection-list) - (setq buffer-read-only t) - (nrepl-connections-buffer-mode) - (display-buffer (current-buffer))))) - -(defun nrepl--connection-pp (connection) - "Print an nREPL CONNECTION to the current buffer." - (lexical-let* ((buffer-read-only nil) - (buffer (get-buffer connection)) - (endpoint (buffer-local-value 'nrepl-endpoint buffer))) - (insert - (format "%s %-16s %5s %s" - (if (equal connection (car nrepl-connection-list)) "*" " ") - (car endpoint) - (prin1-to-string (cadr endpoint)) - (or (nrepl--project-name - (buffer-local-value 'nrepl-project-dir buffer)) - ""))))) - -(defun nrepl--project-name (path) - "Extracts a project name from PATH, possibly nil. -The project name is the final component of PATH if not nil." - (when path - (file-name-nondirectory (directory-file-name path)))) - -(defun nrepl--update-connections-display (ewoc connections) - "Update the connections EWOC to show CONNECTIONS." - (ewoc-filter ewoc (lambda (n) (member n connections))) - (let ((existing)) - (ewoc-map (lambda (n) (setq existing (cons n existing))) ewoc) - (lexical-let ((added (-difference connections existing))) - (mapc (apply-partially 'ewoc-enter-last ewoc) added) - (save-excursion (ewoc-refresh ewoc))))) - -(defun nrepl--ewoc-apply-at-point (f) - "Apply function F to the ewoc node at point. -F is a function of two arguments, the ewoc and the data at point." - (lexical-let* ((ewoc nrepl--connection-ewoc) - (node (and ewoc (ewoc-locate ewoc)))) - (when node - (funcall f ewoc (ewoc-data node))))) - -(defun nrepl-connections-make-default () - "Make default the connection at point in the connection browser." - (interactive) - (save-excursion - (nrepl--ewoc-apply-at-point #'nrepl--connections-make-default))) - -(defun nrepl--connections-make-default (ewoc data) - "Make the connection in EWOC specified by DATA default. -Refreshes EWOC." - (interactive) - (nrepl-make-repl-connection-default data) - (ewoc-refresh ewoc)) - -(defun nrepl-connections-close-connection () - "Close connection at point in the connection browser." - (interactive) - (nrepl--ewoc-apply-at-point #'nrepl--connections-close-connection)) - -(defun nrepl--connections-close-connection (ewoc data) - "Close the connection in EWOC specified by DATA." - (nrepl-close (get-buffer data)) - (nrepl--update-connections-display ewoc nrepl-connection-list)) - -(defun nrepl-connections-goto-connection () - "Goto connection at point in the connection browser." - (interactive) - (nrepl--ewoc-apply-at-point #'nrepl--connections-goto-connection)) - -(defun nrepl--connections-goto-connection (ewoc data) - "Goto the REPL for the connection in EWOC specified by DATA." - (let ((buffer (buffer-local-value 'nrepl-repl-buffer (get-buffer data)))) - (when buffer - (select-window (display-buffer buffer))))) - -(defun nrepl--clojure-version () - "Retrieve the underlying connection's Clojure version." - (let ((version-string (plist-get (nrepl-send-string-sync "(clojure-version)") :value))) - (substring version-string 1 (1- (length version-string))))) - -(defun nrepl--backend-version () - "Retrieve the underlying connection's nREPL version." - (let ((version-string (plist-get (nrepl-send-string-sync "(:version-string clojure.tools.nrepl/version)") :value))) - (substring version-string 1 (1- (length version-string))))) - -(defun nrepl--connection-info (nrepl-connection-buffer) - "Return info about NREPL-CONNECTION-BUFFER. - -Info contains project name, current REPL namespace, host:port endpoint and Clojure version." - (with-current-buffer (get-buffer nrepl-connection-buffer) - (format "Active nrepl connection: %s:%s, %s:%s (Clojure %s, nREPL %s)" - (or (nrepl--project-name nrepl-project-dir) "") - nrepl-buffer-ns - (car nrepl-endpoint) - (cadr nrepl-endpoint) - (nrepl--clojure-version) - (nrepl--backend-version)))) - -(defun nrepl-display-current-connection-info () - "Display information about the current connection." - (interactive) - (message (nrepl--connection-info (nrepl-current-connection-buffer)))) - -(defun nrepl-rotate-connection () - "Rotate and display the current nrepl connection." - (interactive) - (setq nrepl-connection-list - (append (cdr nrepl-connection-list) - (list (car nrepl-connection-list)))) - (message (nrepl--connection-info (car nrepl-connection-list)))) - -;;; server messages - -(defun nrepl-current-session () - "Return the current session." - (with-current-buffer (nrepl-current-connection-buffer) - nrepl-session)) - -(defun nrepl-current-tooling-session () - "Return the current tooling session." - (with-current-buffer (nrepl-current-connection-buffer) - nrepl-tooling-session)) - -(defun nrepl-next-request-id () - "Return the next request id." - (with-current-buffer (nrepl-current-connection-buffer) - (number-to-string (incf nrepl-request-counter)))) - -(defun nrepl-send-request (request callback) - "Send REQUEST and register response handler CALLBACK." - (let* ((request-id (nrepl-next-request-id)) - (request (append (list "id" request-id) request)) - (message (nrepl-bencode request))) - (nrepl-log-event request) - (puthash request-id callback nrepl-requests) - (nrepl-write-message (nrepl-current-connection-buffer) message))) - -(defun nrepl-create-client-session (callback) - "Sent a request to create a new client session. -Response will be handled by CALLBACK." - (nrepl-send-request '("op" "clone") - callback)) - -(defun nrepl-send-stdin (input callback) - "Send a stdin message with INPUT. -Register CALLBACK as the response handler." - (nrepl-send-request (list "op" "stdin" - "stdin" input - "session" (nrepl-current-session)) - callback)) - -(defun nrepl-send-interrupt (pending-request-id callback) - "Send an interrupt message for PENDING-REQUEST-ID. -Register CALLBACK as the response handler." - (nrepl-send-request (list "op" "interrupt" - "session" (nrepl-current-session) - "interrupt-id" pending-request-id) - callback)) - -(defun nrepl-eval-request (input &optional ns session) - "Send a request to eval INPUT. -If NS is non-nil, include it in the request. -Use SESSION if it is non-nil, otherwise use the current session." - (append (if ns (list "ns" ns)) - (list - "op" "eval" - "session" (or session (nrepl-current-session)) - "code" input))) - -(defun nrepl-send-string (input callback &optional ns session) - "Send the request INPUT and register the CALLBACK as the response handler. -See command `nrepl-eval-request' for details on how NS and SESSION are processed." - (let ((ns (if (string-match "[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" input) - "user" - ns))) - (nrepl-send-request (nrepl-eval-request input ns session) callback))) - -(defun nrepl-sync-request-handler (buffer) - "Make a synchronous request handler for BUFFER." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (setq nrepl-sync-response - (plist-put nrepl-sync-response :value value))) - (lambda (buffer out) - (let ((so-far (plist-get nrepl-sync-response :stdout))) - (setq nrepl-sync-response - (plist-put nrepl-sync-response - :stdout (concat so-far out))))) - (lambda (buffer err) - (let ((so-far (plist-get nrepl-sync-response :stderr))) - (setq nrepl-sync-response - (plist-put nrepl-sync-response - :stderr (concat so-far err))))) - (lambda (buffer) - (setq nrepl-sync-response - (plist-put nrepl-sync-response :done t))))) - -(defun nrepl-send-request-sync (request) - "Send REQUEST to the backend synchronously (discouraged). -The result is a plist with keys :value, :stderr and :stdout." - (with-current-buffer (nrepl-current-connection-buffer) - (setq nrepl-sync-response nil) - (nrepl-send-request request (nrepl-sync-request-handler (current-buffer))) - (while (or (null nrepl-sync-response) - (null (plist-get nrepl-sync-response :done))) - (accept-process-output nil 0.005)) - nrepl-sync-response)) - -(defun nrepl-send-string-sync (input &optional ns session) - "Send the INPUT to the backend synchronously. -See command `nrepl-eval-request' for details about how NS and SESSION -are processed." - (nrepl-send-request-sync (nrepl-eval-request input ns session))) - -(defalias 'nrepl-eval 'nrepl-send-string-sync) -(defalias 'nrepl-eval-async 'nrepl-send-string) - -(defun nrepl-send-input (&optional newline) - "Go to the end of the input and send the current input. -If NEWLINE is true then add a newline at the end of the input." - (unless (nrepl-in-input-area-p) - (error "No input at point")) - (goto-char (point-max)) - (let ((end (point))) ; end of input, without the newline - (nrepl-add-to-input-history (buffer-substring nrepl-input-start-mark end)) - (when newline - (insert "\n") - (nrepl-show-maximum-output)) - (let ((inhibit-modification-hooks t)) - (add-text-properties nrepl-input-start-mark - (point) - `(nrepl-old-input - ,(incf nrepl-old-input-counter)))) - (let ((overlay (make-overlay nrepl-input-start-mark end))) - ;; These properties are on an overlay so that they won't be taken - ;; by kill/yank. - (overlay-put overlay 'read-only t) - (overlay-put overlay 'face 'nrepl-input-face))) - (let* ((input (nrepl-current-input)) - (form (if (and (not (string-match "\\`[ \t\r\n]*\\'" input)) nrepl-use-pretty-printing) - (format "(clojure.pprint/pprint %s)" input) input))) - (goto-char (point-max)) - (nrepl-mark-input-start) - (nrepl-mark-output-start) - (nrepl-send-string form (nrepl-handler (current-buffer)) nrepl-buffer-ns))) - -(defun nrepl-newline-and-indent () - "Insert a newline, then indent the next line. -Restrict the buffer from the prompt for indentation, to avoid being -confused by strange characters (like unmatched quotes) appearing -earlier in the buffer." - (interactive) - (save-restriction - (narrow-to-region nrepl-prompt-start-mark (point-max)) - (insert "\n") - (lisp-indent-line))) - -(defun nrepl-indent-and-complete-symbol () - "Indent the current line and perform symbol completion. -First indent the line. If indenting doesn't move point, complete -the symbol." - (interactive) - (let ((pos (point))) - (lisp-indent-line) - (when (= pos (point)) - (if (save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t)) - (completion-at-point))))) - -(defun nrepl-kill-input () - "Kill all text from the prompt to point." - (interactive) - (cond ((< (marker-position nrepl-input-start-mark) (point)) - (kill-region nrepl-input-start-mark (point))) - ((= (point) (marker-position nrepl-input-start-mark)) - (nrepl-delete-current-input)))) - -(defun nrepl-input-complete-p (start end) - "Return t if the region from START to END is a complete sexp." - (save-excursion - (goto-char start) - (cond ((looking-at "\\s *[@'`#]?[(\"]") - (ignore-errors - (save-restriction - (narrow-to-region start end) - ;; Keep stepping over blanks and sexps until the end of - ;; buffer is reached or an error occurs. Tolerate extra - ;; close parens. - (loop do (skip-chars-forward " \t\r\n)") - until (eobp) - do (forward-sexp)) - t))) - (t t)))) - -(defun nrepl-return (&optional end-of-input) - "Evaluate the current input string, or insert a newline. -Send the current input ony if a whole expression has been entered, -i.e. the parenthesis are matched. -When END-OF-INPUT is non-nil, send the input even if the parentheses -are not balanced." - (interactive "P") - (cond - (end-of-input - (nrepl-send-input)) - ((and (get-text-property (point) 'nrepl-old-input) - (< (point) nrepl-input-start-mark)) - (nrepl-grab-old-input end-of-input) - (nrepl-recenter-if-needed)) - ((nrepl-input-complete-p nrepl-input-start-mark (point-max)) - (nrepl-send-input t)) - (t - (nrepl-newline-and-indent) - (message "[input not complete]")))) - -(defun nrepl-recenter-if-needed () - "Make sure that the point is visible." - (unless (pos-visible-in-window-p (point-max)) - (save-excursion - (goto-char (point-max)) - (recenter -1)))) - -(defun nrepl-grab-old-input (replace) - "Resend the old REPL input at point. -If REPLACE is non-nil the current input is replaced with the old -input; otherwise the new input is appended. The old input has the -text property `nrepl-old-input'." - (multiple-value-bind (beg end) (nrepl-property-bounds 'nrepl-old-input) - (let ((old-input (buffer-substring beg end)) ;;preserve - ;;properties, they will be removed later - (offset (- (point) beg))) - ;; Append the old input or replace the current input - (cond (replace (goto-char nrepl-input-start-mark)) - (t (goto-char (point-max)) - (unless (eq (char-before) ?\ ) - (insert " ")))) - (delete-region (point) (point-max)) - (save-excursion - (insert old-input) - (when (equal (char-before) ?\n) - (delete-char -1))) - (forward-char offset)))) - -(defun nrepl-closing-return () - "Evaluate the current input string after closing all open lists." - (interactive) - (goto-char (point-max)) - (save-restriction - (narrow-to-region nrepl-input-start-mark (point)) - (while (ignore-errors (save-excursion (backward-up-list 1)) t) - (insert ")"))) - (nrepl-return)) - -(defun nrepl-toggle-pretty-printing () - "Toggle pretty-printing in the REPL." - (interactive) - (setq nrepl-use-pretty-printing (not nrepl-use-pretty-printing)) - (message "Pretty printing in nREPL %s." - (if nrepl-use-pretty-printing "enabled" "disabled"))) - -(defvar nrepl-clear-buffer-hook) - -(defun nrepl-clear-buffer () - "Delete the output generated by the Clojure process." - (interactive) - (let ((inhibit-read-only t)) - (delete-region (point-min) nrepl-prompt-start-mark) - (delete-region nrepl-output-start nrepl-output-end) - (when (< (point) nrepl-input-start-mark) - (goto-char nrepl-input-start-mark)) - (recenter t)) - (run-hooks 'nrepl-clear-buffer-hook)) - -(defun nrepl-find-and-clear-repl-buffer () - "Find the current REPL buffer and clear it. -Returns to the buffer in which the command was invoked." - (interactive) - (let ((origin-buffer (current-buffer))) - (switch-to-buffer (nrepl-current-repl-buffer)) - (nrepl-clear-buffer) - (switch-to-buffer origin-buffer))) - -(defun nrepl-input-line-beginning-position () - "Return the position of the beginning of input." - (save-excursion - (goto-char nrepl-input-start-mark) - (line-beginning-position))) - -(defun nrepl-clear-output () - "Delete the output inserted since the last input." - (interactive) - (let ((start (save-excursion - (nrepl-previous-prompt) - (ignore-errors (forward-sexp)) - (forward-line) - (point))) - (end (1- (nrepl-input-line-beginning-position)))) - (when (< start end) - (let ((inhibit-read-only t)) - (delete-region start end) - (save-excursion - (goto-char start) - (insert - (propertize ";;; output cleared" 'face 'font-lock-comment-face))))))) - -(defun nrepl-find-ns () - "Return the ns specified in the buffer, or \"user\" if no ns declaration is found." - (or (save-restriction - (widen) - (clojure-find-ns)) - "user")) - -(defun nrepl-current-ns () - "Return the ns in the current context. -If `nrepl-buffer-ns' has a value then return that, otherwise -search for and read a `ns' form." - (let ((ns nrepl-buffer-ns)) - (or (and (string= ns "user") - (nrepl-find-ns)) - ns))) - -;;; Words of inspiration -(defun nrepl-user-first-name () - "Find the current user's first name." - (let ((name (if (string= (user-full-name) "") - (user-login-name) - (user-full-name)))) - (string-match "^[^ ]*" name) - (capitalize (match-string 0 name)))) - -(defvar nrepl-words-of-inspiration - `("The best way to predict the future is to invent it. -Alan Kay" - "A point of view is worth 80 IQ points. -Alan Kay" - "Lisp isn't a language, it's a building material. -Alan Kay" - "Simple things should be simple, complex things should be possible. -Alan Kay" - "Measuring programming progress by lines of code is like measuring aircraft building progress by weight. -Bill Gates" - "Controlling complexity is the essence of computer programming. -Brian Kernighan" - "The unavoidable price of reliability is simplicity. -C.A.R. Hoare" - "You're bound to be unhappy if you optimize everything. -Donald Knuth" - "Simplicity is prerequisite for reliability. -Edsger W. Dijkstra" - "Deleted code is debugged code. -Jeff Sickel" - "The key to performance is elegance, not battalions of special cases. -Jon Bentley and Doug McIlroy" - "First, solve the problem. Then, write the code. -John Johnson" - "Simplicity is the ultimate sophistication. -Leonardo da Vinci" - "Programming is not about typing... it's about thinking. -Rich Hickey" - "Design is about pulling things apart. -Rich Hickey" - "Programmers know the benefits of everything and the tradeoffs of nothing. -Rich Hickey" - "Code never lies, comments sometimes do. -Ron Jeffries" - "Take this nREPL, brother, and may it serve you well." - "Let the hacking commence!" - "Hacks and glory await!" - "Hack and be merry!" - "Your hacking starts... NOW!" - "May the Source be with you!" - "May the Source shine upon thy nREPL!" - "Code long and prosper!" - "Happy hacking!" - ,(format "%s, this could be the start of a beautiful program." - (nrepl-user-first-name))) - "Scientifically-proven optimal words of hackerish encouragement.") - -(defun nrepl-random-words-of-inspiration () - "Select a random entry from `nrepl-words-of-inspiration'." - (eval (nth (random (length nrepl-words-of-inspiration)) - nrepl-words-of-inspiration))) - -(defun nrepl--banner () - "Generate the welcome REPL buffer banner." - (format "; nrepl.el %s (Clojure %s, nREPL %s)" - (nrepl-version) - (nrepl--clojure-version) - (nrepl--backend-version))) - -(defun nrepl-insert-banner-and-prompt (ns) - "Insert REPL banner and REPL prompt, taking into account NS." - (when (zerop (buffer-size)) - (insert (propertize (nrepl--banner) 'face 'font-lock-comment-face))) - (goto-char (point-max)) - (nrepl-mark-output-start) - (nrepl-mark-input-start) - (nrepl-insert-prompt ns)) - -(make-variable-buffer-local - (defvar nrepl-last-clojure-buffer nil - "A buffer-local variable holding the last Clojure source buffer. -`nrepl-switch-to-last-clojure-buffer' uses this variable to jump -back to last Clojure source buffer.")) - -(defvar nrepl-current-clojure-buffer nil - "This variable holds current buffer temporarily when connecting to a REPL. -It is set to current buffer when `nrepl' or `nrepl-jack-in' is called. -After the REPL buffer is created, the value of this variable is used -to call `nrepl-remember-clojure-buffer'.") - -(defun nrepl-remember-clojure-buffer (buffer) - "Try to remember the BUFFER from which the user jumps. -The BUFFER needs to be a Clojure buffer and current major mode needs -to be `nrepl-repl-mode'. The user can use `nrepl-switch-to-last-clojure-buffer' -to jump back to the last Clojure source buffer." - (when (and buffer - (eq 'clojure-mode (with-current-buffer buffer major-mode)) - (eq 'nrepl-repl-mode major-mode)) - (setq nrepl-last-clojure-buffer buffer))) - -(defun nrepl-init-repl-buffer (connection buffer &optional noprompt) - "Initialize the REPL for CONNECTION in BUFFER. -Insert a banner, unless NOPROMPT is non-nil." - (with-current-buffer buffer - (unless (eq major-mode 'nrepl-repl-mode) - (nrepl-repl-mode)) - ;; use the same requires by default as clojure.main does - (nrepl-send-string-sync nrepl-repl-requires-sexp) - (nrepl-reset-markers) - (unless noprompt - (nrepl-insert-banner-and-prompt nrepl-buffer-ns)) - (nrepl-remember-clojure-buffer nrepl-current-clojure-buffer) - (current-buffer))) - -(defun nrepl-find-or-create-repl-buffer () - "Return the REPL buffer, create it if necessary." - (let ((buffer (nrepl-current-repl-buffer))) - (if (null buffer) - (error "No active nREPL connection") - (let ((buffer (get-buffer buffer))) - (or (when (buffer-live-p buffer) buffer) - (let ((buffer (nrepl-current-connection-buffer))) - (if (null buffer) - (error "No active nREPL connection") - (nrepl-init-repl-buffer - (get-process buffer) - (get-buffer-create - (nrepl-repl-buffer-name)))))))))) - -(defun nrepl-switch-to-repl-buffer (arg) - "Select the REPL buffer, when possible in an existing window. - -Hint: You can use `display-buffer-reuse-frames' and -`special-display-buffer-names' to customize the frame in which -the buffer should appear. - -With a prefix ARG sets the name of the REPL buffer to the one -of the current source file." - (interactive "P") - (if (not (get-buffer (nrepl-current-connection-buffer))) - (message "No active nREPL connection.") - (progn - (let ((buffer (current-buffer))) - (when arg - (nrepl-set-ns (nrepl-current-ns))) - (pop-to-buffer (nrepl-find-or-create-repl-buffer)) - (nrepl-remember-clojure-buffer buffer) - (goto-char (point-max)))))) - -(defun nrepl-switch-to-relevant-repl-buffer (arg) - "Select the REPL buffer, when possible in an existing window. -The buffer chosen is based on the file open in the current buffer. - -Hint: You can use `display-buffer-reuse-frames' and -`special-display-buffer-names' to customize the frame in which -the buffer should appear. - -With a prefix ARG sets the name of the REPL buffer to the one -of the current source file. - -With a second prefix ARG the chosen REPL buffer is based on a -supplied project directory." - (interactive "P") - (if (not (get-buffer (nrepl-current-connection-buffer))) - (message "No active nREPL connection.") - (progn - (let ((project-directory - (or (when arg - (ido-read-directory-name "Project: ")) - (nrepl-project-directory-for (nrepl-current-dir))))) - (if project-directory - (let ((buf (car (-filter - (lambda (conn) - (let ((conn-proj-dir (with-current-buffer (get-buffer conn) - nrepl-project-dir))) - (when conn-proj-dir - (equal (file-truename project-directory) - (file-truename conn-proj-dir))))) - nrepl-connection-list)))) - (if buf - (setq nrepl-connection-list - (cons buf (delq buf nrepl-connection-list))) - (message "No relevant nREPL connection found. Switching to default connection."))) - (message "No project directory found. Switching to default nREPL connection."))) - (nrepl-switch-to-repl-buffer '())))) - -(defun nrepl-switch-to-last-clojure-buffer () - "Switch to the last Clojure buffer. -The default keybinding for this command is -the same as `nrepl-switch-to-repl-buffer', -so that it is very convenient to jump between a -Clojure buffer and the REPL buffer." - (interactive) - (if (and (eq 'nrepl-repl-mode major-mode) - (buffer-live-p nrepl-last-clojure-buffer)) - (pop-to-buffer nrepl-last-clojure-buffer) - (message "Don't know the original Clojure buffer"))) - -(defun nrepl-set-ns (ns) - "Switch the namespace of the REPL buffer to NS." - (interactive (list (nrepl-current-ns))) - (if ns - (with-current-buffer (nrepl-current-repl-buffer) - (nrepl-send-string - (format "(in-ns '%s)" ns) (nrepl-handler (current-buffer)))) - (message "Sorry, I don't know what the current namespace is."))) - -(defun nrepl-symbol-at-point () - "Return the name of the symbol at point, otherwise nil." - (let ((str (thing-at-point 'symbol))) - (and str - (not (equal str (concat (nrepl-find-ns) "> "))) - (not (equal str "")) - (substring-no-properties str)))) - -;; this is horrible, but with async callbacks we can't rely on dynamic scope -(defvar nrepl-ido-ns nil) - -(defun nrepl-ido-form (ns) - "Construct a Clojure form for ido read using NS." - `(concat (if (find-ns (symbol ,ns)) - (map name (concat (keys (ns-interns (symbol ,ns))) - (keys (ns-refers (symbol ,ns)))))) - (if (not= "" ,ns) [".."]) - (->> (all-ns) - (map (fn [n] - (re-find (re-pattern (str "^" (if (not= ,ns "") - (str ,ns "\\.")) - "[^\\.]+")) - (str n)))) - (filter identity) - (map (fn [n] (str n "/"))) - (into (hash-set))))) - -(defun nrepl-ido-up-ns (ns) - "Perform up using NS." - (mapconcat 'identity (butlast (split-string ns "\\.")) ".")) - -(defun nrepl-ido-select (selected targets callback) - "Peform ido select using SELECTED, TARGETS and CALLBACK." - ;; TODO: immediate RET gives "" as selected for some reason - ;; this is an OK workaround though - (cond ((equal "" selected) - (nrepl-ido-select (car targets) targets callback)) - ((equal "/" (substring selected -1)) ; selected a namespace - (nrepl-ido-read-var (substring selected 0 -1) callback)) - ((equal ".." selected) - (nrepl-ido-read-var (nrepl-ido-up-ns nrepl-ido-ns) callback)) - ;; non ido variable selection techniques don't return qualified symbols, so this shouldn't either - (t (funcall callback selected)))) - -(defun nrepl-ido-read-var-handler (ido-callback buffer) - "Create an ido read var handler with IDO-CALLBACK for BUFFER." - (lexical-let ((ido-callback ido-callback)) - (nrepl-make-response-handler buffer - (lambda (buffer value) - ;; make sure to eval the callback in the buffer that the symbol was requested from so we get the right namespace - (with-current-buffer buffer - (let* ((targets (car (read-from-string value))) - (selected (ido-completing-read "Var: " targets nil t))) - (nrepl-ido-select selected targets ido-callback)))) - nil nil nil))) - -(defun nrepl-ido-read-var (ns ido-callback) - "Perform ido read var in NS using IDO-CALLBACK." - ;; Have to be stateful =( - (setq nrepl-ido-ns ns) - (nrepl-send-string (prin1-to-string (nrepl-ido-form nrepl-ido-ns)) - (nrepl-ido-read-var-handler ido-callback (current-buffer)) - nrepl-buffer-ns - (nrepl-current-tooling-session))) - -(defun nrepl-read-symbol-name (prompt callback &optional query) - "Either read a symbol name using PROMPT or choose the one at point. -Use CALLBACK as the ido read var callback. -The user is prompted with PROMPT if a prefix argument is in effect, -if there is no symbol at point, or if QUERY is non-nil." - (let ((symbol-name (nrepl-symbol-at-point))) - (cond ((not (or current-prefix-arg query (not symbol-name))) - (funcall callback symbol-name)) - (ido-mode (nrepl-ido-read-var nrepl-buffer-ns callback)) - (t (funcall callback (read-from-minibuffer prompt symbol-name)))))) - -(defun nrepl-doc-handler (symbol) - "Create a handler to lookup documentation for SYMBOL." - (let ((form (format "(clojure.repl/doc %s)" symbol)) - (doc-buffer (nrepl-popup-buffer nrepl-doc-buffer t))) - (nrepl-send-string form - (nrepl-popup-eval-out-handler doc-buffer) - nrepl-buffer-ns - (nrepl-current-tooling-session)))) - -(defun nrepl-doc (query) - "Open a window with the docstring for the given QUERY. -Defaults to the symbol at point. With prefix arg or no symbol -under point, prompts for a var." - (interactive "P") - (nrepl-read-symbol-name "Symbol: " 'nrepl-doc-handler query)) - -(defun nrepl-src-handler (symbol) - "Create a handler to lookup source for SYMBOL." - (let ((form (format "(clojure.repl/source %s)" symbol)) - (src-buffer (nrepl-popup-buffer nrepl-src-buffer t))) - (with-current-buffer src-buffer - (clojure-mode) - (nrepl-popup-buffer-mode +1)) - (nrepl-send-string form - (nrepl-popup-eval-out-handler src-buffer) - nrepl-buffer-ns - (nrepl-current-tooling-session)))) - -(defun nrepl-src (query) - "Open a window with the source for the given QUERY. -Defaults to the symbol at point. With prefix arg or no symbol -under point, prompts for a var." - (interactive "P") - (nrepl-read-symbol-name "Symbol: " 'nrepl-src-handler query)) - -;; TODO: implement reloading ns -(defun nrepl-eval-load-file (form) - "Load FORM." - (let ((buffer (current-buffer))) - (nrepl-send-string form (nrepl-interactive-eval-handler buffer)))) - -(defun nrepl-file-string (file) - "Read the contents of a FILE and return as a string." - (with-current-buffer (find-file-noselect file) - (buffer-string))) - -(defun nrepl-load-file-op (filename) - "Send \"load-file\" op for FILENAME." - (nrepl-send-load-file (nrepl-file-string filename) - filename - (file-name-nondirectory filename))) - -(defun nrepl-load-file-core (filename) - "Load the Clojure file FILENAME." - (let ((fn (replace-regexp-in-string - "\\\\" "\\\\\\\\" - (convert-standard-filename (expand-file-name filename))))) - (nrepl-eval-load-file - (format "(clojure.core/load-file \"%s\")\n(in-ns '%s)\n" - fn (nrepl-find-ns))))) - -(defun nrepl-dispatch-load-file (filename) - "Dispatch the load file operation for FILENAME." - (if (nrepl-op-supported-p "load-file") - (nrepl-load-file-op filename) - (nrepl-load-file-core filename))) - -(defun nrepl-load-file (filename) - "Load the Clojure file FILENAME." - (interactive (list - (read-file-name "Load file: " nil nil - nil (if (buffer-file-name) - (file-name-nondirectory - (buffer-file-name)))))) - (remove-overlays (point-min) (point-max) 'nrepl-note-p t) - (nrepl-dispatch-load-file filename) - (message "Loading %s..." filename)) - -(defun nrepl-load-current-buffer () - "Load current buffer's file." - (interactive) - (check-parens) - (unless buffer-file-name - (error "Buffer %s is not associated with a file" (buffer-name))) - (when (and (buffer-modified-p) - (y-or-n-p (format "Save file %s? " (buffer-file-name)))) - (save-buffer)) - (nrepl-load-file (buffer-file-name))) - -;;; selector -(defvar nrepl-selector-methods nil - "List of buffer-selection methods for the `nrepl-select' command. -Each element is a list (KEY DESCRIPTION FUNCTION). -DESCRIPTION is a one-line description of what the key selects.") - -(defvar nrepl-selector-other-window nil - "If non-nil use `switch-to-buffer-other-window'.") - -(defun nrepl-selector (&optional other-window) - "Select a new buffer by type, indicated by a single character. -The user is prompted for a single character indicating the method by -which to choose a new buffer. The `?' character describes then -available methods. OTHER-WINDOW provides an optional target. - -See `def-nrepl-selector-method' for defining new methods." - (interactive) - (message "Select [%s]: " - (apply #'string (mapcar #'car nrepl-selector-methods))) - (let* ((nrepl-selector-other-window other-window) - (ch (save-window-excursion - (select-window (minibuffer-window)) - (read-char))) - (method (cl-find ch nrepl-selector-methods :key #'car))) - (cond (method - (funcall (cl-caddr method))) - (t - (message "No method for character: ?\\%c" ch) - (ding) - (sleep-for 1) - (discard-input) - (nrepl-selector))))) - -(defmacro def-nrepl-selector-method (key description &rest body) - "Define a new `nrepl-select' buffer selection method. - -KEY is the key the user will enter to choose this method. - -DESCRIPTION is a one-line sentence describing how the method -selects a buffer. - -BODY is a series of forms which are evaluated when the selector -is chosen. The returned buffer is selected with -`switch-to-buffer'." - (let ((method `(lambda () - (let ((buffer (progn ,@body))) - (cond ((not (get-buffer buffer)) - (message "No such buffer: %S" buffer) - (ding)) - ((get-buffer-window buffer) - (select-window (get-buffer-window buffer))) - (nrepl-selector-other-window - (switch-to-buffer-other-window buffer)) - (t - (switch-to-buffer buffer))))))) - `(setq nrepl-selector-methods - (cl-sort (cons (list ,key ,description ,method) - (cl-remove ,key nrepl-selector-methods :key #'car)) - #'< :key #'car)))) - -(def-nrepl-selector-method ?? "Selector help buffer." - (ignore-errors (kill-buffer "*Select Help*")) - (with-current-buffer (get-buffer-create "*Select Help*") - (insert "Select Methods:\n\n") - (loop for (key line nil) in nrepl-selector-methods - do (insert (format "%c:\t%s\n" key line))) - (goto-char (point-min)) - (help-mode) - (display-buffer (current-buffer) t)) - (nrepl-selector) - (current-buffer)) - -(pushnew (list ?4 "Select in other window" (lambda () (nrepl-selector t))) - nrepl-selector-methods :key #'car) - -(def-nrepl-selector-method ?q "Abort." - (top-level)) - -(def-nrepl-selector-method ?r - "Current *nrepl* buffer." - (nrepl-find-or-create-repl-buffer)) - -(def-nrepl-selector-method ?n - "NREPL connections buffer." - (nrepl-connection-browser) - nrepl--connection-browser-buffer-name) - -(def-nrepl-selector-method ?v - "*nrepl-events* buffer." - nrepl-event-buffer-name) - -;; TBD -- -;;(def-nrepl-selector-method ?s -;; "Cycle to the next Clojure connection." -;; (nrepl-cycle-connections) -;; (concat "*nrepl " -;; (nrepl-connection-name (nrepl-current-connection)) -;; "*")) - -(defun nrepl-recently-visited-buffer (mode) - "Return the most recently visited buffer whose `major-mode' is MODE. -Only considers buffers that are not already visible." - (loop for buffer in (buffer-list) - when (and (with-current-buffer buffer (eq major-mode mode)) - (not (string-match "^ " (buffer-name buffer))) - (null (get-buffer-window buffer 'visible))) - return buffer - finally (error "Can't find unshown buffer in %S" mode))) - -(def-nrepl-selector-method ?c - "most recently visited clojure-mode buffer." - (nrepl-recently-visited-buffer 'clojure-mode)) - -(def-nrepl-selector-method ?e - "most recently visited emacs-lisp-mode buffer." - (nrepl-recently-visited-buffer 'emacs-lisp-mode)) - -;;; interrupt -(defun nrepl-interrupt-handler (buffer) - "Create an interrupt response handler for BUFFER." - (nrepl-make-response-handler buffer nil nil nil nil)) - -(defun nrepl-hash-keys (hashtable) - "Return a list of keys in HASHTABLE." - (let ((keys '())) - (maphash (lambda (k v) (setq keys (cons k keys))) hashtable) - keys)) - -(defun nrepl-interrupt () - "Interrupt any pending evaluations." - (interactive) - (let ((pending-request-ids (nrepl-hash-keys nrepl-requests))) - (dolist (request-id pending-request-ids) - (nrepl-send-interrupt request-id (nrepl-interrupt-handler (current-buffer)))))) - -;;; server -(defun nrepl-server-filter (process output) - "Process nREPL server output from PROCESS contained in OUTPUT." - (with-current-buffer (process-buffer process) - (save-excursion - (goto-char (point-max)) - (insert output))) - (when (string-match "nREPL server started on port \\([0-9]+\\)" output) - (let ((port (string-to-number (match-string 1 output)))) - (message (format "nREPL server started on %s" port)) - (with-current-buffer (process-buffer process) - (let ((nrepl-process (nrepl-connect "localhost" port))) - (setq nrepl-connection-buffer - (buffer-name (process-buffer nrepl-process))) - (with-current-buffer (process-buffer nrepl-process) - (setq nrepl-server-buffer - (buffer-name (process-buffer process)) - nrepl-project-dir - (buffer-local-value - 'nrepl-project-dir (process-buffer process))))))))) - -(defun nrepl-server-sentinel (process event) - "Handle nREPL server PROCESS EVENT." - (let* ((b (process-buffer process)) - (connection-buffer (buffer-local-value 'nrepl-connection-buffer b)) - (problem (if (and b (buffer-live-p b)) - (with-current-buffer b - (buffer-substring (point-min) (point-max))) - ""))) - (when b - (kill-buffer b)) - (cond - ((string-match "^killed" event) - nil) - ((string-match "^hangup" event) - (when connection-buffer - (nrepl-close connection-buffer))) - ((string-match "Wrong number of arguments to repl task" problem) - (error "Leiningen 2.x is required by nREPL.el")) - (t (error "Could not start nREPL server: %s" problem))))) - -;;;###autoload -(defun nrepl-enable-on-existing-clojure-buffers () - "Enable interaction mode on existing Clojure buffers. -See command `nrepl-interaction-mode'." - (interactive) - (add-hook 'clojure-mode-hook 'clojure-enable-nrepl) - (save-window-excursion - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (eq major-mode 'clojure-mode) - (clojure-enable-nrepl)))))) - -;;;###autoload -(defun nrepl-disable-on-existing-clojure-buffers () - "Disable interaction mode on existing Clojure buffers. -See command `nrepl-interaction-mode'." - (interactive) - (save-window-excursion - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (eq major-mode 'clojure-mode) - (setq nrepl-buffer-ns "user") - (clojure-disable-nrepl)))))) - -(defun nrepl-possibly-disable-on-existing-clojure-buffers () - "If not connected, disable nrepl interaction mode on existing Clojure buffers." - (when (not (nrepl-current-connection-buffer)) - (nrepl-disable-on-existing-clojure-buffers))) - -;;;###autoload -(defun nrepl-jack-in (&optional prompt-project) - "Start a nREPL server for the current project and connect to it. -If PROMPT-PROJECT is t, then prompt for the project for which to -start the server." - (interactive "P") - (setq nrepl-current-clojure-buffer (current-buffer)) - (lexical-let* ((project (when prompt-project - (ido-read-directory-name "Project: "))) - (project-dir (nrepl-project-directory-for - (or project (nrepl-current-dir))))) - (when (nrepl-check-for-repl-buffer nil project-dir) - (let* ((nrepl-project-dir project-dir) - (cmd (if project - (format "cd %s && %s" project nrepl-server-command) - nrepl-server-command)) - (process (start-process-shell-command - "nrepl-server" - (generate-new-buffer-name (nrepl-server-buffer-name)) - cmd))) - (set-process-filter process 'nrepl-server-filter) - (set-process-sentinel process 'nrepl-server-sentinel) - (set-process-coding-system process 'utf-8-unix 'utf-8-unix) - (with-current-buffer (process-buffer process) - (setq nrepl-project-dir project-dir)) - (message "Starting nREPL server..."))))) - -(defun nrepl-current-dir () - "Return the directory of the current buffer." - (lexical-let ((file-name (buffer-file-name (current-buffer)))) - (or (when file-name - (file-name-directory file-name)) - list-buffers-directory))) - -(defun nrepl-project-directory-for (dir-name) - "Return the project directory for the specified DIR-NAME." - (when dir-name - (locate-dominating-file dir-name "project.clj"))) - -(defun nrepl-check-for-repl-buffer (endpoint project-directory) - "Check whether a matching connection buffer already exists. -Looks for buffers where `nrepl-endpoint' matches ENDPOINT, -or `nrepl-project-dir' matches PROJECT-DIRECTORY. -If so ask the user for confirmation." - (if (cl-find-if - (lambda (buffer) - (lexical-let ((buffer (get-buffer buffer))) - (or (and endpoint - (equal endpoint - (buffer-local-value 'nrepl-endpoint buffer))) - (and project-directory - (equal project-directory - (buffer-local-value 'nrepl-project-dir buffer)))))) - (nrepl-connection-buffers)) - (y-or-n-p - "An nREPL buffer already exists. Do you really want to create a new one? ") - t)) - -(defun nrepl--close-buffer (buffer) - "Close the nrepl BUFFER." - (when (get-buffer-process buffer) - (delete-process (get-buffer-process buffer))) - (when (get-buffer buffer) - (kill-buffer buffer))) - -(defun nrepl-close-ancilliary-buffers () - "Close buffers that are shared across connections." - (interactive) - (dolist (buf-name `(,nrepl-error-buffer - ,nrepl-doc-buffer - ,nrepl-src-buffer - ,nrepl-macroexpansion-buffer - ,nrepl-event-buffer-name)) - (nrepl--close-buffer buf-name))) - -(defun nrepl-close (connection-buffer) - "Close the nrepl connection for CONNECTION-BUFFER." - (interactive (list (nrepl-current-connection-buffer))) - (nrepl--close-connection-buffer connection-buffer) - (nrepl-possibly-disable-on-existing-clojure-buffers) - (nrepl--connections-refresh)) - -(defun nrepl-quit () - "Quit the nrepl server." - (interactive) - (when (y-or-n-p "Are you sure you want to quit nrepl?") - (dolist (connection nrepl-connection-list) - (when connection - (nrepl-close connection))) - (message "All active nrepl connections were closed") - (nrepl-close-ancilliary-buffers))) - -(defun nrepl-restart (&optional prompt-project) - "Quit nrepl and restart it. -If PROMPT-PROJECT is t, then prompt for the project in which to -restart the server." - (interactive) - (nrepl-quit) - (nrepl-jack-in current-prefix-arg)) - -;;; client -(defun nrepl-op-supported-p (op) - "Return t iff the given operation OP is supported by nREPL server." - (with-current-buffer (nrepl-current-connection-buffer) - (if (and nrepl-ops (assoc op nrepl-ops)) - t))) - -(defun nrepl-describe-handler (process-buffer) - "Return a handler to describe into PROCESS-BUFFER." - (lexical-let ((buffer process-buffer)) - (lambda (response) - (nrepl-dbind-response response (ops) - (cond (ops - (with-current-buffer buffer - (setq nrepl-ops ops)))))))) - -(defun nrepl-describe-session (process) - "Peform describe for the given server PROCESS." - (let ((buffer (process-buffer process))) - (nrepl-send-request (list "op" "describe") - (nrepl-describe-handler buffer)))) - -(defun nrepl-setup-default-namespaces (process) - "Setup default namespaces for PROCESS." - (let ((buffer (process-buffer process))) - (with-current-buffer buffer - (nrepl-send-string - nrepl-repl-requires-sexp - (nrepl-make-response-handler - buffer nil - (lambda (buffer out) (message out)) - (lambda (buffer err) (message err)) - nil) - nrepl-buffer-ns - nrepl-tooling-session)))) - -(defun nrepl-repl-buffer-name () - "Generate a REPL buffer name based on current connection buffer." - (with-current-buffer (get-buffer (nrepl-current-connection-buffer)) - (nrepl-buffer-name nrepl-repl-buffer-name-template))) - -(defun nrepl-create-repl-buffer (process) - "Create a REPL buffer for PROCESS." - (nrepl-init-repl-buffer - process - (let ((buffer-name (nrepl-repl-buffer-name))) - (if nrepl-pop-to-repl-buffer-on-connect - (pop-to-buffer buffer-name) - (generate-new-buffer buffer-name)) - buffer-name))) - -(defun nrepl-new-tooling-session-handler (process) - "Create a new tooling session handler for PROCESS." - (lexical-let ((process process)) - (lambda (response) - (nrepl-dbind-response response (id new-session) - (cond (new-session - (with-current-buffer (process-buffer process) - (setq nrepl-tooling-session new-session) - (remhash id nrepl-requests) - (nrepl-setup-default-namespaces process)))))))) - -(defun nrepl-make-repl (process) - "Make a REPL for the connection PROCESS." - (lexical-let ((connection-buffer (process-buffer process)) - (repl-buffer (nrepl-create-repl-buffer process))) - (with-current-buffer repl-buffer - (setq nrepl-connection-buffer (buffer-name connection-buffer))) - (with-current-buffer connection-buffer - (setq nrepl-repl-buffer (buffer-name repl-buffer))))) - -(defun nrepl-new-session-handler (process no-repl-p) - "Create a new session handler for PROCESS. -When NO-REPL-P is truthy, suppress creation of a REPL buffer." - (lexical-let ((process process) - (no-repl-p no-repl-p)) - (lambda (response) - (nrepl-dbind-response response (id new-session) - (remhash id nrepl-requests) - (cond (new-session - (lexical-let ((connection-buffer (process-buffer process))) - (message "Connected. %s" (nrepl-random-words-of-inspiration)) - (setq nrepl-session new-session - nrepl-connection-buffer connection-buffer) - (unless no-repl-p - (nrepl-make-repl process) - (nrepl-make-repl-connection-default connection-buffer)) - (run-hooks 'nrepl-connected-hook)))))))) - -(defun nrepl-init-client-sessions (process no-repl-p) - "Initialize client sessions for PROCESS. -When NO-REPL-P is truthy, suppress creation of a REPL buffer." - (nrepl-create-client-session (nrepl-new-session-handler process no-repl-p)) - (nrepl-create-client-session (nrepl-new-tooling-session-handler process))) - -(defun nrepl-connect (host port &optional no-repl-p) - "Connect to a running nREPL server running on HOST and PORT. -When NO-REPL-P is truthy, suppress creation of a REPL buffer." - (message "Connecting to nREPL on %s:%s..." host port) - (let* ((nrepl-endpoint `(,host ,port)) - (process (open-network-stream "nrepl" - (nrepl-make-connection-buffer) host - port))) - (set-process-filter process 'nrepl-net-filter) - (set-process-sentinel process 'nrepl-sentinel) - (set-process-coding-system process 'utf-8-unix 'utf-8-unix) - (with-current-buffer (process-buffer process) - (setq nrepl-endpoint `(,host ,port))) - (let ((nrepl-connection-dispatch (buffer-name (process-buffer process)))) - (nrepl-init-client-sessions process no-repl-p) - (nrepl-describe-session process)) - process)) - -(defun nrepl-default-port () - "Attempt to read port from target/repl-port. -Falls back to `nrepl-port' if not found." - (let* ((dir (nrepl-project-directory-for (nrepl-current-dir))) - (f (expand-file-name "target/repl-port" dir)) - (port (when (file-exists-p f) - (with-temp-buffer - (insert-file-contents f) - (buffer-string))))) - (or port nrepl-port))) - -;;;###autoload -(add-hook 'nrepl-connected-hook 'nrepl-enable-on-existing-clojure-buffers) -(add-hook 'nrepl-disconnected-hook - 'nrepl-possibly-disable-on-existing-clojure-buffers) - -;;;###autoload -(defun nrepl (host port) - "Connect nrepl to HOST and PORT." - (interactive (list (read-string "Host: " nrepl-host nil nrepl-host) - (string-to-number (let ((port (nrepl-default-port))) - (read-string "Port: " port nil port))))) - (setq nrepl-current-clojure-buffer (current-buffer)) - (when (nrepl-check-for-repl-buffer `(,host ,port) nil) - (nrepl-connect host port))) - -;;;###autoload -(eval-after-load 'clojure-mode - '(progn - (define-key clojure-mode-map (kbd "C-c M-j") 'nrepl-jack-in) - (define-key clojure-mode-map (kbd "C-c M-c") 'nrepl))) - -(provide 'nrepl) -;;; nrepl.el ends here