#+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)))