(in-package :glue)

; Lets just ignore this for now
(defmacro with-mutex (mutex &body body)
 `(progn ,@body))

(defun make-mutex () nil)

(defun status (message)
 (format t "Status message ~A~%" message))

(defun make-thread (func)
  (format t "This makes a mockery of actually having threads...~%")
  (funcall func))

(defun prin1-to-string-for-emacs (object)
  (with-standard-io-syntax
    (let ((*print-case* :downcase)
          (*print-readably* nil)
          (*print-pretty* nil))
      (prin1-to-string object))))

(defun debug-output-swank-std-out ()
 (when *dedicated-io-stream*
  (loop while (listen *dedicated-io-stream*) do (format t "SWANK-IO: ~A~%" (read-line *dedicated-io-stream*)))))

(defmacro destructure-case (value &rest patterns)
  "Dispatch VALUE to one of PATTERNS.
A cross between `case' and `destructuring-bind'.
The pattern syntax is:
  ((HEAD . ARGS) . BODY)
The list of patterns is searched for a HEAD `eq' to the car of
VALUE. If one is found, the BODY is executed with ARGS bound to the
corresponding values in the CDR of VALUE."
  (let ((operator (gensym "op-"))
	(operands (gensym "rand-"))
	(tmp (gensym "tmp-")))
    `(let* ((,tmp ,value)
	    (,operator (car ,tmp))
	    (,operands (cdr ,tmp)))
       (case ,operator
         ,@(loop for (pattern . body) in patterns collect 
                   (if (eq pattern t)
                       `(t ,@body)
                       (destructuring-bind (op &rest rands) pattern
                         `(,op (destructuring-bind ,rands ,operands 
                                 ,@body)))))
         ,@(if (eq (caar (last patterns)) t)
               '()
               `((t (format t "No case!!~%") (error "destructure-case failed: ~S" ,tmp))))))))