From c4403522df754627d698f0806d3920764e3d1291 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Wed, 5 Oct 2022 11:28:34 +1100 Subject: Adding ability to navigate within help buffer --- hcel-client.el | 38 ++++++++++++++++++++++++++++++++++++++ hcel-minor.el | 4 ++-- hcel-results.el | 17 ++++++++++------- hcel-utils.el | 10 ++++++++++ 4 files changed, 60 insertions(+), 9 deletions(-) diff --git a/hcel-client.el b/hcel-client.el index d5f7abd..fef8bf6 100644 --- a/hcel-client.el +++ b/hcel-client.el @@ -159,6 +159,44 @@ Example of approximate location: (hcel-format-pagination-query page per-page)) nil with-header)) +(defun hcel-api-global-identifier-a (package-id component-id module-name entity + name) + (hcel-url-fetch-json + (concat hcel-host "/api/globalIdentifierA/" + (hcel-format-package-id package-id "-") "/" component-id "/" + module-name "/" entity "/" name))) + +(defun hcel-api-global-identifier-e (package-id module-path start-line start-column + end-line end-column name) + (hcel-url-fetch-json + (concat hcel-host "/api/globalIdentifierE/" + (hcel-format-package-id package-id "-") "/" + (replace-regexp-in-string "/" "%2F" module-path) "/" + (number-to-string start-line) "/" + (number-to-string start-column) "/" + (number-to-string end-line) "/" + (number-to-string end-column) "/" name))) + +(defun hcel-global-identifier (location-info &optional name) + (let ((tag (hcel-location-tag location-info))) + (cond ((equal tag "ApproximateLocation") + (hcel-api-global-identifier-a + (alist-get 'packageId location-info) + (alist-get 'componentId location-info) + (alist-get 'moduleName location-info) + (alist-get 'entity location-info) + (alist-get 'name location-info))) + ((equal tag "ExactLocation") + (hcel-api-global-identifier-e + (alist-get 'packageId location-info) + (alist-get 'modulePath location-info) + (alist-get 'startLine location-info) + (alist-get 'startColumn location-info) + (alist-get 'endLine location-info) + (alist-get 'endColumn location-info) + name)) + (t (error "Location info %S not supported." location-info))))) + (defun hcel-api-global-references (name) (hcel-url-fetch-json (concat hcel-host "/api/globalReferences/" name))) diff --git a/hcel-minor.el b/hcel-minor.el index 687c596..26badbb 100644 --- a/hcel-minor.el +++ b/hcel-minor.el @@ -73,11 +73,11 @@ (buffer-substring-no-properties (progn (text-property-search-backward - 'internal-id internal-id 'string=) + 'internal-id internal-id 'equal) (point)) (progn (text-property-search-forward - 'internal-id internal-id 'string=) + 'internal-id internal-id 'equal) (point))))) (docstring (cond ((derived-mode-p 'hcel-outline-mode) diff --git a/hcel-results.el b/hcel-results.el index 6cac9de..3a676b9 100644 --- a/hcel-results.el +++ b/hcel-results.el @@ -436,17 +436,20 @@ Start by choosing a package." (hcel-ids 'package query hcel-package-id)) (define-key hcel-mode-map "i" #'hcel-package-ids) -;; TODO: it is impossible with the current API to follow link within the help -;; buffer, as definitionSite does not contain signature, and ExactLocation does -;; not contain component name or even name +(defun hcel-tag-span-button-help (marker) + (hcel-help-internal + (hcel-global-identifier + (get-text-property marker 'location-info) + (hcel-string-with-text-property-at-point 'location-info)))) + (defun hcel-help-internal (identifier) (help-setup-xref (list #'hcel-help-internal identifier) (called-interactively-p 'interactive)) (with-help-window (help-buffer) - (with-current-buffer standard-output - (insert - (hcel-ids-render-identifier - identifier 'hcel-tag-span-button-load-source))))) + (with-current-buffer standard-output + (insert + (hcel-ids-render-identifier + identifier 'hcel-tag-span-button-help))))) (defun hcel-help (query) (interactive diff --git a/hcel-utils.el b/hcel-utils.el index d5b75cf..be152f5 100644 --- a/hcel-utils.el +++ b/hcel-utils.el @@ -191,5 +191,15 @@ Example of an idSrcSpan: (or (get-text-property (point) prop) (get-text-property (max (point-min) (1- (point))) prop))) +(defun hcel-string-with-text-property-at-point (prop) + "Find the string with property PROP at point. + +Does not check whether point does indeed has property PROP." + (save-excursion + (let ((beg) (end)) + (setq end (next-single-char-property-change (point) prop)) + (setq beg (previous-single-char-property-change end prop)) + (buffer-substring-no-properties beg end)))) + (provide 'hcel-utils) ;;; hcel-utils.el ends here. -- cgit v1.2.3