1 ;;; web-autoload.el --- Autoload from web site
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2009-12-26 Sat
11 ;; Features that might be required by this library:
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 ;; Experimental code. Not ready to use at all.
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;; This program is free software; you can redistribute it and/or
29 ;; modify it under the terms of the GNU General Public License as
30 ;; published by the Free Software Foundation; either version 3, or
31 ;; (at your option) any later version.
33 ;; This program is distributed in the hope that it will be useful,
34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
36 ;; General Public License for more details.
38 ;; You should have received a copy of the GNU General Public License
39 ;; along with this program; see the file COPYING. If not, write to
40 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
41 ;; Floor, Boston, MA 02110-1301, USA.
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 ;;(eval-when-compile (require 'web-vcs)) ;; Gives recursion
48 ;;(eval-when-compile (require 'nxhtml-base))
50 (defcustom web-autoload-autocompile t
51 "Byt compile downloaded files if t."
55 (defun web-autoload (fun src docstring interactive type)
56 "Set up FUN to be autoloaded from SRC.
57 This works similar to `autoload' and the arguments DOCSTRING,
58 INTERACTIVE and TYPE are handled similary.
60 However loading can be done from a web url.
61 In that case SRC should have the format
63 (WEB-VCS BASE-URL RELATIVE-URL BASE-DIR)
67 - WEB-VCS is specifies a web repository type, see
68 `web-vcs-get-files-from-root'.
69 - BASE-URL is the base url, similar to the URL argument to the
72 - RELATIVE-URL is relative location. This will be relative to
73 BASE-DIR in file tree and to BASE-URL on the web \(only
74 logically in the latter case).
76 Loading will be done from the file resulting from expanding
77 RELATIVE-URL relative to BASE-DIR. If this file exists load it
78 directly, otherwise download it first."
79 (unless (functionp fun)
80 (let ((int (when interactive '(interactive))))
83 (setq type 'defmacro))
86 (put fun 'web-autoload src)
88 `(web-autoload-1 ,fun ,src ,docstring ,int ,type)))))
90 ;; (defun web-autoload-default-filename-element ()
91 ;; ;; Fix-me: el or elc?
92 ;; ;; Fix-me: remove nxhtml binding
93 ;; (expand-file-name "nxhtml-loaddefs.elc" nxhtml-install-dir))
95 ;; Fix-me: change name
96 (defvar web-autoload-skip-require-advice nil)
99 (defmacro web-autoload-1 (fun src docstring interactive type)
101 (,type ,fun (&rest args)
103 "\n\nArguments are not yet known since the real function is not loaded."
104 "\nFunction is defined by `web-autoload' to be loaded using definition\n\n "
108 ;; (find-lisp-object-file-name 'chart-complete 'defun)
109 (let* ((lib-web (or (find-lisp-object-file-name ',fun 'defun)
110 ;;(web-autoload-default-filename-element)
112 (old-hist-elt (when lib-web (load-history-filename-element lib-web)))
113 (auto-fun (symbol-function ',fun))
115 ;; Fix-me: Can't do this because we may have to go back here again...
117 (if (not (listp ',src))
118 ;; Just a local file, for testing of logics.
119 (let ((lib-file (locate-library ',src)))
121 (unless (symbol-function ',fun)
122 (setq err (format "%s is not in library %s" ',fun lib-file))))
123 ;; If file is a list then it should be a web url:
124 ;; (web-vcs base-url relative-url base-dir)
125 ;; Convert from repository url to file download url.
126 (let* (;;(vcs (nth 0 ',src))
127 ;;(base-url (nth 1 ',src))
128 (rel-url (nth 2 ',src))
129 ;;(base-dir (nth 3 ',src))
130 ;;(rel-url-el (concat rel-url ".el"))
134 ;;(unless (stringp base-url) (setq base-url (symbol-value base-url)))
135 ;;(unless (stringp base-dir) (setq base-dir (symbol-value base-dir)))
136 ;;(setq dl-file (expand-file-name rel-url-el base-dir))
137 (web-vcs-message-with-face 'web-vcs-gold "web-autoload-1: BEG fun=%s" ',fun)
138 ;; Fix-me: assume we can do require (instead of load, so
139 ;; we do not have to defadvice load to).
140 (unless (ad-is-advised 'require)
141 (error "web-autoload-1: require is not advised"))
142 (unless (ad-is-active 'require)
143 (error "web-autoload-1: require advice is not active"))
144 (when (catch 'web-autoload-comp-restart
145 (require (intern (file-name-nondirectory rel-url)))
147 (web-autoload-byte-compile-queue))
148 (when (equal (symbol-function ',fun) auto-fun)
149 (error "Couldn't web autoload function %s" ',fun))
150 (web-vcs-message-with-face 'web-vcs-gold "web-autoload-1: END fun=%s" ',fun)
153 ;; Fix-me: Wrong place to do the cleanup! It must be done
154 ;; after loading a file. All autoload in that file must be
155 ;; deleted from the nxhtml-loaddefs entry.
157 ;; Delete old load-history entry for ,fun. A new entry
159 (let* ((tail (cdr old-hist-elt))
160 (new-tail (when tail (delete (cons 'defun ',fun) tail))))
161 (when tail (setcdr old-hist-elt new-tail)))
162 ;; Finally call the real function
163 (if (called-interactively-p ',fun)
164 (call-interactively ',fun)
165 (if (functionp ',fun)
168 (let ((the-macro (append '(,fun) args nil)))
169 (eval the-macro))))))))
171 ;; Fix-me: Set up a byte compilation queue. Move function for byte compiling here.
173 (defvar web-autoload-cleanup-dummy-el
174 (let* ((this-dir (file-name-directory (or load-file-name
175 (when (boundp 'bytecomp-filename) bytecomp-filename)
177 (expand-file-name "temp-cleanup.el" this-dir)))
179 (defun web-autoload-try-cleanup-after-failed-compile (active-comp)
180 (let* ((bc-input-buffer (get-buffer " *Compiler Input*"))
181 (bc-outbuffer (get-buffer " *Compiler Output*"))
182 ;;(active-comp (car web-autoload-compile-queue))
183 (active-file (car active-comp))
184 (active-elc (byte-compile-dest-file active-file)))
185 ;; Delete bytecomp buffers
186 (display-buffer "*Messages*")
187 (web-vcs-message-with-face 'web-vcs-red "Trying to cleanup (%s %s %s)" bc-input-buffer bc-outbuffer active-elc)
188 (when bc-input-buffer (kill-buffer bc-input-buffer))
190 (kill-buffer bc-outbuffer)
191 (setq bytecomp-outbuffer nil))
192 ;; Delete half finished elc file
193 (when (file-exists-p active-elc)
194 (delete-file active-elc))
195 ;; Delete load-history entry
197 (setq load-history (cdr load-history)))
198 ;; Try to reset some variables (just guesses)
200 (setq byte-compile-constants nil)
201 (setq byte-compile-variables nil)
202 (setq byte-compile-bound-variables nil)
203 (setq byte-compile-const-variables nil)
204 ;;(setq byte-compile-macro-environment byte-compile-initial-macro-environment)
205 (setq byte-compile-function-environment nil)
206 (setq byte-compile-unresolved-functions nil)
207 (setq byte-compile-noruntime-functions nil)
208 (setq byte-compile-tag-number 0)
209 (setq byte-compile-output nil)
210 (setq byte-compile-depth 0)
211 (setq byte-compile-maxdepth 0)
212 ;;(setq byte-code-vector nil)
213 (setq byte-compile-current-form nil)
214 (setq byte-compile-dest-file nil)
215 (setq byte-compile-current-file nil)
216 (setq byte-compile-current-group nil)
217 (setq byte-compile-current-buffer nil)
218 (setq byte-compile-read-position nil)
219 (setq byte-compile-last-position nil)
220 (setq byte-compile-last-warned-form nil)
221 (setq byte-compile-last-logged-file nil)
222 ;;(defvar bytecomp-outbuffer)
223 ;;(defvar byte-code-meter)
225 ;; Try compiling something go get right state ...
227 (unless (file-exists-p web-autoload-cleanup-dummy-el)
228 (let ((buf (find-file-noselect web-autoload-cleanup-dummy-el)))
229 (with-current-buffer buf
233 (byte-compile-file web-autoload-cleanup-dummy-el nil))))
236 (setq trace-buffer "*Messages*")
237 (trace-function-background 'byte-compile-form)
238 (trace-function-background 'byte-compile-file-form)
239 (trace-function-background 'byte-optimize-form)
240 (trace-function-background 'byte-compile-normal-call)
241 (trace-function-background 'byte-compile-cl-warn)
242 (trace-function-background 'byte-compile-const-symbol-p)
243 (trace-function-background 'byte-compile-warn)
244 (trace-function-background 'byte-compile-warning-enabled-p)
245 (trace-function-background 'byte-compile-callargs-warn)
246 (trace-function-background 'byte-compile-splice-in-already-compiled-code)
247 (trace-function-background 'byte-inline-lapcode)
248 (trace-function-background 'byte-decompile-bytecode-1)
251 (defvar web-autoload-require-list nil)
253 (defun web-autoload-require (feature web-vcs base-url relative-url base-dir compile-fun)
254 "Prepare to download file if necessary when `require' is called.
255 WEB-VCS BASE-URL RELATIVE-URL"
256 (add-to-list 'web-autoload-require-list `(,feature ,web-vcs ,base-url ,relative-url ,base-dir ,compile-fun)))
260 (provide 'web-autoload)
261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
262 ;;; web-autoload.el ends here