Adding hcel minor mode and find references in outline mode

4 files changed, 61 insertions, 23 deletions

diff --git a/lisp/hcel-outline.el b/lisp/hcel-outline.el
index b55c2b5..3732ed2 100644
--- a/lisp/hcel-outline.el
+++ b/lisp/hcel-outline.el
@@ -31,12 +31,12 @@
       (switch-to-buffer (get-buffer-create hcel-outline-buffer-name))
       (save-excursion
         (mapc
-         (lambda (package)
+         (lambda (package-id)
            (insert
             (concat (propertize
-                     (hcel-format-package-id package)
+                     (hcel-format-package-id package-id)
                      'thing 'package
-                     'package package
+                     'package-id package-id
                      'children-loaded nil)
                     "\n")))
          (hcel-api-packages)))
@@ -45,22 +45,22 @@
 (define-key hcel-mode-map "o" 'hcel)
 
 ;; TODO: maybe remove
-(defun hcel-outline-update-opened (package module-path)
+(defun hcel-outline-update-opened (package-id module-path)
   "Update the outline tree depending on openness of packages and modules.
 
 If a package is opened outside of the outline mode (mainly source mode), then
 update in the outline mode too."
   (with-current-buffer hcel-outline-buffer-name
     (save-excursion
-      (hcel-outline-goto-package package)
+      (hcel-outline-goto-package package-id)
       (hcel-outline-load-modules-at-point)
       (hcel-outline-goto-module module-path)
       (hcel-outline-load-identifiers-at-point))))
 
-(defun hcel-outline-goto-package (package)
+(defun hcel-outline-goto-package (package-id)
   (goto-char (point-min))
   (re-search-forward
-   (format "^%s$" (hcel-format-package-id package)))
+   (format "^%s$" (hcel-format-package-id package-id)))
   (beginning-of-line))
 
 (defun hcel-outline-goto-module (module-path)
@@ -80,7 +80,7 @@ update in the outline mode too."
   (unless (get-text-property (point) 'children-loaded)
     (save-excursion
       (let ((inhibit-read-only t)
-            (package (get-text-property (point) 'package)))
+            (package-id (get-text-property (point) 'package-id)))
         (put-text-property
          (progn (beginning-of-line) (point))
          (progn (end-of-line) (point))
@@ -92,10 +92,10 @@ update in the outline mode too."
             (propertize (concat
                          (make-string hcel-outline-indentation 32) module "\n")
                         'thing 'module
-                        'package package
+                        'package-id package-id
                         'module-path module
                         'folded t)))
-         (hcel-api-package-info package))))))
+         (hcel-api-package-info package-id))))))
 
 (defun hcel-outline-toggle-children ()
   (interactive)
@@ -113,7 +113,7 @@ update in the outline mode too."
   (unless (get-text-property (point) 'children-loaded)
     (save-excursion
       (let* ((inhibit-read-only t)
-             (package-id (get-text-property (point) 'package))
+             (package-id (get-text-property (point) 'package-id))
              (module-path (get-text-property (point) 'module-path))
              (imenu-index))
         (put-text-property
@@ -134,7 +134,7 @@ update in the outline mode too."
                        (car pair)
                        "\n")
                'thing 'identifier
-               'package package-id
+               'package-id package-id
                'module-path module-path
                'position (cdr pair))))
            imenu-index))))))
@@ -146,7 +146,7 @@ update in the outline mode too."
       (error "Point is not at a module!"))
     (let ((buffer
            (hcel-load-module-source
-            (plist-get props 'package)
+            (plist-get props 'package-id)
             (plist-get props 'module-path))))
       (hcel-outline-load-identifiers-at-point)
       (if other-window
@@ -160,7 +160,7 @@ update in the outline mode too."
       (error "Point is not at an identifier!"))
     (let ((buffer
            (hcel-load-module-source
-            (plist-get props 'package)
+            (plist-get props 'package-id)
             (plist-get props 'module-path))))
       (if other-window
           (switch-to-buffer-other-window buffer)
diff --git a/lisp/hcel-results.el b/lisp/hcel-results.el
index 63f3c91..2636b41 100644
--- a/lisp/hcel-results.el
+++ b/lisp/hcel-results.el
@@ -179,15 +179,32 @@ Start by choosing a package."
 (defun hcel-find-references-at-point ()
   "Find references of the identifier at point."
   (interactive)
-  (when-let ((id (alist-get 'externalId (hcel-lookup-identifier-at-point)))
-             (buffer-name (hcel-refs-format-id id)))
-    (with-current-buffer (get-buffer-create buffer-name)
-      (hcel-refs-mode)
-      (setq hcel-refs-id id)
-      (hcel-refs-update-references-package)
-      (switch-to-buffer-other-window buffer-name))))
+  (hcel-find-references-internal hcel-package-id hcel-module-path
+                                 (get-text-property (point) 'identifier)))
 (define-key hcel-mode-map (kbd "M-?") 'hcel-find-references-at-point)
 
+(defun hcel-minor-find-references-at-point ()
+  (interactive)
+  (let ((props (text-properties-at (point))))
+    (cond ((eq major-mode 'hcel-outline-mode)
+           (hcel-find-references-internal
+            (plist-get props 'package-id)
+            (plist-get props 'module-path)
+            (plist-get props 'internal-id)))
+          (t (error "%S not supported!" major-mode)))))
+
+(defun hcel-find-references-internal (package-id module-path identifier)
+  (when (and package-id module-path identifier)
+    (with-current-buffer (hcel-buffer-name package-id module-path)
+      (when-let* ((id (alist-get
+                       'externalId
+                       (alist-get (intern identifier) hcel-identifiers)))
+                  (buffer-name (hcel-refs-format-id id)))
+        (with-current-buffer (get-buffer-create buffer-name)
+          (hcel-refs-mode)
+          (setq hcel-refs-id id)
+          (hcel-refs-update-references-package))
+        (switch-to-buffer-other-window buffer-name)))))
 ;; hcel-ids-mode
 (defcustom hcel-ids-per-page 20
   "hcel-ids mode number of results per page."
diff --git a/lisp/hcel-source.el b/lisp/hcel-source.el
index 29efab0..783436b 100644
--- a/lisp/hcel-source.el
+++ b/lisp/hcel-source.el
@@ -365,4 +365,23 @@ May cause error if the identifier has exact location."
             (t
              (error "unimplemented: %s" (hcel-location-tag location-info)))))))
 
+;; hcel-minor mode
+(defvar hcel-minor-major-modes
+  '(hcel-outline-mode hcel-ids-mode eldoc-mode)
+  "Major modes where hcel-minor mode can live in.")
+
+(defvar hcel-minor-mode-map
+  (let ((kmap (make-sparse-keymap)))
+    (define-key kmap (kbd "M-?") 'hcel-minor-find-references-at-point)
+    kmap))
+
+(define-minor-mode hcel-minor-mode
+  "A minor mode for exploring haskell codebases."
+  :after-hook
+  (if hcel-minor-mode
+      (if (not (memq major-mode hcel-minor-major-modes))
+          (error "Not in one of the following modes: %s"
+                 (string-join (mapcar 'prin1-to-string hcel-minor-major-modes)
+                              ", ")))))
+
 (provide 'hcel-source)
diff --git a/lisp/hcel-utils.el b/lisp/hcel-utils.el
index 9db5d81..9526521 100644
--- a/lisp/hcel-utils.el
+++ b/lisp/hcel-utils.el
@@ -121,8 +121,10 @@ Example of an idSrcSpan:
                       (replace-regexp-in-string
                        "\n" " " (mapconcat
                                  (lambda (component)
-                                   (or (alist-get 'name component)
-                                       (alist-get 'contents component)))
+                                   (propertize
+                                    (or (alist-get 'name component)
+                                        (alist-get 'contents component))
+                                    'internal-id (alist-get 'internalId component)))
                                  components
                                  "")))))))