;;; -*- lisp -*- ; This file assumes UTF-8 charset -- Faré
(in-package :exscribe-user)

(defvar *cl-compat* :common-lisp)

(define-macro (funcall* x . r) `(funcall (function ,x) ,@r))
(define-macro (apply* x . r) `(apply (function ,x) ,@r))
(define-macro (map* x . r) `(mapcar (function ,x) ,@r))

(define (foo->string x)
  (cond ((string? x) x)
	((null? x) "")
	((symbol? x) (symbol->string x))
	((number? x) (number->string x))
	((pair? x) (string-append (foo->string (car x))
				  (foo->string (cdr x))))
	(else "")))

(defun make-rest-arg (x) `(&rest ,x))

(define lf #.(format nil "~%"))
(define lflf #.(format nil "~%~%"))
(define (footnote* . l) (footnote :note (apply 'p* l)))

(defmacro % (x)
  `(scribble:with-preprocessor () ,x))
(defun %%raw (&rest r)
  #'(lambda (s)
      (dolist (x r) (princ x s))
      nil))
(defmacro %raw (&rest r)
  `(% (%%raw ,@r)))
(define (raw-environment pre post)
  (let ((pre (%raw pre)) (post (%raw post)))
    #'(lambda (&rest x) (list pre x post))))
(define-markup (format-selector
		 (:txt #f) (:html #f) (:tex #f) (:info #f) (:man #f) (:pdf pdf))
  (ecase *scribe-format*
    ((txt) txt)
    ((html) (or html txt))
    ((tex) (or tex txt))
    ((pdf) (or pdf txt))
    ((info) (or info txt))
    ((man) (or man txt))))
(define-markup (make-environment
		 (:txt (lambda (x) x))
		 (:html #f) (:tex #f) (:info #f) (:man #f) (:pdf #f))
  (format-selector :txt txt :html html :tex tex :info info :man man :pdf pdf))
(define (p-justify . x)
    (apply 'p :align :justify x))
(define (fq .  x)
    (apply (make-environment
	    :txt (raw-environment "« " " »")
	    :tex (raw-environment "«~" "~»")
;;;	    :html (raw-environment "« " " »")
	    :html (raw-environment "« " " »")
	    :pdf (raw-environment "« " " »"))
	   x))
(define (nq . x)
    (apply (make-environment
	    :txt (raw-environment "\"" "\"")
	    :tex (raw-environment "``" "''")
	    :html (raw-environment "``" "´´")
	    :pdf (raw-environment "\"" "\""))
	   x))
(define (q . x) (apply 'nq x))
(defmacro fset! (x y) `(setf (symbol-function ',x) (function ,y)))
(defmacro def-ref-maker (n &rest r)
  `(let ((f (ref-maker ,@r))) (defun ,n (&rest r) (apply f r))))
(defmacro set-ref-maker (n &rest r)
  `(setf (symbol-function ',n) (ref-maker ,@r)))
(defvar *scribe-html-section-title-start* nil)
(defvar *scribe-html-section-title-stop* nil)

(defun symbol-cased (x) (string-upcase x))
(defun vector-ref (x y) (svref x y))
(defmacro for-each* (x &rest r) `(mapc (function ,x) ,@r))
(defun bo-file-exists? (x)
  (exscribe::find-exscribe-file x nil))

(defun title* (&rest x) (apply #'title x))
(defun *p (&rest x) (apply #'p x))

(defun make-tag (tg) (lambda (&rest x) (apply 'tag tg x)))
(defun open-tag (tag attributes close)
  #'(lambda (s)
     (html-dumper::html-open-tag s tag attributes close)))
(defun close-tag (tag)
  #'(lambda (s) (html-dumper::html-close-tag s tag)))