262 lines
10 KiB
EmacsLisp
262 lines
10 KiB
EmacsLisp
;;; 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
|