Wandbox を Emacs から利用する. Warning : This repo was moved to https://github.com/kosh04/emacs-wandbox

wandbox.el

;;; wandbox.el --- Wandbox interface for Emacs

;; Let's Play Wandbox!
;; - http://melpon.org/wandbox/
;; - https://github.com/melpon/wandbox >>> /kennel/API.rst

;;; Example:

;; ## インタラクティブに利用する
;;
;; M-x wandbox-compile-file - ファイルを指定してコンパイル
;; M-x wandbox-compile-region - リージョンを指定してコンパイル
;; M-x wandbox-compile-buffer - バッファ全体をコンパイル
;;
;; ## Emacs Lisp から利用する
;;
;; (wandbox-compile :compiler "gcc-head" :options "warning" :code "main(){}")
;; (wandbox-compile :name "C" :compiler-option "-lm" :file "/path/to/prog.c")
;; (wandbox-compile :name "Perl" :code "while (<>) { print uc($_); }" :stdin "hello world\n")
;; (wandbox-compile :name "Ruby2.0" :code "p ARGV" :runtime-option "1\n2\n3")
;;
;; (add-to-list '*wandbox-profiles* '(:name "User Profile" :compiler "clang-head"))
;; (wandbox-compile :name "User Profile" :code "...")

;;; TODO:

;; - github にコミット
;; - ドキュメントを書く
;; - merge-plist
;; - コンパイル結果のデータをユーザが弄れるようにする
;; - gist キーワードの追加
;; - 複数プロファイルの指定
;; - request.el を利用するかどうか

;;; Code:

