cider-common.el (19542B)
1 ;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- 2 3 ;; Copyright © 2015-2023 Artur Malabarba 4 5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com> 6 7 ;; This program is free software; you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 20 ;;; Commentary: 21 22 ;; Common functions that are useful in both Clojure buffers and REPL 23 ;; buffers. 24 25 ;;; Code: 26 27 (require 'subr-x) 28 (require 'nrepl-dict) 29 (require 'cider-util) 30 (require 'xref) 31 (require 'tramp) 32 33 (defcustom cider-prompt-for-symbol nil 34 "Controls when to prompt for symbol when a command requires one. 35 36 When non-nil, always prompt, and use the symbol at point as the default 37 value at the prompt. 38 39 When nil, attempt to use the symbol at point for the command, and only 40 prompt if that throws an error." 41 :type '(choice (const :tag "always" t) 42 (const :tag "dwim" nil)) 43 :group 'cider 44 :package-version '(cider . "0.9.0")) 45 46 (defcustom cider-special-mode-truncate-lines t 47 "If non-nil, contents of CIDER's special buffers will be line-truncated. 48 Should be set before loading CIDER." 49 :type 'boolean 50 :group 'cider 51 :package-version '(cider . "0.15.0")) 52 53 (defun cider--should-prompt-for-symbol (&optional invert) 54 "Return the value of the variable `cider-prompt-for-symbol'. 55 Optionally invert the value, if INVERT is truthy." 56 (if invert (not cider-prompt-for-symbol) cider-prompt-for-symbol)) 57 58 (defun cider-prompt-for-symbol-function (&optional invert) 59 "Prompt for symbol if funcall `cider--should-prompt-for-symbol' is truthy. 60 Otherwise attempt to use the symbol at point for the command, and only 61 prompt if that throws an error. 62 63 INVERT inverts the semantics of the function `cider--should-prompt-for-symbol'." 64 (if (cider--should-prompt-for-symbol invert) 65 #'cider-read-symbol-name 66 #'cider-try-symbol-at-point)) 67 68 (defun cider--kw-to-symbol (kw) 69 "Convert the keyword KW to a symbol." 70 (when kw 71 (replace-regexp-in-string "\\`:+" "" kw))) 72 73 ;;; Minibuffer 74 (defvar cider-minibuffer-history '() 75 "History list of expressions read from the minibuffer.") 76 77 (defvar cider-minibuffer-map 78 (let ((map (make-sparse-keymap))) 79 (set-keymap-parent map minibuffer-local-map) 80 (define-key map (kbd "TAB") #'complete-symbol) 81 (define-key map (kbd "M-TAB") #'complete-symbol) 82 map) 83 "Minibuffer keymap used for reading Clojure expressions.") 84 85 (declare-function cider-complete-at-point "cider-completion") 86 (declare-function cider-eldoc "cider-eldoc") 87 (defun cider-read-from-minibuffer (prompt &optional value) 88 "Read a string from the minibuffer, prompting with PROMPT. 89 If VALUE is non-nil, it is inserted into the minibuffer as initial-input. 90 PROMPT need not end with \": \". If it doesn't, VALUE is displayed on the 91 prompt as a default value (used if the user doesn't type anything) and is 92 not used as initial input (input is left empty)." 93 (minibuffer-with-setup-hook 94 (lambda () 95 (set-syntax-table clojure-mode-syntax-table) 96 (add-hook 'completion-at-point-functions 97 #'cider-complete-at-point nil t) 98 (setq-local eldoc-documentation-function #'cider-eldoc) 99 (run-hooks 'eval-expression-minibuffer-setup-hook)) 100 (let* ((has-colon (string-match ": \\'" prompt)) 101 (input (read-from-minibuffer (cond 102 (has-colon prompt) 103 (value (format "%s (default %s): " prompt value)) 104 (t (format "%s: " prompt))) 105 (when has-colon value) ; initial-input 106 cider-minibuffer-map nil 107 'cider-minibuffer-history 108 (unless has-colon value)))) ; default-value 109 (if (and (equal input "") value (not has-colon)) 110 value 111 input)))) 112 113 (defun cider-read-symbol-name (prompt callback) 114 "Read a symbol name using PROMPT with a default of the one at point. 115 Use CALLBACK as the completing read var callback." 116 (funcall callback (cider-read-from-minibuffer 117 prompt 118 ;; if the thing at point is a keyword we treat it as symbol 119 (cider--kw-to-symbol (cider-symbol-at-point 'look-back))))) 120 121 (defun cider-try-symbol-at-point (prompt callback) 122 "Call CALLBACK with symbol at point. 123 On failure, read a symbol name using PROMPT and call CALLBACK with that." 124 (condition-case nil (funcall callback (cider--kw-to-symbol (cider-symbol-at-point 'look-back))) 125 ('error (funcall callback (cider-read-from-minibuffer prompt))))) 126 127 (declare-function cider-mode "cider-mode") 128 129 (defcustom cider-jump-to-pop-to-buffer-actions 130 '((display-buffer-reuse-window display-buffer-same-window)) 131 "Determines what window `cider-jump-to` uses. 132 The value is passed as the `action` argument to `pop-to-buffer`. 133 134 The default value means: 135 136 - If the target file is already visible in a window, reuse it (switch to it). 137 - Otherwise, open the target buffer in the current window. 138 139 For further details, see https://docs.cider.mx/cider/config/basic_config.html#control-what-window-to-use-when-jumping-to-a-definition" 140 :type 'sexp 141 :group 'cider 142 :package-version '(cider . "0.24.0")) 143 144 (defun cider-jump-to (buffer &optional pos other-window) 145 "Push current point onto marker ring, and jump to BUFFER and POS. 146 POS can be either a number, a cons, or a symbol. 147 If a number, it is the character position (the point). 148 If a cons, it specifies the position as (LINE . COLUMN). COLUMN can be nil. 149 If a symbol, `cider-jump-to' searches for something that looks like the 150 symbol's definition in the file. 151 If OTHER-WINDOW is non-nil don't reuse current window." 152 (with-no-warnings 153 (xref-push-marker-stack)) 154 (if other-window 155 (pop-to-buffer buffer 'display-buffer-pop-up-window) 156 (pop-to-buffer buffer cider-jump-to-pop-to-buffer-actions)) 157 (with-current-buffer buffer 158 (widen) 159 (goto-char (point-min)) 160 (cider-mode +1) 161 (let ((status 162 (cond 163 ;; Line-column specification. 164 ((consp pos) 165 (forward-line (1- (or (car pos) 1))) 166 (if (cdr pos) 167 (move-to-column (cdr pos)) 168 (back-to-indentation))) 169 ;; Point specification. 170 ((numberp pos) 171 (goto-char pos)) 172 ;; Symbol or string. 173 (pos 174 ;; Try to find (def full-name ...). 175 (if (or (save-excursion 176 (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote pos)) 177 nil 'noerror)) 178 (let ((name (replace-regexp-in-string ".*/" "" pos))) 179 ;; Try to find (def name ...). 180 (or (save-excursion 181 (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote name)) 182 nil 'noerror)) 183 ;; Last resort, just find the first occurrence of `name'. 184 (save-excursion 185 (search-forward name nil 'noerror))))) 186 (goto-char (match-beginning 0)) 187 (message "Can't find %s in %s" pos (buffer-file-name)) 188 'not-found)) 189 (t 'not-found)))) 190 (unless (eq status 'not-found) 191 ;; Make sure the location we jump to is centered within the target window 192 (recenter))))) 193 194 (defun cider--find-buffer-for-file (file) 195 "Return a buffer visiting FILE. 196 If FILE is a temp buffer name, return that buffer." 197 (if (string-prefix-p "*" file) 198 file 199 (and file 200 (not (cider--tooling-file-p file)) 201 (cider-find-file file)))) 202 203 (defun cider--jump-to-loc-from-info (info &optional other-window) 204 "Jump to location give by INFO. 205 INFO object is returned by `cider-var-info' or `cider-member-info'. 206 OTHER-WINDOW is passed to `cider-jump-to'." 207 (let* ((line (nrepl-dict-get info "line")) 208 (file (nrepl-dict-get info "file")) 209 (name (nrepl-dict-get info "name")) 210 ;; the filename might actually be a REPL buffer name 211 (buffer (cider--find-buffer-for-file file))) 212 (if buffer 213 (cider-jump-to buffer (if line (cons line nil) name) other-window) 214 (error "No source location")))) 215 216 (declare-function url-filename "url-parse" (cl-x) t) 217 218 (defun cider--url-to-file (url) 219 "Return the filename from the resource URL. 220 Uses `url-generic-parse-url' to parse the url. The filename is extracted and 221 then url decoded. If the decoded filename has a Windows device letter followed 222 by a colon immediately after the leading '/' then the leading '/' is dropped to 223 create a valid path." 224 (let ((filename (url-unhex-string (url-filename (url-generic-parse-url url))))) 225 (if (string-match "^/\\([a-zA-Z]:/.*\\)" filename) 226 (match-string 1 filename) 227 filename))) 228 229 (defun cider-make-tramp-prefix (method user host) 230 "Constructs a Tramp file prefix from METHOD, USER, HOST. 231 It originated from Tramp's `tramp-make-tramp-file-name'. The original be 232 forced to make full file name with `with-parsed-tramp-file-name', not providing 233 prefix only option." 234 (concat tramp-prefix-format 235 (unless (zerop (length method)) 236 (concat method tramp-postfix-method-format)) 237 (unless (zerop (length user)) 238 (concat user tramp-postfix-user-format)) 239 (when host 240 (if (string-match tramp-ipv6-regexp host) 241 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) 242 host)) 243 tramp-postfix-host-format)) 244 245 (defun cider-tramp-prefix (&optional buffer) 246 "Use the filename for BUFFER to determine a tramp prefix. 247 Defaults to the current buffer. Return the tramp prefix, or nil 248 if BUFFER is local." 249 (let* ((buffer (or buffer (current-buffer))) 250 (name (or (buffer-file-name buffer) 251 (with-current-buffer buffer 252 default-directory)))) 253 (when (tramp-tramp-file-p name) 254 (with-parsed-tramp-file-name name v 255 (with-no-warnings 256 (cider-make-tramp-prefix v-method v-user v-host)))))) 257 258 (defun cider--client-tramp-filename (name &optional buffer) 259 "Return the tramp filename for path NAME relative to BUFFER. 260 If BUFFER has a tramp prefix, it will be added as a prefix to NAME. 261 If the resulting path is an existing tramp file, it returns the path, 262 otherwise, nil." 263 (let* ((buffer (or buffer (current-buffer))) 264 (name (replace-regexp-in-string "^file:" "" name)) 265 (name (concat (cider-tramp-prefix buffer) name))) 266 (if (and (tramp-tramp-file-p name) 267 (tramp-handle-file-exists-p name)) 268 name))) 269 270 (defun cider--server-filename (name) 271 "Return the nREPL server-relative filename for NAME." 272 (if (tramp-tramp-file-p name) 273 (with-parsed-tramp-file-name name nil 274 localname) 275 name)) 276 277 (defcustom cider-path-translations nil 278 "Alist of path prefixes to path prefixes. 279 Useful to intercept the location of a path in a container (or virtual 280 machine) and translate to the original location. If your project is located 281 at \"~/projects/foo\" and the src directory of foo is mounted at \"/src\" 282 in the container, the alist would be `((\"/src\" \"~/projects/foo/src\"))." 283 :type '(alist :key-type string :value-type string) 284 :group 'cider 285 :package-version '(cider . "0.23.0")) 286 287 (defun cider--translate-path (path direction) 288 "Attempt to translate the PATH in the given DIRECTION. 289 Looks at `cider-path-translations' for (container . host) alist of path 290 prefixes and translates PATH from container to host or vice-versa depending on 291 whether DIRECTION is 'from-nrepl or 'to-nrepl." 292 (seq-let [from-fn to-fn path-fn] (cond ((eq direction 'from-nrepl) '(car cdr identity)) 293 ((eq direction 'to-nrepl) '(cdr car expand-file-name))) 294 (let ((path (funcall path-fn path))) 295 (seq-some (lambda (translation) 296 (let ((prefix (file-name-as-directory (expand-file-name (funcall from-fn translation))))) 297 (when (string-prefix-p prefix path) 298 (replace-regexp-in-string (format "^%s" (regexp-quote prefix)) 299 (file-name-as-directory 300 (expand-file-name (funcall to-fn translation))) 301 path)))) 302 cider-path-translations)))) 303 304 (defun cider--translate-path-from-nrepl (path) 305 "Attempt to translate the nREPL PATH to a local path." 306 (cider--translate-path path 'from-nrepl)) 307 308 (defun cider--translate-path-to-nrepl (path) 309 "Attempt to translate the local PATH to an nREPL path." 310 (cider--translate-path (expand-file-name path) 'to-nrepl)) 311 312 (defvar cider-from-nrepl-filename-function 313 (with-no-warnings 314 (lambda (path) 315 (let ((path* (if (eq system-type 'cygwin) 316 (cygwin-convert-file-name-from-windows path) 317 path))) 318 (or (cider--translate-path-from-nrepl path*) path*)))) 319 "Function to translate nREPL namestrings to Emacs filenames.") 320 321 (defcustom cider-prefer-local-resources nil 322 "Prefer local resources to remote (tramp) ones when both are available." 323 :type 'boolean 324 :group 'cider) 325 326 (defun cider--file-path (path) 327 "Return PATH's local or tramp path using `cider-prefer-local-resources'. 328 If no local or remote file exists, return nil." 329 (let* ((local-path (funcall cider-from-nrepl-filename-function path)) 330 (tramp-path (and local-path (cider--client-tramp-filename local-path)))) 331 (cond ((equal local-path "") "") 332 ((and cider-prefer-local-resources (file-exists-p local-path)) 333 local-path) 334 ((and tramp-path (file-exists-p tramp-path)) 335 tramp-path) 336 ((and local-path (file-exists-p local-path)) 337 local-path)))) 338 339 (declare-function archive-extract "arc-mode") 340 (declare-function archive-zip-extract "arc-mode") 341 342 (defun cider-find-file (url) 343 "Return a buffer visiting the file URL if it exists, or nil otherwise. 344 If URL has a scheme prefix, it must represent a fully-qualified file path 345 or an entry within a zip/jar archive. If AVFS (archive virtual file 346 system; see online docs) is mounted the archive entry is opened inside the 347 AVFS directory, otherwise the entry is archived into a temporary read-only 348 buffer. If URL doesn't contain a scheme prefix and is an absolute path, it 349 is treated as such. Finally, if URL is relative, it is expanded within each 350 of the open Clojure buffers till an existing file ending with URL has been 351 found." 352 (require 'arc-mode) 353 (cond ((string-match "^file:\\(.+\\)" url) 354 (when-let* ((file (cider--url-to-file (match-string 1 url))) 355 (path (cider--file-path file))) 356 (find-file-noselect path))) 357 ((string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" url) 358 (when-let* ((entry (match-string 3 url)) 359 (file (cider--url-to-file (match-string 2 url))) 360 (path (cider--file-path file)) 361 (name (format "%s:%s" path entry)) 362 (avfs (format "%s%s#uzip/%s" 363 (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/")) 364 path entry))) 365 (cond 366 ;; 1) use avfs 367 ((file-exists-p avfs) 368 (find-file-noselect avfs)) 369 ;; 2) already uncompressed 370 ((find-buffer-visiting name)) 371 ;; 3) on remotes use Emacs built-in archiving 372 ((tramp-tramp-file-p path) 373 (find-file path) 374 (goto-char (point-min)) 375 ;; anchor to eol to prevent eg. clj matching cljs. 376 (re-search-forward (concat entry "$")) 377 (let ((archive-buffer (current-buffer))) 378 (archive-extract) 379 (kill-buffer archive-buffer)) 380 (current-buffer)) 381 ;; 4) Use external zip program to extract a single file 382 (t 383 (with-current-buffer (generate-new-buffer 384 (file-name-nondirectory entry)) 385 ;; Use appropriate coding system for bytes read from unzip cmd to 386 ;; display Emacs native newlines regardless of whether the file 387 ;; uses unix LF or dos CRLF line endings. 388 ;; It's important to avoid spurious CR characters, which may 389 ;; appear as `^M', because they can confuse clojure-mode's symbol 390 ;; detection, e.g. `clojure-find-ns', and break `cider-find-var'. 391 ;; `clojure-find-ns' uses Emacs' (thing-at-point 'symbol) as 392 ;; part of identifying a file's namespace, and when a file 393 ;; isn't decoded properly, namespaces can be reported as 394 ;; `my.lib^M' which `cider-find-var' won't know what to do with. 395 (let ((coding-system-for-read 'prefer-utf-8)) 396 (archive-zip-extract path entry)) 397 (set-visited-file-name name) 398 (setq-local default-directory (file-name-directory path)) 399 (setq-local buffer-read-only t) 400 (set-buffer-modified-p nil) 401 (set-auto-mode) 402 (current-buffer)))))) 403 (t (if-let* ((path (cider--file-path url))) 404 (find-file-noselect path) 405 (unless (file-name-absolute-p url) 406 (let ((cider-buffers (cider-util--clojure-buffers)) 407 (url (file-name-nondirectory url))) 408 (or (cl-loop for bf in cider-buffers 409 for path = (with-current-buffer bf 410 (expand-file-name url)) 411 if (and path (file-exists-p path)) 412 return (find-file-noselect path)) 413 (cl-loop for bf in cider-buffers 414 if (string= (buffer-name bf) url) 415 return bf)))))))) 416 417 (defun cider--open-other-window-p (arg) 418 "Test prefix value ARG to see if it indicates displaying results in other window." 419 (let ((narg (prefix-numeric-value arg))) 420 (pcase narg 421 (-1 t) ; - 422 (16 t) ; empty empty 423 (_ nil)))) 424 425 (defun cider-abbreviate-ns (namespace) 426 "Return a string that abbreviates NAMESPACE." 427 (when namespace 428 (let* ((names (reverse (split-string namespace "\\."))) 429 (lastname (car names))) 430 (concat (mapconcat (lambda (s) (concat (substring s 0 1) ".")) 431 (reverse (cdr names)) 432 "") 433 lastname)))) 434 435 (defun cider-last-ns-segment (namespace) 436 "Return the last segment of NAMESPACE." 437 (when namespace 438 (car (reverse (split-string namespace "\\."))))) 439 440 441 (provide 'cider-common) 442 ;;; cider-common.el ends here