about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el
diff options
context:
space:
mode:
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el232
1 files changed, 232 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el
new file mode 100644
index 000000000000..6f7353532b9a
--- /dev/null
+++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el
@@ -0,0 +1,232 @@
+;;; cider-browse-ns.el --- CIDER namespace browser
+
+;; Copyright © 2014-2018 John Andrews, Bozhidar Batsov and CIDER contributors
+
+;; Author: John Andrews <john.m.andrews@gmail.com>
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;; This file is not part of GNU Emacs.
+
+;;; Commentary:
+
+;; M-x cider-browse-ns
+;;
+;; Display a list of all vars in a namespace.
+;; Pressing <enter> will take you to the cider-doc buffer for that var.
+;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode').
+
+;; M-x cider-browse-ns-all
+;;
+;; Explore Clojure namespaces by browsing a list of all namespaces.
+;; Pressing <enter> expands into a list of that namespace's vars as if by
+;; executing the command (cider-browse-ns "my.ns").
+
+;;; Code:
+
+(require 'cider-client)
+(require 'cider-popup)
+(require 'cider-compat)
+(require 'cider-util)
+(require 'nrepl-dict)
+
+(require 'subr-x)
+(require 'easymenu)
+(require 'thingatpt)
+
+(defconst cider-browse-ns-buffer "*cider-ns-browser*")
+
+(defvar-local cider-browse-ns-current-ns nil)
+
+;; Mode Definition
+
+(defvar cider-browse-ns-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map cider-popup-buffer-mode-map)
+    (define-key map "d" #'cider-browse-ns-doc-at-point)
+    (define-key map "s" #'cider-browse-ns-find-at-point)
+    (define-key map (kbd "RET") #'cider-browse-ns-operate-at-point)
+    (define-key map "^" #'cider-browse-ns-all)
+    (define-key map "n" #'next-line)
+    (define-key map "p" #'previous-line)
+    (easy-menu-define cider-browse-ns-mode-menu map
+      "Menu for CIDER's namespace browser"
+      '("Namespace Browser"
+        ["Show doc" cider-browse-ns-doc-at-point]
+        ["Go to definition" cider-browse-ns-find-at-point]
+        "--"
+        ["Browse all namespaces" cider-browse-ns-all]))
+    map))
+
+(defvar cider-browse-ns-mouse-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] #'cider-browse-ns-handle-mouse)
+    map))
+
+(define-derived-mode cider-browse-ns-mode special-mode "browse-ns"
+  "Major mode for browsing Clojure namespaces.
+
+\\{cider-browse-ns-mode-map}"
+  (setq-local electric-indent-chars nil)
+  (setq-local sesman-system 'CIDER)
+  (when cider-special-mode-truncate-lines
+    (setq-local truncate-lines t))
+  (setq-local cider-browse-ns-current-ns nil))
+
+(defun cider-browse-ns--text-face (var-meta)
+  "Return font-lock-face for a var.
+VAR-META contains the metadata information used to decide a face.
+Presence of \"arglists-str\" and \"macro\" indicates a macro form.
+Only \"arglists-str\" indicates a function. Otherwise, its a variable.
+If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn."
+  (cond
+   ((not var-meta) 'font-lock-function-name-face)
+   ((and (nrepl-dict-contains var-meta "arglists")
+         (string= (nrepl-dict-get var-meta "macro") "true"))
+    'font-lock-keyword-face)
+   ((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face)
+   (t 'font-lock-variable-name-face)))
+
+(defun cider-browse-ns--properties (var var-meta)
+  "Decorate VAR with a clickable keymap and a face.
+VAR-META is used to decide a font-lock face."
+  (let ((face (cider-browse-ns--text-face var-meta)))
+    (propertize var
+                'font-lock-face face
+                'mouse-face 'highlight
+                'keymap cider-browse-ns-mouse-map)))
+
+(defun cider-browse-ns--list (buffer title items &optional ns noerase)
+  "Reset contents of BUFFER.
+Display TITLE at the top and ITEMS are indented underneath.
+If NS is non-nil, it is added to each item as the
+`cider-browse-ns-current-ns' text property.  If NOERASE is non-nil, the
+contents of the buffer are not reset before inserting TITLE and ITEMS."
+  (with-current-buffer buffer
+    (cider-browse-ns-mode)
+    (let ((inhibit-read-only t))
+      (unless noerase (erase-buffer))
+      (goto-char (point-max))
+      (insert (cider-propertize title 'ns) "\n")
+      (dolist (item items)
+        (insert (propertize (concat "  " item "\n")
+                            'cider-browse-ns-current-ns ns)))
+      (goto-char (point-min)))))
+
+(defun cider-browse-ns--first-doc-line (doc)
+  "Return the first line of the given DOC string.
+If the first line of the DOC string contains multiple sentences, only
+the first sentence is returned.  If the DOC string is nil, a Not documented
+string is returned."
+  (if doc
+      (let* ((split-newline (split-string doc "\n"))
+             (first-line (car split-newline)))
+        (cond
+         ((string-match "\\. " first-line) (substring first-line 0 (match-end 0)))
+         ((= 1 (length split-newline)) first-line)
+         (t (concat first-line "..."))))
+    "Not documented."))
+
+(defun cider-browse-ns--items (namespace)
+  "Return the items to show in the namespace browser of the given NAMESPACE.
+Each item consists of a ns-var and the first line of its docstring."
+  (let* ((ns-vars-with-meta (cider-sync-request:ns-vars-with-meta namespace))
+         (propertized-ns-vars (nrepl-dict-map #'cider-browse-ns--properties ns-vars-with-meta)))
+    (mapcar (lambda (ns-var)
+              (let* ((doc (nrepl-dict-get-in ns-vars-with-meta (list ns-var "doc")))
+                     ;; to avoid (read nil)
+                     ;; it prompts the user for a Lisp expression
+                     (doc (when doc (read doc)))
+                     (first-doc-line (cider-browse-ns--first-doc-line doc)))
+                (concat ns-var " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face))))
+            propertized-ns-vars)))
+
+;; Interactive Functions
+
+;;;###autoload
+(defun cider-browse-ns (namespace)
+  "List all NAMESPACE's vars in BUFFER."
+  (interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list))))
+  (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary)
+    (cider-browse-ns--list (current-buffer)
+                           namespace
+                           (cider-browse-ns--items namespace))
+    (setq-local cider-browse-ns-current-ns namespace)))
+
+;;;###autoload
+(defun cider-browse-ns-all ()
+  "List all loaded namespaces in BUFFER."
+  (interactive)
+  (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary)
+    (let ((names (cider-sync-request:ns-list)))
+      (cider-browse-ns--list (current-buffer)
+                             "All loaded namespaces"
+                             (mapcar (lambda (name)
+                                       (cider-browse-ns--properties name nil))
+                                     names))
+      (setq-local cider-browse-ns-current-ns nil))))
+
+(defun cider-browse-ns--thing-at-point ()
+  "Get the thing at point.
+Return a list of the type ('ns or 'var) and the value."
+  (let ((line (car (split-string (string-trim (thing-at-point 'line)) " "))))
+    (if (string-match "\\." line)
+        `(ns ,line)
+      `(var ,(format "%s/%s"
+                     (or (get-text-property (point) 'cider-browse-ns-current-ns)
+                         cider-browse-ns-current-ns)
+                     line)))))
+
+(defun cider-browse-ns-doc-at-point ()
+  "Show the documentation for the thing at current point."
+  (interactive)
+  (let* ((thing (cider-browse-ns--thing-at-point))
+         (value (cadr thing)))
+    ;; value is either some ns or a var
+    (cider-doc-lookup value)))
+
+(defun cider-browse-ns-operate-at-point ()
+  "Expand browser according to thing at current point.
+If the thing at point is a ns it will be browsed,
+and if the thing at point is some var - its documentation will
+be displayed."
+  (interactive)
+  (let* ((thing (cider-browse-ns--thing-at-point))
+         (type (car thing))
+         (value (cadr thing)))
+    (if (eq type 'ns)
+        (cider-browse-ns value)
+      (cider-doc-lookup value))))
+
+(declare-function cider-find-ns "cider-find")
+(declare-function cider-find-var "cider-find")
+
+(defun cider-browse-ns-find-at-point ()
+  "Find the definition of the thing at point."
+  (interactive)
+  (let* ((thing (cider-browse-ns--thing-at-point))
+         (type (car thing))
+         (value (cadr thing)))
+    (if (eq type 'ns)
+        (cider-find-ns nil value)
+      (cider-find-var current-prefix-arg value))))
+
+(defun cider-browse-ns-handle-mouse (event)
+  "Handle mouse click EVENT."
+  (interactive "e")
+  (cider-browse-ns-operate-at-point))
+
+(provide 'cider-browse-ns)
+
+;;; cider-browse-ns.el ends here