path: root/form.scm

; vim: set et :
(use-modules (ice-9 regex))
(use-modules (srfi srfi-27))
(load "lang-tags.scm")

(define haddelitembtnjs #f)
(define haddelcmitembtnjs #f)

(define (current-year)
  (string->number (strftime "%Y" (localtime (current-time)))))

(define (random-string len)
  (define (iter n s)
    (if (< n 1)
      s
      (iter (- n 1) (string-append s (string (integer->char (+ (random-integer 24) 65)))))))
  (iter len ""))

(define (decide-by-lang de en)
  `((!? "if (strstr($_SERVER['REQUEST_URI'], '/application/') || strstr($_SERVER['REQUEST_URI'], '/review/') || basename(dirname($_SERVER['REQUEST_URI'])) === 'en') {")
    ,en
    (!? "} else {")
    ,de
    (!? "}")))

(define* (stepform num h1 h2 lis #:key (last #f) (elements-before-overlay `'()) (php-args "") (appname "ds") )
  `((!span "") ; dummy for tidy
    (!php ,(string-append"/* vim: set ts=4 sw=4 et : */ if (!isset($doPDF)) {" php-args))
    (@p (define stepform_lis ',lis))
    (@p (main ,h1 ,h2
              (append
              ,elements-before-overlay
              `((!? "}")
                (@p (overlay
                      `(@p (fieldset
                             (string-append ,,,appname (number->string ,,,num) "App")
                             (string-append "app" (number->string ,,,num) "Ctrl")
                             stepform_lis))))
                (!? "if (!isset($doPDF)) {")
                (!p "* " (@p (parse-mess "?mandatory")))
                (!div #((id uibottom)(style "display: none;"))
                      ,(if (= ,num 2)
                         `((!div #((style "display: inline-block; width: 49%;"))
                                 (!button #((style "background: darkgrey; margin-right: .5em;")
                                            (onclick "return saves2();"))
                                          ,(parse-mess "?save")))
                           (!div #((style "display: inline-block; width: 49%; text-align: right;"))
                                 (!button #(onclick "return continue_step3();")
                                          ,(parse-mess "?next")))))
                      ,(if (and (> ,num 2) (not ,last))
                         `((!div #((style "display: inline-block; width: 49%;"))
                                 (!button #((style "background: darkgrey;")
                                            (onclick "return save();"))
                                          ,(parse-mess "?save")))
                           (!div #((style "display: inline-block; width: 49%; text-align: right;"))
                                 (!button #((onclick ,(string-append "return return_step" (convert (- ,num 1)) "();"))
                                            (style "margin-right: .5em;"))
                                          ,(parse-mess "?back"))
                                 (!button #(onclick ,(string-append "return continue_step" (convert (+ ,num 1)) "();"))
                                          ,(parse-mess "?next")))))
                      ,(if ,last
                         `((!div #((style "display: inline-block; width: 49%;"))
                                 (!button #((style "background: darkgrey;")
                                            (onclick "return save();"))
                                          ,(parse-mess "?save")))
                           (!div #((style "display: inline-block; width: 49%; text-align: right;"))
                                 (!button #((onclick ,(string-append "return return_step" (convert (- ,num 1)) "();"))
                                            (style "margin-right: .5em;"))
                                          ,(parse-mess "?back"))
                                 (!button #(onclick "return check_and_send();")
                                          ,(parse-mess "?send"))))))
                (!? "}")))))
    (@p (minjs
          `((@p (stepdatajs ,,num ,,appname))
            (@p (stepsubmitjs ,,num ,,appname))
            (@p (stepbootstrapjs ,,num ,,appname))
            (@dump ,(string-append "s" (number->string ,num) ".js"))
            (@p (stepjs ,,num ,,appname))
            )))))

(define (stepdatajs num appname)
  (let ((n (number->string num)))
        `(,(string-append
             "window.s" n " = {};\n"
             "try { window.s" n " = JSON.parse('<?php echo str_replace(\"'\", \"\\'\", str_replace(\"\\\\\", \"\\\\\\\\\", $s" n ")); ?>');\n"
             "} catch (e) { ; };\n"))))

(define (stepsubmitjs num appname)
  (let ((n (number->string num)))
        `(,(string-append
             "function submitValues() {\n"
             "return safeSubmit({\n"
             "'s': " n ",\n"
             "'uid': '<?php echo $_SESSION['uid']; ?>',\n"
             "'value': acc()\n"
             "});\n"
             "}\n"))))

(define (stepbootstrapjs num appname)
  (let ((n (number->string num)))
        `(,(string-append
             "function stepBootstrap" (convert num) "() {\n"
             "window.app" n " = angular.module('" appname n "App', []);\n"
             "window.app" n ".controller('app" n "Ctrl', ['$scope', function ($scope) {\n"
             "$scope.d = window.s" n ";\n"
             "}]);\n"
             "angular.bootstrap($('#" appname n "App'), ['" appname n "App']);\n"
             "}\n"
             "function stepActivate" (convert num) "() {\n"
             "$('#" appname n "App').show();\n"
             "$('#" appname n "App input').trigger('change');\n"
             "$('#" appname n "App select').trigger('change');\n"
             "$('#uibottom').show();\n"
             "}\n"
             ))))

(define (stepjs num appname)
  (define func (random-string 10))
  `((!? "if (isset($doPDF)) {")
    ,(string-append "function " func "() { $('#" appname (convert num) "App input, #" appname (convert num) "App textarea, #" appname (convert num) "App select').prop('disabled', true); $('" appname (convert num) "App button').prop('disabled', true).css('display', 'none'); }")
    ,(string-append "$(document).ready(function () {" func "(); let observer = new MutationObserver(function () { " func "();  }); observer.observe(document.querySelector('#" appname (convert num) "App'), {subtree: true, childList: true,}); });")
    (!? "}")))

(define* (main h1 h2 lis #:key (style "padding: 0;"))
  `(!div #((class main)(style ,style))
         (!h1 (@p (parse-mess ,h1)))
         (!h2 (@p (parse-mess ,h2)))
         ,lis))

