emacs/nxhtml/web-autoload.el

   1 ;;; web-autoload.el --- Autoload from web site
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2009-12-26 Sat
   5 ;; Version:
   6 ;; Last-Updated:
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   None
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; Experimental code. Not ready to use at all.
  20 ;;
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22 ;;
  23 ;;; Change log:
  24 ;;
  25 ;;
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  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.
  32 ;;
  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.
  37 ;;
  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.
  42 ;;
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44 ;;
  45 ;;; Code:
  46
  47 ;;(eval-when-compile (require 'web-vcs)) ;; Gives recursion
  48 ;;(eval-when-compile (require 'nxhtml-base))
  49
  50 (defcustom web-autoload-autocompile t
  51   "Byt compile downloaded files if t."
  52   :type 'boolean
  53   :group 'web-vcs)
  54
  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.
  59
  60 However loading can be done from a web url.
  61 In that case SRC should have the format
  62
  63   (WEB-VCS BASE-URL RELATIVE-URL BASE-DIR)
  64
  65 where
  66
  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
  70     function above.
  71
  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).
  75
  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))))
  81       (cond
  82        ((eq type 'macro)
  83         (setq type 'defmacro))
  84        (t
  85         (setq type 'defun)))
  86       (put fun 'web-autoload src)
  87       (eval
  88        `(web-autoload-1 ,fun ,src ,docstring ,int ,type)))))
  89
  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))
  94
  95 ;; Fix-me: change name
  96 (defvar web-autoload-skip-require-advice nil)
  97
  98 ;; Fix-me: Use TYPE
  99 (defmacro web-autoload-1 (fun src docstring interactive type)
 100   `(progn
 101      (,type ,fun (&rest args)
 102        ,(concat docstring
 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  "
 105                 (format "%S"
 106                         src))
 107        ,interactive
 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)
 111                            ))
 112               (old-hist-elt (when lib-web (load-history-filename-element lib-web)))
 113               (auto-fun (symbol-function ',fun))
 114               err)
 115          ;; Fix-me: Can't do this because we may have to go back here again...
 116          ;;(fset ',fun nil)
 117          (if (not (listp ',src))
 118              ;; Just a local file, for testing of logics.
 119              (let ((lib-file (locate-library ',src)))
 120                (load ',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"))
 131                   ;;file-url
 132                   ;;dl-file
 133                   )
 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)))
 146                      nil)
 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)
 151              (web-vcs-log-save)
 152              ))
 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.
 156          ;;
 157          ;; Delete old load-history entry for ,fun. A new entry
 158          ;; has been added.
 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)
 166                (apply ',fun args)
 167              ;; It is a macro
 168              (let ((the-macro (append '(,fun) args nil)))
 169                (eval the-macro))))))))
 170
 171 ;; Fix-me: Set up a byte compilation queue. Move function for byte compiling here.
 172
 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)
 176                                             buffer-file-name))))
 177     (expand-file-name "temp-cleanup.el" this-dir)))
 178
 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))
 189     (when bc-outbuffer
 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
 196     (when nil
 197       (setq load-history (cdr load-history)))
 198     ;; Try to reset some variables (just guesses)
 199     (when nil
 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)
 224       )
 225     ;; Try compiling something go get right state ...
 226     (when nil
 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
 230             (insert ";; Dummy")
 231             (basic-save-buffer)
 232             (kill-buffer))))
 233       (byte-compile-file web-autoload-cleanup-dummy-el nil))))
 234
 235 (defun big-trace ()
 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)
 249   )
 250
 251 (defvar web-autoload-require-list nil)
 252
 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)))
 257
 258 ;;(big-trace)
 259
 260 (provide 'web-autoload)
 261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 262 ;;; web-autoload.el ends here