src/wordview.tcl

   1 # -* wish *-
   2 # fallback which allows me to run wordview.tcl without doing make
   3 package require Tcl 8.3
   4
   5 if ![info exist charset_lib] {
   6   set charset_lib /usr/local/lib/catdoc
   7 }
   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
  20 menu .mainmenu
  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
  25 $m add separator
  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
  30 $m add separator
  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
  37 #
  38 # build charset menu
  39 #
  40
  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
  47 }
  48
  49 set in_charset Default
  50
  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}
  56 $m add separator
  57 $m add command -label "About..." -command AboutDialog
  58
  59
  60
  61 text .text -width 80 -height 25  -xscrollcommand ".xs set" \
  62     -yscrollcommand ".ys set"   -wrap word \
  63      -spacing3 2m
  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
  75 grid .text .ys
  76 grid .xs x
  77 grid .text -sticky news
  78 grid .xs -sticky we
  79 grid .ys -sticky ns
  80 grid columnconfigure . 0 -weight 1
  81 grid columnconfigure . 1 -weight 0
  82 grid rowconfigure . 0 -weight 1
  83 grid rowconfigure . 1 -weight 0
  84
  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]} {
  90         set FindCase ""
  91 }
  92
  93
  94 proc show_help {page} {
  95         global argv0
  96         if [winfo exists .man] {
  97                 wm deiconify .man
  98                 raise .man
  99                 .man.text delete 0.0 end
 100         } else {
 101                 toplevel .man -class Man
 102                 wm title .man "[file tail $argv0] help: $page"
 103                 menu .man.menu
 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
 112         }
 113         .man.text insert end [exec man $page 2>/dev/null | col -b ]
 114 }
 115
 116 proc load_file {{name {}}} {
 117 global filename
 118 if ![string length $name] {set name [tk_getOpenFile -filetypes {
 119 {{Msword files} .doc}
 120 {{RTF files} .rtf}
 121 {{MS Write files} .wri}
 122 {{All files} *}} ]}
 123 if ![string length $name] return
 124 if ![file readable $name] {
 125   return -code error "Cannot open file $name"
 126 }
 127 set filename $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
 132 reread
 133 }
 134
 135 proc make_opt {var flag} {
 136   upvar #0 $var charset
 137   switch $charset {
 138         "Default" {return ""}
 139         "unicode" {return "-u"}
 140         default {return "$flag $charset"}
 141   }
 142 }
 143 proc reread {args} {
 144 global filename in_charset out_charset
 145
 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
 150 .text delete 0.0 end
 151 .text insert 0.0 [read $f] doc
 152 .text mark set insert 1.0
 153 .text configure -state disabled
 154 .text see 1.0
 155 if [catch {close $f} msg] {
 156  tk_messageBox -icon error -title error -message $msg -type ok
 157  return
 158 }
 159 }
 160 proc write_file {{name {}}} {
 161     global filename
 162     if ![string length $name] {
 163        set name [tk_getSaveFile -filetypes {
 164       {{Text files} .txt}
 165       {{LaTeX files} .tex}}]
 166     }
 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]
 171     } else {
 172        eval exec catdoc [make_opt in_charset -s] [make_opt out_charset -d]\
 173                 [list $filename]  > [list $name]
 174     }
 175 }
 176 # -postcommand for Edit menu
 177 proc EditEnable {} {
 178 if [llength [.text tag ranges sel]] {
 179   .mainmenu.edit entryconfigure Copy -state normal
 180 } else {
 181   .mainmenu.edit entryconfigure Copy -state disabled
 182 }
 183 }
 184 proc CopySel {} {
 185 clipboard clear
 186 clipboard append -- [.text get sel.first sel.last]
 187 }
 188 proc FindDialog {} {
 189 make_transient .find "Find"
 190 frame .find.top
 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
 195 FindOptionFrame
 196 frame .find.b
 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
 202 pack .find.b
 203 focus .find.top.e
 204 }
 205 proc EnableSearch {} {
 206 global FindPattern ReplaceString
 207 if ![info exists FindPattern] {
 208   .mainmenu.search entryconfigure "Find Again" -state disabled
 209 } else {
 210   .mainmenu.search entryconfigure "Find Again" -state normal
 211 }
 212 }
 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}
 217 toplevel $wpath
 218 wm transient $wpath .
 219 wm positionfrom $wpath program
 220 wm geometry $wpath +$x+$y
 221 wm title  $wpath $title
 222 }
 223 proc FindOptionFrame {} {
 224 frame .find.opt
 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 {}\
 230   -text "Ignore case"
 231 pack .find.opt.dir .find.opt.regex .find.opt.case -side left
 232 }
 233 proc DoFind {{quiet 0}} {
 234 global FindPattern FindMode FindDir FindCase
 235 if ![string length $FindPattern] {return 0}
 236 if {$FindMode=="-backwords"} {
 237     set stopindex 0.0
 238 } else {
 239   set stopindex end
 240 }
 241 set index [eval ".text search $FindCase $FindMode $FindDir -- \
 242   [list $FindPattern] insert $stopindex"]
 243 if ![string length $index] {
 244   if !$quiet {
 245    tk_messageBox -type ok -title "Not found" -message "Pattern not found"
 246   }
 247  return 0
 248 } else {
 249 .text tag remove sel 0.0 end
 250 if {$FindMode=="-exact"} {
 251 .text tag add sel $index "$index + [string length $FindPattern] chars"
 252 } else {
 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"
 256 }
 257 .text mark set insert sel.last
 258 .text see $index
 259 .text see insert
 260 focus .text
 261 return 1
 262 }
 263 }
 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
 274 }
 275 if [llength $argv] {
 276  if {![file exist [lindex $argv 0]]} {
 277     puts stderr "No such file: [lindex $argv 0]"
 278     exit 1
 279  }
 280 load_file [lindex $argv 0]
 281 }
 282 focus .text