eval region, coffee-script

swank-coffee.el

;;; swank-coffee.el hanachin_
;;;
;;; Copyright (c) 2010 Ivan Shvedunov. All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(define-slime-contrib slime-coffee
  "Emacs-side support for Swank-COFFEE."
  (:authors "Ivan Shvedunov")
  (:license "X11-style")
  (:slime-dependencies slime-repl slime-js)
  (:on-load
   (add-hook 'slime-event-hooks 'slime-coffee-event-hook-function))
  (:on-unload
   (remove-hook 'slime-event-hooks 'slime-coffee-event-hook-function)))

(defun slime-coffee-repl-update-package ()
  (let ((name (slime-current-package)))
    (with-current-buffer (slime-output-buffer)
      (let ((previouse-point (- (point) slime-repl-input-start-mark)))
        (setf (slime-lisp-package) name
              (slime-lisp-package-prompt-string) name
              slime-buffer-package name)
        (slime-repl-insert-prompt)
        (when (plusp previouse-point)
          (goto-char (+ previouse-point slime-repl-input-start-mark)))))))

(defun slime-coffee-event-hook-function (event)
  (when (equal "COFFEE" (slime-lisp-implementation-type))
    (destructure-case event
      ((:new-package package prompt)
       (let ((buffer (slime-connection-output-buffer)))
         (setf (slime-lisp-package) package)
         (setf (slime-lisp-package-prompt-string) prompt)
         (when (buffer-live-p buffer)
           (with-current-buffer buffer
             (setq slime-buffer-package package)
             (slime-coffee-repl-update-package)
             (save-excursion
               (goto-char (marker-position slime-repl-prompt-start-mark))
               (slime-mark-output-start))))
         t))
      (t nil))))

(defvar slime-coffee-remote-history nil
  "History list for COFFEE remote names.")

