Create a gist now

Instantly share code, notes, and snippets.

@kikairoya /wandbox.l
Last active Dec 28, 2015

post to wandbox from xyzzy
(eval-when (:compile-toplevel :load-toplevel :execute)
(require 'xml-http-request)
(require 'json))
(defpackage :wandbox
(:use :lisp :editor))
(in-package "wandbox")
(export '(post-wandbox-region post-wandbox post-wandbox-string show-compiler-list show-compiler-options))
(defvar *wandbox-compiler-alist* nil)
(defun encode-json-string (s)
(with-output-to-string (r)
(princ #\" r)
(map nil #'(lambda (x) (princ (encode-json-char x) r)) s)
(princ #\" r)))
(defun encode-json-char (c)
(case c
(#\TAB "\\t")
(#\LFD "\\n")
(#\RET "\\r")
(#\C-h "\\b")
(#\C-l "\\f")
(#\\ "\\\\")
(#\" "\\\"")
(t (let ((uc (char-unicode c)))
(when uc
(if (<= 32 uc 126)
(format nil "~A" c)
(format nil "\\u~4,'0x" uc)))))))
(defun get-compiler-alist ()
(setf *wandbox-compiler-alist* (json:json-decode (xhr:xhr-get "" :key #'xhr:xhr-response-text)))))
(defun refresh-compiler-alist-async (callback)
(xhr:with-xhr-get-async ("")
(on :success (res)
(setf *wandbox-compiler-alist* (json:json-decode (xhr:xhr-response-text res))))
(on :failure (res)
(setf *wandbox-compiler-alist* nil))
(on :complete (res)
(funcall callback))))
(defun get-default-compiler-options (compiler)
#'(lambda (o)
(let ((x (cdr (assoc "default" o :test #'string=))))
(if (stringp x)
(cdr (assoc "name" o :test #'string=)))))
#'(lambda (o) (cdr (assoc "default" o :test #'string=)))
(cdr (assoc "switches"
(car (member-if
#'(lambda (o) (string= (cdr (assoc "name" o :test #'string=)) compiler))
(get-compiler-alist))) :test #'string=))))))
(defun do-post-wandbox (compiler str)
(let ((r (xhr:xhr-post
(encode-json-string str)
(encode-json-string (reduce #'(lambda (a b) (concat a "," b)) (get-default-compiler-options compiler) :initial-value ""))
(encode-json-string compiler)
:headers '(:Content-type "application/json"))))
(if (= (xhr:xhr-status r) 200)
(let* ((e (json:json-decode (xhr:xhr-response-text r) :strict nil :json-object :hash-table))
(cm (gethash "compiler_message" e))
(pm (gethash "program_message" e))
(st (gethash "status" e))
(sg (gethash "signal" e)))
(if st (format t "exit code: ~A~A\n" st (if sg (format nil " [~A]") "")))
(if cm (format t "[compiler]\n~A\n" cm))
(if pm (format t "[program]\n~A\n" pm)))
(princ (xhr:xhr-status-text r)))))
(defun post-wandbox-region (compiler)
(interactive "sCompiler:" :default0 "gcc-head")
(let ((p1 (mark))
(p2 (point)))
(post-wandbox-string compiler (buffer-substring (min p1 p2) (max p1 p2)))))
(defun post-wandbox (compiler)
(interactive "sCompiler:" :default0 "gcc-head")
(post-wandbox-string compiler (buffer-substring (point-min) (point-max))))
(defun post-wandbox-string (compiler str)
(interactive "sCompiler\nsProgram" :default0 "gcc-head")
(let ((buf (selected-buffer)))
(with-output-to-temp-buffer ("*compilation*")
(setf buf (selected-buffer))
(do-post-wandbox compiler str)
(set-buffer buf))))))
(defun show-compiler-list ()
(let ((buf (selected-buffer)))
(with-output-to-temp-buffer ("*compilation*")
(setf buf (selected-buffer))
(dolist (c (map 'list
#'(lambda (o) (cdr (assoc "name" o :test #'string=)))
(princ c)
(princ #\LFD))
(set-buffer buf)))))
(defun show-compiler-options (compiler)
(interactive "sCompiler:" :default0 "gcc-head")
(let ((buf (selected-buffer)))
(with-output-to-temp-buffer ("*compilation*")
(setf buf (selected-buffer))
(princ compiler)
(princ #\LFD)
(dolist (c (get-default-compiler-options compiler))
(princ c)
(princ #\LFD))
(set-buffer buf)))))
(refresh-compiler-alist-async #'(lambda () nil))
(provide "wandbox")

well done lad I haven't learnt this language but I shall enjoy it so thoroughly I will crap my pants.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment