about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-common.el
diff options
context:
space:
mode:
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-common.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-common.el375
1 files changed, 375 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-common.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-common.el
new file mode 100644
index 000000000000..3bae267a22d9
--- /dev/null
+++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-common.el
@@ -0,0 +1,375 @@
+;;; cider-common.el --- Common use functions         -*- lexical-binding: t; -*-
+
+;; Copyright © 2015-2018  Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.am@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/>.
+
+;;; Commentary:
+
+;; Common functions that are useful in both Clojure buffers and REPL
+;; buffers.
+
+;;; Code:
+
+(require 'subr-x)
+(require 'cider-compat)
+(require 'nrepl-dict)
+(require 'cider-util)
+(require 'etags) ; for find-tags-marker-ring
+(require 'tramp)
+
+(defcustom cider-prompt-for-symbol t
+  "Controls when to prompt for symbol when a command requires one.
+
+When non-nil, always prompt, and use the symbol at point as the default
+value at the prompt.
+
+When nil, attempt to use the symbol at point for the command, and only
+prompt if that throws an error."
+  :type '(choice (const :tag "always" t)
+                 (const :tag "dwim" nil))
+  :group 'cider
+  :package-version '(cider . "0.9.0"))
+
+(defcustom cider-special-mode-truncate-lines t
+  "If non-nil, contents of CIDER's special buffers will be line-truncated.
+Should be set before loading CIDER."
+  :type 'boolean
+  :group 'cider
+  :package-version '(cider . "0.15.0"))
+
+(defun cider--should-prompt-for-symbol (&optional invert)
+  "Return the value of the variable `cider-prompt-for-symbol'.
+Optionally invert the value, if INVERT is truthy."
+  (if invert (not cider-prompt-for-symbol) cider-prompt-for-symbol))
+
+(defun cider-prompt-for-symbol-function (&optional invert)
+  "Prompt for symbol if funcall `cider--should-prompt-for-symbol' is truthy.
+Otherwise attempt to use the symbol at point for the command, and only
+prompt if that throws an error.
+
+INVERT is used to invert the semantics of the function `cider--should-prompt-for-symbol'."
+  (if (cider--should-prompt-for-symbol invert)
+      #'cider-read-symbol-name
+    #'cider-try-symbol-at-point))
+
+(defun cider--kw-to-symbol (kw)
+  "Convert the keyword KW to a symbol."
+  (when kw
+    (replace-regexp-in-string "\\`:+" "" kw)))
+
+;;; Minibuffer
+(defvar cider-minibuffer-history '()
+  "History list of expressions read from the minibuffer.")
+
+(defvar cider-minibuffer-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map minibuffer-local-map)
+    (define-key map (kbd "TAB") #'complete-symbol)
+    (define-key map (kbd "M-TAB") #'complete-symbol)
+    map)
+  "Minibuffer keymap used for reading Clojure expressions.")
+
+(declare-function cider-complete-at-point "cider-completion")
+(declare-function cider-eldoc "cider-eldoc")
+(defun cider-read-from-minibuffer (prompt &optional value)
+  "Read a string from the minibuffer, prompting with PROMPT.
+If VALUE is non-nil, it is inserted into the minibuffer as initial-input.
+PROMPT need not end with \": \". If it doesn't, VALUE is displayed on the
+prompt as a default value (used if the user doesn't type anything) and is
+not used as initial input (input is left empty)."
+  (minibuffer-with-setup-hook
+      (lambda ()
+        (set-syntax-table clojure-mode-syntax-table)
+        (add-hook 'completion-at-point-functions
+                  #'cider-complete-at-point nil t)
+        (setq-local eldoc-documentation-function #'cider-eldoc)
+        (run-hooks 'eval-expression-minibuffer-setup-hook))
+    (let* ((has-colon (string-match ": \\'" prompt))
+           (input (read-from-minibuffer (cond
+                                         (has-colon prompt)
+                                         (value (format "%s (default %s): " prompt value))
+                                         (t (format "%s: " prompt)))
+                                        (when has-colon value) ; initial-input
+                                        cider-minibuffer-map nil
+                                        'cider-minibuffer-history
+                                        (unless has-colon value)))) ; default-value
+      (if (and (equal input "") value (not has-colon))
+          value
+        input))))
+
+(defun cider-read-symbol-name (prompt callback)
+  "Read a symbol name using PROMPT with a default of the one at point.
+Use CALLBACK as the completing read var callback."
+  (funcall callback (cider-read-from-minibuffer
+                     prompt
+                     ;; if the thing at point is a keyword we treat it as symbol
+                     (cider--kw-to-symbol (cider-symbol-at-point 'look-back)))))
+
+(defun cider-try-symbol-at-point (prompt callback)
+  "Call CALLBACK with symbol at point.
+On failure, read a symbol name using PROMPT and call CALLBACK with that."
+  (condition-case nil (funcall callback (cider--kw-to-symbol (cider-symbol-at-point 'look-back)))
+    ('error (funcall callback (cider-read-from-minibuffer prompt)))))
+
+(declare-function cider-mode "cider-mode")
+
+(defun cider-jump-to (buffer &optional pos other-window)
+  "Push current point onto marker ring, and jump to BUFFER and POS.
+POS can be either a number, a cons, or a symbol.
+If a number, it is the character position (the point).
+If a cons, it specifies the position as (LINE . COLUMN).  COLUMN can be nil.
+If a symbol, `cider-jump-to' searches for something that looks like the
+symbol's definition in the file.
+If OTHER-WINDOW is non-nil don't reuse current window."
+  (with-no-warnings
+    (ring-insert find-tag-marker-ring (point-marker)))
+  (if other-window
+      (pop-to-buffer buffer)
+    ;; like switch-to-buffer, but reuse existing window if BUFFER is visible
+    (pop-to-buffer buffer '((display-buffer-reuse-window display-buffer-same-window))))
+  (with-current-buffer buffer
+    (widen)
+    (goto-char (point-min))
+    (cider-mode +1)
+    (cond
+     ;; Line-column specification.
+     ((consp pos)
+      (forward-line (1- (or (car pos) 1)))
+      (if (cdr pos)
+          (move-to-column (cdr pos))
+        (back-to-indentation)))
+     ;; Point specification.
+     ((numberp pos)
+      (goto-char pos))
+     ;; Symbol or string.
+     (pos
+      ;; Try to find (def full-name ...).
+      (if (or (save-excursion
+                (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote pos))
+                                       nil 'noerror))
+              (let ((name (replace-regexp-in-string ".*/" "" pos)))
+                ;; Try to find (def name ...).
+                (or (save-excursion
+                      (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote name))
+                                             nil 'noerror))
+                    ;; Last resort, just find the first occurrence of `name'.
+                    (save-excursion
+                      (search-forward name nil 'noerror)))))
+          (goto-char (match-beginning 0))
+        (message "Can't find %s in %s" pos (buffer-file-name))))
+     (t nil))))
+
+(defun cider--find-buffer-for-file (file)
+  "Return a buffer visiting FILE.
+If FILE is a temp buffer name, return that buffer."
+  (if (string-prefix-p "*" file)
+      file
+    (and file
+         (not (cider--tooling-file-p file))
+         (cider-find-file file))))
+
+(defun cider--jump-to-loc-from-info (info &optional other-window)
+  "Jump to location give by INFO.
+INFO object is returned by `cider-var-info' or `cider-member-info'.
+OTHER-WINDOW is passed to `cider-jump-to'."
+  (let* ((line (nrepl-dict-get info "line"))
+         (file (nrepl-dict-get info "file"))
+         (name (nrepl-dict-get info "name"))
+         ;; the filename might actually be a REPL buffer name
+         (buffer (cider--find-buffer-for-file file)))
+    (if buffer
+        (cider-jump-to buffer (if line (cons line nil) name) other-window)
+      (error "No source location"))))
+
+(declare-function url-filename "url-parse" (cl-x) t)
+
+(defun cider--url-to-file (url)
+  "Return the filename from the resource URL.
+Uses `url-generic-parse-url' to parse the url.  The filename is extracted and
+then url decoded.  If the decoded filename has a Windows device letter followed
+by a colon immediately after the leading '/' then the leading '/' is dropped to
+create a valid path."
+  (let ((filename (url-unhex-string (url-filename (url-generic-parse-url url)))))
+    (if (string-match "^/\\([a-zA-Z]:/.*\\)" filename)
+        (match-string 1 filename)
+      filename)))
+
+(defun cider-make-tramp-prefix (method user host)
+  "Constructs a Tramp file prefix from METHOD, USER, HOST.
+It originated from Tramp's `tramp-make-tramp-file-name'.  The original be
+forced to make full file name with `with-parsed-tramp-file-name', not providing
+prefix only option."
+  (concat tramp-prefix-format
+          (unless (zerop (length method))
+            (concat method tramp-postfix-method-format))
+          (unless (zerop (length user))
+            (concat user tramp-postfix-user-format))
+          (when host
+            (if (string-match tramp-ipv6-regexp host)
+                (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
+              host))
+          tramp-postfix-host-format))
+
+(defun cider-tramp-prefix (&optional buffer)
+  "Use the filename for BUFFER to determine a tramp prefix.
+Defaults to the current buffer.  Return the tramp prefix, or nil
+if BUFFER is local."
+  (let* ((buffer (or buffer (current-buffer)))
+         (name (or (buffer-file-name buffer)
+                   (with-current-buffer buffer
+                     default-directory))))
+    (when (tramp-tramp-file-p name)
+      (with-parsed-tramp-file-name name v
+        (with-no-warnings
+          (cider-make-tramp-prefix v-method v-user v-host))))))
+
+(defun cider--client-tramp-filename (name &optional buffer)
+  "Return the tramp filename for path NAME relative to BUFFER.
+If BUFFER has a tramp prefix, it will be added as a prefix to NAME.
+If the resulting path is an existing tramp file, it returns the path,
+otherwise, nil."
+  (let* ((buffer (or buffer (current-buffer)))
+         (name (replace-regexp-in-string "^file:" "" name))
+         (name (concat (cider-tramp-prefix buffer) name)))
+    (if (tramp-handle-file-exists-p name)
+        name)))
+
+(defun cider--server-filename (name)
+  "Return the nREPL server-relative filename for NAME."
+  (if (tramp-tramp-file-p name)
+      (with-parsed-tramp-file-name name nil
+        localname)
+    name))
+
+(defvar cider-from-nrepl-filename-function
+  (with-no-warnings
+    (if (eq system-type 'cygwin)
+        #'cygwin-convert-file-name-from-windows
+      #'identity))
+  "Function to translate nREPL namestrings to Emacs filenames.")
+
+(defcustom cider-prefer-local-resources nil
+  "Prefer local resources to remote (tramp) ones when both are available."
+  :type 'boolean
+  :group 'cider)
+
+(defun cider--file-path (path)
+  "Return PATH's local or tramp path using `cider-prefer-local-resources'.
+If no local or remote file exists, return nil."
+  (let* ((local-path (funcall cider-from-nrepl-filename-function path))
+         (tramp-path (and local-path (cider--client-tramp-filename local-path))))
+    (cond ((equal local-path "") "")
+          ((and cider-prefer-local-resources (file-exists-p local-path))
+           local-path)
+          ((and tramp-path (file-exists-p tramp-path))
+           tramp-path)
+          ((and local-path (file-exists-p local-path))
+           local-path))))
+
+(declare-function archive-extract "arc-mode")
+(declare-function archive-zip-extract "arc-mode")
+
+(defun cider-find-file (url)
+  "Return a buffer visiting the file URL if it exists, or nil otherwise.
+If URL has a scheme prefix, it must represent a fully-qualified file path
+or an entry within a zip/jar archive.  If URL doesn't contain a scheme
+prefix and is an absolute path, it is treated as such.  Finally, if URL is
+relative, it is expanded within each of the open Clojure buffers till an
+existing file ending with URL has been found."
+  (require 'arc-mode)
+  (cond ((string-match "^file:\\(.+\\)" url)
+         (when-let* ((file (cider--url-to-file (match-string 1 url)))
+                     (path (cider--file-path file)))
+           (find-file-noselect path)))
+        ((string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" url)
+         (when-let* ((entry (match-string 3 url))
+                     (file  (cider--url-to-file (match-string 2 url)))
+                     (path  (cider--file-path file))
+                     ;; It is used for targeting useless intermediate buffer.
+                     ;; That buffer is made by (find-file path) below.
+                     ;; It has the name which is the last part of the path.
+                     (trash (replace-regexp-in-string "^/.+/" "" path))
+                     (name  (format "%s:%s" path entry)))
+           (or (find-buffer-visiting name)
+               (if (tramp-tramp-file-p path)
+                   (progn
+                     ;; Use emacs built in archiving.
+                     ;; This makes a list of files in archived Zip or Jar.
+                     ;; That list buffer is useless after jumping to the
+                     ;; buffer which has the real definition.
+                     ;; It'll be removed by (kill-buffer trash) below.
+                     (find-file path)
+                     (goto-char (point-min))
+                     ;; Make sure the file path is followed by a newline to
+                     ;; prevent eg. clj matching cljs.
+                     (search-forward (concat entry "\n"))
+                     ;; moves up to matching line
+                     (forward-line -1)
+                     (archive-extract)
+                     ;; Remove useless buffer made by (find-file path) above.
+                     (kill-buffer trash)
+                     (current-buffer))
+                 ;; Use external zip program to just extract the single file
+                 (with-current-buffer (generate-new-buffer
+                                       (file-name-nondirectory entry))
+                   (archive-zip-extract path entry)
+                   (set-visited-file-name name)
+                   (setq-local default-directory (file-name-directory path))
+                   (setq-local buffer-read-only t)
+                   (set-buffer-modified-p nil)
+                   (set-auto-mode)
+                   (current-buffer))))))
+        (t (if-let* ((path (cider--file-path url)))
+               (find-file-noselect path)
+             (unless (file-name-absolute-p url)
+               (let ((cider-buffers (cider-util--clojure-buffers))
+                     (url (file-name-nondirectory url)))
+                 (or (cl-loop for bf in cider-buffers
+                              for path = (with-current-buffer bf
+                                           (expand-file-name url))
+                              if (and path (file-exists-p path))
+                              return (find-file-noselect path))
+                     (cl-loop for bf in cider-buffers
+                              if (string= (buffer-name bf) url)
+                              return bf))))))))
+
+(defun cider--open-other-window-p (arg)
+  "Test prefix value ARG to see if it indicates displaying results in other window."
+  (let ((narg (prefix-numeric-value arg)))
+    (pcase narg
+      (-1 t) ; -
+      (16 t) ; empty empty
+      (_ nil))))
+
+(defun cider-abbreviate-ns (namespace)
+  "Return a string that abbreviates NAMESPACE."
+  (when namespace
+    (let* ((names (reverse (split-string namespace "\\.")))
+           (lastname (car names)))
+      (concat (mapconcat (lambda (s) (concat (substring s 0 1) "."))
+                         (reverse (cdr names))
+                         "")
+              lastname))))
+
+(defun cider-last-ns-segment (namespace)
+  "Return the last segment of NAMESPACE."
+  (when namespace
+    (car (reverse (split-string namespace "\\.")))))
+
+
+(provide 'cider-common)
+;;; cider-common.el ends here