diff options
Diffstat (limited to 'form.scm')
| -rw-r--r-- | form.scm | 989 |
1 files changed, 989 insertions, 0 deletions
diff --git a/form.scm b/form.scm new file mode 100644 index 0000000..628c6cf --- /dev/null +++ b/form.scm @@ -0,0 +1,989 @@ +; 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))) + " " ,(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;")) " ") + ;(!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;")) " ") + + )) + (!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;")) " ") '())))) + + +(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))))) + " " ,(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")) " ") + (!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"))) |