Overview
Comment: | Restructured to fix some sillyness, that first example was not good |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.64 |
Files: | files | file ages | folders |
SHA1: |
3cd84125f8d042fdc6ae90e486472451 |
User & Date: | matt on 2017-03-03 08:15:01 |
Other Links: | branch diff | manifest | tags |
Context
2017-03-03
| ||
15:00 | removed duplicate rows check-in: 667aa76ce0 user: pjhatwal tags: v1.64 | |
08:15 | Restructured to fix some sillyness, that first example was not good check-in: 3cd84125f8 user: matt tags: v1.64 | |
06:10 | Merged from v1.63 check-in: 64f440e2e1 user: matt tags: v1.64 | |
Changes
Added cgisetup/pages/home.scm version [25e1fcbe47].
> > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (use regex) (load "models/pgdb.scm") (include "pages/home_ctrl.scm") (include "pages/home_view.scm") |
Added cgisetup/pages/home_ctrl.scm version [cf27e7d669].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== ;; a function <pagename>-action is called on POST (define (home-action action) (case (string->symbol action) ((filter) (let ((target-type (s:get-input 'target-type)) (target-filter (s:get-input 'tfilter)) (target (s:get-input 'target)) (row-or-col (s:get-input 'row-or-col))) ;; ;; s:set! is a page local var. Better than s:session-var-set! but still not a good idea. ;; (s:set! "row-or-col" (if (list? row-or-col) (string-intersperse row-or-col ",") row-or-col)) (s:set! "target-type" target-type) (s:set! "tfilter" target-filter) (s:set! "target" target) (s:set! "target-filter" target-filter))))) |
Added cgisetup/pages/home_view.scm version [5519b84d66].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (define (pages:home session db shared) (let* ((dbh (s:db)) (ttypes (pgdb:get-target-types dbh)) (selected (string->number (or (s:get "target-type") "0"))) (curr-trec (filter (lambda (x)(eq? selected (vector-ref x 0))) ttypes)) (curr-ttype (if (and selected (not (null? curr-trec))) (vector-ref (car curr-trec) 1) #f)) (all-parts (if curr-ttype (append (string-split curr-ttype "/") '("runname" "testname")) '())) (tfilter (or (s:get "target-filter") "%")) (targets (pgdb:get-targets-of-type dbh selected tfilter)) ;; (target (s:session-var-get "target")) ;; (target-patt (or target "%")) (row-or-col (string-split (or (s:get "row-or-col") "") ",")) (all-data (if selected (pgdb:get-stats-given-target dbh selected tfilter) '())) ;; (all-data (pgdb:get-tests dbh tfilter)) (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col 0))) (s:div 'class "col_12" (s:fieldset "Area type and target filter" (s:form 'action "home.filter" 'method "post" (s:div 'class "col_12" (s:div 'class "col_6" (s:select (map (lambda (x) (let ((tt-id (vector-ref x 0)) (ttype (vector-ref x 1))) (if (eq? tt-id selected) (list ttype tt-id ttype #t) (list ttype tt-id ttype #f)))) ttypes) 'name 'target-type)) (s:div 'class "col_4" (s:input-preserve 'name "tfilter" 'placeholder "Filter targets")) (s:div 'class "col_2" (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))) ;; use radio buttons to select whether to put this identifier in row or column. ;; this seems clumsly and takes up a lot of screen realestate ;; (s:div 'class "col_12" ;; (s:div 'class "col_1" "identifier") ;; (map (lambda (target-var) ;; (s:div 'class "col_1" target-var)) ;; all-parts)) ;; (s:div 'class "col_12" ;; (s:div 'class "col_1" "row") ;; (map (lambda (target-var) ;; (s:div 'class "col_1" (s:input 'type "checkbox" 'name "row-or-col" 'value target-var ;; ;; this silly trick preserves the checkmark ;; (if (member target-var row-or-col) 'checked "") ;; ""))) ;; all-parts)) )) (s:fieldset (conc "Runs data for " tfilter) ;; ;; A very basic display ;; (let* ((a-keys (sort (hash-table-keys ordered-data) string>=?)) (b-keys (sort (apply append (map (lambda (sub-key) (let ((subdat (hash-table-ref ordered-data sub-key))) (hash-table-keys subdat))) a-keys)) string>=?))) (if #f ;; swap rows/cols (s:table (s:tr (s:td "")(map s:tr b-keys)) (map (lambda (row-key) (let ((subdat (hash-table-ref ordered-data row-key))) (s:tr (s:td row-key) (map (lambda (col-key) (s:td (let ((dat (hash-table-ref/default subdat col-key #f))) (s:td (if dat (list (vector-ref dat 0)(vector-ref dat 1)) ""))))) b-keys)))) a-keys)) (s:table (s:tr (s:td "")(map s:td a-keys)) (map (lambda (row-key) (s:tr (s:td row-key) (map (lambda (col-key) (let ((val (let* ((ht (hash-table-ref/default ordered-data col-key #f))) (if ht (hash-table-ref/default ht row-key #f))))) (if val (let* ((total (vector-ref val 1)) (pass (vector-ref val 2)) (fail (vector-ref val 3)) (other (vector-ref val 4)) (passper (round (* (/ pass total) 100))) (failper (- 100 passper)) (run-key ;; (string-substitute ;; %2F = / ;; "-" "%2D" ;;(string-substitute "/" "%2F" (conc col-key "/" row-key) 'all) (string-substitute "[/]" "_x_" (conc col-key "/" row-key) 'all) ;; 'all))) )) (s:td 'style (conc "background: linear-gradient(to right, green " passper "%, red " failper "%);") (s:a 'href (s:link-to "run" 'target run-key) (conc total "/" pass "/" fail "/" other)))) (s:td "")))) a-keys))) b-keys)))))))) |
Modified cgisetup/pages/index.scm from [c9ec62b2df] to [5f74568a94].
1 2 3 4 5 6 7 8 9 10 11 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== | > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (use regex) ;; (load "models/pgdb.scm") (include "pages/index_ctrl.scm") (include "pages/index_view.scm") |
Modified cgisetup/pages/index_ctrl.scm from [b425d92984] to [2db5974e1a].
︙ | ︙ | |||
9 10 11 12 13 14 15 | ;; PURPOSE. ;;====================================================================== ;; a function <pagename>-action is called on POST (define (index-action action) (case (string->symbol action) | < < < < < < < < < | < < < < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | ;; PURPOSE. ;;====================================================================== ;; a function <pagename>-action is called on POST (define (index-action action) (case (string->symbol action) (else #f))) ;;====================================================================== ;; Below are the raw chunks of html, css and jquery stuff needed to make ;; html kickstart and other useful things work ;;====================================================================== (define index:kickstart-junk |
︙ | ︙ |
Modified cgisetup/pages/index_view.scm from [d888a50158] to [7dcf5f509d].
1 2 3 4 5 6 7 8 9 10 11 12 13 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (define (pages:index session db shared) (let* ((dbh (s:db)) | < | < | < < < < < < < < < < < < | | | | | | | | | < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | | < < | | | < < < < < < < < < < < < < < < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (define (pages:index session db shared) (let* ((dbh (s:db)) (page-name (sdat-get-page s:session))) (if (equal? page-name "api") (s:call page-name) ;; go straight to the api (list "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">" (s:html (s:title (conc "Megatest")) (s:head index:kickstart-junk ) (s:body (s:div 'class "grid flex" 'id "top_of_page" ;; add visible to columns to help visualize them e.g. "col_12 visible" (case (string->symbol page-name) ((index) (s:call "home")) (else (s:call page-name)))) index:jquery index:javascript )))))) |
Added cgisetup/pages/run.scm version [5c8c5b7d2d].
> > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (load "models/pgdb.scm") (include "pages/run_ctrl.scm") (include "pages/run_view.scm") |
Added cgisetup/pages/run_ctrl.scm version [4336cde456].
> > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== ;; a function <pagename>-action is called on POST (define (run-action action) (case (string->symbol action) ((dosomething) (dosomething)))) |
Added cgisetup/pages/run_view.scm version [c41e1c874c].
> > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | ;;====================================================================== ;; Copyright 2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (define (pages:run session db shared) (let* ((dbh (s:db)) (target (s:get-param 'target))) (s:div 'class "col_12" (s:fieldset "Show a run" target)))) |