From e32fbf40bd932904ff62fc7ab3702e6bc87e170a Mon Sep 17 00:00:00 2001 From: Tim Engler Date: Tue, 29 Nov 2022 08:17:26 +0800 Subject: [PATCH] Fixed it so that the Customization variable "Idris2 Source Locations" actually works. Added code cleanup by @ska80 --- idris2-commands.el | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/idris2-commands.el b/idris2-commands.el index 97b70ff..49444d2 100644 --- a/idris2-commands.el +++ b/idris2-commands.el @@ -344,12 +344,40 @@ compiler-annotated output. Does not return a line number." (formatting (cdr ty))) (idris2-show-info (format "%s" result) formatting))) +(defun file-for-fully-qualified-name (name) + "Guesses a relative filename for a full-qualified idris2 name" + (let* ((name-components (butlast (split-string name "\\."))) + (dirs (butlast name-components)) + (name (car (last name-components))) + (full-dir (mapconcat #'file-name-as-directory dirs "")) + ) + (concat full-dir name ".idr") + ) + ) + +(defun idris2-find-full-path (file name) + "Searches through idris2-process-current-working-directory and idris2-source-locations for given file and returns first match." + (if (file-exists-p file) file + (let* ((file-dirs (cons idris2-process-current-working-directory idris2-source-locations)) + (file-based-on-name (file-for-fully-qualified-name name)) + ;;(replace-regexp-in-string (replace-regexp-in-string "\(.*\)\..*" "\1" name) + (poss-full-filenames (mapcar #'(lambda (d) (concat (file-name-as-directory d) file-based-on-name)) file-dirs)) + (act-full-filenames (seq-filter #'file-exists-p poss-full-filenames)) + ) + (unless (null act-full-filenames) + (unless (null (cdr act-full-filenames)) + (message "Multiple locations found for file '%s': %s" file act-full-filenames)) + (car act-full-filenames)) + ) + ) + ) + (defun idris2-jump-to-location (loc is-same-window) "Jumps to specified location." (pcase-let* ((`(,_name (:filename ,file) (:start ,line ,col) (:end ,_ ,_)) loc) - (full-path file)) + (full-path (idris2-find-full-path file _name))) (xref-push-marker-stack) ;; this pushes a "tag" mark. haskell mode ;; also does this and it seems appropriate, allows the user to pop ;; the tag and go back to the previous point. (pop-tag-mark