From b13a70c089fd725fd9ef458a36ba30a08f2898ee Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Sat, 15 Jul 2017 15:58:51 +0200 Subject: Add support for interactive location references in REPL --- CHANGELOG.md | 2 + cider-interaction.el | 2 +- cider-repl.el | 134 +++++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 132 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 68f9d43c..87e10386 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,8 @@ ### New Features * [#2050](https://github.com/clojure-emacs/cider/pull/2050) Use `view-mode` for `cider-grimoire` buffers +* Make stacktraces and other location references in REPL clickable. +* Highlight root namespace in REPL stacktraces. * Filter stacktrace to just frames from your project. * [#1918](https://github.com/clojure-emacs/cider/issues/1918): Add new commands `cider-browse-spec` and `cider-browse-spec-all` which start a spec browser. * [#2015](https://github.com/clojure-emacs/cider/pull/2015): Show symbols as special forms *and* macros in `cider-doc` diff --git a/cider-interaction.el b/cider-interaction.el index 36297114..09b72a2f 100644 --- a/cider-interaction.el +++ b/cider-interaction.el @@ -1125,7 +1125,7 @@ ADDITIONAL-PARAMS is a plist to be appended to the request message. If `cider-interactive-eval-override' is a function, call it with the same arguments and only proceed with evaluation if it returns nil." - (let ((form (or form (apply #'buffer-substring bounds))) + (let ((form (or form (apply #'buffer-substring-no-properties bounds))) (start (car-safe bounds)) (end (car-safe (cdr-safe bounds)))) (when (and start end) diff --git a/cider-repl.el b/cider-repl.el index 31e9ae46..c47b80c2 100644 --- a/cider-repl.el +++ b/cider-repl.el @@ -550,6 +550,33 @@ When there is a possible unfinished ansi control sequence, (insert-before-markers (cadr ansi-color-context)) (setq ansi-color-context nil))) +(defvar cider-repl--root-ns-highlitht-template "\\<%s[^$/: \t\n]+" + "Regexp used to highlight root ns in REPL buffers.") + +(defvar-local cider-repl--root-ns-regexp nil + "Cache of root ns regexp in REPLs") + +(defun cider-repl--apply-current-project-color (string) + "Fontify project's root namespace to make stacktraces more readable. +Foreground of `cider-stacktrace-ns-face' is used to propertize matched +namespaces. STRING is REPL's output." + (if (null nrepl-project-dir) + string + (unless cider-repl--root-ns-regexp + (let ((root (file-name-nondirectory (directory-file-name nrepl-project-dir)))) + (setq cider-repl--root-ns-regexp + ;; Replace _ or - with regexp patter to accommodate "raw" namespaces + (format cider-repl--root-ns-highlitht-template + (replace-regexp-in-string "[_-]+" "[_-]+" root))))) + (let ((start 0) + (end 0)) + (while (setq start (string-match cider-repl--root-ns-regexp string end)) + (setq end (match-end 0)) + (let ((face-spec (list (cons 'foreground-color + (face-attribute 'cider-stacktrace-ns-face :foreground nil t))))) + (font-lock-prepend-text-property start end 'face face-spec string))) + string))) + (defun cider-repl--emit-output-at-pos (buffer string output-face position &optional bol) "Using BUFFER, insert STRING (applying to it OUTPUT-FACE) at POSITION. If BOL is non-nil insert at the beginning of line." @@ -560,10 +587,14 @@ If BOL is non-nil insert at the beginning of line." (goto-char position) ;; TODO: Review the need for bol (when (and bol (not (bolp))) (insert-before-markers "\n")) - (insert-before-markers - (ansi-color-apply (propertize string - 'font-lock-face output-face - 'rear-nonsticky '(font-lock-face)))) + (setq string + (thread-first string + (propertize 'font-lock-face output-face + 'rear-nonsticky '(font-lock-face)) + (ansi-color-apply) + (cider-repl--apply-current-project-color) + (propertize 'help-echo 'cider-locref-help-echo))) + (insert-before-markers string) (cider-repl--flush-ansi-color-context) (when (and (= (point) cider-repl-prompt-start-mark) (not (bolp))) @@ -930,7 +961,100 @@ namespace to switch to." :both)) -;;;;; History +;;; Location References + +(defcustom cider-locref-regexp-alist + '((stdout-stacktrace "[ \t]\\(at \\([^$(]+\\).*(\\([^:()]+\\):\\([0-9]+\\))\\)" 1 2 3 4) + (aviso-stacktrace "^[ \t]*\\(\\([^$/ \t]+\\).*? +\\([^:]+\\): +\\([0-9]+\\)\\)" 1 2 3 4) + (print-stacktrace "\\[\\([^][$ \t]+\\).* +\\([^ \t]+\\) +\\([0-9]+\\)\\]" 0 1 2 3) + (timbre-log "\\(TRACE\\|INFO\\|DEBUG\\|WARN\\|ERROR\\) +\\(\\[\\([^:]+\\):\\([0-9]+\\)\\]\\)" 2 3 nil 4)) + "Alist holding regular expressions for inline location references. +Each element in the alist has the form (NAME REGEXP HIGHLIGHT VAR FILE +LINE), where NAME is the identifier of the regexp, REGEXP - regexp matching +a location, HIGHLIGHT - sub-expression matching region to highlight on +mouse-over, VAR - sub-expression giving Clojure VAR to look up. FILE is +currently only used when VAR is nil and must be full resource path in that +case." + :type '(alist :key-type sexp) + :group 'cider-repl + :package-version '(cider. "0.16.0")) + +(defun cider--locref-at-point-1 (reg-list &optional pos) + "Workhorse for getting locref at POS. +REG-LIST is an entry in `cider-locref-regexp-alist'." + (save-excursion + (let ((pos (or pos (point)))) + (goto-char pos) + (beginning-of-line) + (when (re-search-forward (nth 1 reg-list) (point-at-eol) t) + (let ((ix-highlight (or (nth 2 reg-list) 0)) + (ix-var (nth 3 reg-list)) + (ix-file (nth 4 reg-list)) + (ix-line (nth 5 reg-list))) + (list + :type (car reg-list) + :highlight (cons (match-beginning ix-highlight) (match-end ix-highlight)) + :var (and ix-var + (replace-regexp-in-string "_" "-" + (match-string-no-properties ix-var) + nil t)) + :file (and ix-file (match-string-no-properties ix-file)) + :line (and ix-line (string-to-number (match-string-no-properties ix-line))))))))) + +(defun cider-locref-at-point (&optional pos) + "Return a plist of components of the location reference at POS. +Limit search to current line only and return nil if no location has been +found. Returned keys are :type, :highlight, :var, :file, :line, where +:highlight is a cons of positions, :var and :file are strings or nil, :line +is a number. See `cider-locref-regexp-alist' for how to specify regexes +for locref look up." + (seq-some (lambda (rl) (cider--locref-at-point-1 rl pos)) + cider-locref-regexp-alist)) + +(defun cider-jump-to-locref-at-point (&optional pos) + "Identify location reference at POS and navigate to it. +This function is used from help-echo property inside REPL buffers and uses +regexes from `cider-locref-regexp-alist' to infer locations at point." + (interactive) + (if-let ((loc (cider-locref-at-point pos))) + (let* ((var (plist-get loc :var)) + (line (plist-get loc :line)) + (file (if var + (or (cider-sync-request:ns-path var) + (nrepl-dict-get (cider-sync-request:info var) "file")) + (plist-get loc :file)))) + (if file + (cider--jump-to-loc-from-info (nrepl-dict "file" file "line" line)) + (error "No source location for %s" var))) + (user-error "No location reference at point"))) + +(defvar cider-locref-hoover-overlay + (let ((o (make-overlay 1 1))) + (overlay-put o 'category 'cider-error-hoover) + ;; (overlay-put o 'face 'highlight) + (overlay-put o 'pointer 'hand) + (overlay-put o 'mouse-face 'highlight) + (overlay-put o 'follow-link 'mouse) + (overlay-put o 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [return] 'cider-jump-to-locref-at-point) + (define-key map [mouse-2] 'cider-jump-to-locref-at-point) + map)) + o) + "Overlay used during hoovering on location references in REPL buffers. +One for all REPLs.") + +(defun cider-locref-help-echo (win buffer pos) + "Function for help-echo property in REPL buffers. +WIN, BUFFER and POS are the window, buffer and point under mouse position." + (with-current-buffer buffer + (if-let ((hl (plist-get (cider-locref-at-point pos) :highlight))) + (move-overlay cider-locref-hoover-overlay (car hl) (cdr hl)) + (delete-overlay cider-locref-hoover-overlay)) + nil)) + + +;;; History (defcustom cider-repl-wrap-history nil "T to wrap history around when the end is reached." -- cgit v1.2.3