picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

gui.l (8280B)


      1 # 02jun13abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 ### GUI ###
      5 (de menu (Ttl . Prg)
      6    (action
      7       (html 0 Ttl *Css NIL
      8          (<layout>
      9             ((180 0 'menu)
     10                (<div> @
     11                   (expires)
     12                   (<menu>
     13                      (,"Home" "!start")
     14                      (,"logout" (and *Login "!stop"))
     15                      (NIL (<hr>))
     16                      (T ,"Data"
     17                         (,"Orders" (and (may Order) "app/ord.l"))
     18                         (,"Items" (and (may Item) "app/item.l"))
     19                         (,"Customers/Suppliers" (and (may Customer) "app/cusu.l"))
     20                         (,"Salutations" (and (may Customer) "app/sal.l")) )
     21                      (T ,"Report"
     22                         (,"Inventory" (and (may Report) "app/inventory.l"))
     23                         (,"Sales" (and (may Report) "app/sales.l")) )
     24                      (T ,"System"
     25                         (,"Role Administration" (and (may RoleAdmin) "app/role.l"))
     26                         (,"User Administration" (and (may UserAdmin) "app/user.l")) ) ) )
     27                ((NIL NIL 'main)
     28                   (<div> @ (run Prg 1)) ) ) ) ) ) )
     29 
     30 (de start ()
     31    (setq *Url "!start")
     32    (and (app) (setq *Menu 3))
     33    (menu "PicoLisp App"
     34       (<h2> NIL "PicoLisp App")
     35       (<img> "@img/7fach.gif" "7fach Logo")
     36       (----)
     37       (form NIL
     38          (gui '(+Init +Map +TextField)
     39             (cons *Ctry *Lang)
     40             *Locales
     41             (mapcar car *Locales)
     42             ',"Language" )
     43          (gui '(+Button) ',"Change"
     44             '(let V (val> (field -1))
     45                (locale (car V) (cdr V) "app/loc/") ) ) )
     46       (loginForm) ) )
     47 
     48 (de stop ()
     49    (logout)
     50    (start) )
     51 
     52 # Search dialogs
     53 (de choCuSu (Dst)
     54    (diaform '(Dst)
     55       (<grid> "--.-.-."
     56          ,"Number" (gui 'nr '(+Var +NumField) '*CuSuNr 10)
     57          ,"Name" (gui 'nm '(+Focus +Var +TextField) '*CuSuNm 30)
     58          ,"Phone" (gui 'tel '(+Var +TelField) '*CuSuTel 20)
     59          (searchButton '(init> (: home query)))
     60          ,"Zip" (gui 'plz '(+Var +TextField) '*CuSuPlz 10)
     61          ,"City" (gui 'ort '(+Var +TextField) '*CuSuOrt 30)
     62          ,"Mobile" (gui 'mob '(+Var +TelField) '*CuSuMob 20)
     63          (resetButton '(nr nm tel plz ort mob query)) )
     64       (gui 'query '(+QueryChart) (cho)
     65          '(goal
     66             (quote
     67                @Nr (and *CuSuNr (cons @ T))
     68                @Nm *CuSuNm
     69                @Tel *CuSuTel
     70                @Plz *CuSuPlz
     71                @Ort *CuSuOrt
     72                @Mob *CuSuMob
     73                (select (@@)
     74                   ((nr +CuSu @Nr) (nm +CuSu @Nm) (tel +CuSu @Tel)
     75                      (plz +CuSu @Plz) (ort +CuSu @Ort) (mob +CuSu @Mob) )
     76                   (range @Nr @@ nr)
     77                   (tolr @Nm @@ nm)
     78                   (fold @Tel @@ tel)
     79                   (head @Plz @@ plz)
     80                   (part @Ort @@ ort)
     81                   (fold @Mob @@ mob) ) ) )
     82          9
     83          '((This) (list This (: nr) This (: nm2) (: em) (: plz) (: ort) (: tel) (: mob))) )
     84       (<table> 'chart (choTtl ,"Customers/Suppliers" 'nr '+CuSu)
     85          (quote
     86             (btn)
     87             (align "#")
     88             (NIL ,"Name")
     89             (NIL)
     90             (NIL ,"EMail")
     91             (NIL ,"Zip")
     92             (NIL ,"City")
     93             (NIL ,"Phone")
     94             (NIL ,"Mobile") )
     95          (do (cho)
     96             (<row> (alternating)
     97                (gui 1 '(+DstButton) Dst)
     98                (gui 2 '(+NumField))
     99                (gui 3 '(+ObjView +TextField) '(: nm))
    100                (gui 4 '(+TextField))
    101                (gui 5 '(+MailField))
    102                (gui 6 '(+TextField))
    103                (gui 7 '(+TextField))
    104                (gui 8 '(+TelField))
    105                (gui 9 '(+TelField)) ) ) )
    106       (<spread>
    107          (scroll (cho))
    108          (newButton T Dst '(+CuSu)
    109             '(nr genKey 'nr '+CuSu)
    110             'nm *CuSuNm
    111             'plz *CuSuPlz
    112             'ort *CuSuOrt
    113             'tel *CuSuTel
    114             'mob *CuSuMob )
    115          (cancelButton) ) ) )
    116 
    117 (de choItem (Dst)
    118    (diaform '(Dst)
    119       (<grid> "--.-."
    120          ,"Number" (gui 'nr '(+Focus +Var +NumField) '*ItemNr 10)
    121          ,"Supplier" (gui 'sup '(+Var +TextField) '*ItemSup 20)
    122          (searchButton '(init> (: home query)))
    123          ,"Description" (gui 'nm '(+Var +TextField) '*ItemNm 30)
    124          ,"Price" (gui 'pr '(+Var +FixField) '*ItemPr 2 12)
    125          (resetButton '(nr nm pr sup query)) )
    126       (gui 'query '(+QueryChart) (cho)
    127          '(goal
    128             (quote
    129                @Nr (and *ItemNr (cons @ T))
    130                @Nm *ItemNm
    131                @Pr (and *ItemPr (cons @ T))
    132                @Sup *ItemSup
    133                (select (@@)
    134                   ((nr +Item @Nr) (nm +Item @Nm) (pr +Item @Pr) (nm +CuSu @Sup (sup +Item)))
    135                   (range @Nr @@ nr)
    136                   (part @Nm @@ nm)
    137                   (range @Pr @@ pr)
    138                   (tolr @Sup @@ sup nm) ) ) )
    139          6
    140          '((This) (list This (: nr) This (: sup) (: sup ort) (: pr))) )
    141       (<table> 'chart (choTtl ,"Items" 'nr '+Item)
    142          (quote
    143             (btn)
    144             (align "#")
    145             (NIL ,"Description")
    146             (NIL ,"Supplier")
    147             (NIL ,"City")
    148             (align ,"Price") )
    149          (do (cho)
    150             (<row> (alternating)
    151                (gui 1 '(+DstButton) Dst)
    152                (gui 2 '(+NumField))
    153                (gui 3 '(+ObjView +TextField) '(: nm))
    154                (gui 4 '(+ObjView +TextField) '(: nm))
    155                (gui 5 '(+TextField))
    156                (gui 6 '(+FixField) 2) ) ) )
    157       (<spread>
    158          (scroll (cho))
    159          (newButton T Dst '(+Item)
    160             '(nr genKey 'nr '+Item)
    161             'nm *ItemNm
    162             'pr *ItemPr )
    163          (cancelButton) ) ) )
    164 
    165 (de choOrd (Dst)
    166    (diaform '(Dst)
    167       (<grid> "--.-.-."
    168          ,"Number" (gui 'nr '(+Focus +Var +NumField) '*OrdNr 10)
    169          ,"Customer" (gui 'cus '(+Var +TextField) '*OrdCus 20)
    170          ,"City" (gui 'ort '(+Var +TextField) '*OrdOrt 20)
    171          (searchButton '(init> (: home query)))
    172          ,"Date" (gui 'dat '(+Var +DateField) '*OrdDat 10)
    173          ,"Supplier" (gui 'sup '(+Var +TextField) '*OrdSup 20)
    174          ,"Item" (gui 'item '(+Var +TextField) '*OrdItem 20)
    175          (resetButton '(nr cus ort dat sup item query)) )
    176       (gui 'query '(+QueryChart) (cho)
    177          '(goal
    178             (quote
    179                @Nr (cons (or *OrdNr T))
    180                @Dat (cons (or *OrdDat T))
    181                @Cus *OrdCus
    182                @Ort *OrdOrt
    183                @Sup *OrdSup
    184                @Item *OrdItem
    185                (select (@@)
    186                   ((nr +Ord @Nr) (dat +Ord @Dat)
    187                      (nm +CuSu @Cus (cus +Ord))
    188                      (ort +CuSu @Ort (cus +Ord))
    189                      (nm +Item @Item (itm +Pos) ord)
    190                      (nm +CuSu @Sup (sup +Item) (itm +Pos) ord) )
    191                   (range @Nr @@ nr)
    192                   (range @Dat @@ dat)
    193                   (tolr @Cus @@ cus nm)
    194                   (part @Ort @@ cus ort)
    195                   (part @Item @@ pos itm nm)
    196                   (tolr @Sup @@ pos itm sup nm) ) ) )
    197          9
    198          '((This)
    199             (list This (: nr) This
    200                (: cus) (: cus ort)
    201                (: pos 1 itm sup) (: pos 1 itm)
    202                (: pos 2 itm sup) (: pos 2 itm) ) ) )
    203       (<table> 'chart (choTtl ,"Orders" 'nr '+Ord)
    204          (quote
    205             (btn)
    206             (align "#")
    207             (NIL ,"Date")
    208             (NIL ,"Customer")
    209             (NIL ,"City")
    210             (NIL ,"Supplier" "(1)")
    211             (NIL ,"Item" "(1)")
    212             (NIL ,"Supplier" "(2)")
    213             (NIL ,"Item" "(2)") )
    214          (do (cho)
    215             (<row> (alternating)
    216                (gui 1 '(+DstButton) Dst)
    217                (gui 2 '(+NumField))
    218                (gui 3 '(+ObjView +DateField) '(: dat))
    219                (gui 4 '(+ObjView +TextField) '(: nm))
    220                (gui 5 '(+TextField))
    221                (gui 6 '(+ObjView +TextField) '(: nm))
    222                (gui 7 '(+ObjView +TextField) '(: nm))
    223                (gui 8 '(+ObjView +TextField) '(: nm))
    224                (gui 9 '(+ObjView +TextField) '(: nm)) ) ) )
    225       (<spread>
    226          (scroll (cho))
    227          (newButton T Dst '(+Ord)
    228             '(nr genKey 'nr '+Ord)
    229             'dat (date) )
    230          (cancelButton) ) ) )
    231 
    232 # vi:et:ts=3:sw=3