2 # fallback which allows me to run wordview.tcl without doing make
3 package require Tcl 8.3
5 if ![info exist charset_lib] {
6 set charset_lib /usr/local/lib/catdoc
8 option add *Text.Font {Courier 11} widgetDefault
9 option add *Text.Background white widgetDefault
10 option add *Text.Foreground black widgetDefault
11 option add *Text.selectBackground black widgetDefault
12 option add *Text.selectForeground white widgetDefault
13 option add *Text.findMode exact widgetDefault
14 option add *Text.findCase no widgetDefault
15 option add *Menu.highlightBackground MidnightBlue widgetDefault
16 option add *Menu.highlightThickness 0 widgetDefault
17 option add *Menu.activeBackground MidnightBlue widgetDefault
18 option add *Menu.activeForeground white widgetDefault
19 option add *Menu.activeBorderWidth 0 widgetDefault
21 . configure -menu .mainmenu
22 .mainmenu add cascade -label File -menu [set m [menu .mainmenu.file]] -underline 0
23 $m add command -label Open... -command load_file -accelerator Ctrl-O
24 $m add command -label "Save As..." -command write_file -accelerator Ctrl-S -state disabled
26 $m add command -label Quit -command exit -accelerator Alt-F4
27 set m [menu .mainmenu.edit -postcommand EditEnable]
28 .mainmenu add cascade -label Edit -menu $m -underline 0 -state disabled
29 $m add command -label Copy -command CopySel -accelerator Ctrl-C
31 $m add command -label "Select All" -accelerator Ctrl-A -command \
32 {.text tag add sel 0.0 end}
33 .mainmenu add cascade -label Find -menu .mainmenu.search -underline 1 -state disabled
34 set m [menu .mainmenu.search -postcommand EnableSearch]
35 $m add command -label "Find..." -command FindDialog -accelerator Ctrl-F
36 $m add command -label "Find Again" -accelerator F3 -command DoFind
41 .mainmenu add cascade -state disabled -label Encoding -menu [set m [menu .mainmenu.encoding]]
42 $m add radio -label Default -value Default -var in_charset
43 $m add radio -label unicode -value unicode -var in_charset
44 foreach l [glob [file join $charset_lib *.txt]] {
45 set n [file rootname [file tail $l]]
46 $m add radio -label $n -value $n -var in_charset
49 set in_charset Default
51 trace var in_charset w reread
52 set m [menu .mainmenu.help]
53 .mainmenu add cascade -label Help -menu $m -underline 0
54 $m add command -label "Manual page" -command [list show_help [file tail $argv0]]
55 $m add command -label "Regular expressions" -command {show_help re_syntax}
57 $m add command -label "About..." -command AboutDialog
61 text .text -width 80 -height 25 -xscrollcommand ".xs set" \
62 -yscrollcommand ".ys set" -wrap word \
64 .text tag configure sel -relief flat -borderwidth 0
65 .text tag configure doc -lmargin1 0.2i -lmargin2 0
66 scrollbar .ys -orient vert -command ".text yview"
67 scrollbar .xs -orient horiz -command ".text xview"
68 bind .text <F3> { if [info exists FindPattern] DoFind}
69 bind .text <Control-O> load_file
70 bind .text <Control-o> load_file
71 bind .text <Control-S> {write_file}
72 bind .text <Control-s> {write_file}
73 bind .text <Control-F> FindDialog
74 bind .text <Control-f> FindDialog
77 grid .text -sticky news
80 grid columnconfigure . 0 -weight 1
81 grid columnconfigure . 1 -weight 0
82 grid rowconfigure . 0 -weight 1
83 grid rowconfigure . 1 -weight 0
85 # Find options (All this can be tuned from dialog)
86 set FindMode -[option get .text findMode FindMode] ;# no -regexp for novices
87 set FindDir -forwards ;# Why not -backwards
88 set FindCase -nocase ;# Leave it empty if you want to be case sensitive
89 if {[option get .text findCase FindCase]} {
94 proc show_help {page} {
96 if [winfo exists .man] {
99 .man.text delete 0.0 end
101 toplevel .man -class Man
102 wm title .man "[file tail $argv0] help: $page"
104 .man.menu add cascade -label File -menu [set m [menu .man.menu.file]]
105 .man configure -menu .man.menu
106 $m add command -label Close -command {destroy .man}
107 text .man.text -yscrollcommand {.man.y set}
108 scrollbar .man.y -command {.man.text yview} -orient vert
109 grid .man.text .man.y -sticky news
110 grid columnconfigure .man 0 -weight 1
111 grid columnconfigure .man 1 -weight 0
113 .man.text insert end [exec man $page 2>/dev/null | col -b ]
116 proc load_file {{name {}}} {
118 if ![string length $name] {set name [tk_getOpenFile -filetypes {
119 {{Msword files} .doc}
121 {{MS Write files} .wri}
123 if ![string length $name] return
124 if ![file readable $name] {
125 return -code error "Cannot open file $name"
128 .mainmenu entryconfigure Encoding -state normal
129 .mainmenu.file entryconfigure "Save As..." -state normal
130 .mainmenu entryconfigure "Edit" -state normal
131 .mainmenu entryconfigure "Find" -state normal
135 proc make_opt {var flag} {
136 upvar #0 $var charset
138 "Default" {return ""}
139 "unicode" {return "-u"}
140 default {return "$flag $charset"}
144 global filename in_charset out_charset
146 set inopt [make_opt in_charset -s]
147 set f [open "|catdoc -w $inopt -d utf-8 \"$filename\"" r]
148 fconfigure $f -encoding utf-8
149 .text configure -state normal
151 .text insert 0.0 [read $f] doc
152 .text mark set insert 1.0
153 .text configure -state disabled
155 if [catch {close $f} msg] {
156 tk_messageBox -icon error -title error -message $msg -type ok
160 proc write_file {{name {}}} {
162 if ![string length $name] {
163 set name [tk_getSaveFile -filetypes {
165 {{LaTeX files} .tex}}]
167 if ![string length $name] return
168 if {[file extension $name]==".tex"} {
169 eval exec catdoc -t [make_opt in_charset -s] [make_opt out_charset -d]\
170 [list $filename] > [list $name]
172 eval exec catdoc [make_opt in_charset -s] [make_opt out_charset -d]\
173 [list $filename] > [list $name]
176 # -postcommand for Edit menu
178 if [llength [.text tag ranges sel]] {
179 .mainmenu.edit entryconfigure Copy -state normal
181 .mainmenu.edit entryconfigure Copy -state disabled
186 clipboard append -- [.text get sel.first sel.last]
189 make_transient .find "Find"
191 label .find.top.l -text "Find"
192 entry .find.top.e -width 30 -textvar FindPattern
193 bind .find.top.e <Key-Return> ".find.b.find invoke"
194 pack .find.top.l .find.top.e -side left
197 button .find.b.find -text "Search" -command DoFind
198 button .find.b.close -text "Close" -command "destroy .find"
199 pack .find.b.find .find.b.close -side left -padx 20
200 pack .find.top -pady 5 -anchor w -padx 10
201 pack .find.opt -pady 10
205 proc EnableSearch {} {
206 global FindPattern ReplaceString
207 if ![info exists FindPattern] {
208 .mainmenu.search entryconfigure "Find Again" -state disabled
210 .mainmenu.search entryconfigure "Find Again" -state normal
213 proc make_transient {wpath title} {
214 set x [expr [winfo rootx .]+[winfo width .]/3]
215 set y [expr [winfo rooty .]+[winfo height .]/3]
216 catch {destroy $wpath}
218 wm transient $wpath .
219 wm positionfrom $wpath program
220 wm geometry $wpath +$x+$y
221 wm title $wpath $title
223 proc FindOptionFrame {} {
225 checkbutton .find.opt.dir -variable FindDir -onvalue -backwards\
226 -offvalue -forwards -text Backward
227 checkbutton .find.opt.regex -variable FindMode -onvalue\
228 -regex -offvalue -exact -text RegExp
229 checkbutton .find.opt.case -variable FindCase -onvalue -nocase -offvalue {}\
231 pack .find.opt.dir .find.opt.regex .find.opt.case -side left
233 proc DoFind {{quiet 0}} {
234 global FindPattern FindMode FindDir FindCase
235 if ![string length $FindPattern] {return 0}
236 if {$FindMode=="-backwords"} {
241 set index [eval ".text search $FindCase $FindMode $FindDir -- \
242 [list $FindPattern] insert $stopindex"]
243 if ![string length $index] {
245 tk_messageBox -type ok -title "Not found" -message "Pattern not found"
249 .text tag remove sel 0.0 end
250 if {$FindMode=="-exact"} {
251 .text tag add sel $index "$index + [string length $FindPattern] chars"
253 eval "regexp $FindCase --" [list $FindPattern [.text get "$index linestart"\
254 "$index lineend"] match]
255 .text tag add sel $index "$index + [string length $match] chars"
257 .text mark set insert sel.last
264 proc AboutDialog {} {
265 make_transient .about "About WordView"
266 message .about.m -aspect 250 -text "MS-Word viewer for UNIX
267 Copyright (c) by Victor B. Wagner 1997-98
268 This program is distributed under
269 GNU General Public License Version 2 or above
270 Check http://www.gnu.org/copyleft/gpl.html for copying
271 and warranty conditions" -justify center
272 button .about.ok -text Ok -command {destroy .about}
273 pack .about.m .about.ok
276 if {![file exist [lindex $argv 0]]} {
277 puts stderr "No such file: [lindex $argv 0]"
280 load_file [lindex $argv 0]