You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
225 lines
9.3 KiB
225 lines
9.3 KiB
;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- |
|
|
|
;; Copyright (C) 2015 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 'cider-compat) |
|
(require 'nrepl-client) |
|
(require 'cider-util) |
|
|
|
(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")) |
|
|
|
(defun cider--should-prompt-for-symbol (&optional invert) |
|
(if invert (not cider-prompt-for-symbol) cider-prompt-for-symbol)) |
|
|
|
(defun cider-prompt-for-symbol-function (&optional invert) |
|
(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))) |
|
|
|
(declare-function cider-read-from-minibuffer "cider-interaction") |
|
|
|
(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))))) |
|
|
|
(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))) |
|
('error (funcall callback (cider-read-from-minibuffer prompt))))) |
|
|
|
(declare-function cider-jump-to "cider-interaction") |
|
|
|
(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-jamp-to'." |
|
(let* ((line (nrepl-dict-get info "line")) |
|
(file (nrepl-dict-get info "file")) |
|
(name (nrepl-dict-get info "name")) |
|
(buffer (and file |
|
(not (cider--tooling-file-p file)) |
|
(cider-find-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-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) |
|
(let ((vec (tramp-dissect-file-name name))) |
|
(tramp-make-tramp-file-name (tramp-file-name-method vec) |
|
(tramp-file-name-user vec) |
|
(tramp-file-name-host vec) |
|
nil))))) |
|
|
|
(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 (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)) |
|
(name (format "%s:%s" path entry))) |
|
(or (find-buffer-visiting name) |
|
(if (tramp-tramp-file-p path) |
|
(progn |
|
;; Use emacs built in archiving |
|
(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) |
|
(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)))) |
|
|
|
(provide 'cider-common) |
|
;;; cider-common.el ends here
|
|
|