(eval-when-compile
  (require 'cl))
(require 'url-http)
(require 'json)

;;(defvar *wandbox-default-compiler* "gcc-head")

(defvar *wandbox-profiles*
  '(
    (:name "C++" :compiler "gcc-head" :options "warning,boost-1.55,sprout,gnu++1y" :ext "cc")
    (:name "CPP" :compiler "gcc-4.8.2-pp" :options "cpp-p" :ext "cpp")
    (:name "C" :compiler "clang-3.3-c" :options "warning,c99" :ext "c")
    (:name "C#" :compiler "mcs" :ext "cs")
    (:name "D" :compiler "gdc-head" :ext "d")
    (:name "Haskell" :compiler "ghc" :ext "hs")
    (:name "Perl" :compiler "perl-5.18.0" :options "perl5.18.0" :ext "pl")
    (:name "Python2.7" :compiler "python-2.7.3" :ext "py")
    (:name "Python3.3" :compiler "python-3.3.2" :ext "py")
    (:name "Ruby1.9" :compiler "ruby-1.9.3-p0" :ext "rb")
    (:name "Ruby2.0" :compiler "ruby-2.0.0-p247" :ext "rb")
    (:name "MRuby" :compiler "mruby-head" :ext "rb")
    (:name "Erlang" :compiler "erlang-maint" :ext "erl")
    (:name "Rust" :compiler "rust-head" :ext "rs")
    (:name "Bash" :compiler "bash" :ext "sh")
    (:name "SQL" :compiler "sqlite-3.8.1" :ext "sql")
    (:name "Lua" :compiler "lua-5.2.2" :ext "lua")
    (:name "PHP" :compiler "php-5.5.6" :ext "php")
    (:name "Lazy K" :compiler "lazyk" :ext "lazy")
    (:name "CLISP" :compiler "clisp-2.49.0" :ext "lisp")
    (:name "Pascal" :compiler "fpc-2.6.2" :ext "pas")
    ))

(defvar *wandbox-response-keywords*
  '(
    ;;"compiler_output"
    ;;"compiler_error"
    "compiler_message"
    ;;"program_output"
    ;;"program_error"
    "program_message"
    "status"
    "signal"
    ))

(defun wandbox--fetch-url (url)
  (declare (special url-http-end-of-headers))
  (with-current-buffer (url-retrieve-synchronously url)
    (unwind-protect
        (buffer-substring (1+ url-http-end-of-headers) (point-max))
      (kill-buffer (current-buffer)))))

(defvar *wandbox-compiler-alist* nil)

(defun wandbox-compiler-alist ()
  (unless *wandbox-compiler-alist*
    (setq *wandbox-compiler-alist*
          (json-read-from-string
           (wandbox--fetch-url "http://melpon.org/wandbox/api/list.json"))))
  *wandbox-compiler-alist*)

(defun wandbox-compiler-list ()
  "利用できるコンパイラ一覧をリスト形式で返す."
  (mapcar (lambda (x) (cdr (assoc 'name x)))
          (wandbox-compiler-alist)))

(defun wandbox-default-compiler-options (compiler)
  "引数 COMPILER の既定オプションを返す."
  (labels ((mapcan (fn list &rest more-list)
             (apply #'nconc (apply #'mapcar fn list more-list)))
           (join (list separator)
             (mapconcat #'identity list separator)))
    (join (mapcan (lambda (o)
                    (let ((x (or (cdr (assoc 'default o)) "")))
                      (cond ((stringp x) (list x))
                            ((eq x t) (list (cdr (assoc 'name o))))
                            (t nil))))
                  (catch 'switches
                    (dotimes (i (length (wandbox-compiler-alist)))
                      (let ((x (elt (wandbox-compiler-alist) i)))
                        (if (member `(name . ,compiler) x)
                            (throw 'switches (cdr (assoc 'switches x))))))))
          ",")))

(defun* wandbox-build-request-data (&key compiler
                                     (options "")
                                     (code "")
                                     (stdin "")
                                     (compiler-option "")
                                     (runtime-option "")
                                     &allow-other-keys)
  "Wandbox API に渡すための JSON データを生成する."
  (unless (member compiler (wandbox-compiler-list))
    (error "Unknown compiler: %s" compiler))
  (let ((alist `(("compiler" . ,compiler)
                 ("options" . ,options)
                 ("code" . ,code)
                 ("stdin" . ,stdin)
                 ("compiler-option-raw" . ,compiler-option)
                 ("runtime-option-raw" . ,runtime-option))))
    (prog1
        (json-encode alist)
      ;; debug log
      (labels ((truncate (str)
                 (if (< 20 (length str)) (format "%.20s..." str) str)))
        (dolist (key '("code" "stdin"))
          (setf #1=(cdr (assoc key alist)) (truncate #1#)))
        (message "Wandbox build request: %s" (json-encode alist))))))

(defun wandbox-format-url-buffer (status)
  (declare (special url-http-end-of-headers))
  (let ((buf (current-buffer)))
    (unwind-protect
         (progn
           (when (equal (car status) :error)
             (error "return error: %s" (cdr status)))
           (let* ((http-body (buffer-substring (1+ url-http-end-of-headers) (point-max)))
                  (alist (let ((json-key-type 'string))
                           (json-read-from-string
                            (decode-coding-string http-body 'utf-8-unix)))))
             (with-output-to-temp-buffer "*Wandbox Output*"
               (dolist (res *wandbox-response-keywords*)
                 (when (assoc res alist)
                   (princ (format "<<< %s >>>" (car (assoc res alist))))
                   (terpri)
                   (princ (cdr (assoc res alist)))
                   (terpri))))))
      (kill-buffer buf))))

(defun wandbox-post (json)
  (let ((url-request-method "POST")
        (url-request-extra-headers '(("Content-Type" . "application/json")))
        (url-request-data json))
    (url-retrieve "http://melpon.org/wandbox/api/compile.json"
                  'wandbox-format-url-buffer))
  t)

(defun* wandbox-compile (&rest profile
                         &key compiler
                         (options "")
                         (code "")
                         (stdin "")
                         (compiler-option "")
                         (runtime-option "")
                         (file nil)
                         (name nil)
                         &allow-other-keys)
  "CODE を COMPILER でコンパイルする.
FILE を指定すると CODE の代わりに選択したファイルをコンパイルする.
NAME を指定すると *wandbox-profiles* からプロファイルを選択する."
  (when (and (stringp file)
             (not (zerop (length file)))
             (file-exists-p file))
    (setq profile (plist-put profile :code (with-temp-buffer
                                             (insert-file-contents file)
                                             (buffer-string)))))
  (when name
    (setq profile (append profile (wandbox-find-profile :name name))))
  (wandbox-post (apply #'wandbox-build-request-data profile)))

(defun wandbox-find-profile (key item)
  (find item *wandbox-profiles*
        :key (lambda (x) (plist-get x key))
        :test #'string=))

(defun wandbox-read-profile (key)
  (let* ((items (mapcar (lambda (x) (plist-get x key))
                        *wandbox-profiles*))
         (name (completing-read "Profile: " items)))
    (wandbox-find-profile :name name)))

(defun wandbox-compile-file (filename)
  "指定したファイルをコンパイルする.
コンパイラはファイル名から自動判別する."
  (interactive "fFile to wandbox: ")
  (let ((profile (or (wandbox-find-profile :ext (file-name-extension filename))
                     (wandbox-read-profile :name))))
    (apply #'wandbox-compile :file filename profile)))

(defun wandbox-compile-region (from to)
  "指定したリージョンをコンパイルする."
  (interactive "r")
  (let ((profile (wandbox-read-profile :name))
        (code (buffer-substring-no-properties from to)))
    (apply #'wandbox-compile :code code profile)))

(defun wandbox-compile-buffer ()
  "バッファ全体をコンパイルする."
  (interactive)
  (wandbox-compile-region (point-min) (point-max)))

(provide 'wandbox)

;;; wandbox.el ends here