(define (minjs lis)
  `(!script (!? "minStart();" ) "\n" ,lis "\n" (!? "minEnd();")))

(define (newbuttonjs func variable)
  `(,(minjs
       (string-append
         "function " func "(me) {\n"
         "    var v = JSON.parse(acc());\n"
         "    if (typeof v." variable " === 'object') v." variable ".push([]);\n"
         "    else v." variable " = [];\n"
         "    if (safeSubmit({\n"
         "        's': $(me).closest('fieldset').attr('id').substr(2, 1),\n"
         "        'uid': '<?php echo $_SESSION['uid']; ?>',\n"
         "        'value': JSON.stringify(v)\n"
         "    })) location.reload();\n"
         "    return false;\n"
         "}"))))

(define (delitembuttonjs)
  (unless #f
    (minjs
      `(,(set! haddelitembtnjs #t)
         ,(string-append
            "function delItem(o) {\n"
            "    o.parent().parent().remove();\n"
            "    if (submitValues()) location.reload();\n"
            "    return false;\n"
            "}")))))

(define (delcmitembuttonjs)
  (unless haddelcmitembtnjs
    (minjs
      `(,(set! haddelitembtnjs #t)
         ,(string-append
            "function delCMItem(o) {\n"
            "    o.parent().remove();\n"
            "    if (submitValues()) location.reload();\n"
            "    return false;\n"
            "}")))))

;(define (textarea ...)
(define (textarea text)
  `(!textarea #((readonly "readonly")) ,text))

;(define (textareaonside ...)
(define (textareaonside width label text)
  `((!div #(data-field-span ,width)
          (!span ,label)
          (!textarea #((readonly "readonly"))
                     ,text))))

;(define (checkboxsimple ...)
(define (checkboxsimple width name label)
  `((!div #(data-field-span ,width)
          (!input #((type "checkbox")
                    (name ,name)
                    (ng-checked ,(string-append "d." name)))
                  "&nbsp;" ,(parse-mess label)))))

;(define (checkboxconglomerate (mehrere mit <br> getrennt, siehe ds/s5.php ...)
(define (checkboxconglomerate width checkboxes textarea-label textarea-name)
  (define (iter items)
    (if (null? items)
        '()
        (let ((e (car items)))
          (append
           `((!input #((type "checkbox") (name ,(car e)) (ng-checked ,(string-append "d." (car e)))) ,(cadr e))
             (!br))
           (iter (cdr items))))))

  `((!div #(data-row-span ,width)
          (!div #(data-field-span ,width)
                ,@(iter checkboxes)
                (!br)
                ,textarea-label ":"
                (!textarea #((name ,textarea-name) (rows "2")) ,(string-append "{{ d." textarea-name " }}"))
                (!br)))))


;(define (multicontainar form classes variable labeldelbtn labelnewbtn btnprefix lis)
;(@p (multicontainer "3" "study" "studies" "Studium loeschen" "Weiteres Studium anlegen" "study" `((@p (legend "...") ....))))
;(define (multicontainer width form classes variable labeldelbtn labelnewbtn btnprefix lis)
;  (if (null? lis) '() (let ((e (car items)))
;    (append (list ((

; #:funcnewbtn - explicitly name btn
; #:divargs - arguments for the outer div
; #:labelduration - label text for the duration
(define* (multicontainer width class name variable labeldelbtn labelnewbtn #:key (funcnewbtn (random-string 16)) (divargs #()) (labelduration "") (selectname "") (options '())  .opt)
    `((!div ,(merge-html-args `#((class ,class) (ng-repeat ,(string-append "b in d." variable))) divargs)
            ,(row width `(
                    (!div #((data-field-span 1) (class "mand")) ,(parse-mess name) "*")
                    ,(textareasimple 2 "" class #t #:prefix "b")
                    ,(if (string=? labelduration "") '() `("\n<? if (isset($doPDF)) { ?></div><div data-row-span=\"3\"><? } ?>"
                        (!div #((style "clear: both;")) "&nbsp;")
                        ;(!div #((data-field-span 1) (class "mand")) ,(parse-mess labelduration))
                        ;(!div #((data-field-span 2))
                        ,(selectonside 1 2 "" labelduration selectname options #t #:prefix "b" #:noempty #t)
                        (!div #((style "clear: both;")) "&nbsp;")

                              ))
                    (!button #((onclick "return delItem($(this));")) ,(parse-mess labeldelbtn))

            )))
      (!button #((id ,(string-append "btn_" class)) (onclick ,(string-append "return " funcnewbtn "(this);"))) ,(parse-mess labelnewbtn))
      (@p (newbuttonjs ,funcnewbtn ,variable))
      (@p (delitembuttonjs))
      ))

; #:funcnewbtn - explicitly name btn
(define* (custommulticontainer class legend variable labeldelbtn labelnewbtn options #:key (funcnewbtn (random-string 16)))
    `((!legend ,(parse-mess legend))
      (!div ,(merge-html-args `#((style "margin-bottom: 1.5em;")(class ,class) (ng-repeat ,(string-append "b in d." variable))))
            (,options ((!button #((onclick "return delCMItem($(this));")) ,(parse-mess labeldelbtn)))))
      (!button #((id ,(string-append "btn_" class)) (onclick ,(string-append "return " funcnewbtn "(this);"))) ,(parse-mess labelnewbtn))
      (@p (newbuttonjs ,funcnewbtn ,variable))
      (@p (delcmitembuttonjs))
      )
)

(define* (s5spacer #:key (includenbsp #f) . opt)
    `(("<? if (isset($doPDF)) { ?></div><div data-row-span=\"3\"><? } ?>") (,(if includenbsp `(!div #((style "clear: both;")) "&nbsp;") '()))))


(define* (social width1 width2 label inputs #:key (prefix "d") (message "") (textprefix "") (textarea #f) (comment_on '()) (aftermessage '()) (afterspan '()))
  `((!legend ,(parse-mess label))
    ,(row width1
          `((!div
             #((data-field-span ,width2))
             ,@(let iter ((i inputs))
                 (if (null? i)
                   '()
                   (append
                     `((!input ,`#((type "checkbox") (name ,(car i)) (ng-checked ,(string-append prefix "." (car i)))))
                       "&nbsp;" ,(parse-mess (string-append textprefix (car i)))
                       (!div #((style "clear:both; margin-bottom: .4em;")))
                       ,(if (member (car i) comment_on)
                          `((!div #((style "display: none; margin-top: .3em; margin-left: 2em; padding-bottom: .8em;")
                                    (id ,(string-append (car i) "_comment")))
                                  ,(parse-mess "?social_comment") "*"
                                  (!textarea #((class "mand")
                                               (ng-value ,(string-append prefix "." (car i) "_comment"))
                                               (name ,(string-append (car i) "_comment")))))
                            (!script
                              ,(string-append
                                "$('input[name=" (car i) "]').on('change', function () {"
                                "    if ($(this).is(':checked')) {"
                                "        $('#" (car i) "_comment').show();"
                                "    } else {"
                                "        $('#" (car i) "_comment').hide();"
                                "    }"
                                "});")))))
                     (iter (cdr i)))))
             ,(if textarea
                `((!br)
                  ,(parse-mess-as-text (string-append textprefix "sonstiges"))
                  (!textarea #((name "sonstiges") (rows "2")) ,(string-append "{{ " prefix ".sonstiges }}")))
                `((!br)
                  ,(string-append (parse-mess-as-text (string-append textprefix "sonstiges")) "&nbsp;")
                  (!textarea #((name "sonstiges")) ,(string-append "{{ " prefix ".sonstiges }}"))))
             (!br)
             ,(if (string=? message "") '() `(!p (!i #((class "fas fa-exclamation-triangle"))) " " ,(parse-mess message)))
             ,aftermessage)
        ,afterspan))))

; fieldsetargs - arguments for the fieldset element
(define* (fieldset app cntrl lis #:key (fieldsetargs #()) .opt)
  `(!fieldset ,(merge-html-args `#((id ,app) (ng-controller ,cntrl) (style "display: none;")) fieldsetargs)
        ,@lis))

; #:formargs - arguments for the grid-form
(define* (grid-form lis #:key (formargs #()))
    `(!form ,(merge-html-args `#((class "grid-form")) formargs) ,@lis)
)

; #:divargs - arguments for the overlay div
; #:formargs - arguments for the grid-form
(define* (overlay lis #:key (divargs #()) (formargs #()) . opt)
  `(!div ,(merge-html-args `#((id "overlay")) divargs) (!form ,(merge-html-args `#((class "grid-form")) formargs) ,@lis)))

;textsimple pruefen, sollte ds/s3.php  "Geben Sie Ihre aktuelle ...."

;(define (row width lis . style)
;  `(!div #(data-row-span ,width)
;         ,lis))

; #:divargs - arguments of the div
(define* (row width lis #:key (divargs #()) . opt)
  `(!div ,(merge-html-args `#((data-row-span ,width)) divargs) ,lis))
   

;    (if (= (length class) 2)
     
;(define (row width lis . style)
;  `(!div #(data-row-span ,width)
;     ,lis))

(define (tabular width1 width2 col1name col2name sumfield1 sumfield2 l)
  (define (tabular-inner width1 width2 l)
    (let iter ((lis l))
      (if (null? lis)
	   '()
	   (cons `(@p (row ,(+ width1 width2)
			   `((!div #(data-field-span ,,width1) ,,(caar lis))
			     (!div #(data-field-span ,,width2) ,,(cadar lis)))))
		 (iter (cdr lis))))))

  (append `((@p (row ,(+ width1 width2)
	     `((!div #(data-field-span ,,width1) ,,col1name)
	       (!div #(data-field-span ,,width2) ,,col2name)))))

	  (tabular-inner width1 width2 l)

	  `((@p (row ,(+ width1 width2)
		     `((!div #(data-field-span ,,width1) ,,sumfield1)
		       (!div #(data-field-span ,,width2) ,,sumfield2)))))

	  ))

;(define (tabular2 width1 width2 col1name col2name sumfield1 sumfield2 lis1 lis2)
;  (let iter ((lis1 lis1) (lis2 lis2))
;    (if (or (null? lis1) (null? lis2))
;        '()
;        (let ((e1 (car lis1))
;              (e2 (car lis2)))
;          (cons `(@p (row ,(+ width1 width2)
;                          `((!div #(data-field-span ,width1) ,e1)
;                            (!div #(data-field-span ,width2) ,e2))))
;                (iter (cdr lis1) (cdr lis2))))))
;  
;  (append `((@p (row ,(+ width1 width2))
;                `((!div #(data-field-span ,width1) ,col1name)
;                  (!div #(data-field-span ,width2) ,col2name))))
;          (iter lis1 lis2)
;          `((@p (row ,(+ width1 width2))
;                `((!div #(data-field-span ,width1) ,sumfield1)
;                  (!div #(data-field-span ,width2) ,sumfield2))))))


(define (tip1 name . tip)
  (if (null? tip) '() `(!span #(("style" "font-size: 1.2rem; text-transform: none; cursor: pointer;")
				("onmouseover" ,(string-append "$('#" name "_tip').show();"))
				("onmouseleave" ,(string-append "$('#" name "_tip').hide();"))
				("onclick" ,(string-append "$('#" name "_tip').toggle();")))
			      "ⓘ")))

(define (tip2 name . tip)
  (if (null? tip) '() `(!p #(("id" ,(string-append name "_tip"))
			     ("style" "display: none; font-size: 1rem; text-align: justify; hyphens: auto;"))
			   ,tip)))

;upload form used in s6
; #:dataformat - a list of 2 elements specifying the type and accepted documents in input
; #:info - optional list of elements which will be placed below the upload fields
; #:inputclasses - html classes to be added to the file input field
; #:titlemandargs - a string, mainly used to add a " * " in the title infront of the " : ". The mand class would put it after the " : "
(define* (s6-upload-form doctype #:key (dataformat '("pdf" "application/pdf, .pdf")) (info `()) (inputclasses "mand") (titlemandargs "*") .options)
  `(!div #(class "upload")
    (!b #() ,(string-append (parse-mess-as-text (string-append "?s6_" doctype)) titlemandargs))
    (!php ,(string-append "$e = false; if (file_exists(\"../../uploads/\" . $puid . \"_\" . \"" doctype "." (car dataformat) "\")) { $e = true;"))
    (!span " " (!a #((class "uploaded") (href ,(string-append "download.php?" doctype)) (target "_blank")) ,(parse-mess "?hochgeladen")))
    (!form #((style "display: inline-block;") (action "delupload.php") (method "post") (enctype "multipart/form-data"))
      (!input #((type "hidden") (name ,doctype) (value "1")))
      (!input #((type "submit") (class "delete") (onclick "return submitValues();") (value ,(parse-mess-as-text "?del"))))
    )
    (!input #((type "hidden") (name ,(string-append doctype "_done")) (class "done") (value "1")))
    (!input #((type "hidden") (name "done") (class "done") (value "1")))
    (!php "}")
    (!form #((action "upload.php") (method "post") (enctype "multipart/form-data"))
      (!input #((type "hidden") (name ,doctype) (value "1")))
      (!input #((type "file") (class ,inputclasses) (name "file") (accept ,(cadr dataformat))))
      (!input #((type "submit") (style "display: none;") (onclick "return submitValues();") (value "<?php if ($e) { echo $mess['replace']; } else { echo $mess['upload']; } ?>") (name "upload")))
    )
    ,info
  )
)

; a small infoparagraph
; #:class - class to be added to the <i>
; #:style - style of the <p>
(define* (info-paragraph text #:key (class "fa fa-info") (style "padding-left: 2em; margin-top: .5em; margin-bottom: .5em; font-size: 80%;") (want-space #t) . opt)
  `(!p ,(if (string=? style "") `#() `#((style ,style)))
    ,(if want-space `((!i #((class ,class))) " ") `())
    ,(parse-mess text)
  ))

; a list containing an enumumeration of texts
; #:etradivstyleargs - name says it all (extra style arguments for the outer div)
; #:extralistitemargs - a list of extra style arguments for the enumerated texts
; -> if there are 7 items and only item 5 should have an extra style argument the list needs to be '("" "" "" "" "style")
; #:optionalelements - a list of optional elements to be added after the enumeration
; #:upperulmargintop - the margin for the <ul>
(define* (info-list title list-items #:key (extradivstyleargs "") (extralistitemargs '()) (optionalelements '()) (upperulmargintop ".2em"). opt)
    `(!div #((style ,(string-append extradivstyleargs " padding-left: 2em; padding-top: .7em; font-size: 80%;")))
      (!i #((class "fa fa-info"))) " "
      ,(parse-mess title)
      (!ul #((style ,(string-append "margin-top: " upperulmargintop "; padding-left: 1.8em;")))
        ,@(let iter ((item list-items) (arg extralistitemargs))
          (if (null? item)
            '()
            (append `(
              (!li ,(if (string-null? (getstringhelper item arg)) `#() `#((style ,(getstringhelper item arg)))) ,(parse-mess (car item)))
              ,(iter (cdr item) (if (null? arg) '() (cdr arg))))))
      ))
      ,@(let iter2 ((option optionalelements))
        (if (null? option)
          '()
          (append
            `(,(car option))
            (iter2 (cdr option))))
      )
    ))

; a helper method for info-list (see above)
(define (getstringhelper item arg)
  (string-append (if (or (null? arg) (string-null? (car arg))) "" (car arg)) (if (null? (cdr item)) "" "padding-bottom: .3em;")))

; #:tip - the tooltip text
; #:tipname - name for the tooltip
; #:divargs - arguments for the outer div
; #:labelargs - arguments for the label
; #:selectargs - arguments for the select element
; #:optionargs - arguments for each option in the select (only if not php)
; #:noempty - removes the empty option from the select
(define* (selectsimple width classes label name options mand #:key (usesprefix #f) (tip "") (tipname "") (divargs #()) (labelargs #()) (selectargs #()) (optionargs #()) (noempty #f) (prefix "d") (afterselect `()) . opt)
  `(!div ,(merge-vectors 
    `#((data-field-span ,width)) 
    (if (string=? classes "")
      `#()
      `#((class ,classes))
    )
    divargs)
	 (!label ,(merge-html-args (if (not mand) #() `#((class "mand"))) labelargs)
		 (,(parse-mess label) ,(if (string=? tip "") '() (tip1 (if (string=? tipname "") name tipname) (parse-mess tip)))))
	 (!select ,(merge-vectors 
		     `#((name ,name))          
          (if (string=? (string-append (if (not mand) "" "mand ") classes) "")
            `#()
            `#((class ,(string-append (if (not mand) "" "mand ") classes)))
          )
		     selectargs)
        ,(if noempty '() `(!option ,(merge-html-args `#((value "")) optionargs) ""))
		  ,@(let iter ((opts options))
		      (if (null? opts)
			'()
            (if (string=? (caar opts) "!php")
              (append `(!php ,(cadar opts))
                      (iter (cdr opts)))
              (append `((!option ,(merge-html-args `#((value ,(caar opts))
					     (ng-selected ,(string-append (if usesprefix "s." (string-append prefix ".")) name " == '" (caar opts) "'"))) optionargs)
					   ,(parse-mess (cadar opts))))
				(iter (cdr opts)))))))
	 ,(if (string=? tip "") '() (tip2 (if (string=? tipname "") name tipname) (parse-mess tip)))
    ,afterselect))

; #:tip - the tooltip message
; #:div1args - arguments for the first div
; #:labelargs - arguments for the label in the first div
; #:div2args - arguments for the second div
; #:inputargs - arguments for the input in the second div
(define* (inputonside width1 width2 classes label name mand #:key (tip "") (div1args #()) (labelargs #()) (div2args #()) (inputargs #()) (prefix "d") . opt)
  `((!div ,(merge-html-args `#((data-field-span ,width1)) div1args)
          (!span ,(merge-html-args (if (not mand) #() `#((class "mand"))) labelargs)
                 (,(parse-mess label) ,(if (string=? tip "") '() (tip1 name (parse-mess tip))))))
    (!div ,(merge-html-args `#((data-field-span ,width2)) div2args)
         (!input ,(merge-vectors 
                  (if (string=? (string-append (if (not mand) "" "mand ") classes) "")  
                    `#() 
                    `#((class ,(string-append (if (not mand) "" "mand ") classes))))
                  `#((name ,name))
                  `#((type "text"))
                  `#((value ,(string-append "{{ " prefix "." name " }}")))
                  inputargs))
         ,(if (string=? tip "") '() (tip2 name (parse-mess tip))))))

; #:tip - the tooltip message
; #:div1args - arguments for the first div
; #:labelargs - arguments for the label in the first div
; #:div2args - arguments for the second div
; #:textareaargs - arguments for the textarea in the second div
(define* (textareaonside width1 width2 classes label name mand #:key (tip "") (div1args #()) (labelargs #()) (div2args #()) (textareaargs #()) (prefix "d") . opt)
  `((!div ,(merge-html-args `#((data-field-span ,width1)) div1args)
          (!span ,(merge-html-args (if (not mand) #() `#((class "mand"))) labelargs)
                 (,(parse-mess label) ,(if (string=? tip "") '() (tip1 name (parse-mess tip))))))
    (!div ,(merge-html-args `#((data-field-span ,width2)) div2args)
         (!textarea ,(merge-vectors 
                  (if (string=? (string-append (if (not mand) "" "mand ") classes) "")
                    `#() 
                    `#((class ,(string-append (if (not mand) "" "mand ") classes))))
                  `#((name ,name))
                  textareaargs) ,(string-append "{{ " prefix "." name " }}"))
         ,(if (string=? tip "") '() (tip2 name (parse-mess tip))))))



(define (parse-mess text)
  (if (and (> (string-length text) 0) (string=? (substring text 0 1) "?"))
    `(!= ,(string-append "$mess['" (substring text 1 (string-length text)) "']"))
    `(,text)))

(define (parse-mess-as-text text)
  (if (and (> (string-length text) 0) (string=? (substring text 0 1) "?"))
    (string-append "<?php echo $mess['" (substring text 1 (string-length text)) "']; ?>")
    text))

; #:legendargs - arguments for the legend
(define* (legend text #:key (legendargs #()) . opt)
  `(!legend ,legendargs ,(parse-mess text)))

; #:tip - the tooltip message
; #:div1args - arguments for the outer div
; #:labelargs - arguments for the label
; #:div2args - arguments for the inner div
; #:selectargs - arguments for the select element
; #:optionargs - arguments for each option of the select
; #:prefix -
; #:noempty - remove the empty option from the select
(define* (selectonside width1 width2 classes label name options mand #:key (tip "") (div1args #()) (labelargs #()) (div2args #()) (selectargs #()) (optionargs #()) (prefix "d") (noempty #f) . opt)
  `((!div ,(merge-html-args `#((data-field-span ,width1)) div1args)
         (!span ,(merge-html-args (if (not mand) '() #((class "mand"))) labelargs)
                 (,(parse-mess label)
                   ,(if (string=? tip "") '() `(!span #(("style" "font-size: 1.2rem; text-transform: none; cursor: pointer;")
                            ("onmouseover" ,(string-append "$('#" name "_tip').show();"))
                            ("onmouseleave" ,(string-append "$('#" name "_tip').hide();"))
                            ("onclick" ,(string-append "$('#" name "_tip').toggle();")))
                          "ⓘ")))))
	 (!div ,(merge-html-args `#((data-field-span ,width2)) div2args)
         (!select ,(merge-html-args `#((class ,(string-append (if (not mand) "" "mand ") classes))
                    (name ,name)) selectargs)
                  ,(if noempty '() `(!option ,(merge-html-args `#((value "")) optionargs) ""))
                  ,@(let iter ((opts options))
                      (if (null? opts)
                        '()
                       (if (string=? (caar opts) "!php")
                        (append `((!php ,(cadar opts)))
                                (iter (cdr opts)))
                        (append `((!option ,(merge-html-args `#((value ,(caar opts))
                                             (ng-selected ,(string-append prefix "."  name " == '" (caar opts) "'"))) optionargs)
                                  ,(parse-mess (cadar opts))))
                                (iter (cdr opts)))))))
         ,(if (string=? tip "") '() `(!p #(("id" ,(string-append name "_tip"))
               ("style" "display: none; font-size: 1rem; text-align: justify; hyphens: auto;"))
             ,(parse-mess tip))))))

; #:div1args - arguments for the first div
; #:labelargs - arguments for the label in the first div
; #:div2args - arguments for the second div
; #:spanargs - arguments for the span in the second div
; #:tip - the tex of the tooltip
(define* (textsimple width classes label text mand #:key (div1args #()) (labelargs #()) (div2args #()) (spanargs #()) (tip "") . opt)
  `((!div ,(merge-html-args `#((data-field-span ,width)) div1args)
          (!label ,(merge-html-args (if (not mand) '() `#((class "mand"))) labelargs) ,(parse-mess label))
          ,(if (string=? tip "") '() (tip1 label tip)))
    (!div ,(merge-html-args `#((data-field-span ,width)) div2args)
          (!span ,(merge-html-args `#((class ,(string-append (if (not mand) "" "mand ") classes))) spanargs)
                 ,(parse-mess text))
          ,(if (string=? tip "") '() (tip2 label tip)))))


; #:divargs - arguments for the outer div of the calculationresult
; #:labelargs - arguments for the label
; #:inputargs - arguments for the input field
; #:readonly - if the inputfield should be read-only
; #:maxlength - the maxlength argument value
; #:size - the site argument value
(define* (calculationinput width classes label name mand #:key (divargs #()) (labelargs #()) (inputargs #()) (readonly #f) (maxlength -1) (size -1) . opt)
  `(!div ,(merge-html-args `#((data-field-span ,width)(style "background: lightgrey;")) divargs)
    (!label ,(merge-html-args `#((for ,name)) labelargs) ,(parse-mess label))
    (!input ,(merge-vectors `#((class ,(string-append (if mand "mand" "") classes))
              (type "text")
	      (name ,name)
	      (value ""))
    (if readonly `#((readonly "readonly")) #())
    (if (not (= maxlength -1)) `#((maxlength ,maxlength)) #())
    (if (not (= size -1)) `#((size ,size)) #())
    inputargs))))

; #:divargs - arguments for the outer div of the button
; #:buttonargs - arguments for the button itself
(define* (simplebutton width onclick label #:key (divargs #()) (buttonargs #()) . opt)
  `(!div ,(merge-html-args `#((data-field-span ,width)) divargs)
    (!button ,(merge-html-args `#((onclick ,onclick)) buttonargs) ,(parse-mess label))))

;; Simple definition of fold-left (left fold)
(define (fold-left f acc lst)
  (if (null? lst)
      acc
      (fold-left f (f acc (car lst)) (cdr lst))))


(define (merge-vectors . vectors)
  (define (merge-alists a1 a2)
	(let ((filtered-a1 (filter (lambda (pair) (not (assoc (car pair) a2))) a1)))
	  (append a2 filtered-a1)))

  (define alists (map vector->list vectors))

  (define merged-alist
	(fold-left merge-alists '() alists))

  (list->vector merged-alist))


(define (merge-html-args old . new)
  (merge-vectors old (if (null? new) #() (car new))))

(define (fieldsimple width lis)
  `(!div #(data-field-span ,width)
         ,lis))

; #:divargs - arguments for the outer div of the input
; #:tip - tooltip text
; #:usesprefix - if the input should use d.name or s.name, #t for s.name
; #:labelargs - arguments for the label
; #:inputargs - arguments for the input
; #:tipname - use this instead of the name parameter for the name of the tip
; #:warning - add a warning after the label-text in the label
; #:readonly - readonly/protected
; #:type - the type of the input field (default "text")
(define* (inputsimple width classes label name mand #:key (divargs #()) (tip "") (usesprefix #f) (labelargs #()) (inputargs #()) (tipname "") (warning "") (ng-value #t) (readonly #f) (type "text") (value ""))
  `((!div ,(merge-html-args 
	     `#((data-field-span ,width)) 
	     divargs)

          (!label ,(merge-html-args 
		     (if (not mand) #() `#((class "mand"))) 
		     labelargs) 
		  ,(string-append 
				  (parse-mess-as-text label) 
				  (if (string=? warning "") 
				     "" 
				     (string-append "<span 'color: red;'>" (parse-mess warning) "</span>"))) 
		  ,(if (string=? tip "") '() (tip1 (if (string=? tipname "") name tipname) (parse-mess tip))))

          (!input ,(merge-vectors 
            (if (string=? (string-append (if (not mand) "" "mand ") classes) "")
            `#((name ,name) (type "text"))
            `#((class ,(string-append (if (not mand) "" "mand ") classes)) (name ,name) (type ,type))
            )
            (if ng-value
              `#((value ,(string-append (if usesprefix "{{ s." "{{ d.") (if (string=? value "") name value) " }}")))
              `#()
            )
            (if readonly
              `#((protected protected)(readonly readonly))
              `#())
		        inputargs))

          ,(if (string=? tip "") '() (tip2 (if (string=? tipname "") name tipname) (parse-mess tip))))))

; OBSOLETE
(define* (inputwithwarning width classes label warning name mand #:key (divargs #()) (tip "") (usesprefix #f) (labelargs #()) (inputargs #()) (tipname "") . opt)
 `(,(inputsimple width classes label name mand #:warning warning)))

; OBSOLETE
(define (inputwithextras width classes style label name tipname mand . opt)
  `(,(inputsimple width classes label name mand #:tipname tipname)))


(define (centeredtextinfo style1 title text) 
    `((!center #() (!b #() ,(parse-mess title)))
	      (!p #(style ,style1) ,(parse-mess text))
	      ))

; items - '(#(value labeltext) #(value labeltext))
(define* (simpleradiobuttons name items #:key (backgroundcolor "#eee") (mand #f))
  `(!div #(style ,(string-append "background: " backgroundcolor "; border: 1px solid lightgrey; padding: .3em;"))
    ,@(let iter ((item items))
      (if (null? item)
        '()
        (append 
          `((!div #() 
            (!p #()
              (!input 
                ,(if mand 
                  `#((type "radio") (id ,(if (<= (vector-length (car item)) 2) name (vector-ref (car item) 2))) (class "mand") (name ,name) (value ,(vector-ref (car item) 0)))
                  `#((type "radio") (id ,(if (<= (vector-length (car item)) 2) name (vector-ref (car item) 2))) (name ,name) (value ,(vector-ref (car item) 0)))))
              (!label 
                #((for ,(vector-ref (car item) 0))) ,(parse-mess (vector-ref (car item) 1))))))
          (iter (cdr item))
        ))
    )
  ))

; texts - a list
(define* (legalstuffinfo title texts #:key (optionalelements `())) 
  `((!h3 #() ,(parse-mess title))
    ,@(let iter ((text texts))
      (if (null? text)
        '()
        (append
          `(,(info-paragraph (car text) #:class "" #:style "" #:want-space #f))
          (iter (cdr text)))))
    ,optionalelements))

(define (checkboxforlegalstuff name text)
  `(!p #()
    (!input #((class "mand") (type "checkbox") (name ,name) (id ,name)))
    (!b #() ,(parse-mess text))))

(define (small width label)
    `(!div #(data-field-span "1") 
     (!small #() ,(parse-mess label))))


; #:divargs - arguments for the outer div of the textarea
; #:tip - tooltip text
; #:usesprefix - if the input should use d.name or s.name, #t for s.name
; #:labelargs - arguments for the label
; #:textareaargs - arguments for the textarea
; #:tipname - use this instead of the name parameter for the name of the tip
; #:warning - add a warning after the label-text in the label
; #:label - if the textare should have an aditional label
(define* (textareasimple width classes name mand #:key (divargs #()) (tip "") (labelargs #()) (textareaargs #()) (tipname "") (warning "") (nolabel #f) (prefix "s") (label "") . opt)
  `((!div ,(merge-html-args 
	     `#((data-field-span ,width)) 
	     divargs)

          ,(if (string=? label "") '() `(!label ,(merge-html-args 
		     (if (not mand) #() `#((class "mand"))) 
		     labelargs) 
		  ,(string-append 
				  (parse-mess-as-text label) 
				  (if (string=? warning "") 
				     "" 
				     (string-append "<span 'color: red;'>" (parse-mess warning) "</span>"))) 
		  ,(if (string=? tip "") '() (tip1 (if (string=? tipname "") name tipname) (parse-mess tip)))))

          (!textarea ,(merge-html-args 
		     `#((class ,(string-append (if (not mand) "" "mand ") classes))
			(name ,name)) 
		     textareaargs) ,(string-append "{{ " prefix "." name " }}")))

          ,(if (string=? tip "") '() (tip2 (if (string=? tipname "") name tipname) (parse-mess tip)))))

(define simple-from-until-as-month-and-year-descending
  `(,(selectsimple 1 "" "?von_monat" "startmonat"
                  (let iter ((mth 1))
                    (if (<= mth 12)
                      (cons `(,(convert mth) ,(convert mth)) (iter (+ mth 1)))
                      '()))
                  #t #:prefix "b")
    ,(selectsimple 1 "" "?von_jahr" "startjahr"
                   (let iter ((yr (current-year)))
                     (if (>= yr 1970)
                       (cons `(,(convert yr) ,(convert yr)) (iter (- yr 1)))
                       '()))
                   #t #:prefix "b")
    ,(selectsimple 1 "" "?bis_monat" "endemonat"
                   (let iter ((mth 1))
                     (if (<= mth 12)
                       (cons `(,(convert mth) ,(convert mth)) (iter (+ mth 1)))
                       '()))
                   #t #:prefix "b")
    ,(selectsimple 1 "" "?bis_jahr" "endejahr"
                   (let iter ((yr (current-year)))
                     (if (>= yr 1970)
                       (cons `(,(convert yr) ,(convert yr)) (iter (- yr 1)))
                       '()))
                   #t #:prefix "b")))

(define simple-from-as-month-and-year-descending
  `(,(selectsimple 1 "" "?monat" "startmonat"
                  (let iter ((mth 1))
                    (if (<= mth 12)
                      (cons `(,(convert mth) ,(convert mth)) (iter (+ mth 1)))
                      '()))
                  #t #:prefix "b")
    ,(selectsimple 1 "" "?jahr" "startjahr"
                   (let iter ((yr (current-year)))
                     (if (>= yr 1970)
                       (cons `(,(convert yr) ,(convert yr)) (iter (- yr 1)))
                       '()))
                   #t #:prefix "b")))


(define* (moneytable name in ass out lia prefix #:key (ng-prefix "d") (in-class-outer "in") (in-class "sum_in")) `(
    (!p #((style "color:black;"))
        ,(parse-mess name))

    ,(if in
       `(
         ,(row 3
               `(
                 (!div #((data-field-span "2") (style "color: black;"))
                       (!b ,(parse-mess (string-append prefix "in"))))

                 (!div #((data-field-span "1") (style "color: black;"))
                       (!b ,(parse-mess (string-append prefix "betrag"))))
                 ))

         (!div #(class ,in-class-outer) ,in)
         ,(row 3
               `(
                 (!div #((data-field-span "2"))
                       (!b #((style "color: black;")) ,(parse-mess (string-append prefix "summe"))))

                 (!div #((data-field-span "1"))
                       (!b #((style "color: black;") (class "sumfield") (id ,in-class))
                           ,(string-append "{{ " ng-prefix "." in-class " }}")))
                 )
               #:divargs #((style "background: darkgrey;")))

         (!br)
         ))

    ,(if ass
       `(
         ,(row 3
               `(
                 (!div #((data-field-span "2") (style "color: black;"))
                       (!b ,(parse-mess (string-append prefix "ass"))))

                 (!div #((data-field-span "1") (style "color: black;"))
                       (!b ,(parse-mess (string-append prefix "betrag"))))
                 ))

         (!div #(class ass) ,ass)

         ,(row 3
               `(
                 (!div #((data-field-span "2"))
                       (!b #((style "color: black;")) ,(parse-mess (string-append prefix "summe"))))

                 (!div #((data-field-span "1"))
                       (!b #((style "color: black;") (class "sumfield") (id "sum_ass"))
                           ,(string-append "{{ " ng-prefix ".sum_ass }}")))
                 ) #:divargs #((style "background: darkgrey;")))

         (!br)
         ))

    ,(if out
       `(
         ,(row 3
               `(
                 (!div #((data-field-span "2") (style "color: black;"))
                       (!b ,(parse-mess (string-append prefix "out"))))

                 (!div #((data-field-span "1") (style "color: black;"))
                       (!b ,(parse-mess (string-append prefix "betrag"))))
                 ))

         (!div #(class out) ,out)

         ,(row 3
               `(
                 (!div #((data-field-span "2"))
                       (!b #((style "color: black;")) ,(parse-mess (string-append prefix "summe"))))

                 (!div #((data-field-span "1"))
                       (!b #((style "color: black;") (class "sumfield") (id "sum_out"))
                           ,(string-append "{{ " ng-prefix ".sum_out }}")))
                 )
               #:divargs #((style "background: darkgrey;")))

         ,(row 3
               `(
                 (!div #((data-field-span "2"))
                       (!b #((style "color: black;")) ,(parse-mess (string-append prefix "semfee"))))

                 (!div #((data-field-span "1"))
                       (!input #((type "text") (class "value mand") (name "semfee") (value ,(string-append "{{ " ng-prefix ".semfee }}")))))
                 )
               #:divargs #((style "background: #c1c1c1;")))

         (!br)
         ))

    ,(if lia
       `(
         ,(row 3
               `(
                 (!div #((data-field-span "2") (style "color: black;"))
                       (!b ,(parse-mess (string-append prefix "lia"))))

                 (!div #((data-field-span "1") (style "color: black;"))
                       (!b ,(parse-mess (string-append prefix "betrag"))))
                 ))

         (!div #(class lia) ,lia)

         ,(row 3
               `(
                 (!div #((data-field-span "2"))
                       (!b #((style "color: black;")) ,(parse-mess (string-append prefix "summe"))))

                 (!div #((data-field-span "1"))
                       (!b #((style "color: black;") (class "sumfield") (id "sum_lia"))
                           ,(string-append "{{ " ng-prefix ".sum_lia }}")))
                 )
               #:divargs #((style "background: darkgrey;")))
         ))
    ))

(define* (moneytextinputrow class text input #:key (prefix "d")) `(
    ,(row 3 `(
        (!div #((data-field-span "2"))
            (!b ,(parse-mess text))
        )
        (!div #((data-field-span "1"))
            (!input #((name ,input) (class ,class) (value ,(string-append "{{ " prefix "." input " }}")) (type "text")))
        )
    ))
))

(define* (moneyinputinputrow class input1 input2 #:key (prefix "d") (placeholder1 "") (placeholder2 "")) `(
    ,(row 3 `(
        (!div #((data-field-span "2"))
            (!input #((name ,input1) (value ,(string-append "{{ " prefix "." input1 " }}")) (type "text") (placeholder ,(parse-mess-as-text placeholder1))))

        )
        (!div #((data-field-span "1"))
            (!input #((name ,input2) (class ,class) (value ,(string-append "{{ " prefix "." input2 " }}")) (type "text") (placeholder ,(parse-mess-as-text placeholder2))))
        )
    ))
))

(define* (kontoangabe rows) `(
    ,@(let iter ((r rows))
        (if (null? r)
            '()
            (append `(
                ,(row (count-elements (car r)) `(
                    ,@(let iter ((e (car r)))
                        (if (null? e)
                            '()
                            (append `( 
                                ,(inputsimple 1 "" (caar e) (cadar e) (caddr (cdar e)) #:value (caddar e) #:ng-value #t)      
                            ) (iter (cdr e)))
                        )
                    )
                ))   
            ) (iter (cdr r)))
        )
    )
))

(define (count-elements lst)
  (if (null? lst)
      0
      (+ 1 (count-elements (cdr lst)))))

(define bundeslaender
  `(("bw" "?land_bw")
    ("by" "?land_by")
    ("be" "?land_be")
    ("bb" "?land_bb")
    ("hb" "?land_hb")
    ("hh" "?land_hh")
    ("he" "?land_he")
    ("mv" "?land_mv")
    ("ni" "?land_ni")
    ("nw" "?land_nw")
    ("rp" "?land_rp")
    ("sl" "?land_sl")
    ("sn" "?land_sn")
    ("st" "?land_st")
    ("sh" "?land_sh")
    ("th" "?land_th")))