diff options
| -rw-r--r-- | lisp/hcel-results.el | 2 | ||||
| -rw-r--r-- | lisp/hcel-source.el | 90 |
2 files changed, 66 insertions, 26 deletions
diff --git a/lisp/hcel-results.el b/lisp/hcel-results.el index 59213e6..6f9a29e 100644 --- a/lisp/hcel-results.el +++ b/lisp/hcel-results.el @@ -197,7 +197,7 @@ Start by choosing a package." (alist-get 'packageId (plist-get props 'location-info)) (alist-get 'modulePath (plist-get props 'location-info)) (plist-get props 'internal-id))) - (t (error "%S not supported!" major-mode))))) + (t (error "%S not supported and not in eldoc doc buffer." major-mode))))) (defun hcel-find-references-internal (package-id module-path identifier) (when (and package-id module-path identifier) diff --git a/lisp/hcel-source.el b/lisp/hcel-source.el index 31a17e1..e8f91b8 100644 --- a/lisp/hcel-source.el +++ b/lisp/hcel-source.el @@ -348,31 +348,71 @@ May cause error if the identifier has exact location." (hcel-find-definition)) (defun hcel-find-definition () - (let* ((location-info - (hcel-get-location-info (hcel-lookup-identifier-at-point) - (hcel-lookup-occurrence-at-point)))) - (when (string= (hcel-location-tag location-info) "ApproximateLocation") - (setq location-info (hcel-approx-to-exact-location location-info))) - (let ((module-path (alist-get 'modulePath location-info)) - (line-beg (alist-get 'startLine location-info)) - (col-beg (alist-get 'startColumn location-info)) - (line-end (alist-get 'endLine location-info)) - (col-end (alist-get 'endColumn location-info))) - (cond ((string= (hcel-location-tag location-info) "ExactLocation") - (let ((pos) (len) - (buffer (hcel-load-module-location-info location-info t))) - (with-current-buffer buffer - (save-excursion - (goto-line-column line-beg col-beg) - (setq pos (1- (point))) - (goto-line-column line-end col-end) - (setq len (- (point) pos 1)))) - (list (xref-make-match - "hcel match" - (xref-make-buffer-location buffer pos) - len)))) - (t - (error "unimplemented: %s" (hcel-location-tag location-info))))))) + (hcel-find-definition-internal + hcel-package-id hcel-module-path + (get-text-property (point) 'identifier) + (get-text-property (point) 'occurrence))) + +(add-hook 'hcel-minor-mode-hook + (lambda () + (add-hook 'xref-backend-functions + #'hcel-minor--xref-backend nil t))) +(defun hcel-minor--xref-backend () 'hcel-minor-xref) +(cl-defmethod xref-backend-definitions ((_backend (eql hcel-minor-xref)) _identifiers) + (hcel-minor-find-definition-at-point)) +(defun hcel-minor-find-definition-at-point () + (interactive) + (let ((props (text-properties-at (point)))) + (cond ((or (eq major-mode 'hcel-outline-mode) + (eq (current-buffer) eldoc--doc-buffer)) + (hcel-find-definition-internal + (plist-get props 'package-id) + (plist-get props 'module-path) + (plist-get props 'internal-id))) + ((eq major-mode 'hcel-ids-mode) + (hcel-find-definition-internal + (alist-get 'packageId (plist-get props 'location-info)) + (alist-get 'modulePath (plist-get props 'location-info)) + (plist-get props 'internal-id))) + (t (error "%S not supported and not in eldoc doc buffer." major-mode))))) + +(defun hcel-find-definition-internal (package-id module-path identifier + &optional occurrence) + (when (and package-id module-path (or identifier occurrence)) + (let ((hcel-buffer (hcel-buffer-name package-id module-path))) + (when (or (get-buffer hcel-buffer) + (and (y-or-n-p "Open module source?") + (hcel-load-module-source + package-id module-path)))) + (with-current-buffer hcel-buffer + (let ((location-info + (hcel-get-location-info + (when identifier + (alist-get (intern identifier) hcel-identifiers)) + (when occurrence + (alist-get (intern occurrence) hcel-occurrences))))) + (when (string= (hcel-location-tag location-info) "ApproximateLocation") + (setq location-info (hcel-approx-to-exact-location location-info))) + (let ((module-path (alist-get 'modulePath location-info)) + (line-beg (alist-get 'startLine location-info)) + (col-beg (alist-get 'startColumn location-info)) + (line-end (alist-get 'endLine location-info)) + (col-end (alist-get 'endColumn location-info))) + (cond ((string= (hcel-location-tag location-info) "ExactLocation") + (let ((pos) (len) + (buffer (hcel-load-module-location-info location-info t))) + (with-current-buffer buffer + (save-excursion + (goto-line-column line-beg col-beg) + (setq pos (1- (point))) + (goto-line-column line-end col-end) + (setq len (- (point) pos 1)))) + (list (xref-make-match + "hcel match" + (xref-make-buffer-location buffer pos) + len)))) + (t + (error "unimplemented: %s" (hcel-location-tag location-info)))))))))) ;; hcel-minor mode (defvar hcel-minor-major-modes |