xhtml.l (20758B)
1 # 07aug13abu 2 # (c) Software Lab. Alexander Burger 3 4 # *JS "*JS" *Style *Menu *Tab *ID 5 6 (mapc allow '(*JS *Menu *Tab *ID)) 7 (setq *Menu 0 *Tab 1) 8 (off "*JS") 9 10 (de htPrin (Prg Ofs) 11 (default Ofs 1) 12 (for X Prg 13 (if (atom X) 14 (ht:Prin (eval X Ofs)) 15 (eval X Ofs) ) ) ) 16 17 (de htJs () 18 (for X "*JS" 19 (prin " " (car X) "=\"") 20 (ht:Prin (cdr X)) 21 (prin "\"") ) ) 22 23 (de htStyle (Attr) 24 (cond 25 ((atom Attr) 26 (prin " class=\"") 27 (ht:Prin Attr) 28 (prin "\"") ) 29 ((and (atom (car Attr)) (atom (cdr Attr))) 30 (prin " " (car Attr) "=\"") 31 (ht:Prin (cdr Attr)) 32 (prin "\"") ) 33 (T (mapc htStyle Attr)) ) ) 34 35 (de dfltCss (Cls) 36 (htStyle 37 (cond 38 ((not *Style) Cls) 39 ((atom *Style) (pack *Style " " Cls)) 40 ((and (atom (car *Style)) (atom (cdr *Style))) 41 (list Cls *Style) ) 42 ((find atom *Style) 43 (replace *Style @ (pack @ " " Cls)) ) 44 (T (cons Cls *Style)) ) ) ) 45 46 (de tag (Nm Attr Ofs Prg) 47 (prin '< Nm) 48 (and Attr (htStyle @)) 49 (prin '>) 50 (if (atom Prg) 51 (ht:Prin (eval Prg Ofs)) 52 (for X Prg 53 (if (atom X) 54 (ht:Prin (eval X Ofs)) 55 (eval X Ofs) ) ) ) 56 (prin "</" Nm '>) ) 57 58 (de <tag> (Nm Attr . Prg) 59 (tag Nm Attr 2 Prg) ) 60 61 (de <js> ("JS" . "Prg") 62 (let "*JS" (append "*JS" "JS") 63 (run "Prg") ) ) 64 65 (de style (X Prg) 66 (let *Style 67 (nond 68 (X *Style) 69 (*Style X) 70 ((pair X) 71 (cond 72 ((atom *Style) (pack *Style " " X)) 73 ((and (atom (car *Style)) (atom (cdr *Style))) 74 (list X *Style) ) 75 ((find atom *Style) 76 (replace *Style @ (pack @ " " X)) ) 77 (T (cons X *Style)) ) ) 78 ((or (pair (car X)) (pair (cdr X))) 79 (cond 80 ((atom *Style) (list *Style X)) 81 ((and (atom (car *Style)) (atom (cdr *Style))) 82 (if (= (car X) (car *Style)) 83 X 84 (list *Style X) ) ) 85 (T 86 (cons X (delete (assoc (car X) *Style) *Style)) ) ) ) 87 (NIL X) ) 88 (run Prg 2 '(*Style)) ) ) 89 90 (de <style> ("X" . "Prg") 91 (style "X" "Prg") ) 92 93 (de nonblank (Str) 94 (or Str `(pack (char 160) (char 160))) ) 95 96 ### XHTML output ### 97 (de html (Upd Ttl Css Attr . Prg) 98 (httpHead NIL Upd) 99 (ht:Out *Chunked 100 ## (xml? T) 101 (prinl "<!DOCTYPE html>") 102 (prinl "<html lang=\"" (or *Lang "en") "\">") 103 (prinl "<head>") 104 (and Ttl (<tag> 'title NIL Ttl) (prinl)) 105 (and *Host *Port (prinl "<base href=\"" (baseHRef) "\"/>")) 106 (when Css 107 (if (atom Css) 108 ("css" Css) 109 (mapc "css" Css) 110 (when (fin Css) 111 (prinl "<style type=\"text/css\">") 112 (prinl @) 113 (prinl "</style>") ) ) ) 114 (mapc javascript *JS) 115 (and *SesId (javascript NIL "SesId = '" @ "';")) 116 (prinl "</head>") 117 (tag 'body Attr 2 Prg) 118 (prinl "</html>") ) ) 119 120 (de "css" (Css) 121 (prinl "<link rel=\"stylesheet\" type=\"text/css\" href=\"" (srcUrl Css) "\"/>") ) 122 123 (de javascript (JS . @) 124 (when *JS 125 (when JS 126 (prinl "<script type=\"text/javascript\" src=\"" (srcUrl JS) "\"></script>") ) 127 (when (rest) 128 (prinl "<script type=\"text/javascript\">" @ "</script>") ) ) ) 129 130 (de <div> (Attr . Prg) 131 (tag 'div Attr 2 Prg) 132 (prinl) ) 133 134 (de <span> (Attr . Prg) 135 (tag 'span Attr 2 Prg) ) 136 137 (de <br> Prg 138 (htPrin Prg 2) 139 (prinl "<br/>") ) 140 141 (de -- () 142 (prinl "<br/>") ) 143 144 (de ---- () 145 (prinl "<br/><br/>") ) 146 147 (de <hr> () 148 (prinl "<hr/>") ) 149 150 (de <nbsp> (N) 151 (do (or N 1) (prin " ")) ) 152 153 (de <small> Prg 154 (tag 'small NIL 2 Prg) ) 155 156 (de <big> Prg 157 (tag 'big NIL 2 Prg) ) 158 159 (de <em> Prg 160 (tag 'em NIL 2 Prg) ) 161 162 (de <strong> Prg 163 (tag 'strong NIL 2 Prg) ) 164 165 (de <h1> (Attr . Prg) 166 (tag 'h1 Attr 2 Prg) 167 (prinl) ) 168 169 (de <h2> (Attr . Prg) 170 (tag 'h2 Attr 2 Prg) 171 (prinl) ) 172 173 (de <h3> (Attr . Prg) 174 (tag 'h3 Attr 2 Prg) 175 (prinl) ) 176 177 (de <h4> (Attr . Prg) 178 (tag 'h4 Attr 2 Prg) 179 (prinl) ) 180 181 (de <h5> (Attr . Prg) 182 (tag 'h5 Attr 2 Prg) 183 (prinl) ) 184 185 (de <h6> (Attr . Prg) 186 (tag 'h6 Attr 2 Prg) 187 (prinl) ) 188 189 (de <p> (Attr . Prg) 190 (tag 'p Attr 2 Prg) 191 (prinl) ) 192 193 (de <pre> (Attr . Prg) 194 (tag 'pre Attr 2 Prg) 195 (prinl) ) 196 197 (de <ol> (Attr . Prg) 198 (tag 'ol Attr 2 Prg) 199 (prinl) ) 200 201 (de <ul> (Attr . Prg) 202 (tag 'ul Attr 2 Prg) 203 (prinl) ) 204 205 (de <li> (Attr . Prg) 206 (tag 'li Attr 2 Prg) 207 (prinl) ) 208 209 (de <href> (Str Url Tar) 210 (prin "<a href=\"" 211 (sesId 212 (ifn (pre? "+" Url) 213 Url 214 (setq Tar "_blank") 215 (pack (cdr (chop Url))) ) ) 216 "\"" ) 217 (and Tar (prin " target=\"" Tar "\"")) 218 (and *Style (htStyle @)) 219 (prin '>) 220 (ht:Prin Str) 221 (prin "</a>") ) 222 223 (de <img> (Src Alt Url DX DY) 224 (when Url 225 (prin "<a href=\"" 226 (sesId 227 (ifn (pre? "+" Url) 228 Url 229 (pack (cdr (chop Url)) "\" target=\"_blank") ) ) 230 "\">" ) ) 231 (prin "<img src=\"" (sesId Src) "\"") 232 (when Alt 233 (prin " alt=\"") 234 (ht:Prin Alt) 235 (prin "\"") ) 236 (and DX (prin " width=\"" DX "\"")) 237 (and DY (prin " height=\"" DY "\"")) 238 (and *Style (htStyle @)) 239 (prin "/>") 240 (and Url (prin "</a>")) ) 241 242 (de <this> (Var Val . Prg) 243 (prin "<a href=\"" (sesId *Url) '? Var '= (ht:Fmt Val) "\"") 244 (and *Style (htStyle @)) 245 (prin '>) 246 (htPrin Prg 2) 247 (prin "</a>") ) 248 249 (de <table> (Attr Ttl "Head" . Prg) 250 (tag 'table Attr 1 251 (quote 252 (and Ttl (tag 'caption NIL 1 Ttl)) 253 (when (find cdr "Head") 254 (tag 'tr NIL 1 255 (quote 256 (for X "Head" 257 (tag 'th (car X) 2 (cdr X)) ) ) ) ) 258 (htPrin Prg 2) ) ) 259 (prinl) ) 260 261 (de <row> (Cls . Prg) 262 (tag 'tr NIL 1 263 (quote 264 (let (L Prg H (up "Head")) 265 (while L 266 (let (X (pop 'L) C (pack Cls (and Cls (caar H) " ") (caar H)) N 1) 267 (while (== '- (car L)) 268 (inc 'N) 269 (pop 'L) 270 (pop 'H) ) 271 (setq C 272 (if2 C (> N 1) 273 (list C (cons 'colspan N)) 274 C 275 (cons 'colspan N) ) ) 276 (tag 'td 277 (if (== 'align (car (pop 'H))) 278 (list '(align . right) C) 279 C ) 280 1 281 (quote 282 (if (atom X) 283 (ht:Prin (eval X 1)) 284 (eval X 1) ) ) ) ) ) ) ) ) ) 285 286 (de <th> (Attr . Prg) 287 (tag 'th Attr 2 Prg) ) 288 289 (de <tr> (Attr . Prg) 290 (tag 'tr Attr 2 Prg) ) 291 292 (de <td> (Attr . Prg) 293 (tag 'td Attr 2 Prg) ) 294 295 (de <grid> (X . Lst) 296 (tag 'table 'grid 1 297 (quote 298 (while Lst 299 (tag 'tr NIL 1 300 (quote 301 (use X 302 (let L (and (sym? X) (chop X)) 303 (do (or (num? X) (length X)) 304 (tag 'td 305 (cond 306 ((pair X) (pop 'X)) 307 ((= "." (pop 'L)) 'align) ) 308 1 309 (quote 310 (if (atom (car Lst)) 311 (ht:Prin (eval (pop 'Lst) 1)) 312 (eval (pop 'Lst) 1) ) ) ) ) ) ) ) ) ) ) ) 313 (prinl) ) 314 315 (de <trident> Lst 316 (<table> '(width . "100%") NIL NIL 317 (<tr> NIL 318 (<td> '((width . "33%") (align . left)) 319 (eval (car Lst) 1) ) 320 (<td> '((width . "34%") (align . center)) 321 (eval (cadr Lst) 1) ) 322 (<td> '((width . "33%") (align . right)) 323 (eval (caddr Lst) 1) ) ) ) ) 324 325 (de <spread> Lst 326 (<table> '(width . "100%") NIL '((norm) (align)) 327 (<row> NIL 328 (eval (car Lst) 1) 329 (run (cdr Lst) 1) ) ) ) 330 331 (de tip ("Str" "Txt") 332 (<span> (cons 'title "Str") "Txt") ) 333 334 (de <tip> ("Str" . "Prg") 335 (style (cons 'title "Str") "Prg") ) 336 337 # Layout 338 (de <layout> "Lst" 339 (let ("X" 0 "Y" 0) 340 (recur ("Lst" "Y") 341 (for "L" "Lst" 342 (let 343 ("Args" (mapcar eval (cddar "L")) 344 "DX" (eval (caar "L")) 345 "DY" (eval (cadar "L")) 346 "Cls" (unless (sub? ":" (car "Args")) (pop '"Args")) 347 "Style" 348 (cons 'style 349 (glue "; " 350 (cons 351 "position:absolute" 352 (pack "top:" "Y" "px") 353 (pack "left:" "X" "px") 354 (cond 355 ((=0 "DX") "min-width:100%") 356 ("DX" (pack "width:" @ "px")) ) 357 (cond 358 ((=0 "DY") "min-height:100%") 359 ("DY" (pack "height:" @ "px")) ) 360 "Args" ) ) ) ) 361 (prog1 (if "Cls" (list "Cls" "Style") "Style") # -> '@' 362 (eval (cadr "L")) ) 363 (let "X" (+ "X" "DX") 364 (recurse (cddr "L") "Y") ) 365 (inc '"Y" "DY") ) ) ) ) ) 366 367 # Menus 368 (de urlMT (Url Menu Tab Id Str) 369 (pack Url '? "*Menu=+" Menu "&*Tab=+" Tab "&*ID=" (ht:Fmt Id) Str) ) 370 371 (de <menu> Lst 372 (let (M 1 N 1 E 2 U) 373 (recur (Lst N E) 374 (<ul> NIL 375 (for L Lst 376 (nond 377 ((car L) (<li> NIL (htPrin (cdr L) 2))) 378 ((=T (car L)) 379 (if (setq U (eval (cadr L) E)) 380 (<li> (pack (if (= U *Url) 'act 'cmd) N) 381 (<tip> "-->" 382 (<href> (eval (car L) E) 383 (urlMT U *Menu (if (= U *Url) *Tab 1) 384 (eval (caddr L)) 385 (eval (cadddr L)) ) ) ) ) 386 (<li> (pack 'cmd N) 387 (ht:Prin (eval (car L) E)) ) ) ) 388 ((bit? M *Menu) 389 (<li> (pack 'sub N) 390 (<tip> ,"Open submenu" 391 (<href> 392 (eval (cadr L) E) 393 (urlMT *Url (| M *Menu) *Tab *ID) ) ) ) 394 (setq M (>> -1 M)) 395 (recur (L) 396 (for X (cddr L) 397 (when (=T (car X)) 398 (recurse X) 399 (setq M (>> -1 M)) ) ) ) ) 400 (NIL 401 (<li> (pack 'top N) 402 (<tip> ,"Close submenu" 403 (<href> 404 (eval (cadr L) E) 405 (urlMT *Url (x| M *Menu) *Tab *ID) ) ) 406 (setq M (>> -1 M)) 407 (recurse (cddr L) (inc N) (inc E)) ) ) ) ) ) ) ) ) 408 409 # Update link 410 (de updLink () 411 (<tip> ,"Update" 412 (<span> 'step (<href> "@" (urlMT *Url *Menu *Tab *ID))) ) ) 413 414 # Tabs 415 (de <tab> Lst 416 (<table> 'tab NIL NIL 417 (for (N . L) Lst 418 (if (= N *Tab) 419 (<td> 'top (ht:Prin (eval (car L) 1))) 420 (<td> 'sub 421 (<href> (eval (car L) 1) (urlMT *Url *Menu N *ID)) ) ) ) ) 422 (htPrin (get Lst *Tab -1) 2) ) 423 424 ### DB Linkage ### 425 (de mkUrl (Lst) 426 (pack (pop 'Lst) '? 427 (make 428 (while Lst 429 (and 430 (sym? (car Lst)) 431 (= `(char '*) (char (car Lst))) 432 (link (pop 'Lst) '=) ) 433 (link (ht:Fmt (pop 'Lst))) 434 (and Lst (link '&)) ) ) ) ) 435 436 (de <$> (Str Obj Msg Tab) 437 (cond 438 ((not Obj) (ht:Prin Str)) 439 ((=T Obj) (<href> Str (pack Msg Str))) 440 ((send (or Msg 'url>) Obj (or Tab 1)) 441 (<href> Str (mkUrl @)) ) 442 (T (ht:Prin Str)) ) ) 443 444 # Links to previous and next object 445 (de stepBtn (Var Cls Hook Msg) 446 (default Msg 'url>) 447 (<span> 'step 448 (use (Rel S1 S2) 449 (if (isa '+Joint (setq Rel (meta *ID Var))) 450 (let Lst (get *ID Var (; Rel slot)) 451 (setq 452 S2 (lit (cadr (memq *ID Lst))) 453 S1 (lit (car (seek '((L) (== *ID (cadr L))) Lst))) ) ) 454 (let 455 (K 456 (cond 457 ((isa '+Key Rel) 458 (get *ID Var) ) 459 ((isa '+Fold Rel) 460 (cons (fold (get *ID Var)) *ID) ) 461 (T 462 (cons 463 (get *ID Var) 464 (conc 465 (mapcar '((S) (get *ID S)) (; Rel aux)) 466 *ID ) ) ) ) 467 Q1 (init (tree Var Cls Hook) K NIL) 468 Q2 (init (tree Var Cls Hook) K T) ) 469 (unless (get *ID T) 470 (step Q1 T) 471 (step Q2 T) ) 472 (setq 473 S1 (list 'step (lit Q1) T) 474 S2 (list 'step (lit Q2) T) ) ) ) 475 (if (and (eval S1) (send Msg @ *Tab)) 476 (<tip> ,"Next object of the same type" 477 (<href> "<<<" (mkUrl @)) ) 478 (prin "<<<") ) 479 (prin " -- ") 480 (if (and (eval S2) (send Msg @ *Tab)) 481 (<tip> ,"Next object of the same type" 482 (<href> ">>>" (mkUrl @)) ) 483 (prin ">>>") ) ) ) ) 484 485 # Character Separated Values 486 (off "*CSV") 487 488 (de csv ("Nm" . "Prg") 489 (call 'rm "-f" (tmp "Nm" ".csv")) 490 (let "*CSV" (pack "+" (tmp "Nm" ".csv")) 491 (run "Prg") ) 492 (<href> "CSV" (tmp "Nm" ".csv")) ) 493 494 (de <0> @ 495 (when "*CSV" 496 (out @ 497 (prin (next)) 498 (while (args) 499 (prin "^I" (next)) ) 500 (prinl "^M") ) ) ) 501 502 (de <%> @ 503 (prog1 (pass pack) 504 (ht:Prin @) 505 (prinl "<br/>") 506 (<0> @) ) ) 507 508 (de <!> ("Lst") 509 (when "*CSV" 510 (out @ 511 (prin (eval (cadar "Lst"))) 512 (for "S" (cdr "Lst") 513 (prin "^I" (eval (cadr "S"))) ) 514 (prinl "^M") ) ) 515 "Lst" ) 516 517 (de <+> (Str Obj Msg Tab) 518 (<$> Str Obj Msg Tab) 519 (and "*CSV" (out @ (prin Str "^I"))) ) 520 521 (de <-> (Str Obj Msg Tab) 522 (<$> Str Obj Msg Tab) 523 (<0> Str) ) 524 525 # Interactive tree 526 (de <tree> ("Url" "Path" "Tree" "Able?" "Excl?" "Expand" "Print") 527 (default "Print" 'ht:Prin) 528 (let ("Pos" "Tree" "F" (pop '"Path") "A" 0) 529 (when "Path" 530 (loop 531 (and "F" 532 (not (cdr "Path")) 533 (map 534 '((L) 535 (when (pair (car L)) (set L (caar L))) ) 536 "Pos" ) ) 537 (T (atom (car (setq "Pos" (nth "Pos" (abs (pop '"Path"))))))) 538 (NIL "Path") 539 (setq "Pos" (cdar "Pos")) ) 540 (set "Pos" 541 (if (atom (car "Pos")) 542 (cons (car "Pos") ("Expand" (car "Pos"))) 543 (caar "Pos") ) ) ) 544 (setq "Pos" (car "Pos")) 545 ("tree" "Tree") 546 "Tree" ) ) 547 548 (de "tree" ("Tree" "Lst") 549 (prinl "<ul>") 550 (for ("N" . "X") "Tree" 551 (prin "<li><a id=\"T" (inc '"A") "\"></a>") 552 (cond 553 ((pair "X") 554 (let "L" (append "Lst" (cons "N")) 555 (<href> (if (== "X" "Pos") "<+>" "[+]") 556 (pack "Url" 557 '? (ht:Fmt (cons NIL "L")) 558 "#T" (max 1 (- "A" 12)) ) ) 559 (space) 560 ("Print" (car "X")) 561 (and (cdr "X") ("tree" @ "L")) ) ) 562 (("Able?" "X") 563 (let "L" (append "Lst" (cons (- "N"))) 564 (<href> (if (== "X" "Pos") "< >" "[ ]") 565 (pack "Url" 566 "?" (ht:Fmt (cons ("Excl?" "X") "L")) 567 "#T" (max 1 (- "A" 12)) ) ) 568 (space) 569 ("Print" "X") ) ) 570 (T ("Print" "X")) ) 571 (prin "</li>") ) 572 (prinl "</ul>") ) 573 574 ### HTML form ### 575 (de <post> (Attr Url . Prg) 576 (prin 577 "<form enctype=\"multipart/form-data\" action=\"" 578 (sesId Url) 579 (and *JS "\" onkeydown=\"return formKey(event)\" onkeypress=\"return formKey(event)\" onsubmit=\"return doPost(this)") 580 "\" method=\"post\">" ) 581 (prin "<noscript><input type=\"hidden\" name=\"*JS\" value=\"\"/></noscript>") 582 (tag 'fieldset Attr 2 Prg) 583 (prinl "</form>") ) 584 585 (de htmlVar ("Var") 586 (prin "name=\"") 587 (if (pair "Var") 588 (prin (car "Var") ":" (cdr "Var") ":") 589 (prin "Var") ) 590 (prin "\"") ) 591 592 (de htmlVal ("Var") 593 (if (pair "Var") 594 (cdr (assoc (cdr "Var") (val (car "Var")))) 595 (val "Var") ) ) 596 597 (de <label> (Attr . Prg) 598 (tag 'label Attr 2 Prg) ) 599 600 (de <field> (N "Var" Max Flg) 601 (prin "<input type=\"text\" ") 602 (htmlVar "Var") 603 (prin " value=\"") 604 (ht:Prin (htmlVal "Var")) 605 (prin "\" size=\"") 606 (if (lt0 N) 607 (prin (- N) "\" style=\"text-align: right;\"") 608 (prin N "\"") ) 609 (and Max (prin " maxlength=\"" Max "\"")) 610 (when *JS 611 (prin " onchange=\"return fldChg(this)\"") 612 (htJs) ) 613 (dfltCss "field") 614 (and Flg (prin " disabled=\"disabled\"")) 615 (prinl "/>") ) 616 617 (de <hidden> ("Var" Val) 618 (prin "<input type=\"hidden\" ") 619 (htmlVar "Var") 620 (prin " value=\"") 621 (ht:Prin Val) 622 (prinl "\"/>") ) 623 624 (de <passwd> (N "Var" Max Flg) 625 (prin "<input type=\"password\" ") 626 (htmlVar "Var") 627 (prin " value=\"") 628 (ht:Prin (htmlVal "Var")) 629 (prin "\" size=\"" N "\"") 630 (and Max (prin " maxlength=\"" Max "\"")) 631 (when *JS 632 (prin " onchange=\"return fldChg(this)\"") 633 (htJs) ) 634 (dfltCss "passwd") 635 (and Flg (prin " disabled=\"disabled\"")) 636 (prinl "/>") ) 637 638 (de <upload> (N "Var" Flg) 639 (prin "<input type=\"file\" ") 640 (htmlVar "Var") 641 (prin " value=\"") 642 (ht:Prin (htmlVal "Var")) 643 (prin "\" size=\"" N "\"") 644 (when *JS 645 (prin " onchange=\"return fldChg(this)\"") 646 (htJs) ) 647 (dfltCss "upload") 648 (and Flg (prin " disabled=\"disabled\"")) 649 (prinl "/>") ) 650 651 (de <area> (Cols Rows "Var" Flg) 652 (prin "<textarea ") 653 (htmlVar "Var") 654 (prin " cols=\"" Cols "\" rows=\"" Rows "\" wrap=\"off\"") 655 (when *JS 656 (prin " onchange=\"return fldChg(this)\"") 657 (htJs) ) 658 (dfltCss "area") 659 (and Flg (prin " disabled=\"disabled\"")) 660 (prin '>) 661 (ht:Prin (htmlVal "Var")) 662 (prinl "</textarea>") ) 663 664 (de <select> (Lst "Var" Flg) 665 (prin "<select ") 666 (htmlVar "Var") 667 (when *JS 668 (prin " onchange=\"return fldChg(this)\"") 669 (htJs) ) 670 (dfltCss "select") 671 (prin '>) 672 (for "X" Lst 673 (let "V" (if (atom "X") "X" (car "X")) 674 (prin 675 "<option" 676 (and (pair "X") (pack " title=\"" (cdr "X") "\"")) 677 (cond 678 ((= "V" (htmlVal "Var")) " selected=\"selected\"") 679 (Flg " disabled=\"disabled\"") ) 680 '> ) 681 (ht:Prin "V") ) 682 (prin "</option>") ) 683 (prinl "</select>") ) 684 685 (de <check> ("Var" Flg) 686 (let Val (htmlVal "Var") 687 (prin "<input type=\"hidden\" ") 688 (htmlVar "Var") 689 (prin " value=\"" (and Flg Val T) "\">") 690 (prin "<input type=\"checkbox\" ") 691 (htmlVar "Var") 692 (prin " value=\"T\"" (and Val " checked=\"checked\"")) 693 (when *JS 694 (prin " onchange=\"return fldChg(this)\"") 695 (htJs) ) 696 (dfltCss "check") 697 (and Flg (prin " disabled=\"disabled\"")) 698 (prinl "/>") ) ) 699 700 (de <radio> ("Var" Val Flg) 701 (prin "<input type=\"radio\" ") 702 (htmlVar "Var") 703 (prin " value=\"") 704 (ht:Prin Val) 705 (prin "\"" (and (= Val (htmlVal "Var")) " checked=\"checked\"")) 706 (when *JS 707 (prin " onchange=\"return fldChg(this)\"") 708 (htJs) ) 709 (dfltCss "radio") 710 (and Flg (prin " disabled=\"disabled\"")) 711 (prinl "/>") ) 712 713 (de <submit> (S "Var" Flg JS) 714 (prin "<input type=\"submit\"") 715 (and "Var" (space) (htmlVar "Var")) 716 (prin " value=\"") 717 (ht:Prin S) 718 (prin "\"") 719 (when *JS 720 (prin " onmousedown=\"inBtn(1)\" onblur=\"inBtn(0)\"") 721 (and JS (prin " onclick=\"return doBtn(this)\"")) 722 (htJs) ) 723 (dfltCss "submit") 724 (and Flg (prin " disabled=\"disabled\"")) 725 (prinl "/>") ) 726 727 (de <image> (Src "Var" Flg JS) 728 (prin "<input type=\"image\"") 729 (and "Var" (space) (htmlVar "Var")) 730 (prin " src=\"" (sesId Src) "\"") 731 (when *JS 732 (prin " onmousedown=\"inBtn(1)\" onblur=\"inBtn(0)\"") 733 (and JS (prin " onclick=\"return doBtn(this)\"")) 734 (htJs) ) 735 (dfltCss "image") 736 (and Flg (prin " disabled=\"disabled\"")) 737 (prinl "/>") ) 738 739 (de <reset> (S Flg) 740 (prin "<input type=\"reset\" value=\"") 741 (ht:Prin S) 742 (prin "\"") 743 (dfltCss "reset") 744 (and Flg (prin " disabled=\"disabled\"")) 745 (prinl "/>") ) 746 747 # vi:et:ts=3:sw=3