fix(lib): package URL in documentation

Fixes [[doom-package:*]] links in (future) docs and always displays a
homepage URL in 'SPC h p' (or 'C-h p') package docs.
This commit is contained in:
Henrik Lissner 2021-10-18 00:49:05 +02:00
parent 0112319c04
commit ff854157a6
2 changed files with 47 additions and 41 deletions

View file

@ -565,10 +565,10 @@ If prefix arg is present, refresh the cache."
(pp-to-string recipe))))
(package--print-help-section "Homepage")
(doom--help-insert-button (doom--package-url package)))
(doom--help-insert-button (doom-package-homepage package)))
(`elpa (insert "[M]ELPA ")
(doom--help-insert-button (doom--package-url package))
(doom--help-insert-button (doom-package-homepage package))
(package--print-help-section "Location")
(doom--help-insert-button
(abbreviate-file-name
@ -652,45 +652,6 @@ If prefix arg is present, refresh the cache."
packages nil t nil nil
(if guess (symbol-name guess)))))))
(defun doom--package-url (package)
(cond ((assq package package--builtins)
(user-error "Package is built into Emacs and cannot be looked up"))
((when-let (location (locate-library (symbol-name package)))
(with-temp-buffer
(insert-file-contents (concat (file-name-sans-extension location) ".el")
nil 0 4096)
(let ((case-fold-search t))
(when (re-search-forward " \\(?:URL\\|homepage\\|Website\\): \\(http[^\n]+\\)\n" nil t)
(match-string-no-properties 1))))))
((and (ignore-errors (eq (doom-package-backend package) 'quelpa))
(let* ((plist (cdr (doom-package-prop package :recipe)))
(fetcher (plist-get plist :fetcher)))
(pcase fetcher
(`git (plist-get plist :url))
(`github (format "https://github.com/%s.git" (plist-get plist :repo)))
(`gitlab (format "https://gitlab.com/%s.git" (plist-get plist :repo)))
(`bitbucket (format "https://bitbucket.com/%s" (plist-get plist :repo)))
(`wiki (format "https://www.emacswiki.org/emacs/download/%s"
(or (car-safe (doom-enlist (plist-get plist :files)))
(format "%s.el" package))))
(_ (plist-get plist :url))))))
((and (require 'package nil t)
(or package-archive-contents
(progn (package-refresh-contents)
package-archive-contents))
(pcase (package-desc-archive (cadr (assq package package-archive-contents)))
("org" "https://orgmode.org")
((or "melpa" "melpa-mirror")
(format "https://melpa.org/#/%s" package))
("gnu"
(format "https://elpa.gnu.org/packages/%s.html" package))
(archive
(if-let (src (cdr (assoc package package-archives)))
(format "%s" src)
(user-error "%S isn't installed through any known source (%s)"
package archive))))))
((user-error "Cannot find the homepage for %S" package))))
;;;###autoload
(defun doom/help-package-config (package)
"Jump to any `use-package!', `after!' or ;;;###package block for PACKAGE.

View file

@ -258,3 +258,48 @@ Must be run from a magit diff buffer."
(interactive)
(magit-commit-create
(list "-e" "-m" (doom/bumpify-diff))))
;;
;;; Package metadata
;;;###autoload
(defun doom-package-homepage (package)
"Return the url to PACKAGE's homepage (usually a repo)."
(doom-initialize-packages)
(or (get package 'homepage)
(put package 'homepage
(cond ((when-let (location (locate-library (symbol-name package)))
(with-temp-buffer
(if (string-match-p "\\.gz$" location)
(jka-compr-insert-file-contents location)
(insert-file-contents (concat (file-name-sans-extension location) ".el")
nil 0 4096))
(let ((case-fold-search t))
(when (re-search-forward " \\(?:URL\\|homepage\\|Website\\): \\(http[^\n]+\\)\n" nil t)
(match-string-no-properties 1))))))
((when-let ((recipe (straight-recipes-retrieve package)))
(straight--with-plist (straight--convert-recipe recipe)
(host repo)
(pcase host
(`github (format "https://github.com/%s" repo))
(`gitlab (format "https://gitlab.com/%s" repo))
(`bitbucket (format "https://bitbucket.com/%s" (plist-get plist :repo)))
(`git repo)
(_ nil)))))
((or package-archive-contents
(progn (package-refresh-contents)
package-archive-contents))
(pcase (ignore-errors (package-desc-archive (cadr (assq package package-archive-contents))))
(`nil nil)
("org" "https://orgmode.org")
((or "melpa" "melpa-mirror")
(format "https://melpa.org/#/%s" package))
("gnu"
(format "https://elpa.gnu.org/packages/%s.html" package))
(archive
(if-let (src (cdr (assoc package package-archives)))
(format "%s" src)
(user-error "%S isn't installed through any known source (%s)"
package archive)))))
((user-error "Can't get homepage for %S package" package))))))