;;;macros for creating accessors
;;creates parameter<opt> accessor for <opt> 
(defmacro create-accessor (opt)
    `(define ,(prefix-symbol-with "parameter" opt)
       (compose-protected cadr
			  (lambda (options)
			    (if (list? options)
				(assoc ',opt options)
				(format-error "Wrong argument to parameter:~A : ~A" ',opt options))))))

;;creates parameter<opt> accessor for <opt> 
(defmacro create-list-accessor (opt)
    `(define ,(prefix-symbol-with "parameter" opt)
       (compose-protected cdr
			  (lambda (options)
			    (if (list? options)
				(assoc ',opt options)
				(format-error "Wrong argument to parameter:~A : ~A" ',opt options)))))) 
#|
(defmacro create-accessor (opt)
    `(define (,(prefix-symbol-with "parameter" opt) options)
       (let ((assoc-pair (assoc ',opt options)))
	 (if assoc-pair (cadr assoc-pair) #f))))
(defmacro create-list-accessor (opt)
    `(define (,(prefix-symbol-with "parameter" opt) options)
       (let ((assoc-pair (assoc ',opt options)))
	 (if assoc-pair (cdr assoc-pair) #f))))
|#

;;creates accessor parameter:[one->two-three] 
(defmacro create-compositor (one two three)
    `(define ,(create-name "parameter:" one "->" three)
       (compose-protected ,(create-name "parameter:" two "->" three)
			  ,(create-name "parameter:" one "->" two))))

;;creates accessor parameter:[one->two-three] 
(defmacro create-long-compositor (one two three)
    `(define ,(create-name "parameter:" one "->" two "-" three)
       (compose-protected ,(create-name "parameter:" two "->" three)
			  ,(create-name "parameter:" one "->" two))))

;;creates accessor parameter:[one->two]
(defmacro create-short-compositor (one two)
    `(define ,(create-name "parameter:" two)
       (compose-protected ,(create-name "parameter:" one "->" two) ,(create-name "parameter:" one))))

#|
(defmacro create-accessor (opt)
    `(define (,(string->symbol (string-append "parameter" (symbol->string `,opt))) options)
       (let ((assoc-pair (assoc ',opt options)))
	 (if assoc-pair (cadr assoc-pair) #f))))

(defmacro create-list-accessor (opt)
    `(define (,(string->symbol (string-append "parameter" (symbol->string `,opt))) options)
       (let ((assoc-pair (assoc ',opt options)))
	 (if assoc-pair (cdr assoc-pair) #f))))
|#
;;; accessors for names, units, minimum, maximum, shipped, current, suggested, i-depend-on, resettable, doc.

;;;:names have different structure than other options
;;;define accessors parameter:<option> for all :names options
(create-list-accessor :names)   ;avoids extra layer of parens

;;;accessors for human name
(create-accessor :human)
(define parameter:names->human parameter:human)
(define (parameter:human-name options)
  (parameter:names->human (parameter:names options)))

;;;accessors and some mutators for scheme options
(create-list-accessor :scheme)
(define parameter:names->scheme parameter:scheme)

(define (parameter:scheme->name scheme-opt)
  (if (list? scheme-opt)
      (car scheme-opt)
      (format-error "Wrong argument to parameter:schme->name : ~A" scheme-opt)))
(define (parameter:scheme->file x)
  (if (and (list? x) (list? (cdr x)))
      (cadr x)
      (format-error "Wrong argument to parameter:scheme->file : ~A" x)))
(define (parameter:set-scheme->file! scm-options file) (set-cdr! scm-options (list file)))

(create-long-compositor names scheme name)
(create-long-compositor names scheme file)
(create-short-compositor names scheme)
(create-short-compositor names scheme-name)
(create-short-compositor names scheme-file)

;;;accessors for c options
(create-list-accessor :c)
(define parameter:names->c parameter:c)

(define (parameter:c->name-and-type x)
  (if (list? x)
      (car x)
      (format-error "Wrong type to parameter:c->name-and-type : ~A" x)))
(define (parameter:c->name x)
  (if (and (list? x) (list? (car x)))
      (caar x)
      (format-error "Wrong argument to parameter:c->name-and-type ~S" x)))
(define (parameter:c->type x)
  (if (and (list? x) (list? (car x)) (list? (cdar x)))
      (cadar x)
      (format-error "Wrong argument to parameter:c->type : ~A" x)))
(define (parameter:c->files x)
  (if (list? x)
      (cdr x)
      (format-error "Wrong argument to parameter:c->files : ~A" x)))

(for-each (lambda (p) (eval `(create-long-compositor names c ,p)))
	  '(name-and-type name type files))
#|
(create-long-compositor names c name-and-type)
(create-long-compositor names c name)
(create-long-compositor names c type)
(create-long-compositor names c files)
|#

(for-each (lambda (p) (eval `(create-short-compositor names ,p)))
	  '(c c-name-and-type c-name c-type c-files))
#|
(create-short-compositor names c)
(create-short-compositor names c-name-and-type)
(create-short-compositor names c-name)
(create-short-compositor names c-type)
(create-short-compositor names c-files)
|#

;;;other accessors
;;;define accessors parameter:<option> for all options besides :names :i-depend-on :depends-on-me
(for-each (lambda (p) (eval `(create-accessor ,p)))
	  (remove-if (lambda (x) (eq? x ':names)) *options*))

(define (parameter:doc-short options)
  (let ((assoc-pair (assoc ':doc-short options)))
    (if assoc-pair
	(cadr assoc-pair)
	(get-first-line (parameter:doc options)))))

(define (parameter:i-depend-on par)
  ((compose-protected parameter:human-name->i-depend-on parameter:human-name) par))
(define (parameter:depends-on-me par)
  ((compose-protected parameter:human-name->depends-on-me parameter:human-name) par))

(define parameter:pair assoc)

;;;end of file
