Archived
1
0
Fork 0
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/elpa/devdocs-browser-20231231.1455/devdocs-browser.el

828 lines
34 KiB
EmacsLisp
Raw Normal View History

2022-09-22 21:35:32 +00:00
;;; devdocs-browser.el --- Browse devdocs.io documents using EWW -*- lexical-binding: t; -*-
;; Copyright (C) 2021
;; Author: blahgeek <i@blahgeek.com>
;; URL: https://github.com/blahgeek/emacs-devdocs-browser
;; Version: 20210525
;; Keywords: docs, help, tools
;; Package-Requires: ((emacs "27.1"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Browse devdocs.io documents inside Emacs using EWW.
;;; Code:
(require 'files)
(require 'shr)
(require 'eww)
(require 'eldoc)
(require 'imenu)
(defgroup devdocs-browser nil
"Browse devdocs.io."
:group 'tools
:group 'web)
(defcustom devdocs-browser-cache-directory
(expand-file-name "devdocs-browser" user-emacs-directory)
"Directory to store devdocs cache files."
:type 'directory
:group 'devdocs-browser)
(defcustom devdocs-browser-base-url "https://devdocs.io/"
"Base URL to fetch json metadata files."
:type 'string)
(defcustom devdocs-browser-doc-base-url "https://documents.devdocs.io/"
"Base URL for doc contents."
:type 'string)
(defcustom devdocs-browser-major-mode-docs-alist
'((c++-mode . ("cpp"))
(c-mode . ("c"))
(go-mode . ("go"))
(python-mode . ("Python"))
(emacs-lisp-mode . ("elisp"))
2023-02-21 18:17:08 +00:00
(rust-mode . ("rust"))
2022-09-22 21:35:32 +00:00
(cmake-mode . ("CMake")))
"Alist of MAJOR-MODE and list of docset names.
When calling `devdocs-browser-open', this variable will be used
to pick a list of docsets based on the current MAJOR-MODE.
Docset name may be SLUG (e.g. 'python~3.8') or NAME (e.g. 'Python'),
if it's a NAME and multiple choices are possible,
one of the installed docs with the NAME will be used.
Also see `devdocs-browser-active-docs'."
:type '(alist :key-type function
:value-type (list string)))
(defvar-local devdocs-browser-active-docs
nil
"List of docset names used by `devdocs-browser-open' to pick docsets.
If this var is set to non-nil,
it have higher priority than `devdocs-browser-major-mode-docs-alist'.
See `devdocs-browser-major-mode-docs-alist' for the meaning of NAME.")
(defcustom devdocs-browser-highlight-lang-mode-alist '()
"Alist of language name and MAJOR-MODE, to highlight HTML pre blocks.
If language is not found in this alist,
`devdocs-browser-highlight-lang-mode-alist-default' will be used.
See https://prismjs.com/ for list of language names."
:type '(alist :key-type string
:value-type function))
(defvar devdocs-browser-highlight-lang-mode-alist-default
'(("html" . html-mode)
("xml" . xml-mode)
("css" . css-mode)
("clike" . c-mode)
("javascript" . js-mode)
("js" . js-mode)
("jsx" . js-mode)
("bash" . sh-mode)
("shell" . sh-mode)
("c" . c-mode)
("cpp" . c++-mode)
("cmake" . cmake-mode)
("go" . go-mode)
("haskell" . haskell-mode)
("hs" . haskell-mode)
("java" . java-mode)
("json" . js-mode)
("elisp" . elisp-mode)
("emacs" . elisp-mode)
("lua" . lua-mode)
("makefile" . makefile-mode)
("markdown" . markdown-mode)
("md" . markdown-mode)
("nginx" . conf-mode)
("objectivec" . objc-mode)
("objc" . objc-mode)
("perl" . perl-mode)
("protobuf" . protobuf-mode)
("python" . python-mode)
("py" . python-mode)
("ruby" . ruby-mode)
2023-02-21 18:17:08 +00:00
("rust" . rust-mode)
2022-09-22 21:35:32 +00:00
("rb" . ruby-mode)
("sql" . sql-mode)
("typescript" . typescript-mode))
"Default value for `devdocs-browser-highlight-lang-mode-alist'.")
2024-03-20 13:57:39 +00:00
(defun devdocs-browser--clear-dom-id-attr (dom)
"Clear id attribute for DOM and its children."
(dom-remove-attribute dom 'id)
(mapc #'devdocs-browser--clear-dom-id-attr (dom-non-text-children dom)))
2022-09-22 21:35:32 +00:00
(defun devdocs-browser--eww-fontify-pre (dom)
"Return fontified string for pre DOM."
(with-temp-buffer
(shr-generic dom)
(when (> shr-indentation 0)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(shr-indent)
(forward-line 1))))
(let* ((language (dom-attr dom 'data-language))
(mode (cdr (or (assoc language devdocs-browser-highlight-lang-mode-alist)
(assoc language devdocs-browser-highlight-lang-mode-alist-default)))))
(when (fboundp mode)
(delay-mode-hooks (funcall mode))
(font-lock-default-function mode)
(font-lock-default-fontify-region (point-min) (point-max) nil)))
(buffer-string)))
(defun devdocs-browser--eww-tag-pre (dom)
"Rendering function for pre DOM."
2024-03-20 13:57:39 +00:00
;; must clear all 'id' attributes in dom.
;; otherwise, shr would try to add text properties based on it, but since they are rendered in temp-buffer, the marker would be invalid
(devdocs-browser--clear-dom-id-attr dom)
2022-09-22 21:35:32 +00:00
(let ((shr-folding-mode 'none)
(shr-current-font 'default))
(shr-ensure-newline)
(insert (devdocs-browser--eww-fontify-pre dom))
(shr-ensure-newline)))
(defun devdocs-browser--eww-tag-maybe-set-title (dom)
"Maybe set DOM as title if it's not set yet."
(when (zerop (length (plist-get eww-data :title)))
(eww-tag-title dom)))
(defun devdocs-browser--eww-tag-h1 (dom)
"Rendering function for h1 DOM. Maybe use it as title."
(devdocs-browser--eww-tag-maybe-set-title dom)
(shr-tag-h1 dom))
(defun devdocs-browser--eww-tag-h2 (dom)
"Rendering function for h2 DOM. Maybe use it as title."
(devdocs-browser--eww-tag-maybe-set-title dom)
(shr-heading dom (if shr-use-fonts
'(variable-pitch (:height 1.2 :weight bold))
'bold)))
(defun devdocs-browser--eww-tag-h3 (dom)
"Rendering function for h2 DOM. Maybe use it as title."
(devdocs-browser--eww-tag-maybe-set-title dom)
(shr-heading dom (if shr-use-fonts
'(variable-pitch (:height 1.1 :weight bold))
'bold)))
(defun devdocs-browser--eww-tag-h4 (dom)
"Rendering function for h4 DOM."
(shr-heading dom 'bold))
(defun devdocs-browser--eww-tag-h5 (dom)
"Rendering function for h5 DOM."
(shr-heading dom 'italic))
2024-03-20 13:57:39 +00:00
(defun devdocs-browser--eww-tag-generic-ensure-paragraph (dom)
"Rendering function for generic DOM while ensuring paragraph."
(shr-ensure-paragraph)
(shr-generic dom))
2022-09-22 21:35:32 +00:00
(defvar-local devdocs-browser--eww-data '()
"Plist data for current eww page, contain :doc and :path.")
(defun devdocs-browser--eww-fix-url (url)
"Fix links' URL in docs by appending suffix and mtime."
;; shr-expand-url may be call in a temp buffer
;; we need to temporary bind this buffer to access the buffer-local variable.
(with-current-buffer (window-buffer)
(let ((url-parsed (url-generic-parse-url url))
(root-url-parsed (url-generic-parse-url (plist-get eww-data :url)))
(mtime (plist-get (plist-get devdocs-browser--eww-data :doc) :mtime)))
(when (and mtime
(equal (url-type url-parsed) (url-type root-url-parsed))
(equal (url-host url-parsed) (url-host root-url-parsed))
(not (string-match-p "\\.html" url)))
(setf (url-filename url-parsed)
(if (equal (url-type url-parsed) "file")
(concat (url-filename url-parsed) ".html")
(format "%s.html?%s" (url-filename url-parsed) mtime)))
(setq url (url-recreate-url url-parsed)))))
url)
(defun devdocs-browser--eww-parse-url-path (url)
"Return URL's doc :path ('hello/world#target')."
;; see devdocs-browser--eww-open for url pattern
(when-let* ((url-parsed (url-generic-parse-url url))
(doc (plist-get devdocs-browser--eww-data :doc))
(slug (plist-get doc :slug))
(filename-suffix (if (equal (url-type url-parsed) "file")
".html"
(format ".html?%s" (plist-get doc :mtime))))
(filename-prefix (if (equal (url-type url-parsed) "file")
(devdocs-browser-offline-data-dir slug)
(concat "/" slug "/")))
(path (url-filename url-parsed)))
(when (and (string-prefix-p filename-prefix path)
(string-suffix-p filename-suffix path))
(setq path (string-remove-prefix filename-prefix path))
(setq path (string-remove-suffix filename-suffix path))
(when (url-target url-parsed)
(setq path (concat path "#" (url-target url-parsed))))
path)))
(defun devdocs-browser--eww-page-path ()
"Return current page's :path ('hello/world#target')."
(devdocs-browser--eww-parse-url-path (plist-get eww-data :url)))
(defun devdocs-browser--eww-link-eldoc (&optional _)
"Show URL link or description at current point."
(when-let ((url (get-text-property (point) 'shr-url)))
(if-let ((path (devdocs-browser--eww-parse-url-path url)))
(let* ((doc (plist-get devdocs-browser--eww-data :doc))
(index (plist-get doc :index))
(entries (plist-get index :entries))
(entry (seq-find
(lambda (x) (equal (plist-get x :path) path))
entries)))
(concat
(when entry
(propertize (plist-get entry :name) 'face 'font-lock-keyword-face))
(when entry
(format " (%s): " (plist-get entry :type)))
(propertize path 'face 'italic)))
(format "External link: %s" (propertize url 'face 'italic)))))
(defun devdocs-browser--position-by-target (target)
"Find buffer position for TARGET (url hash)."
(save-excursion
(goto-char (point-min))
(when-let ((match (text-property-search-forward 'shr-target-id target #'member)))
(prop-match-beginning match))))
(defun devdocs-browser--imenu-create-index ()
"Create index alist for current buffer for imenu.
Can be used as `imenu-create-index-function'."
(when-let* ((doc (plist-get devdocs-browser--eww-data :doc))
(entries (plist-get (plist-get doc :index) :entries))
(page-path (devdocs-browser--eww-page-path))
(page-url (url-generic-parse-url page-path)))
(seq-filter
#'identity
(mapcar
(lambda (entry)
(when-let* ((name (plist-get entry :name))
(path (plist-get entry :path))
(url (url-generic-parse-url path))
(target (url-target url))
(_ (equal (url-filename url) (url-filename page-url))))
(cons name (devdocs-browser--position-by-target target))))
entries))))
(define-obsolete-function-alias 'devdocs-browser-eww-goto-target 'imenu "20220917")
(defun devdocs-browser-eww-open-in-default-browser ()
"Open current page in devdocs.io in browser."
(interactive)
(when-let* ((doc (plist-get devdocs-browser--eww-data :doc))
(slug (plist-get doc :slug))
(path (devdocs-browser--eww-page-path))
(url (concat devdocs-browser-base-url slug "/" path)))
(browse-url-default-browser url)))
(defun devdocs-browser--eww-recenter-advice (res)
"Recenter current cursor for devdocs buffer, used for advice :filter-return (return `RES')."
(when devdocs-browser--eww-data
(recenter))
res)
(defun devdocs-browser--eww-browse-url-new-window-advice (args)
"Advice around `eww-browse-url' with ARGS, set NEW-WINDOW if URL is external."
(let ((url (car args))
(new-window (cadr args)))
(when (and devdocs-browser--eww-data
(not (devdocs-browser--eww-parse-url-path url)))
(setq new-window t))
(list url new-window)))
(define-minor-mode devdocs-browser-eww-mode
"Minor mode for browsing devdocs pages with eww."
:lighter " Devdocs"
:interactive nil
:group 'devdocs-browser
:keymap (let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-o") #'devdocs-browser-eww-open-in-default-browser)
map)
(setq-local shr-external-rendering-functions
(append shr-external-rendering-functions
'((pre . devdocs-browser--eww-tag-pre)
(h1 . devdocs-browser--eww-tag-h1)
(h2 . devdocs-browser--eww-tag-h2)
(h3 . devdocs-browser--eww-tag-h3)
(h4 . devdocs-browser--eww-tag-h4)
2024-03-20 13:57:39 +00:00
(h5 . devdocs-browser--eww-tag-h5)
(summary . devdocs-browser--eww-tag-generic-ensure-paragraph)
(section . devdocs-browser--eww-tag-generic-ensure-paragraph))))
2022-09-22 21:35:32 +00:00
(setq-local imenu-create-index-function
#'devdocs-browser--imenu-create-index)
2023-08-10 14:03:04 +00:00
(when (boundp 'eww-auto-rename-buffer)
(setq-local eww-auto-rename-buffer nil))
2022-09-22 21:35:32 +00:00
(advice-add 'shr-expand-url :filter-return #'devdocs-browser--eww-fix-url)
(advice-add 'eww-display-html :filter-return #'devdocs-browser--eww-recenter-advice)
(advice-add 'eww-browse-url :filter-args #'devdocs-browser--eww-browse-url-new-window-advice)
(add-hook 'eldoc-documentation-functions #'devdocs-browser--eww-link-eldoc nil t)
(eldoc-mode))
(defvar devdocs-browser--docs-dir "docs")
(defvar devdocs-browser--index-json-filename "index.json")
(defvar devdocs-browser--metadata-filename "metadata.el")
(defvar devdocs-browser--offline-data-json-filename "content.json")
(defvar devdocs-browser--offline-data-dir-name "content")
2023-02-21 18:17:08 +00:00
(defun devdocs-browser--completing-read (prompt collection &optional def)
2022-09-22 21:35:32 +00:00
"Helper function for `completing-read'.
PROMPT: same meaning, but this function will append ';' at the end;
COLLECTION: alist of (name . props), where props is a plist with
possibly the following keys: :value, :annotation, :group;
if :group is not nil and name starts with '<group>: ', its removed.
DEF: same meaning;"
2023-02-21 18:17:08 +00:00
;; convert collection to hashtables for faster completion. `complete-with-action' also supports that.
(setq collection (delq nil collection))
(let* ((collection-ht (make-hash-table :test 'equal :size (length collection)))
(annotation-function
(lambda (s)
(let ((annotation (plist-get (gethash s collection-ht) :annotation)))
(if annotation
(concat " " annotation)
nil))))
(group-function
(lambda (s transform)
(let ((group (plist-get (gethash s collection-ht) :group)))
(cond
(transform (if (and group (string-match (rx bos (literal group) ": ") s))
(replace-match "" t t s)
s))
(t group))))))
(mapc (lambda (elem) (puthash (car elem) (cdr elem) collection-ht))
collection)
2022-09-22 21:35:32 +00:00
(setq prompt (concat prompt
(when def
(format " (default %s)" (funcall group-function def t)))
": "))
(let ((res (completing-read
prompt
(lambda (str pred action)
(if (eq action 'metadata)
`(metadata . ((annotation-function . ,annotation-function)
(group-function . ,group-function)))
2023-02-21 18:17:08 +00:00
(complete-with-action action collection str pred)))
2022-09-22 21:35:32 +00:00
nil t ;; require-match
nil nil def)))
2023-02-21 18:17:08 +00:00
(or (plist-get (gethash res collection-ht) :value)
2022-09-22 21:35:32 +00:00
res))))
(defun devdocs-browser--json-parse-buffer ()
"Same as `json-parse-buffer', with custom settings."
(json-parse-buffer :object-type 'plist :array-type 'array))
(defun devdocs-browser--read-json (file-path)
"Read json file in FILE-PATH, if it's a relative path, find it in cache dir."
(let ((filename (expand-file-name file-path devdocs-browser-cache-directory)))
(when (file-exists-p filename)
(with-temp-buffer
(insert-file-contents filename)
(devdocs-browser--json-parse-buffer)))))
(defun devdocs-browser--fetch-json (url-path file-path &optional base-url)
"Fetch json from BASE-URL / URL-PATH, also save to FILE-PATH.
BASE-URL defaults to `devdocs-browser-base-url'."
(let ((cache-filename (expand-file-name file-path devdocs-browser-cache-directory)))
(unless (file-exists-p (file-name-directory cache-filename))
(make-directory (file-name-directory cache-filename) t))
(with-temp-file cache-filename
(erase-buffer)
(url-insert-file-contents (concat (or base-url devdocs-browser-base-url) url-path))
(devdocs-browser--json-parse-buffer))))
(defvar devdocs-browser--docs-list-cache nil "Cached docs list.")
;;;###autoload
(defun devdocs-browser-list-docs (&optional refresh-cache)
"Get doc metadata lists, reload cache if REFRESH-CACHE."
(setq devdocs-browser--docs-list-cache
(or (and (not refresh-cache) devdocs-browser--docs-list-cache)
(and (not refresh-cache) (devdocs-browser--read-json "docs.json"))
(devdocs-browser--fetch-json "docs.json" "docs.json"))))
;;;###autoload
2024-03-20 13:57:39 +00:00
(defun devdocs-browser-update-metadata ()
2022-09-22 21:35:32 +00:00
"Update doc metadata list.
To upgrade docs content, see `devdocs-browser-upgrade-doc'."
(interactive)
(let ((count (length (devdocs-browser-list-docs t))))
(message (concat "Doc metadata updated, found total %s docs. "
"You may want to run `devdocs-browser-install-doc' "
"or `devdocs-browser-upgrade-doc'.")
count)))
2024-03-20 13:57:39 +00:00
;;;###autoload
(defalias 'devdocs-browser-update-docs 'devdocs-browser-update-metadata)
(make-obsolete 'devdocs-browser-update-docs 'devdocs-browser-update-metadata "20231231")
2022-09-22 21:35:32 +00:00
(defun devdocs-browser-find-doc (slug-or-name)
"Find doc from docs list by SLUG-OR-NAME."
(let ((docs-list (devdocs-browser-list-docs)))
(seq-find (lambda (doc)
(or (equal (plist-get doc :slug) slug-or-name)
(equal (plist-get doc :name) slug-or-name)))
docs-list)))
(defvar devdocs-browser--docs-cache '() "Cached doc indexes plist.")
(defun devdocs-browser--install-doc-internal (doc)
"(Re-)install doc identified by plist DOC. Return t if success."
(let* ((slug (plist-get doc :slug))
(mtime (plist-get doc :mtime))
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
(doc-dir (expand-file-name slug docs-dir))
success)
(unless (file-exists-p docs-dir)
(make-directory docs-dir t))
(when (file-exists-p doc-dir)
(delete-directory doc-dir t))
;; do not leave empty directory
(unwind-protect
(progn
(devdocs-browser--fetch-json
(format "docs/%s/index.json?%s" slug mtime)
(expand-file-name devdocs-browser--index-json-filename doc-dir))
(with-temp-file (expand-file-name devdocs-browser--metadata-filename doc-dir)
(print doc (current-buffer)))
(setq success t))
(unless success
(delete-directory doc-dir t)))
(if success
(message "Installed devdocs doc %s version %s" slug mtime)
(message "Failed to install devdocs doc %s" slug))
;; remove cache
(setq devdocs-browser--docs-cache
(lax-plist-put devdocs-browser--docs-cache slug nil))
success))
(defun devdocs-browser--doc-readable-name (doc)
"Get human readable name for DOC."
(let ((slug (plist-get doc :slug))
(name (plist-get doc :name))
(version (plist-get doc :version))
(release (plist-get doc :release))
res)
(setq res (concat slug " (" name))
(unless (zerop (length version))
(setq res (concat res " " version)))
(unless (zerop (length release))
(setq res (concat res ", " release)))
(setq res (concat res ")"))
res))
;;;###autoload
(defun devdocs-browser-install-doc (slug-or-name &optional force)
"Install doc by SLUG-OR-NAME.
When called interactively, user can choose from the list.
When called interactively with prefix, or FORCE is t, reinstall existing doc."
(interactive
(let* ((force current-prefix-arg)
(installed-docs
(devdocs-browser-list-installed-slugs))
(selected-slug
(devdocs-browser--completing-read
"Install doc"
(mapcar (lambda (doc)
(let ((slug (plist-get doc :slug)))
(unless (and (not force)
(member slug installed-docs))
(cons (devdocs-browser--doc-readable-name doc)
`(:value ,slug)))))
(devdocs-browser-list-docs)))))
(list selected-slug force)))
(let ((doc (devdocs-browser-find-doc slug-or-name)))
(unless (and (not force)
(member (plist-get doc :slug) (devdocs-browser-list-installed-slugs)))
(devdocs-browser--install-doc-internal doc))))
;;;###autoload
(defun devdocs-browser-uninstall-doc (slug)
"Uninstall doc by SLUG.
When called interactively, user can choose from the list."
(interactive (list (completing-read "Uninstall doc: "
(devdocs-browser-list-installed-slugs)
nil t)))
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
(doc-dir (expand-file-name slug docs-dir)))
(when (file-exists-p doc-dir)
(delete-directory doc-dir t)))
(setq devdocs-browser--docs-cache
(lax-plist-put devdocs-browser--docs-cache slug nil)))
(defun devdocs-browser--upgrade-readable-name (old-doc new-doc)
"Get human readable name for upgrade from OLD-DOC to NEW-DOC."
(let ((slug (plist-get old-doc :slug))
(name (plist-get old-doc :name))
(old-version (plist-get old-doc :version))
(old-release (plist-get old-doc :release))
(old-mtime (plist-get old-doc :mtime))
(new-version (plist-get new-doc :version))
(new-release (plist-get new-doc :release))
(new-mtime (plist-get new-doc :mtime))
res)
(setq res (format "%s (%s" slug name))
(unless (equal old-version new-version)
(setq res (concat res (format " %s->%s" old-version new-version))))
(unless (equal old-release new-release)
(setq res (concat res (format ", %s->%s" old-release new-release))))
(setq res (concat res (format ", %s->%s)" old-mtime new-mtime)))
res))
(defun devdocs-browser--upgrade-readable-name-or-nil (slug)
"Get human readable name for upgrading SLUG if it needs upgrade."
(let ((old-doc (devdocs-browser--load-doc slug))
(new-doc (devdocs-browser-find-doc slug)))
(when (and new-doc
(> (plist-get new-doc :mtime) (plist-get old-doc :mtime)))
(devdocs-browser--upgrade-readable-name old-doc new-doc))))
;;;###autoload
(defun devdocs-browser-upgrade-doc (slug)
"Upgrade doc by SLUG, return t if upgrade success.
Also download new version of offline data if
there's offline data for current version.
When called interactively, user can choose from list.
You may need to call `devdocs-browser-update-docs' first."
(interactive
(let (rows)
(dolist (slug (devdocs-browser-list-installed-slugs))
(let ((desc (devdocs-browser--upgrade-readable-name-or-nil slug)))
(when desc
(push (cons desc slug) rows))))
(if (null rows)
(progn
(message "All docs up to date")
(list nil))
(list
(cdr (assoc (completing-read "Upgrade doc: " rows nil t) rows))))))
(when (and slug (devdocs-browser--upgrade-readable-name-or-nil slug))
(let* ((has-offline-data (devdocs-browser-offline-data-dir slug))
(doc (devdocs-browser-find-doc slug))
(install-success (devdocs-browser--install-doc-internal doc)))
(when (and has-offline-data install-success)
(devdocs-browser--download-offline-data-internal doc))
install-success)))
;;;###autoload
(defun devdocs-browser-upgrade-all-docs ()
"Upgrade all docs."
(interactive)
(let ((count 0))
(dolist (slug (devdocs-browser-list-installed-slugs))
(message "Processing %s..." slug)
(when (devdocs-browser-upgrade-doc slug)
(setq count (1+ count))))
(message "Upgraded %s docs" count)))
(defun devdocs-browser-list-installed-slugs ()
"Get a list of installed docs' slug name."
(let ((dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory)))
(when (file-exists-p dir)
(directory-files dir nil
;; ignore ".", ".." and hidden files
"^[^.].*"))))
(defun devdocs-browser-find-installed-doc (slug-or-name)
"Find installed doc by SLUG-OR-NAME."
(let ((docs-list (mapcar #'devdocs-browser-installed-doc-info
(devdocs-browser-list-installed-slugs))))
(seq-find (lambda (doc)
(or (equal (plist-get doc :slug) slug-or-name)
(equal (plist-get doc :name) slug-or-name)))
docs-list)))
(defun devdocs-browser-installed-doc-info (slug)
"Get plist info of installed doc identified by SLUG."
(cddr (devdocs-browser--load-doc slug)))
(defun devdocs-browser--load-doc (slug &optional refresh-cache)
"Load doc identified by SLUG, reload cache if REFRESH-CACHE is not nil.
Result is a plist metadata, with an extra :index field at the beginning."
(or (and (not refresh-cache) (lax-plist-get devdocs-browser--docs-cache slug))
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir
devdocs-browser-cache-directory))
(doc-dir (expand-file-name slug docs-dir))
(metadata-filename (expand-file-name devdocs-browser--metadata-filename doc-dir))
(metadata nil)
(index-filename (expand-file-name devdocs-browser--index-json-filename doc-dir))
(index (devdocs-browser--read-json index-filename))
res)
(when (file-exists-p metadata-filename)
(with-temp-buffer
(insert-file-contents metadata-filename)
(setq metadata (read (current-buffer))))
(setq res (append `(:index ,index) metadata))
(setq devdocs-browser--docs-cache
(lax-plist-put devdocs-browser--docs-cache slug res)))
res)))
(defun devdocs-browser--download-offline-data-internal (doc)
"(re-)Download and extract offline data for DOC."
(let* ((slug (plist-get doc :slug))
(mtime (plist-get doc :mtime))
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
(doc-dir (expand-file-name slug docs-dir))
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir))
success)
(unless (file-exists-p doc-dir)
(make-directory doc-dir t))
(when (file-exists-p data-dir)
(delete-directory data-dir t))
;; do not leave half-complete data directory
(unwind-protect
(let ((data (devdocs-browser--fetch-json
(format "%s/db.json?%s" slug mtime)
(expand-file-name devdocs-browser--offline-data-json-filename doc-dir)
devdocs-browser-doc-base-url)))
;; write data to files
(dolist (kv (seq-partition data 2))
(when-let* ((name (substring (symbol-name (car kv)) 1))
(value (cadr kv))
;; prepent "./" to fix paths starting with literal "~" (e.g. deno)
(path (expand-file-name (concat "./" name ".html") data-dir)))
(unless (file-exists-p (file-name-directory path))
(make-directory (file-name-directory path) t))
(write-region value nil path)))
(setq success t))
(unless success
(delete-directory data-dir t)))
(if success
(message "Installed devdocs offline data %s version %s" slug mtime)
(message "Failed to install devdocs offline data %s" slug))
success))
(defun devdocs-browser-offline-data-dir (slug)
"Return doc SLUG's offline data dir if present, return nil otherwise."
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
(doc-dir (expand-file-name slug docs-dir))
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir)))
(when (file-exists-p data-dir)
(file-name-as-directory data-dir))))
(defun devdocs-browser-download-offline-data (slug)
"Download offline data for doc SLUG.
Offline data contains full content pages,
which allows you to view docs without Internet connection.
It may take some time to download offline data.
When called interactively, user can choose from the list."
(interactive (list (completing-read
"Install offline data: "
(seq-filter
(lambda (slug) (null (devdocs-browser-offline-data-dir slug)))
(devdocs-browser-list-installed-slugs))
nil t)))
(when-let* ((doc (devdocs-browser--load-doc slug)))
(devdocs-browser--download-offline-data-internal doc)))
(defun devdocs-browser-remove-offline-data (slug)
"Remove offline data for doc SLUG.
When called interactively, user can choose from the list."
(interactive (list (completing-read
"Remove offline data: "
(seq-filter
#'devdocs-browser-offline-data-dir
(devdocs-browser-list-installed-slugs))
nil t)))
(when-let* ((data-dir (devdocs-browser-offline-data-dir slug)))
(delete-directory data-dir t)))
(defun devdocs-browser--eww-open (doc path)
"Open PATH for document DOC using eww."
(let* ((slug (plist-get doc :slug))
(mtime (plist-get doc :mtime))
base-url url)
;; cannot use format directly because `path' may contains #query
;; path: hello/world#query
;; url for offline: file:///home/path/to/devdocs/python~3.8/hello/world.html#query
;; url for online: https://documents.devdocs.io/python~3.8/hello/world.html?161818817#query
(let ((offline-data-dir (devdocs-browser-offline-data-dir slug)))
(if offline-data-dir
(progn
(setq base-url (concat "file://" offline-data-dir))
(setq url (url-generic-parse-url (concat "file://" offline-data-dir path)))
(setf (url-filename url) (concat (url-filename url) ".html")))
(setq base-url (concat devdocs-browser-doc-base-url slug "/"))
(setq url (url-generic-parse-url
(concat devdocs-browser-doc-base-url slug "/" path)))
(setf (url-filename url)
(format "%s.html?%s" (url-filename url) mtime))))
(pop-to-buffer (format "*devdocs-%s*" slug))
(if devdocs-browser-eww-mode
(eww-save-history)
(eww-mode)
(devdocs-browser-eww-mode))
(setq-local devdocs-browser--eww-data
(list :doc doc
:base-url base-url))
(eww (url-recreate-url url))
(recenter)))
(defun devdocs-browser--default-active-slugs (&optional no-fallback-all)
"Default active doc slugs for current buffer, fallback to all slugs if not NO-FALLBACK-ALL."
(if devdocs-browser--eww-data
(list (plist-get (plist-get devdocs-browser--eww-data :doc) :slug))
(let ((names (or devdocs-browser-active-docs
(alist-get major-mode devdocs-browser-major-mode-docs-alist)))
slugs)
(dolist (name names)
(when-let* ((doc (devdocs-browser-find-installed-doc name))
(slug (plist-get doc :slug)))
(setq slugs (push slug slugs))))
(or slugs
(and (not no-fallback-all) (devdocs-browser-list-installed-slugs))))))
;;;###autoload
(defun devdocs-browser-open-in (slug-or-name-list)
"Open entry in specified docs SLUG-OR-NAME-LIST.
When called interactively, user can choose from the list."
(interactive
(let ((def (devdocs-browser--default-active-slugs t)))
(list (completing-read-multiple
(concat "Select doc"
(when def (format " (default %s)" def))
": ")
(devdocs-browser-list-installed-slugs)
nil t nil nil def))))
(let ((current-word-regex
(when-let ((word (thing-at-point 'word t)))
(concat "\\<" (regexp-quote word) "\\>")))
slugs rows def)
(dolist (slug-or-name slug-or-name-list)
(when-let* ((doc-simple (devdocs-browser-find-installed-doc slug-or-name))
(slug (plist-get doc-simple :slug))
(doc (devdocs-browser--load-doc slug))
(index (plist-get doc :index))
(entries (plist-get index :entries)))
(setq slugs (push slug slugs))
(let ((new-rows
(mapcar
(lambda (entry)
(let* ((name (plist-get entry :name))
(path (plist-get entry :path))
(type (plist-get entry :type))
(title (concat slug ": " name)))
(when (and (null def) current-word-regex)
(when (string-match-p current-word-regex name)
(setq def title)))
(cons title `(:value (,doc ,path)
:group ,slug
:annotation ,type))))
entries)))
(setq rows (append new-rows rows))
(push (cons (format "%s: INDEX PAGE" slug)
`(:value (,doc "index")
:group ,slug))
rows))))
(let* ((selected-value
(devdocs-browser--completing-read
(format "Devdocs browser [%s]" (mapconcat #'identity slugs ","))
rows def)))
(when selected-value
(apply #'devdocs-browser--eww-open selected-value)))))
;;;###autoload
(defun devdocs-browser-open ()
"Open entry in active docs.
Active docs are specified by `devdocs-browser-active-docs',
or `devdocs-browser-major-mode-docs-alist',
or the current doc type if called in a devdocs eww buffer.
When all of them are nil, all installed docs are used."
(interactive)
(devdocs-browser-open-in (devdocs-browser--default-active-slugs)))
(provide 'devdocs-browser)
;;; devdocs-browser.el ends here