blob: 69bfbe6e297048c633e8864f464625d550edfd7d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
;;; 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
|
