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 () | |
(or | |
*wandbox-compiler-alist* | |
(setf *wandbox-compiler-alist* (json:json-decode (xhr:xhr-get "http://melpon.org/wandbox/api/list.json" :key #'xhr:xhr-response-text))))) | |
(defun refresh-compiler-alist-async (callback) | |
(xhr:with-xhr-get-async ("http://melpon.org/wandbox/api/list.json") | |
(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) | |
(map | |
'list | |
#'(lambda (o) | |
(let ((x (cdr (assoc "default" o :test #'string=)))) | |
(if (stringp x) | |
x | |
(cdr (assoc "name" o :test #'string=))))) | |
(delete-if-not | |
#'(lambda (o) (cdr (assoc "default" o :test #'string=))) | |
(copy-seq | |
(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 | |
"http://melpon.org/wandbox/api/compile.json" | |
(concat | |
"{\"code\":" | |
(encode-json-string str) | |
",\"options\":" | |
(encode-json-string (reduce #'(lambda (a b) (concat a "," b)) (get-default-compiler-options compiler) :initial-value "")) | |
",\"compiler\":" | |
(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") | |
(long-operation | |
(let ((buf (selected-buffer))) | |
(with-output-to-temp-buffer ("*compilation*") | |
(progn | |
(other-window) | |
(setf buf (selected-buffer)) | |
(do-post-wandbox compiler str) | |
(set-buffer buf)))))) | |
(defun show-compiler-list () | |
(interactive) | |
(let ((buf (selected-buffer))) | |
(with-output-to-temp-buffer ("*compilation*") | |
(progn | |
(other-window) | |
(setf buf (selected-buffer)) | |
(dolist (c (map 'list | |
#'(lambda (o) (cdr (assoc "name" o :test #'string=))) | |
(get-compiler-alist))) | |
(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*") | |
(progn | |
(other-window) | |
(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") |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This comment has been minimized.
well done lad I haven't learnt this language but I shall enjoy it so thoroughly I will crap my pants.