[elpa] externals/hcel 71a93991a0 1/2: linking in documentation

[ELPA Syncer]

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

    linking in documentation
    
    Only to module source for now.
---
 hcel-client.el  | 20 ++++++++++++++------
 hcel-results.el |  4 ----
 hcel-source.el  |  3 +--
 hcel-utils.el   | 28 +++++++++++++++++++++++++++-
 4 files changed, 42 insertions(+), 13 deletions(-)

diff --git a/hcel-client.el b/hcel-client.el
index 1e30167e4f..4561af9014 100644
--- a/hcel-client.el
+++ b/hcel-client.el
@@ -59,8 +59,10 @@
 
 (defun hcel-definition-site-location-info (approx-location-info)
   "Call definitionSite with info from an approximate location."
-  (when (string= (hcel-location-tag approx-location-info) "ExactLocation")
-    (error "An ExactLocation supplied."))
+  (when (not (equal (hcel-location-tag approx-location-info)
+                    "ApproximateLocation"))
+    (error "An non ApproximateLocation supplied: %s"
+           (prin1-to-string approx-location-info)))
   (when-let* ((package-id (alist-get 'packageId approx-location-info))
               (component-id (alist-get 'componentId approx-location-info))
               (module-name (alist-get 'moduleName approx-location-info))
@@ -78,8 +80,12 @@
     (hcel-api-definition-site
      package-id "lib" module-name entity name)))
 
-(defun hcel-approx-to-exact-location (approx-location-info)
-  "Fetch exact location given approximate location.
+(defun hcel-to-exact-location (location-info)
+  "Returns exact location given location info.
+
+If LOCATION-INFO is approximate, then fetches exact location info
+using the supplied approximate location-info.  Otherwise returns
+LOCATION-INFO.
 
 Example of approximate location:
 
@@ -95,8 +101,10 @@ Example of approximate location:
         },
         \"tag\": \"ApproximateLocation\"
       }"
-  (alist-get 'location
-             (hcel-definition-site-location-info approx-location-info)))
+  (if (equal (hcel-location-tag location-info) "ApproximateLocation")
+      (alist-get 'location
+               (hcel-definition-site-location-info location-info))
+    location-info))
 
 (defun hcel-api-module-info (package-id module-path)
   (hcel-url-fetch-json
diff --git a/hcel-results.el b/hcel-results.el
index 275cab9236..d793032c60 100644
--- a/hcel-results.el
+++ b/hcel-results.el
@@ -281,10 +281,6 @@ Start by choosing a package."
                               (ignore-errors
                                 (hcel-definition-site-location-info
                                  location-info)))))))
-    ;; TODO: remove
-    ;; (print (with-temp-buffer
-    ;;          (insert (alist-get 'doc result))
-    ;;          (libxml-parse-html-region (point-min) (point-max))))
     (concat
      (propertize
       (format "%s :: %s\n"
diff --git a/hcel-source.el b/hcel-source.el
index dc54e18119..fc7e38c218 100644
--- a/hcel-source.el
+++ b/hcel-source.el
@@ -425,8 +425,7 @@ the location with pulsing.
                 (when identifier
                   (alist-get (intern identifier) hcel-identifiers))
                 occurrence)))
-          (when (string= (hcel-location-tag location-info) 
"ApproximateLocation")
-            (setq location-info (hcel-approx-to-exact-location location-info)))
+          (setq location-info (hcel-to-exact-location location-info))
           (let ((line-beg (alist-get 'startLine location-info))
                 (col-beg (alist-get 'startColumn location-info))
                 (line-end (alist-get 'endLine location-info))
diff --git a/hcel-utils.el b/hcel-utils.el
index 18a8c0731a..a35a44191f 100644
--- a/hcel-utils.el
+++ b/hcel-utils.el
@@ -147,11 +147,37 @@ Example of an idSrcSpan:
 
 (defun hcel-render-html (html)
   (when html
+    ;; (hcel-debug-html html)
     (with-temp-buffer
       (insert html)
-      (shr-render-region (point-min) (point-max))
+      (let ((shr-external-rendering-functions
+             '((span . hcel-tag-span))))
+        (shr-render-region (point-min) (point-max)))
       (buffer-string))))
 
+(defun hcel-debug-html (html)
+  (with-temp-buffer
+    (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-text-property-near-point (prop)
   "Find property prop at point, or just before point."
   (or (get-text-property (point) prop)