From 1b0817abd54e4ff050240bee47b28e66e843eb66 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Wed, 21 Sep 2022 12:52:31 +1000 Subject: Patch from Stefan Monnier. https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01378.html --- .gitignore | 5 +++- hc.el | 58 ---------------------------------------------- hcel-client.el | 2 +- hcel-haddorg.el | 2 +- hcel-outline.el | 34 ++++++++++++++------------- hcel-results.el | 48 ++++++++++++++++++++------------------ hcel-source.el | 72 ++++++++++++++++++++++++++------------------------------- hcel-utils.el | 1 + hcel.el | 60 +++++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 144 insertions(+), 138 deletions(-) delete mode 100644 hc.el create mode 100644 hcel.el diff --git a/.gitignore b/.gitignore index e4e5f6c..bd5709f 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,4 @@ -*~ \ No newline at end of file +*~ +*.elc +/hcel-autoloads.el +/hcel-pkg.el diff --git a/hc.el b/hc.el deleted file mode 100644 index f6239f6..0000000 --- a/hc.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; hc.el --- Haskell codebase explorer -*- lexical-binding: t; -*- - -;; Author: Yuchen Pei -;; Maintainer: Yuchen Pei -;; Created: 2022 -;; Version: 0 -;; Keywords: haskell -;; Package-Requires: ((emacs "28") (haskell-mode)) -;; Package-Type: multi -;; Homepage: https://g.ypei.me/hcel.git - -;; Copyright (C) 2022 Yuchen Pei. -;; -;; 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 . - -(require 'hcel-source) -(require 'hcel-outline) -(require 'hcel-results) -(require 'hcel-utils) - -(defun hcel-package (package-id) - "Select a package, followed by selecting a module to display the source." - (interactive - (list - (completing-read "Select package: " - (mapcar 'hcel-format-package-id - (hcel-api-packages))))) - (call-interactively (hcel-module-selector (hcel-parse-package-id package-id)))) - -(defun hcel-module () - "Select a module to display source." - (interactive) - (call-interactively - (hcel-module-selector hcel-package-id))) - -(defun hcel-module-selector (package-id) - (lambda (module-path) - (interactive - (list - (completing-read "Select module: " - (hcel-list-modules package-id)))) - (switch-to-buffer - (hcel-load-module-source package-id module-path)))) - -(provide 'hc) diff --git a/hcel-client.el b/hcel-client.el index ab64ea3..5ec6055 100644 --- a/hcel-client.el +++ b/hcel-client.el @@ -138,7 +138,7 @@ (goto-char (point-max)) (insert "[" (current-time-string) "] Request: " url "\n")) (with-current-buffer (url-retrieve-synchronously url t) - (let ((header) (status) (fields) (json)) + (let ((header) (status) (fields)) (delete-http-header) (setq header (hcel-parse-http-header (car kill-ring)) status (alist-get 'status header) diff --git a/hcel-haddorg.el b/hcel-haddorg.el index ad797e0..be97e42 100644 --- a/hcel-haddorg.el +++ b/hcel-haddorg.el @@ -29,7 +29,7 @@ (module-name (car splitted)) (entity (if (equal "v" (cadr splitted)) "Val" "Typ")) (name (caddr splitted)) - (package) (unparsed) (package-id)) + (package) (package-id)) (goto-char (point-min)) (setq package (org-entry-get (point) "ITEM")) (setq package-id diff --git a/hcel-outline.el b/hcel-outline.el index a46db14..78aad54 100644 --- a/hcel-outline.el +++ b/hcel-outline.el @@ -17,31 +17,33 @@ ;; You should have received a copy of the GNU Affero General Public ;; License along with hcel. If not, see . +(require 'hcel-source) + (defvar hcel-outline-buffer-name "*hcel-outline*") (defvar hcel-outline-indentation 2) (defvar hcel-outline-mode-map (let ((kmap (make-sparse-keymap))) - (define-key kmap "n" 'outline-next-visible-heading) - (define-key kmap "p" 'outline-previous-visible-heading) - (define-key kmap "f" 'outline-forward-same-level) - (define-key kmap "F" 'hcel-outline-follow-mode) - (define-key kmap "b" 'outline-backward-same-level) - (define-key kmap "u" 'outline-up-heading) - (define-key kmap "\t" 'hcel-outline-toggle-children) - (define-key kmap "\r" 'hcel-outline-open-thing-at-point) - (define-key kmap "o" 'hcel-outline-open-thing-at-point-other-window) - (define-key kmap "q" 'quit-window) + (define-key kmap "n" #'outline-next-visible-heading) + (define-key kmap "p" #'outline-previous-visible-heading) + (define-key kmap "f" #'outline-forward-same-level) + (define-key kmap "F" #'hcel-outline-follow-mode) + (define-key kmap "b" #'outline-backward-same-level) + (define-key kmap "u" #'outline-up-heading) + (define-key kmap "\t" #'hcel-outline-toggle-children) + (define-key kmap "\r" #'hcel-outline-open-thing-at-point) + (define-key kmap "o" #'hcel-outline-open-thing-at-point-other-window) + (define-key kmap "q" #'quit-window) kmap)) (define-derived-mode hcel-outline-mode outline-mode "hcel-outline" - "Major mode for browsing Haskell codebases" + "Major mode for browsing Haskell codebases." (setq-local package-filter nil module-filter nil outline-regexp "\\( *\\)." outline-level (lambda () (1+ (/ (length (match-string 1)) hcel-outline-indentation))) - buffer-read-only t)) -(add-hook 'hcel-outline-mode-hook 'hcel-minor-mode) + buffer-read-only t) + (hcel-minor-mode 1)) (defun hcel () (interactive) @@ -61,7 +63,7 @@ (hcel-api-packages))) (hcel-outline-mode)))) -(define-key hcel-mode-map "o" 'hcel) +(define-key hcel-mode-map "o" #'hcel) ;; TODO: maybe remove (defun hcel-outline-update-opened (package-id module-path) @@ -208,8 +210,8 @@ update in the outline mode too." (if (not (eq major-mode 'hcel-outline-mode)) (error "Not in hcel-outline mode!") (add-hook 'post-command-hook - 'hcel-outline-open-thing-at-point-other-window nil t)) + #'hcel-outline-open-thing-at-point-other-window nil t)) (remove-hook 'post-command-hook - 'hcel-outline-open-thing-at-point-other-window t))) + #'hcel-outline-open-thing-at-point-other-window t))) (provide 'hcel-outline) diff --git a/hcel-results.el b/hcel-results.el index a0ce11b..ff19d26 100644 --- a/hcel-results.el +++ b/hcel-results.el @@ -24,6 +24,7 @@ ;;; Code: (require 'hcel-utils) +(eval-when-compile (require 'compile)) (defun hcel-results-next-error-no-open (n) (interactive "p") @@ -40,7 +41,7 @@ (goto-char (point-min)) (hcel-results-next-error-internal 1 nil)) (if (> n 0) - (dotimes (unused n) + (dotimes (_unused n) (condition-case nil (progn (goto-char (next-single-property-change (point) 'match-line)) @@ -48,7 +49,7 @@ (goto-char (next-single-property-change (point) 'match-line)))) (error (hcel-results-next-page)))) - (dotimes (unused (- n)) + (dotimes (_unused (- n)) (condition-case nil (progn (goto-char (previous-single-property-change (point) 'match-line)) @@ -68,12 +69,15 @@ (compilation-set-overlay-arrow (selected-window)) (hcel-load-module-location-info (get-text-property (point) 'location-info))) +(defvar-local hcel-results-page-number nil) + (defun hcel-results-next-page () (interactive) + ;; FIXME: Using `major-mode' is a code smell. (unless (memq major-mode '(hcel-refs-mode hcel-ids-mode)) (error "Not in hcel-refs or hcel-ids mode: %S" major-mode)) (when (= hcel-results-page-number hcel-results-max-page-number) - (error "Already on the last page.")) + (error "Already on the last page")) (setq hcel-results-page-number (1+ hcel-results-page-number)) (cond ((eq major-mode 'hcel-refs-mode) (hcel-refs-update-references)) ((eq major-mode 'hcel-ids-mode) (hcel-ids-update)) @@ -100,17 +104,17 @@ (define-compilation-mode hcel-refs-mode "hcel-refs" "Major mode for showing references" - (setq-local next-error-function 'hcel-results-next-error + (setq-local next-error-function #'hcel-results-next-error hcel-refs-id nil hcel-refs-package-id nil hcel-results-page-number nil hcel-results-max-page-number nil)) (define-key hcel-refs-mode-map (kbd "M-n") - 'hcel-results-next-error-no-open) + #'hcel-results-next-error-no-open) (define-key hcel-refs-mode-map (kbd "M-p") - 'hcel-results-previous-error-no-open) + #'hcel-results-previous-error-no-open) (defun hcel-refs-update-references () "Find references and update the current hcel-refs-mode buffer." @@ -159,11 +163,11 @@ (defun hcel-refs-reload () (interactive) (hcel-refs-update-references)) -(define-key hcel-refs-mode-map "g" 'hcel-refs-reload) +(define-key hcel-refs-mode-map "g" #'hcel-refs-reload) -(define-key hcel-refs-mode-map "f" 'hcel-results-next-page) +(define-key hcel-refs-mode-map "f" #'hcel-results-next-page) -(define-key hcel-refs-mode-map "b" 'hcel-results-previous-page) +(define-key hcel-refs-mode-map "b" #'hcel-results-previous-page) (defun hcel-refs-buffer-name (id) (format "*hcel-refs %s*" (hcel-refs-format-id id))) @@ -199,14 +203,14 @@ Start by choosing a package." hcel-results-page-number 1 hcel-results-max-page-number max-page-number) (hcel-refs-update-references))) -(define-key hcel-refs-mode-map "P" 'hcel-refs-update-references-package) +(define-key hcel-refs-mode-map "P" #'hcel-refs-update-references-package) (defun hcel-find-references-at-point () "Find references of the identifier at point." (interactive) (hcel-find-references-internal hcel-package-id hcel-module-path (hcel-text-property-near-point 'identifier))) -(define-key hcel-mode-map (kbd "M-?") 'hcel-find-references-at-point) +(define-key hcel-mode-map (kbd "M-?") #'hcel-find-references-at-point) (defun hcel-minor-find-references-at-point () (interactive) @@ -249,13 +253,13 @@ Start by choosing a package." :group 'hcel-ids) (define-compilation-mode hcel-ids-mode "hcel-ids" "Major mode for showing identifiers" - (setq-local next-error-function 'hcel-results-next-error + (setq-local next-error-function #'hcel-results-next-error hcel-ids-scope nil hcel-ids-query nil hcel-ids-package-id nil hcel-results-page-number nil hcel-results-max-page-number nil)) -(add-hook 'hcel-ids-mode-hook 'hcel-minor-mode) +(add-hook 'hcel-ids-mode-hook #'hcel-minor-mode) (defun hcel-ids-update () (unless (eq major-mode 'hcel-ids-mode) @@ -305,14 +309,14 @@ Start by choosing a package." (defun hcel-ids-reload () (interactive) (hcel-ids-update)) -(define-key hcel-ids-mode-map "g" 'hcel-ids-reload) +(define-key hcel-ids-mode-map "g" #'hcel-ids-reload) (define-key hcel-ids-mode-map (kbd "M-n") - 'hcel-results-next-error-no-open) + #'hcel-results-next-error-no-open) (define-key hcel-ids-mode-map (kbd "M-p") - 'hcel-results-previous-error-no-open) -(define-key hcel-ids-mode-map "f" 'hcel-results-next-page) -(define-key hcel-ids-mode-map "b" 'hcel-results-previous-page) + #'hcel-results-previous-error-no-open) +(define-key hcel-ids-mode-map "f" #'hcel-results-next-page) +(define-key hcel-ids-mode-map "b" #'hcel-results-previous-page) (defun hcel-ids-update-query (query) "Search for identities matching query." @@ -323,7 +327,7 @@ Start by choosing a package." (setq hcel-ids-query query hcel-results-page-number 1) (hcel-ids-update)) -(define-key hcel-ids-mode-map "s" 'hcel-ids-update-query) +(define-key hcel-ids-mode-map "s" #'hcel-ids-update-query) (defun hcel-ids-buffer-name (scope query) (format "*hcel-ids-%S %s*" scope query)) @@ -375,9 +379,9 @@ Start by choosing a package." (interactive (list (let ((minibuffer-allow-text-properties t)) (completing-read "Search for identifier globally: " - 'hcel-global-ids-minibuffer-collection)))) + #'hcel-global-ids-minibuffer-collection)))) (hcel-ids 'global query)) -(define-key hcel-mode-map "I" 'hcel-global-ids) +(define-key hcel-mode-map "I" #'hcel-global-ids) (defun hcel-package-ids (query) (interactive (list @@ -390,6 +394,6 @@ Start by choosing a package." (hcel-format-package-id package-id "-")) (hcel-package-ids-minibuffer-collection package-id))))) (hcel-ids 'package query hcel-package-id)) -(define-key hcel-mode-map "i" 'hcel-package-ids) +(define-key hcel-mode-map "i" #'hcel-package-ids) (provide 'hcel-results) diff --git a/hcel-source.el b/hcel-source.el index 7a793c6..2d51672 100644 --- a/hcel-source.el +++ b/hcel-source.el @@ -20,17 +20,20 @@ (require 'hcel-client) (define-derived-mode hcel-mode special-mode "hcel" "Major mode for exploring Haskell codebases" - (setq-local eldoc-documentation-strategy 'eldoc-documentation-compose-eagerly + (setq-local eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly eldoc-documentation-functions '(hcel-eldoc-id-type hcel-eldoc-expression-type hcel-eldoc-docs) - imenu-create-index-function 'hcel-imenu-create-index + imenu-create-index-function #'hcel-imenu-create-index imenu-space-replacement " " hcel-identifiers nil hcel-declarations nil hcel-occurrences nil hcel-package-id nil hcel-module-path nil - hcel-highlight-id nil)) + hcel-highlight-id nil) + (cursor-sensor-mode 1) + (add-hook 'xref-backend-functions #'hcel--xref-backend nil t)) + (defun hcel-buffer-name (package-id module-path) (concat "*hcel " (hcel-format-package-id package-id "-") "/" module-path "*")) @@ -65,7 +68,7 @@ When FORCE is non-nil, kill existing source buffer if any." (switch-to-buffer (hcel-load-module-source hcel-package-id hcel-module-path t)) (error "Not in hcel-mode!"))) -(define-key hcel-mode-map "g" 'hcel-reload-module-source) +(define-key hcel-mode-map "g" #'hcel-reload-module-source) (defun hcel-load-module-location-info (location-info &optional no-jump) "Load a module from exact location info. @@ -118,7 +121,7 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi 'major-mode (get-buffer (if (stringp buffer) buffer (car buffer)))) 'hcel-mode))))) -(define-key hcel-mode-map "b" 'hcel-switch-buffer) +(define-key hcel-mode-map "b" #'hcel-switch-buffer) (defun hcel-lookup-occurrence-at-point () (when-let ((occurrence (get-text-property (point) 'occurrence))) @@ -224,7 +227,7 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi (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) +(define-key hcel-mode-map "O" #'hcel-outline-package-module) ;; eldoc (defun hcel-eldoc-id-type (cb) @@ -312,7 +315,7 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi (defface hcel-highlight-id '((t (:inherit underline))) "Face for highlighting hcel identifier at point.") -(defun hcel-highlight-update (unused unused unused) +(defun hcel-highlight-update (&rest _) ;; if mark is active, change of face will deactivate the mark in transient ;; mark mode (unless mark-active @@ -345,8 +348,6 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi (prop-match-beginning match) (prop-match-end match) 'hcel-highlight-id)))))) -(add-hook 'hcel-mode-hook 'cursor-sensor-mode) - ;; utilities (defun hcel-write-source-line-to-buffer (line) (mapc @@ -360,7 +361,7 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi 'identifier (unless (string= id "") id) 'occurrence (unless (string= occ "") occ) 'cursor-sensor-functions - (when id (list 'hcel-highlight-update)))))) + (when id (list #'hcel-highlight-update)))))) line)) (defun hcel-write-source-to-buffer (lines) @@ -381,13 +382,13 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi 'identifier (unless (string= id "") id) 'occurrence (unless (string= occ "") occ) 'cursor-sensor-functions - (when id (list 'hcel-highlight-update)))))) + (when id (list #'hcel-highlight-update)))))) (dom-by-tag line 'span)) (insert "\n")) (defun hcel-write-html-source-to-buffer (lines) (mapc - 'hcel-write-html-source-line-to-buffer + #'hcel-write-html-source-line-to-buffer lines)) (defun hcel-source-html (json) @@ -410,13 +411,9 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi (alist-get 'name decl)) (progn (goto-line (alist-get 'lineNumber decl)) (point)))) hcel-declarations)) -(define-key hcel-mode-map "j" 'imenu) +(define-key hcel-mode-map "j" #'imenu) ;; xref -(add-hook 'hcel-mode-hook - (lambda () - (add-hook 'xref-backend-functions - #'hcel--xref-backend nil t))) (defun hcel--xref-backend () 'hcel-xref) (cl-defmethod xref-backend-definitions ((_backend (eql hcel-xref)) _identifiers) (hcel-find-definition)) @@ -427,10 +424,6 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi (hcel-text-property-near-point 'identifier) (hcel-text-property-near-point 'occurrence))) -(add-hook 'hcel-minor-mode-hook - (lambda () - (add-hook 'xref-backend-functions - #'hcel-minor--xref-backend nil t))) (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)) @@ -466,8 +459,7 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi (alist-get (intern occurrence) hcel-occurrences))))) (when (string= (hcel-location-tag location-info) "ApproximateLocation") (setq location-info (hcel-approx-to-exact-location location-info))) - (let ((module-path (alist-get 'modulePath location-info)) - (line-beg (alist-get 'startLine location-info)) + (let ((line-beg (alist-get 'startLine location-info)) (col-beg (alist-get 'startColumn location-info)) (line-end (alist-get 'endLine location-info)) (col-end (alist-get 'endColumn location-info))) @@ -494,27 +486,29 @@ If NO-JUMP is non-nil, just open the source and does not jump to the location wi (defvar hcel-minor-mode-map (let ((kmap (make-sparse-keymap))) - (define-key kmap (kbd "M-?") 'hcel-minor-find-references-at-point) + (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" - :after-hook - (if hcel-minor-mode - (if (and (not (memq major-mode hcel-minor-major-modes)) - (not (eq (current-buffer) eldoc--doc-buffer))) - (progn - (hcel-minor-mode 0) - (error "Not in one of the supported modes (%s) or the eldoc buffer." - (string-join (mapcar 'prin1-to-string hcel-minor-major-modes) - ", "))) - (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)) + (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))) + (remove-hook 'eldoc-documentation-functions #'hcel-minor-eldoc-docs t)) + ((not (or (memq major-mode 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) diff --git a/hcel-utils.el b/hcel-utils.el index e5a82e7..1e1afea 100644 --- a/hcel-utils.el +++ b/hcel-utils.el @@ -77,6 +77,7 @@ Example of an idSrcSpan: (col-end (alist-get 'column (alist-get 'end span)))) (buffer-substring-line-column line-beg (1- col-beg) line-end (1- col-end)))) +;; FIXME: Make sure all your definitions have an `hcel-' prefix! ;; buffers and strings manipulation (defun goto-line-column (line column) (goto-line line) diff --git a/hcel.el b/hcel.el new file mode 100644 index 0000000..bdfe65c --- /dev/null +++ b/hcel.el @@ -0,0 +1,60 @@ +;;; hcel.el --- Haskell codebase explorer -*- lexical-binding: t; -*- + +;; Author: Yuchen Pei +;; Maintainer: Yuchen Pei +;; Created: 2022 +;; Version: 0 +;; Keywords: haskell +;; Package-Requires: ((emacs "28")) +;; Package-Type: multi +;; Homepage: https://g.ypei.me/hcel.git + +;; Copyright (C) 2022 Yuchen Pei. +;; +;; 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 . + +(require 'hcel-source) +(require 'hcel-outline) +(require 'hcel-results) +(require 'hcel-utils) + +(defun hcel-package (package-id) + "Select a package, followed by selecting a module to display the source." + (interactive + (list + (completing-read "Select package: " + (mapcar #'hcel-format-package-id + (hcel-api-packages))))) + (call-interactively + (hcel-module-selector (hcel-parse-package-id package-id)))) + +(defun hcel-module () + "Select a module to display source." + (interactive) + (call-interactively + (hcel-module-selector hcel-package-id))) + +(defun hcel-module-selector (package-id) + (lambda (module-path) + (interactive + (list + (completing-read "Select module: " + (hcel-list-modules package-id)))) + (switch-to-buffer + (hcel-load-module-source package-id module-path)))) + +(provide 'hc) +;;; hcel.el ends here. -- cgit v1.2.3