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
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
|
;;; web-autoload.el --- Autoload from web site
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Created: 2009-12-26 Sat
;; Version:
;; Last-Updated:
;; URL:
;; Keywords:
;; Compatibility:
;;
;; Features that might be required by this library:
;;
;; None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Experimental code. Not ready to use at all.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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, 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
;;(eval-when-compile (require 'web-vcs)) ;; Gives recursion
;;(eval-when-compile (require 'nxhtml-base))
(defcustom web-autoload-autocompile t
"Byt compile downloaded files if t."
:type 'boolean
:group 'web-vcs)
(defun web-autoload (fun src docstring interactive type)
"Set up FUN to be autoloaded from SRC.
This works similar to `autoload' and the arguments DOCSTRING,
INTERACTIVE and TYPE are handled similary.
However loading can be done from a web url.
In that case SRC should have the format
(WEB-VCS BASE-URL RELATIVE-URL BASE-DIR)
where
- WEB-VCS is specifies a web repository type, see
`web-vcs-get-files-from-root'.
- BASE-URL is the base url, similar to the URL argument to the
function above.
- RELATIVE-URL is relative location. This will be relative to
BASE-DIR in file tree and to BASE-URL on the web \(only
logically in the latter case).
Loading will be done from the file resulting from expanding
RELATIVE-URL relative to BASE-DIR. If this file exists load it
directly, otherwise download it first."
(unless (functionp fun)
(let ((int (when interactive '(interactive))))
(cond
((eq type 'macro)
(setq type 'defmacro))
(t
(setq type 'defun)))
(put fun 'web-autoload src)
(eval
`(web-autoload-1 ,fun ,src ,docstring ,int ,type)))))
;; (defun web-autoload-default-filename-element ()
;; ;; Fix-me: el or elc?
;; ;; Fix-me: remove nxhtml binding
;; (expand-file-name "nxhtml-loaddefs.elc" nxhtml-install-dir))
;; Fix-me: change name
(defvar web-autoload-skip-require-advice nil)
;; Fix-me: Use TYPE
(defmacro web-autoload-1 (fun src docstring interactive type)
`(progn
(,type ,fun (&rest args)
,(concat docstring
"\n\nArguments are not yet known since the real function is not loaded."
"\nFunction is defined by `web-autoload' to be loaded using definition\n\n "
(format "%S"
src))
,interactive
;; (find-lisp-object-file-name 'chart-complete 'defun)
(let* ((lib-web (or (find-lisp-object-file-name ',fun 'defun)
;;(web-autoload-default-filename-element)
))
(old-hist-elt (when lib-web (load-history-filename-element lib-web)))
(auto-fun (symbol-function ',fun))
err)
;; Fix-me: Can't do this because we may have to go back here again...
;;(fset ',fun nil)
(if (not (listp ',src))
;; Just a local file, for testing of logics.
(let ((lib-file (locate-library ',src)))
(load ',src)
(unless (symbol-function ',fun)
(setq err (format "%s is not in library %s" ',fun lib-file))))
;; If file is a list then it should be a web url:
;; (web-vcs base-url relative-url base-dir)
;; Convert from repository url to file download url.
(let* (;;(vcs (nth 0 ',src))
;;(base-url (nth 1 ',src))
(rel-url (nth 2 ',src))
;;(base-dir (nth 3 ',src))
;;(rel-url-el (concat rel-url ".el"))
;;file-url
;;dl-file
)
;;(unless (stringp base-url) (setq base-url (symbol-value base-url)))
;;(unless (stringp base-dir) (setq base-dir (symbol-value base-dir)))
;;(setq dl-file (expand-file-name rel-url-el base-dir))
(web-vcs-message-with-face 'web-vcs-gold "web-autoload-1: BEG fun=%s" ',fun)
;; Fix-me: assume we can do require (instead of load, so
;; we do not have to defadvice load to).
(unless (ad-is-advised 'require)
(error "web-autoload-1: require is not advised"))
(unless (ad-is-active 'require)
(error "web-autoload-1: require advice is not active"))
(when (catch 'web-autoload-comp-restart
(require (intern (file-name-nondirectory rel-url)))
nil)
(web-autoload-byte-compile-queue))
(when (equal (symbol-function ',fun) auto-fun)
(error "Couldn't web autoload function %s" ',fun))
(web-vcs-message-with-face 'web-vcs-gold "web-autoload-1: END fun=%s" ',fun)
(web-vcs-log-save)
))
;; Fix-me: Wrong place to do the cleanup! It must be done
;; after loading a file. All autoload in that file must be
;; deleted from the nxhtml-loaddefs entry.
;;
;; Delete old load-history entry for ,fun. A new entry
;; has been added.
(let* ((tail (cdr old-hist-elt))
(new-tail (when tail (delete (cons 'defun ',fun) tail))))
(when tail (setcdr old-hist-elt new-tail)))
;; Finally call the real function
(if (called-interactively-p ',fun)
(call-interactively ',fun)
(if (functionp ',fun)
(apply ',fun args)
;; It is a macro
(let ((the-macro (append '(,fun) args nil)))
(eval the-macro))))))))
;; Fix-me: Set up a byte compilation queue. Move function for byte compiling here.
(defvar web-autoload-cleanup-dummy-el
(let* ((this-dir (file-name-directory (or load-file-name
(when (boundp 'bytecomp-filename) bytecomp-filename)
buffer-file-name))))
(expand-file-name "temp-cleanup.el" this-dir)))
(defun web-autoload-try-cleanup-after-failed-compile (active-comp)
(let* ((bc-input-buffer (get-buffer " *Compiler Input*"))
(bc-outbuffer (get-buffer " *Compiler Output*"))
;;(active-comp (car web-autoload-compile-queue))
(active-file (car active-comp))
(active-elc (byte-compile-dest-file active-file)))
;; Delete bytecomp buffers
(display-buffer "*Messages*")
(web-vcs-message-with-face 'web-vcs-red "Trying to cleanup (%s %s %s)" bc-input-buffer bc-outbuffer active-elc)
(when bc-input-buffer (kill-buffer bc-input-buffer))
(when bc-outbuffer
(kill-buffer bc-outbuffer)
(setq bytecomp-outbuffer nil))
;; Delete half finished elc file
(when (file-exists-p active-elc)
(delete-file active-elc))
;; Delete load-history entry
(when nil
(setq load-history (cdr load-history)))
;; Try to reset some variables (just guesses)
(when nil
(setq byte-compile-constants nil)
(setq byte-compile-variables nil)
(setq byte-compile-bound-variables nil)
(setq byte-compile-const-variables nil)
;;(setq byte-compile-macro-environment byte-compile-initial-macro-environment)
(setq byte-compile-function-environment nil)
(setq byte-compile-unresolved-functions nil)
(setq byte-compile-noruntime-functions nil)
(setq byte-compile-tag-number 0)
(setq byte-compile-output nil)
(setq byte-compile-depth 0)
(setq byte-compile-maxdepth 0)
;;(setq byte-code-vector nil)
(setq byte-compile-current-form nil)
(setq byte-compile-dest-file nil)
(setq byte-compile-current-file nil)
(setq byte-compile-current-group nil)
(setq byte-compile-current-buffer nil)
(setq byte-compile-read-position nil)
(setq byte-compile-last-position nil)
(setq byte-compile-last-warned-form nil)
(setq byte-compile-last-logged-file nil)
;;(defvar bytecomp-outbuffer)
;;(defvar byte-code-meter)
)
;; Try compiling something go get right state ...
(when nil
(unless (file-exists-p web-autoload-cleanup-dummy-el)
(let ((buf (find-file-noselect web-autoload-cleanup-dummy-el)))
(with-current-buffer buf
(insert ";; Dummy")
(basic-save-buffer)
(kill-buffer))))
(byte-compile-file web-autoload-cleanup-dummy-el nil))))
(defun big-trace ()
(setq trace-buffer "*Messages*")
(trace-function-background 'byte-compile-form)
(trace-function-background 'byte-compile-file-form)
(trace-function-background 'byte-optimize-form)
(trace-function-background 'byte-compile-normal-call)
(trace-function-background 'byte-compile-cl-warn)
(trace-function-background 'byte-compile-const-symbol-p)
(trace-function-background 'byte-compile-warn)
(trace-function-background 'byte-compile-warning-enabled-p)
(trace-function-background 'byte-compile-callargs-warn)
(trace-function-background 'byte-compile-splice-in-already-compiled-code)
(trace-function-background 'byte-inline-lapcode)
(trace-function-background 'byte-decompile-bytecode-1)
)
(defvar web-autoload-require-list nil)
(defun web-autoload-require (feature web-vcs base-url relative-url base-dir compile-fun)
"Prepare to download file if necessary when `require' is called.
WEB-VCS BASE-URL RELATIVE-URL"
(add-to-list 'web-autoload-require-list `(,feature ,web-vcs ,base-url ,relative-url ,base-dir ,compile-fun)))
;;(big-trace)
(provide 'web-autoload)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; web-autoload.el ends here
|
