From 0f77cab1b303bd23e84a48952834d7d607c089bd Mon Sep 17 00:00:00 2001
From: Yuchen Pei <hi@ypei.me>
Date: Tue, 6 Sep 2022 11:21:51 +1000
Subject: Adding hcel minor mode and find references in outline mode
---
lisp/hcel-outline.el | 28 ++++++++++++++--------------
lisp/hcel-results.el | 31 ++++++++++++++++++++++++-------
lisp/hcel-source.el | 19 +++++++++++++++++++
lisp/hcel-utils.el | 6 ++++--
4 files changed, 61 insertions(+), 23 deletions(-)
(limited to 'lisp')
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
"")))))))
--
cgit v1.2.3