;;; style.scm
;;; Copyright Henry S. Thompson 1996, 1997
;;; Version 1.0

;;; Produced at HCRC, Edinburgh with support for the UK Economic and Social
;;;  Research Council and SunSoft

;;; DSSSL core style language
;;; Last edited: Sat Jan  4 10:52:23 1997

(define *d!mode-table*
  ;; table of construction rules, a-list by mode
  (list (list #t)))

(define *d!cmode*
  ;; current mode, fluid bound
  #t)

(define-macro (d!element . defn)
  (register-rule 'element defn *d!cmode*))

(define-macro (d!default . defn)
  (register-rule 'default defn *d!cmode*))

(define-macro (d!query . defn)
  (register-rule 'query defn *d!cmode*))

(define-macro (d!id . defn)
  (register-rule 'id defn *d!cmode*))

(define-macro (d!root . defn)
  (register-rule 'root defn *d!cmode*))

(define-macro (d!mode name . rules)
  (let ((cmode *d!cmode*))
    (set! *d!cmode* name)
    (map eval rules)
    (set! *d!cmode* cmode))
  #t)

(define register-rule
  (lambda (type defn mode)
    (let ((elt (assq mode *d!mode-table*)))
      (if elt
	  (set-cdr! elt (cons (cons type defn) (cdr elt)))
	(set! *d!mode-table*
	      (cons (list mode (cons type defn)) *d!mode-table*))))
    #t))

(define-macro (d!style . kal)
  `(cons 'd!style (append ',kal)))

(define *d!inh-chars*
  ;; user-defined inherited characteristics
  '())

(define-macro (d!declare-characteristic char pid def)
  `(begin (set! *d!inh-chars* (cons (list ',char ,pid ,def) *d!inh-chars*))
	  (define ,(string->symbol (string-append "inherited-"
						  (symbol->string char)))
	    (lambda () (spec-warning "inherited-xxx not implemented yet")))
	  (define ,(string->symbol (string-append "actual-"
						  (symbol->string char)))
	    (lambda () (spec-warning "actual-xxx not implemented yet")))))

(define-macro (d!declare-char-characteristic+property char pid def)
  ;; incomplete
  `(d!declare-char-property ,char ,def))

(define *d!chr-defs*
  ;; characteristic initial values
  '())

(define-macro (d!declare-initial-value char def)
  `(set! *d!chr-defs* (cons (cons ',char ,def) *d!chr-defs*)))

(define *d!rvts*
  ;; reference value types
  '())

(define-macro (d!declare-reference-value-type id)
  `(set! *d!rvts* (cons ',id *d!rvts*)))

(define-macro (d!define-page-model var . body)
  `(define ,var (cons 'd!pagem ',body)))

(define-macro (d!define-column-set-model var . body)
  `(define ,var (cons 'd!csm ',body)))

(define *d!flow-objs*
  ;; alist of flow-obj-class-names and PIDs
  '())

(define-macro (d!define-flow-object-class name pid)
  `(set! *d!flow-objs* (cons (cons ,'name ,'pid) *d!flow-objs*)))

(define d!color-space
  (lambda args
    ;; temporary
    (cons 'd!color-space args)))

(define d!color
  (lambda args
    ;; temporary
    (cons 'd!color args)))
