← Back to branch summary

~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to tcl/sciGUI/local_extra/HelpSystem-1.5/help_2htm.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2005-01-09 22:58:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050109225821-473xr8vhgugxxx5j
Tags: 3.0-12
http://bugs.debian.org/255869
changed configure.in to build scilab's own malloc.o, closes: #255869

Show diffs side-by-side

added added

removed removed

Lines of Context:
tcl/sciGUI/local_extra/HelpSystem-1.5/help_2htm.tcl
 
1
#===============================================================================
 
2
# HelpSystem     :  Extension 
 
3
#                :  Splits help file(s) to set of HTML files
 
4
# Developed by   :  Andrei A. Gratchev      <grand@deversys.com>
 
5
#===============================================================================
 
6
# Function       :  help::help2html
 
7
# Description    :  Converts help file(s) to sepatated HTML files
 
8
# Parameters     :  None
 
9
# Return         :  Nothing
 
10
#-------------------------------------------------------------------------------
 
11
 
 
12
if {[namespace current]!="::help"} {
 
13
 help::add_ext [info script]
 
14
} else {
 
15
 
 
16
proc help2html:calcimg {name} {
 
17
 variable data
 
18
 variable curfilename
 
19
 
 
20
 set parfnameX [set parfname $name]
 
21
 if {![string match "*.gif" $parfname]} {
 
22
  append parfname ".gif"
 
23
 }
 
24
 if {![info exists data($parfnameX,image)] && ![info exists data($parfname,image)]} {
 
25
  catch {set data($parfname,image) [image create photo -file [file join [file dirname $curfilename] $parfname]]}
 
26
 }
 
27
 return $parfname
 
28
}
 
29
 
 
30
proc help2html:decode_base64 {data} {
 
31
 set i -1
 
32
 foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 + /} {
 
33
  set decode_table($char) [incr i]
 
34
 }
 
35
 set result ""
 
36
 set state 0
 
37
 foreach c [split $data ""] {
 
38
  if {[catch {set x $decode_table($c)}]} {
 
39
   continue
 
40
  }
 
41
  switch [incr state] {
 
42
   1 {set r [expr {($x <<2) & 0xFC}]}
 
43
   2 {append result [format %c [expr {($x >>4) & 0x03 | $r}]]
 
44
      set r [expr {($x <<4) & 0xF0}]
 
45
     }
 
46
   3 {append result [format %c [expr {($x >>2) & 0x0F | $r}]]
 
47
      set r [expr {($x <<6) & 0xC0}]
 
48
     }
 
49
   4 {append result [format %c [expr {$x & 0x3F | $r}]]
 
50
      set state 0
 
51
     }
 
52
  }
 
53
 }
 
54
 return $result
 
55
}
 
