218 lines
8.3 KiB
EmacsLisp
218 lines
8.3 KiB
EmacsLisp
|
;;; skewer-bower.el --- dynamic library loading -*- lexical-binding: t; -*-
|
||
|
|
|
||
|
|
;; This is free and unencumbered software released into the public domain.
|
||
|
|
|
||
|
|
;;; Commentary:
|
||
|
|
|
||
|
|
;; This package loads libraries into the current page using the bower
|
||
|
|
;; infrastructure. Note: bower is not actually used by this package
|
||
|
|
;; and so does *not* need to be installed. Only git is required (see
|
||
|
|
;; `skewer-bower-git-executable'). It will try to learn how to run git
|
||
|
|
;; from Magit if available.
|
||
|
|
|
||
|
|
;; The interactive command for loading libraries is
|
||
|
|
;; `skewer-bower-load'. It will prompt for a library and a version,
|
||
|
|
;; automatically fetching it from the bower infrastructure if needed.
|
||
|
|
;; For example, I often find it handy to load some version of jQuery
|
||
|
|
;; when poking around at a page that doesn't already have it loaded.
|
||
|
|
|
||
|
|
;; Caveat: unfortunately the bower infrastructure is a mess; many
|
||
|
|
;; packages are in some sort of broken state -- missing dependencies,
|
||
|
|
;; missing metadata, broken metadata, or an invalid repository URL.
|
||
|
|
;; Some of this is due to under-specification of the metadata by the
|
||
|
|
;; bower project. Broken packages are unlikely to be loadable by
|
||
|
|
;; skewer-bower.
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
(require 'cl-lib)
|
||
|
|
(require 'skewer-mode)
|
||
|
|
(require 'simple-httpd)
|
||
|
|
(require 'magit nil t) ; optional
|
||
|
|
|
||
|
|
(defcustom skewer-bower-cache-dir (locate-user-emacs-file "skewer-cache")
|
||
|
|
"Location of library cache (git repositories)."
|
||
|
|
:type 'string
|
||
|
|
:group 'skewer)
|
||
|
|
|
||
|
|
(defcustom skewer-bower-endpoint "https://bower.herokuapp.com"
|
||
|
|
"Endpoint for accessing package information."
|
||
|
|
:type 'string
|
||
|
|
:group 'skewer)
|
||
|
|
|
||
|
|
(defcustom skewer-bower-json '("bower.json" "package.json" "component.json")
|
||
|
|
"Files to search for package metadata."
|
||
|
|
:type 'list
|
||
|
|
:group 'skewer)
|
||
|
|
|
||
|
|
; Try to match Magit's configuration if available
|
||
|
|
(defcustom skewer-bower-git-executable "git"
|
||
|
|
"Name of the git executable."
|
||
|
|
:type 'string
|
||
|
|
:group 'skewer)
|
||
|
|
|
||
|
|
(defvar skewer-bower-packages nil
|
||
|
|
"Alist of all packages known to bower.")
|
||
|
|
|
||
|
|
(defvar skewer-bower-refreshed nil
|
||
|
|
"List of packages that have been refreshed recently. This keeps
|
||
|
|
them from hitting the network frequently.")
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun skewer-bower-refresh ()
|
||
|
|
"Update the package listing and packages synchronously."
|
||
|
|
(interactive)
|
||
|
|
(cl-declare (special url-http-end-of-headers))
|
||
|
|
(setf skewer-bower-refreshed nil)
|
||
|
|
(with-current-buffer
|
||
|
|
(url-retrieve-synchronously (concat skewer-bower-endpoint "/packages"))
|
||
|
|
(setf (point) url-http-end-of-headers)
|
||
|
|
(setf skewer-bower-packages
|
||
|
|
(cl-sort
|
||
|
|
(cl-loop for package across (json-read)
|
||
|
|
collect (cons (cdr (assoc 'name package))
|
||
|
|
(cdr (assoc 'url package))))
|
||
|
|
#'string< :key #'car))))
|
||
|
|
|
||
|
|
;; Git functions
|
||
|
|
|
||
|
|
(defun skewer-bower-cache (package)
|
||
|
|
"Return the cache repository directory for PACKAGE."
|
||
|
|
(unless (file-exists-p skewer-bower-cache-dir)
|
||
|
|
(make-directory skewer-bower-cache-dir t))
|
||
|
|
(expand-file-name package skewer-bower-cache-dir))
|
||
|
|
|
||
|
|
(defun skewer-bower-git (package &rest args)
|
||
|
|
"Run git for PACKAGE's repository with ARGS."
|
||
|
|
(with-temp-buffer
|
||
|
|
(when (zerop (apply #'call-process skewer-bower-git-executable nil t nil
|
||
|
|
(format "--git-dir=%s" (skewer-bower-cache package))
|
||
|
|
args))
|
||
|
|
(buffer-string))))
|
||
|
|
|
||
|
|
(defun skewer-bower-git-clone (url package)
|
||
|
|
"Clone or fetch PACKAGE's repository from URL if needed."
|
||
|
|
(if (member package skewer-bower-refreshed)
|
||
|
|
t
|
||
|
|
(let* ((cache (skewer-bower-cache package))
|
||
|
|
(status
|
||
|
|
(if (file-exists-p cache)
|
||
|
|
(when (skewer-bower-git package "fetch")
|
||
|
|
(push package skewer-bower-refreshed))
|
||
|
|
(skewer-bower-git package "clone" "--bare" url cache))))
|
||
|
|
(not (null status)))))
|
||
|
|
|
||
|
|
(defun skewer-bower-git-show (package version file)
|
||
|
|
"Grab FILE from PACKAGE at version VERSION."
|
||
|
|
(when (string-match-p "^\\./" file) ; avoid relative paths
|
||
|
|
(setf file (substring file 2)))
|
||
|
|
(skewer-bower-git package "show" (format "%s:%s" version file)))
|
||
|
|
|
||
|
|
(defun skewer-bower-git-tag (package)
|
||
|
|
"List all the tags in PACKAGE's repository."
|
||
|
|
(split-string (skewer-bower-git package "tag")))
|
||
|
|
|
||
|
|
;; Bower functions
|
||
|
|
|
||
|
|
(defun skewer-bower-package-ensure (package)
|
||
|
|
"Ensure a package is installed in the cache and up to date.
|
||
|
|
Emit an error if the package could not be ensured."
|
||
|
|
(when (null skewer-bower-packages) (skewer-bower-refresh))
|
||
|
|
(let ((url (cdr (assoc package skewer-bower-packages))))
|
||
|
|
(when (null url)
|
||
|
|
(error "Unknown package: %s" package))
|
||
|
|
(when (null (skewer-bower-git-clone url package))
|
||
|
|
(error "Failed to fetch: %s" url))
|
||
|
|
t))
|
||
|
|
|
||
|
|
(defun skewer-bower-package-versions (package)
|
||
|
|
"List the available versions for a package. Always returns at
|
||
|
|
least one version."
|
||
|
|
(skewer-bower-package-ensure package)
|
||
|
|
(or (sort (skewer-bower-git-tag package) #'string<)
|
||
|
|
(list "master")))
|
||
|
|
|
||
|
|
(defun skewer-bower-get-config (package &optional version)
|
||
|
|
"Get the configuration alist for PACKAGE at VERSION. Return nil
|
||
|
|
if no configuration could be found."
|
||
|
|
(skewer-bower-package-ensure package)
|
||
|
|
(unless version (setf version "master"))
|
||
|
|
(json-read-from-string
|
||
|
|
(cl-loop for file in skewer-bower-json
|
||
|
|
for config = (skewer-bower-git-show package version file)
|
||
|
|
when config return it
|
||
|
|
finally (return "null"))))
|
||
|
|
|
||
|
|
;; Serving the library
|
||
|
|
|
||
|
|
(defvar skewer-bower-history ()
|
||
|
|
"Library selection history for `completing-read'.")
|
||
|
|
|
||
|
|
(defun skewer-bowser--path (package version main)
|
||
|
|
"Return the simple-httpd hosted path for PACKAGE."
|
||
|
|
(format "/skewer/bower/%s/%s/%s" package (or version "master") main))
|
||
|
|
|
||
|
|
(defun skewer-bower-prompt-package ()
|
||
|
|
"Prompt for a package and version from the user."
|
||
|
|
(when (null skewer-bower-packages) (skewer-bower-refresh))
|
||
|
|
;; ido-completing-read bug workaround:
|
||
|
|
(when (> (length skewer-bower-history) 32)
|
||
|
|
(setf skewer-bower-history (cl-subseq skewer-bower-history 0 16)))
|
||
|
|
(let* ((packages (mapcar #'car skewer-bower-packages))
|
||
|
|
(selection (nconc skewer-bower-history packages))
|
||
|
|
(package (completing-read "Library: " selection nil t nil
|
||
|
|
'skewer-bower-history))
|
||
|
|
(versions (reverse (skewer-bower-package-versions package)))
|
||
|
|
(version (completing-read "Version: " versions
|
||
|
|
nil t nil nil (car versions))))
|
||
|
|
(list package version)))
|
||
|
|
|
||
|
|
(defun skewer-bower--js-p (filename)
|
||
|
|
"Return non-nil if FILENAME looks like JavaScript."
|
||
|
|
(string-match "\\.js$" filename))
|
||
|
|
|
||
|
|
(defun skewer-bower-guess-main (package version config)
|
||
|
|
"Attempt to determine the main entrypoints from a potentially
|
||
|
|
incomplete or incorrect bower configuration. Returns nil if
|
||
|
|
guessing failed."
|
||
|
|
(let ((check (apply-partially #'skewer-bower-git-show package version))
|
||
|
|
(main (cdr (assoc 'main config))))
|
||
|
|
(cond ((and (vectorp main) (cl-some check main))
|
||
|
|
(cl-coerce (cl-remove-if-not #'skewer-bower--js-p main) 'list))
|
||
|
|
((and (stringp main) (funcall check main))
|
||
|
|
(list main))
|
||
|
|
((funcall check (concat package ".js"))
|
||
|
|
(list (concat package ".js")))
|
||
|
|
((funcall check package)
|
||
|
|
(list package)))))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun skewer-bower-load (package &optional version)
|
||
|
|
"Dynamically load a library from bower into the current page."
|
||
|
|
(interactive (skewer-bower-prompt-package))
|
||
|
|
(let* ((config (skewer-bower-get-config package version))
|
||
|
|
(deps (cdr (assoc 'dependencies config)))
|
||
|
|
(main (skewer-bower-guess-main package version config)))
|
||
|
|
(when (null main)
|
||
|
|
(error "Could not load %s (%s): no \"main\" entrypoint specified"
|
||
|
|
package version))
|
||
|
|
(cl-loop for (dep . version) in deps
|
||
|
|
do (skewer-bower-load (format "%s" dep) version))
|
||
|
|
(cl-loop for entrypoint in main
|
||
|
|
for path = (skewer-bowser--path package version entrypoint)
|
||
|
|
do (skewer-eval path nil :type "script"))))
|
||
|
|
|
||
|
|
(defservlet skewer/bower "application/javascript; charset=utf-8" (path)
|
||
|
|
"Serve a script from the local bower repository cache."
|
||
|
|
(cl-destructuring-bind (_ _skewer _bower package version . parts)
|
||
|
|
(split-string path "/")
|
||
|
|
(let* ((file (mapconcat #'identity parts "/"))
|
||
|
|
(contents (skewer-bower-git-show package version file)))
|
||
|
|
(if contents
|
||
|
|
(insert contents)
|
||
|
|
(httpd-error t 404)))))
|
||
|
|
|
||
|
|
(provide 'skewer-bower)
|
||
|
|
|
||
|
|
;;; skewer-bower.el ends here
|