commit 45a3f5d4801658a4a55a853733827db17280559f
Author: Tomas Hlavaty <tom@logand.com>
Date: Sat, 18 Sep 2010 02:26:29 +0200
Initial commit
Diffstat:
| A | ls-mode.el | | | 24 | ++++++++++++++++++++++++ |
| A | ls-mode.lisp | | | 204 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 228 insertions(+), 0 deletions(-)
diff --git a/ls-mode.el b/ls-mode.el
@@ -0,0 +1,24 @@
+;;; ls-mode.el -- Emacs mode for editing ParenScript code.
+
+(defvar ls-mode-hook nil)
+
+(add-hook 'ls-mode-hook (lambda () (define-key ls-mode-map "\C-ck" 'ls-buffer)))
+
+(add-to-list 'auto-mode-alist '("\\.ls\\'" . ls-mode))
+
+(define-derived-mode ls-mode lisp-mode "LS"
+ "Major mode for editing LS (parenscript) files."
+ (run-hooks 'ls-mode-hook))
+
+(defun run-ls (ifile &optional ofile)
+ (shell-command
+ (format "%s/lisp/clisp/clisp -q -x '(load \"%s\") (js:compile-parenscript-file \"%s\")'"
+ (expand-file-name "~/")
+ (expand-file-name "~/emacs/ls-mode")
+ (expand-file-name ifile))))
+
+(defun ls-buffer ()
+ (interactive)
+ (run-ls (buffer-file-name)))
+
+(provide 'ls-mode)
diff --git a/ls-mode.lisp b/ls-mode.lisp
@@ -0,0 +1,204 @@
+#+sbcl(require :parenscript)
+#-sbcl(progn
+ (load "~/lisp/cl-asdf-1.79/asdf")
+ (push "~/lisp/systems/" asdf:*central-registry*)
+ (asdf:operate 'asdf:load-op :asdf-install)
+ (asdf:operate 'asdf:load-op :parenscript))
+
+(js:defjsmacro labels (defs &body body)
+ `(let ,(loop for (fname fargs fbody) in defs
+ collect `(,fname (lambda ,fargs ,fbody)))
+ ,@body))
+
+;;(js:js-to-string '(labels ((f1 (f1a1 f1a2) f1b) (f2 (f2a1 f2a2) f2b)) b))
+
+(js:defjsmacro flet (defs &body body)
+ ;; same as labels for js
+ `(labels ,defs ,@body))
+
+;;(js:js-to-string '(flet ((f1 (f1a1 f1a2) f1b) (f2 (f2a1 f2a2) f2b)) b))
+
+(js:defjsmacro funcall (fn &rest args)
+ ;; same as labels for js
+ `(,fn ,@args))
+
+;;(js:js-to-string '(funcall 'identity 1 2))
+
+(js:defjsmacro defbuild (name args &body body)
+ (declare (ignore args))
+ `(setf (aref *wbuild* ,name)
+ (lambda (pw self)
+ ,@body)))
+
+(js:defjsmacro defpack (name args &body body)
+ (declare (ignore args))
+ `(setf (aref *wpack* ,name)
+ (lambda (pw w self)
+ ,@body)))
+
+#+nil(js:defjsmacro definit (name args &body body)
+ (declare (ignore args))
+ `(setf (aref *winit* ,name)
+ (lambda (pw w self)
+ ,@body)))
+
+(js:defjsmacro defhandler (name args &body body)
+ `(setf (aref *whandler* ,name)
+ (lambda ,args ,@body)))
+
+(js:defjsmacro awhen (test &body body)
+ `(let ((it ,test))
+ (when it
+ ,@body)))
+
+(js:defjsmacro aif (test then &body else)
+ `(let ((it ,test))
+ (if it ,then (progn ,@body))))
+
+#+nil(js:defjsmacro on-load (&rest body)
+ `(progn
+ (*yahoo*.util.*event.add-listener window "load" (lambda (e) ,@body))))
+
+(js:defjsmacro with-properties (names &body body)
+ `(let ,(mapcar (lambda (name)
+ (list name `(get-property self ,(js::symbol-to-js name))))
+ names)
+ ,@body))
+
+(js:defjsmacro with-signals (names &body body)
+ `(let ,(mapcar (lambda (name)
+ (list name `(get-signal self ,(js::symbol-to-js name))))
+ names)
+ ,@body))
+
+(js:defjsmacro with-packing (names &body body)
+ `(let ,(mapcar (lambda (name)
+ (list name `(get-packing self ,(js::symbol-to-js name))))
+ names)
+ ,@body))
+
+(js:defjsmacro plusp (number)
+ `(< 0 ,number))
+
+(js:defjsmacro minusp (number)
+ `(< ,number 0))
+
+(js:defjsmacro zerop (number)
+ `(= ,number 0))
+
+#+nil(js:defjsmacro push (item place)
+ `(.push ,place ,item))
+
+#+nil(js:defjsmacro pop (place)
+ `(.pop ,place))
+
+(js:defjsmacro null (&optional obj)
+ `(== nil ,obj))
+
+#+nil(js:defjsmacro cons (object1 object2)
+ `(list ,object1 ,object2))
+
+#+nil(js:defjsmacro elt (sequence index)
+ `(slot-value ,sequence ,index))
+
+(js:defjsmacro length (sequence)
+ `(slot-value ,sequence 'length))
+
+#+nil(js:defjsmacro first (sequence)
+ `(slot-value ,sequence 0))
+
+#+nil(js:defjsmacro second (sequence)
+ `(slot-value ,sequence 1))
+
+#+nil(js:defjsmacro rest (sequence)
+ `(.slice ,sequence 1))
+
+#+nil(js:defjsmacro funcall (fn &rest args)
+ `(,fn ,@args))
+
+;;(js:js-to-string '(null))
+;;(js:js-to-string '(null undefined))
+;;(js:js-to-string '(null false))
+;;(js:js-to-string '(null 1))
+;;(js:js-to-string '(null nil))
+
+;;(js:compile-parenscript-file "/home/tomas/public_html/lib/webglade.ls")
+
+(js:defjsmacro defstruct (name-and-options &rest slots)
+ (let* ((name (cond
+ ((symbolp name-and-options) name-and-options)
+ ((listp name-and-options) (first name-and-options))
+ (t (error "Symbol or list expected: ~s" name-and-options))))
+ ;; include
+ (include (when (listp name-and-options)
+ (rest (assoc :include (rest name-and-options)))))
+ (iname (first include))
+ (islots (rest include))
+ ;; constructor
+ (constructor (when (listp name-and-options)
+ (rest (assoc :constructor (rest name-and-options)))))
+ (cname (first constructor))
+ (cargs (rest constructor)))
+ ;;(format t "Constructor ~s" constructor)
+ ;;(format t "iname ~s~%" iname)
+ `(progn
+ ,@(append
+ (when iname
+ (list `(setf (slot-value ,name 'prototype) (new ,iname))))
+ #+nil(unless cname
+ (list `(defun ,(make-cname) ()
+ )))
+ (list
+ `(defun ,name ()
+ ,@(loop for slot in slots
+ for name = (cond
+ ((symbolp slot) slot)
+ ((listp slot) (first slot))
+ (t (error "Symbol or list expected: ~s" name)))
+ for value = (when (listp slot)
+ (second slot))
+ collect `(setf (slot-value this ',name) ,value))))))))
+
+(js:defjsmacro cond (&rest clauses)
+ (labels ((rec (clauses)
+ (when clauses
+ (let ((head (first clauses))
+ (tail (rest clauses)))
+ `(if ,(first head)
+ (progn ,@(rest head))
+ ,(when tail `(progn ,(rec tail))))))))
+ (rec clauses)))
+
+;;(js:js-to-string '(if t "tt" nil))
+
+;;(js:js-to-string '(cond))
+;;(js:js-to-string '(cond (t "tt")))
+;;(js:js-to-string '(cond ((and one two) "12") (nil "ff") (t "tt")))
+
+#+nil(define-js-compiler-macro do (decls termination &rest body)
+ (let ((vars (make-for-vars decls))
+ (steps (make-for-steps decls))
+ (check (js-compile-to-expression (list 'not (first termination))))
+ (body (js-compile-to-body (cons 'progn body) :indent " ")))
+ (make-instance 'js-for
+ :vars vars
+ :steps steps
+ :check check
+ :body body)))
+
+;; modified to check for null array first!
+(js:defjsmacro dolist (i-array &rest body)
+ (let ((var (first i-array))
+ (array (second i-array))
+ (arrvar (js::js-gensym "arr"))
+ (idx (js::js-gensym "i")))
+ `(let ((,arrvar ,array))
+ (when ,arrvar
+ (do ((,idx 0 (1+ ,idx)))
+ ((>= ,idx (slot-value ,arrvar 'length)))
+ (let ((,var (aref ,arrvar ,idx)))
+ ,@body))))))
+
+;;(js:js-to-string '(dolist (i nil) (alert i)))
+;;(js:js-to-string '(dolist (i (list 1 2 3)) (alert i)))
+;;(js:js-to-string '(dolist (i (list 1 2 3) 4) (alert i)))