56
 
 
57
proc help2html {} {
 
58
 variable gw
 
59
 variable data
 
60
 variable index
 
61
 variable font
 
62
 variable fontsize
 
63
 variable linkcolor
 
64
 variable alinkcolor
 
65
 variable backcolor
 
66
 variable forecolor
 
67
 variable stat
 
68
 variable curfilename
 
69
 
 
70
 set tk_strictMotif 0
 
71
 
 
72
 set dir [file dirname $curfilename]
 
73
 if {[set dir [file dirname [tk_getSaveFile -parent $gw -initialdir $dir\
 
74
               -title "Select directory to Save HTML files" \
 
75
               -initialfile "Filename will be ignored"]]]=="."} {
 
76
  return
 
77
 }
 
78
 
 
79
 set count 0
 
80
 set total [llength $index]
 
81
 set stat "Generating HTMLs...."
 
82
 update 
 
83
 foreach topic $index {
 
84
  incr count
 
85
  regsub -all -- {[\?\*\:\>\<\&]} $topic "_" topicfname
 
86
  if {![string match "*.htm" $topic] && ![string match "*.html" $topic]} {
 
87
   append topicfname ".htm"
 
88
  } 
 
89
  if {[catch {set fout [::open [file join $dir $topicfname] "w"]}]!=0} {
 
90
   error "Can't open output file:\n[file join $dir $topicfname]"
 
91
   continue
 
92
  }
 
93
  set stat "Generating HTMLs...  $count of $total  \"$topicfname\""
 
94
  update idletasks
 
95
  catch {fconfigure $fout -eofchar "" -buffersize 32768 -buffering full}
 
96
  puts $fout "<html>\n<head>\n<meta name=\"Generator\" content=\"Help System v.1.5\">"
 
97
  puts $fout "<title>$data($topic,title)</title>\n<basefont name=\"$font\">\n</head>"
 
98
  puts $fout "<body bgcolor=\"$backcolor\" text=\"$forecolor\" link=\"$linkcolor\" alink=\"$alinkcolor\" style=\"font-family: '$font';\">"
 
99
 
 
100
  set _text $data($topic,text)
 
101
  set text ""
 
102
  while {[set pos [string first "<" $_text]]!=-1} {
 
103
   append text [string range $_text 0 [expr $pos - 1]]
 
104
   set _text [string range $_text $pos end]
 
105
   if {[set pos [string first ">" $_text]]!=-1} {
 
106
    set tag [string trim [string range $_text 0 $pos] "< >\t\n"]
 
107
    set _text [string range $_text [incr pos] end]
 
108
   } else {
 
109
    set tag [string trim [string range $_text 0 end] "< >\t\n"]
 
110
    set _text ""
 
111
   }
 
112
   regsub -all -- "\[\r\t\n \]+" $tag " " tag
 
113
   if {[set pos [string first " " $tag]]!=-1} {
 
114
    set tagparams [parsetag [string range $tag $pos end]]
 
115
    set tagname [string range $tag 0 [expr $pos - 1]]
 
116
   } else {
 
117
    set tagparams ""
 
118
    set tagname $tag
 
119
   }
 
120
   set tagname [string tolower $tagname]
 
121
   switch -exact -- $tagname {
 
122
    "a" {
 
123
      if {[set parpos [lsearch -exact $tagparams "href"]]!=-1} {
 
124
       incr parpos
 
125
       set parfname [lindex $tagparams $parpos]
 
126
       if {![regexp -nocase "^tcl(script)?:" $parfname]} {
 
127
        if {[set markpos [string first "#" $parfname]]!=-1} {
 
128
         set mark [string range $parfname $markpos end]
 
129
         set parfname [string range $parfname 0 [incr markpos -1]]
 
130
        } else {
 
131
         set mark ""
 
132
        }
 
133
        if {$mark!="" && [set lpos [lsearch -glob $index "*\?[string range $mark 1 end]"]]!=-1} {
 
134
         set parfname [lindex $index $lpos]
 
135
         set mark ""
 
136
        }
 
137
        regsub -all -- {[\?\*\:\>\<\&]} $parfname "_" parfname
 
138
        if {$parfname!="" && ![string match "*.htm" $parfname] && ![string match "*.html" $parfname]} {
 
139
         append parfname ".htm"
 
140
        } 
 
141
        append parfname $mark
 
142
       } else {
 
143
        set parfname "#"
 
144
       }
 
145
       set tagparams [lreplace $tagparams $parpos $parpos $parfname]
 
146
       set tag $tagname
 
147
       foreach {tagparname tagparvalue} $tagparams {
 
148
        append tag " $tagparname=\"$tagparvalue\""
 
149
       }
 
150
      }
 
151
    }
 
152
    "img" {
 
153
      if {[set parpos [lsearch -exact $tagparams "src"]]!=-1} {
 
154
       incr parpos
 
155
       set parfname [help2html:calcimg [lindex $tagparams $parpos]]
 
156
       set tagparams [lreplace $tagparams $parpos $parpos $parfname]
 
157
      }
 
158
      if {[set parpos [lsearch -exact $tagparams "border"]]!=-1} {
 
159
       lappend tagparams "style" "margin: [lindex $tagparams [incr parpos]]px"
 
160
       set tagparams [lreplace $tagparams [expr {$parpos - 1}] $parpos]
 
161
      }
 
162
      lappend tagparams "border" "0"
 
163
      set tag $tagname
 
164
      foreach {tagparname tagparvalue} $tagparams {
 
165
       append tag " $tagparname=\"$tagparvalue\""
 
166
      }
 
167
    }
 
168
    "li" {
 
169
      if {[set parpos [lsearch -exact $tagparams "type"]]!=-1} {
 
170
#       set _text "<img src=\"[lindex $tagparams [incr parpos]]\">$_text"
 
171
       if {[lindex $tagparams $parpos]!="disc" && \
 
172
           [lindex $tagparams $parpos]!="circle" && \
 
173
           [lindex $tagparams $parpos]!="square" } {
 
174
        lappend tagparams "style" "list-style: url([help2html:calcimg [lindex $tagparams [incr parpos]]]) disc"
 
175
        set tagparams [lreplace $tagparams [expr {$parpos - 1}] $parpos]
 
176
        set tag $tagname
 
177
        foreach {tagparname tagparvalue} $tagparams {
 
178
         append tag " $tagparname=\"$tagparvalue\""
 
179
        }
 
180
       }
 
181
      }
 
182
    }
 
183
    "ol" -
 
184
    "ul" {
 
185
      set f_style ""
 
186
      if {[set parpos [lsearch -exact $tagparams "type"]]!=-1} {
 
187
       if {[lindex $tagparams $parpos]!="disc" && \
 
188
           [lindex $tagparams $parpos]!="circle" && \
 
189
           [lindex $tagparams $parpos]!="square" } {
 
190
        append f_style "list-style: url([help2html:calcimg [lindex $tagparams [incr parpos]]]) disc"
 
191
        set tagparams [lreplace $tagparams [expr {$parpos - 1}] $parpos]
 
192
       }
 
193
      }
 
194
      if {[set parpos [lsearch -exact $tagparams "indent"]]!=-1} {
 
195
       if {$f_style!=""} {append f_style "; "}
 
196
       append f_style "margin-left: [string trim [lindex $tagparams [incr parpos]]]px"
 
197
       set tagparams [lreplace $tagparams [expr {$parpos - 1}] $parpos]
 
198
      }
 
199
      if {$f_style!=""} {
 
200
       lappend tagparams "style" $f_style
 
201
       set tag $tagname
 
202
       foreach {tagparname tagparvalue} $tagparams {
 
203
        append tag " $tagparname=\"$tagparvalue\""
 
204
       }
 
205
      }
 
206
    }
 
207
    "\$" {
 
208
      if {[info exists data(subst,[lindex $tagparams 0],begin)]} {
 
209
       set _text "$data(subst,[lindex $tagparams 0],begin)$_text"
 
210
      }
 
211
      continue
 
212
    }
 
213
    "/\$" {
 
214
      if {[info exists data(subst,[lindex $tagparams 0],end)]} {
 
215
       set _text "$data(subst,[lindex $tagparams 0],end)$_text"
 
216
      }
 
217
      continue
 
218
    }
 
219
    "font" {
 
220
      set f_style ""
 
221
      if {[set parpos [lsearch -exact $tagparams "bgcolor"]]!=-1} {
 
222
       append f_style "background-color: [lindex $tagparams [incr parpos]]"
 
223
       set tagparams [lreplace $tagparams [expr {$parpos - 1}] $parpos]
 
224
      }
 
225
      if {[set parpos [lsearch -exact $tagparams "point-size"]]!=-1} {
 
226
       set f_size [string trim [lindex $tagparams [incr parpos]]]
 
227
       if {[string index $f_size 0]=="+" || [string index $f_size 0]=="-"} {
 
228
        set f_size [expr "$fontsize $f_size"]
 
229
       }
 
230
       if {$f_style!=""} {append f_style "; "}
 
231
       append f_style "font-size: ${f_size}pt"
 
232
       set tagparams [lreplace $tagparams [expr {$parpos - 1}] $parpos]
 
233
      }
 
234
      if {$f_style!=""} {
 
235
       lappend tagparams "style" $f_style
 
236
       set tag $tagname
 
237
       foreach {tagparname tagparvalue} $tagparams {
 
238
        append tag " $tagparname=\"$tagparvalue\""
 
239
       }
 
240
      }
 
241
    }
 
242
   }
 
243
   append text "<$tag>"
 
244
  }
 
245
  append text $_text
 
246
  
 
247
  set ttl $data($topic,title)
 
248
  puts $fout "<h2 align=center>[string map {{&} {&amp;} {>} {&gt;} {<} {&lt;}} $ttl]</h2>\n$text\n</body>\n</html>"
 
249
  ::close $fout
 
250
 }
 
251
 
 
252
 set count 0
 
253
 set total [llength [array names data "*,image"]]
 
254
 set stat "Generating images..."
 
255
 update idletasks
 
256
 foreach im [array names data "*,image"] {
 
257
  if {$im=="__@LoGo@__,image"} {continue}
 
258
  incr count
 
259
  set parfname [string range $im 0 [expr {[string length $im] - 7}]]
 
260
  if {![string match "*.gif" $parfname]} {
 
261
   append parfname ".gif"
 
262
  }
 
263
  set stat "Generating images...  $count of $total  \"$parfname\""
 
264
  update idletasks
 
265
  if {[catch {$data($im) write [file join $dir $parfname] -format GIF}]} {
 
266
   if {[set dt [$data($im) cget -file]]!=""} {
 
267
    file copy -force -- $dt [file join $dir $parfname]
 
268
   } elseif {[set dt [$data($im) cget -data]]!=""} {
 
269
    if {[catch {set fout [::open [file join $dir $parfname] "w"]}]!=0} {
 
270
     error "Can't open output file:\n[file join $dir $parfname]"
 
271
     continue
 
272
    }
 
273
    catch {fconfigure $fout -eofchar "" -buffersize 32768 -buffering full -translation binary}
 
274
    puts -nonewline $fout [help2html:decode_base64 $dt]
 
275
    ::close $fout
 
276
   }
 
277
  }
 
278
 }
 
279
 set stat "Done."
 
280
}
 
281
 
 
282
# Initialization
 
283
rename "userinit" "help_2htm:userinit"
 
284
proc userinit {w} {
 
285
 $w.menuX add command -label "Save as HTML files..." -command "help::help2html"
 
286
 help_2htm:userinit $w
 
287
}
 
288
rename "rightclickX" "help_2htm:rightclickX"
 
289
proc rightclickX {x y} {
 
290
 variable gw
 
291
 variable index
 
292
 $gw.menuX entryconfigure "Save as HTML files..." -state [expr [llength $index]?"normal":"disabled"]
 
293
 help_2htm:rightclickX $x $y
 
294
}
 
295
 
 
296
}; #source