diff options
Diffstat (limited to 'hcel-source.el')
-rw-r--r-- | hcel-source.el | 123 |
1 files changed, 6 insertions, 117 deletions
diff --git a/hcel-source.el b/hcel-source.el index f6e5d55..905950c 100644 --- a/hcel-source.el +++ b/hcel-source.el @@ -20,8 +20,7 @@ (require 'array) (require 'dom) (require 'hcel-client) -(require 'hcel-outline) -(require 'hcel-results) +(require 'text-property-search) (require 'xref) (defvar-local hcel-identifiers nil) @@ -223,18 +222,9 @@ the location with pulsing. (unless (length= expr 0) (hcel-expression-and-type (elt expr (1- (length expr)))))))))) -(defun hcel-outline-package-module () - (interactive) - (let ((package-id hcel-package-id) - (module-path hcel-module-path)) - (hcel) - (hcel-outline-goto-package package-id) - (hcel-outline-load-modules-at-point) - (hcel-outline-goto-module module-path) - (hcel-outline-load-identifiers-at-point))) -(define-key hcel-mode-map "O" #'hcel-outline-package-module) - ;; eldoc +(defvar hcel-eldoc-hook nil) + (defun hcel-eldoc-id-type (cb) (when-let ((symbol (hcel-occ-symbol-at-point)) (doc (hcel-type-at-point)) @@ -246,63 +236,13 @@ the location with pulsing. (funcall cb docstring :thing symbol :face 'font-lock-variable-name-face) - (with-current-buffer eldoc--doc-buffer - (hcel-minor-mode)))) - -(defun hcel-minor-eldoc-id-type (cb) - (when-let* ((identifier (hcel-text-property-near-point 'internal-id)) - (symbol (save-excursion - (buffer-substring - (progn - (text-property-search-backward - 'internal-id identifier 'string=) - (point)) - (progn - (text-property-search-forward - 'internal-id identifier 'string=) - (point))))) - (docstring - (cond ((derived-mode-p 'hcel-outline-mode) - (hcel-render-type-internal - (hcel-text-property-near-point 'package-id) - (hcel-text-property-near-point 'module-path) - identifier)) - ((derived-mode-p 'hcel-ids-mode) - (hcel-render-type-internal - (alist-get 'packageId (hcel-text-property-near-point 'location-info)) - (alist-get 'modulePath (hcel-text-property-near-point 'location-info)) - identifier)) - (t nil)))) - (funcall cb docstring - :thing symbol - :face 'font-lock-variable-name-face) - (with-current-buffer eldoc--doc-buffer - (hcel-minor-mode)))) + (run-hooks 'hcel-eldoc-hook))) (defun hcel-eldoc-docs (cb) (when-let ((docstring (hcel-id-docs-at-point))) (setq this-command nil) (funcall cb docstring) - (with-current-buffer eldoc--doc-buffer - (hcel-minor-mode)))) - -(defun hcel-minor-eldoc-docs (cb) - (when-let* ((docstring - (cond ((derived-mode-p 'hcel-outline-mode) - (hcel-id-docs-internal - (hcel-text-property-near-point 'package-id) - (hcel-text-property-near-point 'module-path) - (hcel-text-property-near-point 'internal-id))) - ((derived-mode-p 'hcel-ids-mode) - (hcel-id-docs-internal - (alist-get 'packageId (hcel-text-property-near-point 'location-info)) - (alist-get 'modulePath (hcel-text-property-near-point 'location-info)) - (hcel-text-property-near-point 'internal-id))) - (t nil)))) - (setq this-command nil) - (funcall cb docstring) - (with-current-buffer eldoc--doc-buffer - (hcel-minor-mode)))) + (run-hooks 'hcel-eldoc-hook))) (defun hcel-eldoc-expression-type (cb) (when mark-active @@ -313,8 +253,7 @@ the location with pulsing. (funcall cb (cdr expr-and-type) :thing (car expr-and-type) :face 'font-lock-variable-name-face) - (with-current-buffer eldoc--doc-buffer - (hcel-minor-mode))))) + (run-hooks 'hcel-eldoc-hook)))) ;; highlight (defface hcel-highlight-id '((t (:inherit underline))) @@ -432,24 +371,6 @@ the location with pulsing. (hcel-text-property-near-point 'identifier) (hcel-text-property-near-point 'occurrence))) -(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) - (cond ((or (derived-mode-p 'hcel-outline-mode) - (eq (current-buffer) eldoc--doc-buffer)) - (hcel-find-definition-internal - (hcel-text-property-near-point 'package-id) - (hcel-text-property-near-point 'module-path) - (hcel-text-property-near-point 'internal-id))) - ((derived-mode-p 'hcel-ids-mode) - (hcel-find-definition-internal - (alist-get 'packageId (hcel-text-property-near-point 'location-info)) - (alist-get 'modulePath (hcel-text-property-near-point 'location-info)) - (hcel-text-property-near-point '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)) @@ -487,37 +408,5 @@ the location with pulsing. (t (error "unimplemented: %s" (hcel-location-tag location-info)))))))))) -;; hcel-minor mode -(defvar hcel-minor-major-modes - '(hcel-outline-mode hcel-ids-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." - :lighter " hcel-minor" - (add-hook 'xref-backend-functions - #'hcel-minor--xref-backend nil t) - (cond - ((null hcel-minor-mode) - (remove-hook 'eldoc-documentation-functions #'hcel-minor-eldoc-id-type t) - (remove-hook 'eldoc-documentation-functions #'hcel-minor-eldoc-docs t)) - ((not (or (apply 'derived-mode-p hcel-minor-major-modes) - (eq (current-buffer) eldoc--doc-buffer))) - (setq hcel-minor-mode nil) - (error "Not in one of the supported modes (%s) or the eldoc buffer." - (mapconcat #'prin1-to-string hcel-minor-major-modes - ", "))) - (t - (add-hook - 'eldoc-documentation-functions #'hcel-minor-eldoc-docs nil t) - (add-hook - 'eldoc-documentation-functions #'hcel-minor-eldoc-id-type nil t) - (setq-local eldoc-documentation-strategy 'eldoc-documentation-compose)))) - (provide 'hcel-source) ;;; hcel-source.el ends here. |