~aleteoryx/tclircc

ref: 59555e2c6591b0f33ae0aa5e91c63a02f797e8e6 tclircc/src/ui.tcl -rw-r--r-- 3.2 KiB
59555e2cAleteoryx ui work, prepping for network add ui 11 days ago
                                                                                
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
namespace eval ui {}
namespace eval ui::basic {}

proc ui::basic::setup {mount} {
  global version

  menu $mount.menu
  $mount configure -menu "$mount.menu"

  menu $mount.menu.conn
  menu $mount.menu.server

  menu $mount.menu.me
  $mount.menu.me add command -label "About" -command [subst {
    tk_messageBox -title "About tclircc" \
                  -message "tclircc $version" \
                  -detail "by Aleteoryx\nhttps://amehut.dev/~aleteoryx/tclircc\n\nThis software is in the public domain." \
                  -type ok \
                  -parent $mount }]

  $mount.menu add cascade -label "connections" -menu $mount.menu.conn
  $mount.menu add cascade -label "networks" -menu $mount.menu.network
  $mount.menu add cascade -label "tclircc" -menu $mount.menu.me
}
proc ui::basic::teardown {mount} {
  destroy $mount.menu
}

namespace eval ui::form {
  variable forms
  variable form_n 0
}

proc ui::form::show {title heading fields check finish cancel} {
  variable forms
  variable form_n
  set tl .form$form_n
  incr form_n

  set forms(${tl}) [list fields $fields  check $check  finish $finish  cancel $cancel]

  set pad_n 0

  toplevel $tl
  wm title $tl $title
  label $tl.heading -text $heading -font TkHeadingFont
  pack $tl.heading -side top
  frame $tl.pad$pad_n -height 10
  pack $tl.pad$pad_n -side top
  incr pad_n

  foreach {framed text widget name args} $fields {
    if {$framed} {
      frame $tl.field_$name
      label $tl.field_$name.lbl -text $text
      $widget $tl.field_$name.wgt {*}$args ::ui::form::forms(${tl}:$name)
      pack $tl.field_$name.lbl -side left
      pack $tl.field_$name.wgt -side right
      pack $tl.field_$name -side top -anchor w
    } else {
      label $tl.field_${name}_lbl -text $text
      $widget $tl.field_${name}_wgt {*}$args ::ui::form::forms(${tl}:$name)
      pack $tl.field_${name}_lbl -side top -anchor w
      pack $tl.field_${name}_wgt -side top -anchor w
    }
    label $tl.field_${name}_err -height 0
    pack $tl.field_${name}_err -side top -anchor w
    frame $tl.pad$pad_n -height 10
    pack $tl.pad$pad_n -side top
    incr pad_n
  }

  frame $tl.buttons
  button $tl.buttons.cancel -text "Cancel" -command [concat [list set tl $tl] {;
    array unset ::ui::form::forms($tl)
    array unset ::ui::form::forms(${tl}:*)
    destroy $tl
    eval [dict get [set ::ui::form::forms($tl)] cancel]
  }]
  button $tl.buttons.ok -text "Ok" -command [concat [list set tl $tl] {;
    set formdata {}
    foreach {framed text widget name args} [dict get [set ::ui::form::forms($tl)] fields] {
      dict set formdata $name [set ::ui::form::forms(${tl}:$name)]
    }

    if {[set errs [eval [dict get [set ::ui::form::forms($tl)] check]]] != {}} {
      ...
    } else {
      array unset ::ui::form::forms($tl)
      array unset ::ui::form::forms(${tl}:*)
      destroy $tl
      eval [dict get [set ::ui::form::forms($tl)] finish]
    }
  }]
  bind $tl <Destroy> {
    if {[info exists ::ui::form::forms(%W)]} {
      array unset ::ui::form::forms(%W)
      array unset ::ui::form::forms(%W:*)
      eval [dict get [set ::ui::form::forms(%W)] cancel]
    }
  }

  pack $tl.buttons.cancel -side left
  pack $tl.buttons.ok -side left
  pack $tl.buttons -side top -anchor w
}