(require 'cl)

(setq jj-shell "/home/jimb/mc/tm/js/src/obj~/js")

(defun jj-insert-file-disassembly (file)
  "Insert SpiderMonkey bytecode disassembly of FILE's top-level code at point.
It must be safe to load FILE, and doing so should not produce any output;
if it does, that output will be inserted along with the disassembly."
  (call-process jj-shell nil (current-buffer) nil
                "-e" (format "disfile('%s')" file))
  (buffer-string))

(defun jj-insert-function-disassembly (file fun)
  "Insert SpiderMonkey bytecode disassembly of FUN in FILE at point.
It must be safe to load FILE, and doing so should not produce any output;
if it does, that output will be inserted along with the disassembly.
FUN may actually be any expression that evaluates to a function; if
evaluating FUN produces any output, that will be included in the disassembly."
  (call-process jj-shell nil (current-buffer) nil
                "-e" (format "load('%s'); dis(%s)" file fun)))

(defun jj-insert-or-replace (title contents)
  "Remove any previous assembly named TITLE, and insert CONTENTS afresh.
Leave point after the new contents."
  (let ((start-label (format "*** disassembly: %s\n" title))
        (end-label   (format "*** end: %s\n" title))
        insert-here)

    ;; Delete any existing copies.
    (save-excursion
      (goto-char (point-min))
      (while (search-forward start-label nil t)
        ;; We've found an existing copy; delete it.
        (goto-char (match-beginning 0))
        (forward-line 0)
        (let ((start (point)))
          (when (search-forward "*** end:" nil t)
            (forward-line 1)
            (delete-region start (point))))
        ;; Put the new copy where the first old copy was.
        (unless insert-here
          (setq insert-here (point)))))

    (when insert-here
      (goto-char insert-here))

    ;; Insert the new text, marking it so we can find it again later.
    (forward-line 0)
    (let ((start (point)))
      (insert start-label)
      (insert contents)
      (insert end-label)
      (comment-region start (point)))))

(defun jj-require-saved-buffer ()
  (when (buffer-modified-p)
    (unless (y-or-n-p (format "Buffer '%s' is modified; save? " 
                              (buffer-name)))
      (error "Must save before disassembling."))
    (save-buffer)))

(defun jj-disassemble ()
  "Insert a byte-code disassembly of the current file.
If the buffer already contains such a disassembly, replace it."
  (interactive)
  (when (called-interactively-p)
    (jj-require-saved-buffer))
  (save-excursion
    (let* ((file buffer-file-name)
           (disassembly
            (with-temp-buffer
              (jj-insert-file-disassembly file)
              (buffer-string))))
      (jj-insert-or-replace "global code" disassembly)))
  (when (called-interactively-p)
    (save-buffer)))

(defun jj-disassemble-function (function)
  "Prompt for the name of a function FUN, and insert its disassembly.
If the buffer already contains such a disassembly, replace it.
FUN may actually be any expression that evaluates to a function; if
evaluating FUN produces any output, that will be included in the disassembly."
  (interactive "MDisassemble function: ")
  (when (called-interactively-p)
    (jj-require-saved-buffer))
  (save-excursion
    (let* ((file buffer-file-name)
           (disassembly
            (with-temp-buffer
              (jj-insert-function-disassembly file function)
              (buffer-string))))
      (jj-insert-or-replace function disassembly)))
  (if (called-interactively-p)
      (save-buffer)))

(defun jj-update-disassemblies ()
  "Refresh all disassemblies in the current buffer."
  (interactive)
  (jj-require-saved-buffer)
  (save-excursion
    (let (disassemblies)
      (goto-char (point-min))
      (while (search-forward "*** disassembly: " nil t)
        (let ((name (buffer-substring-no-properties
                     (point) (progn (end-of-line) (point)))))
          (unless (member name disassemblies)
            (push name disassemblies))))
      (message "%S" disassemblies)
      (loop for d in disassemblies
            do (if (string-equal d "global code")
                   (jj-disassemble)
                 (jj-disassemble-function d)))))
  (when (called-interactively-p)
    (save-buffer)))

(provide 'jimb-js)