File: update-from-1.1.tcl

package info (click to toggle)
dotfile 2.2-1
  • links: PTS
  • area: main
  • in suites: hamm, slink
  • size: 4,596 kB
  • ctags: 456
  • sloc: tcl: 11,732; sh: 965; makefile: 304; csh: 13; ansic: 7
file content (203 lines) | stat: -rw-r--r-- 7,270 bytes parent folder | download
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
### Copyright (C) 1995-1997 Jesper K. Pedersen
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


# Syntax: $argv0 <savefile> <byte compile file> <output-file> <module-name>
# Example: $argv0 ~/.dotfile/.tcsh /usr/local/lib/dotfile/tcsh/ output tcsh
if {$argc != 4} {
  puts "Wrong number of arguments"
}
######################################################################
### This function export the setup into an export file
######################################################################
proc export {filename} {
  global __OUTPUT progList __hash
  set __OUTPUT [open $filename w]

  foreach function $progList {
    puts $__OUTPUT $__hash
    puts $__OUTPUT "\#\#\# $function"
    puts $__OUTPUT $__hash
    puts $__OUTPUT "PAGE $function"
    export_func $function top 2 $function
  }
  close $__OUTPUT
}

######################################################################
### This function export variables to a given function, from a given
### top. 'level' indicated the indentation level in the file
######################################################################
proc export_func {function top level prefix} {
  global children widgetArgs __OUTPUT
  foreach child $children(${function}__$top) {
    set type $widgetArgs(${function}__${child}__type)
    switch $type {
      checkbox -
      entry -
      int -
      float -
      textbox -
      radio -
      menu -
      label -
      listbox {
        upvar \#0 ${prefix}_$child variable
        if {[info exists variable]} {
          if {$type == "radio"} {
            set entries $widgetArgs(${function}__${child}__entries)
            set variable [lindex $entries $variable]
          }
          if {$type == "listbox"} {
            set entries $widgetArgs(${function}__${child}__entries)
            set result ""
            foreach entry $variable {
              lappend result [lindex $entries $entry]
            }
            set variable $result
          }
          puts $__OUTPUT \
              "[space $level][upCase $type] $child \"[escape* $variable]\""
        } else {
          puts "Warning: \"${prefix}_$child\" didn't exists"
        }
      }
      extentry {
        export_extentry $function $level $prefix $child
      }
      frame {
        export_func $function $child $level ${prefix}_$child
      }
      fillout {
        export_fillout $function $level $prefix $child
      }
    }
  }
}

######################################################################
### This function exports an ExtEntry
######################################################################
proc export_extentry {function level prefix name} {
  global widgetArgs scrollValue __OUTPUT
  set count [lindex $scrollValue(${prefix}_$name) 0]
  if {$count != 0} {
    puts $__OUTPUT "[space $level]EXTENTRY $name"
    for {set i 0} {$i < $count} {incr i} {
      puts $__OUTPUT "[space $level]\{"
      export_func $function $name [expr $level+2] ${prefix}_$name$i
      puts $__OUTPUT "[space $level]\}"
    }
  }
}

######################################################################
### This function export a FillOut
######################################################################
proc export_fillout {function level prefix name} {
  global fillList __OUTPUT

  puts $__OUTPUT "[space $level]FILLOUT $name \{"

  set last -1
  incr level 2
  upvar \#0 ${prefix}_$name variable
  if {[info exists fillList(${prefix}_$name)]} {
    foreach filloutelm $fillList(${prefix}_$name) {
      set start [lindex $filloutelm 0]
      set end [lindex $filloutelm 1]
      set elmName [lindex $filloutelm 2]
      set counter [lindex $filloutelm 3]
      if {$last < $start-1} {
        set text [string range $variable [expr $last+1] [expr $start-1]]
        puts $__OUTPUT \
            "[space $level]TEXT \"[escape* $text]\""
      }
      set last $end
      if {$counter == -1} {
        puts $__OUTPUT "[space $level]FILLOUTELM $elmName {}"
      } else {
        puts $__OUTPUT "[space $level]FILLOUTELM $elmName \{"
        export_func $function $elmName [expr $level+2] ${prefix}_${name}_$counter
        puts $__OUTPUT "[space $level]\}"
      }
    }
  }
  if {$last < [string length $variable]} {
    puts $__OUTPUT \
        "[space $level]TEXT \"[escape* [string range $variable [expr $last+1] end]]\""
  }

  puts $__OUTPUT "[space [expr $level-2]]\}"
}

######################################################################
###                             MAIN
######################################################################
set __hash "\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#"
foreach funk {Desc Shortdesc CheckBox Entry Int Float Menu Listbox ExtEntry FillOutElm FillOut Change Save PageEnd} {
  proc $funk {args} {}
}
proc import {file} {
  global argv __files
  source [lindex $argv 1]/$file
  lappend __files $file
}
proc setVar {function child variable value} {
  global scrollValue
  uplevel \#0 "set $variable \"$value\""
}
proc space {number} {
  return [string range "                                                                               " 1 $number]
}
proc upCase {text} {
  return [string toupper $text]
}
proc escape* {string} {
  regsub -all {[\"{}]} $string \\\\\\0 result
  return $result
}
proc uniqAppend {list value} {
  upvar $list l
  if {![info exists l]} {
    uplevel set \"$list\" [list \"$value\"]
  } elseif {[lsearch -exact $l $value] == -1} {
    uplevel lappend \"$list\" \"$value\"
  }
}

switch [lindex $argv 3] {
  Emacs {
    set progList {find_file diff dired sort auto_save backup verson_control undo misc printing completion bookmarks layout tags mouse rlogin slow_terminals emacs_server terminals display modes_general html_helper_mode tcl_mode c-mode comint_general comint_shell hilight_mode outline_mode abbrev python}
  }
  tcsh {
    set progList {prompt_general prompt prompt2 promtpt3 path completion_user completion_misc history_menu logout time misc dirs files jobs watch editor bindings alias limits addSet}
  }
  Fvwm {
    set progList {activeColors inactiveColors stickyColors pagerColors menuColors fonts paths buttonsAndCursors fvwmmodes FVWMwindows MWMmodes TechnicalStuff styles functions popupDefinitions keyBindings mouseBindings ressources}
  }
  Demo {
    ### Nothing to update!
    set __OUTPUT [open [lindex $argv 2] w]
    close $__OUTPUT
    return
  }
  default {error "Unknow module \"[lindex $argv 3]\""}
}

source [lindex $argv 1]
source [lindex $argv 0]
puts "\n\n\nPlease wait....."
export [lindex $argv 2]