[elpa] externals/hcel 5e9cd756af 1/2: Extracting out button actions in rendered html doc

[ELPA Syncer]

branch: externals/hcel
commit 5e9cd756af1e0b1bbd54103204189832e4860527
Author: Yuchen Pei <hi@ypei.me>
Commit: Yuchen Pei <hi@ypei.me>

    Extracting out button actions in rendered html doc
    
    - help mode: should stay in help mode (unimplemented due to API
      limitation, goto definition for now).
    
    - eldoc / id query results: should goto definition.
---
 hcel-results.el | 26 ++++++++++++++++++++------
 hcel-utils.el   | 46 +++++++++++++++++++++++++---------------------
 2 files changed, 45 insertions(+), 27 deletions(-)

diff --git a/hcel-results.el b/hcel-results.el
index d793032c60..da0335e9fe 100644
--- a/hcel-results.el
+++ b/hcel-results.el
@@ -273,14 +273,15 @@ Start by choosing a package."
      (alist-get 'json results))
     (goto-char (point-min))))
 
-(defun hcel-ids-render-result (result)
+(defun hcel-ids-render-result (result &optional button-action)
   (let* ((location-info (alist-get 'locationInfo result))
          (doc (hcel-render-html
                (or (alist-get 'doc result)
                    (alist-get 'documentation
                               (ignore-errors
                                 (hcel-definition-site-location-info
-                                 location-info)))))))
+                                 location-info))))
+               button-action)))
     (concat
      (propertize
       (format "%s :: %s\n"
@@ -433,6 +434,21 @@ Start by choosing a package."
   (hcel-ids 'package query hcel-package-id))
 (define-key hcel-mode-map "i" #'hcel-package-ids)
 
+;; TODO: this is impossible with the current API, as definitionSite does not
+;; contain signature, and ExactLocation does not contain component name or even
+;; name
+(defun hcel-help-tag-span-button-action (marker)
+  (hcel-help-internal
+   (print (hcel-definition-site-location-info
+           (get-text-property marker 'location-info)))))
+
+(defun hcel-help-internal (info)
+  (help-setup-xref (list #'hcel-help-internal info)
+                   (called-interactively-p 'interactive))
+  (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+        (insert (hcel-ids-render-result info)))))
+
 (defun hcel-help (query)
   (interactive
    (list
@@ -440,10 +456,8 @@ Start by choosing a package."
       (completing-read "Find help for identifier: "
                        #'hcel-global-ids-minibuffer-collection))))
   (when (length= (split-string query " ") 2)
-    (with-help-window "*hcel-help*"
-      (with-current-buffer standard-output
-        (insert (hcel-ids-render-result
-                (get-text-property 0 'info hcel-ids--minibuffer-selected)))))))
+    (hcel-help-internal
+     (get-text-property 0 'info hcel-ids--minibuffer-selected))))
 
 (provide 'hcel-results)
 ;;; hcel-results.el ends here.
diff --git a/hcel-utils.el b/hcel-utils.el
index df76f2ae9e..83b3cb6d1d 100644
--- a/hcel-utils.el
+++ b/hcel-utils.el
@@ -145,14 +145,16 @@ Example of an idSrcSpan:
                     (alist-get 'exprType (alist-get 'info expr)))))
     (cons expression type)))
 
-(defun hcel-render-html (html)
+(defun hcel-render-html (html &optional action)
+  (unless action (setq action 'hcel-tag-span-button-load-source))
   (when html
     ;; (hcel-debug-html html)
     (with-temp-buffer
       (insert html)
-      (let ((shr-external-rendering-functions
-             '((span . hcel-tag-span)
-               (div . hcel-tag-div))))
+      (let* ((hcel-tag-span (hcel-tag-span-function action))
+             (shr-external-rendering-functions
+              `((span . ,hcel-tag-span)
+                (div . hcel-tag-div))))
         (shr-render-region (point-min) (point-max)))
       (buffer-string))))
 
@@ -161,23 +163,25 @@ Example of an idSrcSpan:
     (insert html)
     (pp (libxml-parse-html-region (point-min) (point-max)))))
 
-(defun hcel-tag-span (dom)
-  (let ((start (point)))
-    (shr-tag-span dom)
-    (mapc (lambda (attr)
-            (cond ((eq (car attr) 'data-location)
-                   (put-text-property start (point)
-                                      'location-info
-                                      (json-read-from-string (cdr attr)))
-                   (make-text-button start (point)
-                                     'action
-                                     (lambda (m)
-                                       (hcel-load-module-location-info
-                                        (hcel-to-exact-location
-                                         (get-text-property m 
'location-info))))
-                                     'face 'button)
-)))
-     (dom-attributes dom))))
+(defun hcel-tag-span-function (button-action)
+  (lambda (dom)
+    (let ((start (point)))
+      (shr-tag-span dom)
+      (mapc (lambda (attr)
+              (cond ((eq (car attr) 'data-location)
+                     (put-text-property start (point)
+                                        'location-info
+                                        (json-read-from-string (cdr attr)))
+                     (make-text-button start (point)
+                                       'action button-action
+                                       'face 'button)
+                     )))
+            (dom-attributes dom)))))
+
+(defun hcel-tag-span-button-load-source (marker)
+  (hcel-load-module-location-info
+   (hcel-to-exact-location
+    (get-text-property marker 'location-info))))
 
 (defun hcel-tag-div (dom)
   (if (equal (dom-attr dom 'class) "source-code")