diff options
Diffstat (limited to 'hcel-minor.el')
-rw-r--r-- | hcel-minor.el | 143 |
1 files changed, 143 insertions, 0 deletions
diff --git a/hcel-minor.el b/hcel-minor.el new file mode 100644 index 0000000..b507ef4 --- /dev/null +++ b/hcel-minor.el @@ -0,0 +1,143 @@ +;;; hcel-minor.el --- hcel-minor mode for definitions, references and eldoc. -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; This file is part of hcel. +;; +;; hcel is free software: you can redistribute it and/or modify it under +;; the terms of the GNU Affero General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; hcel is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General +;; Public License for more details. +;; +;; You should have received a copy of the GNU Affero General Public +;; License along with hcel. If not, see <https://www.gnu.org/licenses/>. + +(require 'hcel-source) +(require 'hcel-results) +(require 'hcel-outline) + +(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)))) + +(defun hcel-minor-find-references-at-point () + (interactive) + (cond ((or (derived-mode-p 'hcel-outline-mode) + (eq (current-buffer) eldoc--doc-buffer)) + (hcel-find-references-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-references-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-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 1)))) + +(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)))) + +(add-hook 'hcel-ids-mode-hook (lambda () (hcel-minor-mode 1))) +(add-hook 'hcel-outline-mode-hook (lambda () (hcel-minor-mode 1))) + +(add-hook 'hcel-eldoc-hook (lambda () + (with-current-buffer eldoc--doc-buffer + (hcel-minor-mode 1)))) + +(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)))) + +(provide 'hcel-minor) |