(defun slime-coffee-read-remote-index (&optional prompt)
  (let* ((completion-ignore-case nil)
         (remotes (slime-eval '(js:list-remotes)))
         (remote-names
          (loop for remote in remotes
                collect (concat (third remote)
                                "/"
                                (replace-regexp-in-string
                                 "^:" ""(symbol-name (second remote))))))
         (prompt (or prompt "Remote: "))
         (p (or (position
                 (completing-read prompt (slime-bogus-completion-alist remote-names)
                                  nil nil nil
                                  'slime-remote-history nil)
                 remote-names :test #'equal)
                (error "bad remote name"))))
    (first (elt remotes p))))

(defun slime-coffee-select-remote (n)
  "Select COFFEE remote by number"
  (interactive (list (slime-coffee-read-remote-index)))
  (slime-eval-async `(js:select-remote ,n nil)))

(defslime-repl-shortcut slime-repl-coffee-select-remote ("select-remote")
  (:handler 'slime-coffee-select-remote)
  (:one-liner "Select COFFEE remote."))

(defun slime-coffee-sticky-select-remote (n)
  "Select COFFEE remote by number in sticky mode"
  (interactive (list (slime-coffee-read-remote-index)))
  (slime-eval-async `(js:select-remote ,n t)))

(defslime-repl-shortcut slime-repl-coffee-sticky-select-remote ("sticky-select-remote")
  (:handler 'slime-coffee-sticky-select-remote)
  (:one-liner "Select COFFEE remote in sticky mode."))

(defun slime-coffee-set-target-url (url)
  "Set target URL for the proxy"
  (interactive "sTarget URL: ")
  (slime-eval-async `(js:set-target-url ,url)))

(defslime-repl-shortcut slime-repl-coffee-set-target-url ("target-url")
  (:handler 'slime-coffee-set-target-url)
  (:one-liner "Select target URL for the swank-coffee proxy"))

(defun slime-coffee-set-slime-version (url)
  "Set SLIME version for swank-coffee"
  (interactive "sVersion: ")
  (slime-eval-async `(js:set-slime-version ,url)))

(defslime-repl-shortcut slime-repl-coffee-set-slime-version ("coffee-slime-version")
  (:handler 'slime-coffee-set-slime-version)
  (:one-liner "Set SLIME version for swank-coffee"))

;; FIXME: should add an rpc command for browser-only eval

(defun slime-coffee-eval (str &optional cont)
  (slime-eval-async `(swank:interactive-eval ,str) cont))

(defun slime-coffee-reload ()
  (interactive)
  (slime-coffee-eval "SwankCOFFEE.reload()"
    #'(lambda (v)
        (message "Reloading the page"))))

(defun slime-coffee-refresh-css ()
  (interactive)
  (slime-coffee-eval
   (format "SwankCOFFEE.refreshCSS('%s')"
           (replace-regexp-in-string
            "(')" "\\\\\\1"
            (if (string-match "\\.css$" (buffer-file-name))
                (replace-regexp-in-string
                 "^.*/" "" (buffer-file-name))
              "")))
    #'(lambda (v)
        (message "Refreshing CSS"))))

(defun slime-coffee-start-of-toplevel-form ()
  (interactive)
  (when coffee-mode-buffer-dirty-p
    (coffee-mode-wait-for-parse #'slime-coffee-start-of-toplevel-form))
  (coffee-forward-sws)
  (if (= (point) (point-max))
      (coffee-mode-forward-sexp -1)
    (let ((node (coffee-node-at-point)))
      (when (or (null node)
                (coffee-ast-root-p node))
        (error "cannot locate any toplevel form"))
      (while (and (coffee-node-parent node)
                  (not (coffee-ast-root-p (coffee-node-parent node))))
        (setf node (coffee-node-parent node)))
      (goto-char (coffee-node-abs-pos node))
      (coffee-forward-sws)))
  (point))

(defun slime-coffee-end-of-toplevel-form ()
  (interactive)
  (coffee-forward-sws)
  (let ((node (coffee-node-at-point)))
    (unless (or (null node) (coffee-ast-root-p node))
      (while (and (coffee-node-parent node)
                  (not (coffee-ast-root-p (coffee-node-parent node))))
        (setf node (coffee-node-parent node)))
      (goto-char (coffee-node-abs-end node)))
    (point)))

(defun slime-coffee-send-region-defun (start end)
  "Evaluate region test."
  (interactive "r")
  (slime-flash-region start end)
  (let ((coffee-script (buffer-substring-no-properties start end)))
    (with-temp-buffer
      (insert coffee-script)
      (if (= 0 (call-process-region (point-min) (point-max) "coffee" t t nil "-bpes"))
          (slime-coffee-eval
           (buffer-string)
           #'(lambda (v)
               (save-excursion
                 (goto-char start)
                 (let ((sent-func "<...>"))
                   (when (looking-at "[ \t]*\\([^ \t\n{}][^\n{}]*\\)")
                     (setf sent-func (match-string 1)))
                   (message "Sent: %s" sent-func)))))
        (progn
          (string-match "Error:.*$" (buffer-string)  0)
          (message (format "%s" (match-string 0 (buffer-string)))))))))

;; FIXME: this breaks if // comment directly precedes the function
(defun slime-coffee-send-defun ()
  (interactive)
  (save-excursion
    (lexical-let ((start (slime-coffee-start-of-toplevel-form))
                  (end (slime-coffee-end-of-toplevel-form)))
      ;; FIXME: use slime-eval-region
      (slime-flash-region start end)
      (slime-coffee-eval
       (buffer-substring-no-properties start end)
       #'(lambda (v)
           (save-excursion
             (goto-char start)
             (let ((sent-func "<...>"))
               (when (looking-at "[ \t]*\\([^ \t\n{}][^\n{}]*\\)")
                 (setf sent-func (match-string 1)))
               (message "Sent: %s" sent-func))))))))

(define-minor-mode slime-coffee-minor-mode
  "Toggle slime-coffee minor mode
With no argument, this command toggles the mode.
Non-null prefix argument turns on the mode.
Null prefix argument turns off the mode."
  nil
  " slime-coffee"
  '(("\C-\M-x"  . slime-coffee-send-defun)
    ("\C-c\C-c" . slime-coffee-send-defun)
    ("\C-c\C-r" . slime-coffee-send-region-defun)
    ;; ("\C-c\C-r" . slime-eval-region)
    ("\C-c\C-z" . slime-switch-to-output-buffer)))

;; TBD: dabbrev in repl:
;; DABBREV--GOTO-START-OF-ABBREV function skips over REPL prompt
;; because it has property 'intangible' and (forward-char -1) doesn't do
;; what is expected at the propmpt edge. Must redefine this function
;; or define and advice for it.
;; TBD: lost continuations (pipelined request ...) - maybe when closing page
(provide 'slime-coffee)