aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lisp/hcel-results.el2
-rw-r--r--lisp/hcel-source.el90
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