Patch from Stefan Monnier.

https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01378.html

8 files changed, 90 insertions, 84 deletions

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/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 <https://www.gnu.org/licenses/>.
 
+(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/hc.el b/hcel.el
index f6239f6..bdfe65c 100644
--- a/hc.el
+++ b/hcel.el
@@ -1,11 +1,11 @@
-;;; hc.el --- Haskell codebase explorer -*- lexical-binding: t; -*-
+;;; hcel.el --- Haskell codebase explorer -*- lexical-binding: t; -*-
 
 ;; Author: Yuchen Pei <id@ypei.org>
 ;; Maintainer: Yuchen Pei <id@ypei.org>
 ;; Created: 2022
 ;; Version: 0
 ;; Keywords: haskell
-;; Package-Requires: ((emacs "28") (haskell-mode))
+;; Package-Requires: ((emacs "28"))
 ;; Package-Type: multi
 ;; Homepage: https://g.ypei.me/hcel.git
 
@@ -36,9 +36,10 @@
   (interactive
    (list
     (completing-read "Select package: "
-                     (mapcar 'hcel-format-package-id
+                     (mapcar #'hcel-format-package-id
                              (hcel-api-packages)))))
-  (call-interactively (hcel-module-selector (hcel-parse-package-id package-id))))
+  (call-interactively
+   (hcel-module-selector (hcel-parse-package-id package-id))))
 
 (defun hcel-module ()
   "Select a module to display source."
@@ -56,3 +57,4 @@
      (hcel-load-module-source package-id module-path))))
 
 (provide 'hc)
+;;; hcel.el ends here.