From 0f77cab1b303bd23e84a48952834d7d607c089bd Mon Sep 17 00:00:00 2001 From: Yuchen Pei 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