dillo-config

   1 #!/bin/sh
   2 # Find wish, even though the path is unknown, and run it on this script. \
   3 exec wish "$0" "$@"
   4
   5 # Dillo configuration script, by Bob Thomson (rjt@ee.ed.ac.uk).
   6
   7 # The settings are kept in the global array called $prefs[].
   8 # It is indexed by key name.
   9
  10 # use the file in the home directory, or in /etc ??
  11 proc find_source_file {} {
  12
  13 }
  14
  15 # this make some of the more awkward options into a convenient form
  16 proc unpack_options {} {
  17     global prefs width height colours
  18     regexp {([0-9]+)[xX]([0-9]+)} $prefs(geometry) ignore width height
  19
  20     # tcl/tk doesn't like C-style colours
  21     foreach c {link_color visited_color bg_color text_color} {
  22         regsub {0[xX]} $prefs($c) \# colours($c)
  23     }
  24 }
  25
  26 # the reverse of unpack_options
  27 proc pack_options {} {
  28     global prefs width height colours
  29     set prefs(geometry) ${width}x${height}
  30
  31     # dillo doesn't like tcl/tk-style colours
  32     foreach c {link_color visited_color bg_color text_color} {
  33         regsub \# $colours($c) "0x" prefs($c)
  34     }
  35 }
  36
  37 # update the display for new settings
  38 proc refresh {} {
  39     global colours
  40     .entries.b18 configure -bg $colours(link_color) \
  41         -activebackground $colours(link_color)
  42     .entries.b19 configure -bg $colours(visited_color) \
  43         -activebackground $colours(visited_color)
  44     .entries.b20 configure -bg $colours(text_color) \
  45         -activebackground $colours(text_color)
  46     .entries.b21 configure -bg $colours(bg_color) \
  47         -activebackground $colours(bg_color)
  48 }
  49
  50 # set everything to reasonable values
  51 proc load_defaults {} {
  52     global prefs
  53     # these values must be the same as the defaults that dillo uses
  54     array set prefs {
  55         geometry 640x550
  56         use_dicache NO
  57         font_factor 1.0
  58         use_oblique NO
  59         show_alt NO
  60         limit_text_width NO
  61         home "http://dillo.sourceforge.net/"
  62         http_proxy ""
  63         no_proxy ""
  64         bg_color 0xd6d6c0
  65         text_color 0x000000
  66         link_color 0x0000ff
  67         visited_color 0x800080
  68         allow_white_bg NO
  69         force_my_colors NO
  70         force_visited_color NO
  71         panel_size tiny
  72         small_icons NO
  73         show_back YES
  74         show_forw YES
  75         show_home YES
  76         show_reload YES
  77         show_save YES
  78         show_stop YES
  79         show_menubar YES
  80         show_clear_url YES
  81         show_url YES
  82         show_progress_box YES
  83         transient_dialogs NO
  84     }
  85     unpack_options
  86 }
  87
  88 # read from file f, which must be readable
  89 proc read_a_file {f} {
  90     global prefs
  91     set fh [open $f "r"]
  92     while {![eof $fh]} {
  93         gets $fh line
  94         # this next line skips comments, and finds options
  95         if {![regexp {^[ \t]*\#} $line]
  96                 && [regexp {([^= \t]+)[ \t]*=[ \t]*(.+)} $line ignore a b]} {
  97             set prefs($a) $b
  98         }
  99     }
 100     close $fh
 101 }
 102
 103 proc read_prefs {} {
 104     global prefs oldprefs
 105     # this next line makes sure all parameters are set, if not in the file
 106     load_defaults
 107     if {[file exists "~/.dillo/dillorc"]
 108         &&[file readable "~/.dillo/dillorc"]} {
 109         read_a_file "~/.dillo/dillorc"
 110     } else {
 111         # read /etc/dillorc if no per-user config file
 112         if {[file exists "/etc/dillorc"]
 113             &&[file readable "/etc/dillorc"]} {
 114             read_a_file "/etc/dillorc"
 115         }
 116     }
 117     unpack_options
 118     array set oldprefs [array get prefs]
 119 }
 120
 121 proc write_prefs {} {
 122     global prefs oldprefs
 123     pack_options
 124
 125     # create the config dir?
 126     if {[file exists "~/.dillo"] == 0} {
 127         file mkdir "~/.dillo"
 128     }
 129
 130     if {![file exists "~/.dillo/dillorc"]
 131         || [file writable "~/.dillo/dillorc"]} {
 132         set fh [open "~/.dillo/dillorc" "w"]
 133         set keys [array names prefs]
 134         foreach k $keys {
 135             # only write the line if there is a value
 136             if {[regexp {[^ \t]} $prefs($k)]} {
 137                 puts $fh ${k}=$prefs($k)
 138             }
 139         }
 140         close $fh
 141     } else {
 142         tk_dialog .broken "ERROR" \
 143             "The dillo configuration file \"~/.dillo/dillorc\" is unwritable!"\
 144             "" 0 "OK"
 145     }
 146     array set oldprefs [array get prefs]
 147 }
 148
 149 # leave, possibly popping up a dialogue asking whether or not to save
 150 proc quit_save {} {
 151     global prefs oldprefs
 152     pack_options
 153
 154     set modified 0
 155     foreach {k v} [array get prefs] {
 156         if {$v != $oldprefs($k)} {
 157             set modified 1
 158             break
 159         }
 160     }
 161
 162     if {$modified} {
 163         set button [tk_dialog .savepopup "SAVE?" \
 164                         "Save changes before quitting?"\
 165                         "" 0 "Yes" "No" "Cancel"]
 166         if {$button == 0} write_prefs
 167         if {$button == 0 || $button == 1} exit
 168     } else {
 169         exit
 170     }
 171 }
 172
 173 # construct the top-level window
 174 proc build_window {} {
 175     global prefs colours
 176     frame .entries
 177     frame .urls
 178     frame .boxes
 179     frame .buttons
 180
 181     label .entries.l1 -text "Window width"
 182     entry .entries.e1 -textvariable width -width 5 \
 183         -validate key -vcmd {string is integer %P}
 184     label .entries.l2 -text "Window height"
 185     entry .entries.e2 -textvariable height -width 5 \
 186         -validate key -vcmd {string is integer %P}
 187     label .entries.l3 -text "Font scale factor"
 188     entry .entries.e3 -textvariable prefs(font_factor) -width 5 \
 189         -validate key -vcmd {string is double %P}
 190     checkbutton .boxes.c4 -text "Use oblique fonts" -onvalue YES -offvalue NO \
 191             -variable prefs(use_oblique)
 192     checkbutton .boxes.c5 -text "Pop-up text for images" -onvalue YES \
 193         -offvalue NO -variable prefs(show_alt)
 194     label .urls.l6 -text "Home page URL"
 195     entry .urls.e4 -textvariable prefs(home) -width 64
 196     checkbutton .boxes.c7 -text "Allow white backgrounds" -onvalue YES \
 197         -offvalue NO -variable prefs(allow_white_bg)
 198     checkbutton .boxes.c8 -text "Show \"back\" button" -onvalue YES \
 199         -offvalue NO -variable prefs(show_back)
 200     checkbutton .boxes.c9 -text "Show \"forward\" button" -onvalue YES \
 201         -offvalue NO -variable prefs(show_forw)
 202     checkbutton .boxes.c10 -text "Show \"home\" button" -onvalue YES \
 203         -offvalue NO -variable prefs(show_home)
 204     checkbutton .boxes.c11 -text "Show \"reload\" button" -onvalue YES \
 205         -offvalue NO -variable prefs(show_reload)
 206     checkbutton .boxes.c12 -text "Show \"save\" button" -onvalue YES \
 207         -offvalue NO -variable prefs(show_save)
 208     checkbutton .boxes.c13 -text "Show \"stop\" button" -onvalue YES \
 209         -offvalue NO -variable prefs(show_stop)
 210     checkbutton .boxes.c14 -text "Show menu bar" -onvalue YES -offvalue NO \
 211             -variable prefs(show_menubar)
 212     checkbutton .boxes.c15 -text "Show URL bar" -onvalue YES -offvalue NO \
 213             -variable prefs(show_url)
 214     checkbutton .boxes.c16 -text "Show progress box" -onvalue YES \
 215         -offvalue NO -variable prefs(show_progress_box)
 216     checkbutton .boxes.c17 -text "Always use default colours" -onvalue YES \
 217         -offvalue NO -variable prefs(force_my_colors)
 218     checkbutton .boxes.c23 -text "Override visited link colours" -onvalue YES \
 219         -offvalue NO -variable prefs(force_visited_color)
 220     checkbutton .boxes.c18 -text "Use small icons" -onvalue YES -offvalue NO \
 221             -variable prefs(small_icons)
 222     checkbutton .boxes.c19 -text "Limit the width of text" -onvalue YES \
 223         -offvalue NO -variable prefs(limit_text_width)
 224     checkbutton .boxes.c20 -text "Cache decompressed images" -onvalue YES \
 225         -offvalue NO -variable prefs(use_dicache)
 226     checkbutton .boxes.c21 -text "Show clear URL button" -onvalue YES \
 227         -offvalue NO -variable prefs(show_clear_url)
 228     checkbutton .boxes.c22 -text "Allow transient dialogs" -onvalue YES \
 229         -offvalue NO -variable prefs(transient_dialogs)
 230     label .entries.l29 -text "Panel size"
 231     tk_optionMenu .entries.o1 prefs(panel_size) tiny medium large
 232     label .entries.l22 -text "Link colour"
 233     # note that named colours work in tcl/tk; eg. "blue" will not break this
 234     button .entries.b18 -bg $colours(link_color) \
 235         -activebackground $colours(link_color) \
 236         -command {
 237             set c [tk_chooseColor -initialcolor $colours(link_color) \
 238                        -title "Set link colour"]
 239             if {$c != ""} {
 240                 set colours(link_color) $c
 241                 .entries.b18 configure -bg $c -activebackground $c
 242             }
 243         }
 244     label .entries.l23 -text "Visited link colour"
 245     button .entries.b19 -bg $colours(visited_color) -activebackground \
 246         $colours(visited_color) \
 247         -command {
 248             set c [tk_chooseColor -initialcolor $colours(visited_color) \
 249                        -title "Set visited link colour"]
 250             if {$c != ""} {
 251                 set colours(visited_color) $c
 252                 .entries.b19 configure -bg $c -activebackground $c
 253             }
 254         }
 255     label .entries.l24 -text "Text colour"
 256     button .entries.b20 -bg $colours(text_color) \
 257         -activebackground $colours(text_color) \
 258         -command {
 259             set c [tk_chooseColor -initialcolor $colours(text_color) \
 260                        -title "Set text colour"]
 261             if {$c != ""} {
 262                 set colours(text_color) $c
 263                 .entries.b20 configure -bg $c -activebackground $c
 264             }
 265         }
 266     label .entries.l25 -text "Background colour"
 267     button .entries.b21 -bg $colours(bg_color) \
 268         -activebackground $colours(bg_color) \
 269         -command {
 270             set c [tk_chooseColor -initialcolor $colours(bg_color) \
 271                        -title "Set background colour"]
 272             if {$c != ""} {
 273                 set colours(bg_color) $c
 274                 .entries.b21 configure -bg $c -activebackground $c
 275             }
 276         }
 277     label .urls.l26 -text "Proxy URL"
 278     entry .urls.e27 -textvariable prefs(http_proxy) -width 64
 279     label .urls.l28 -text "Unproxied domain"
 280     entry .urls.e29 -textvariable prefs(no_proxy) -width 64
 281
 282     button .buttons.b1 -text "Use defaults" -command {
 283         load_defaults
 284         refresh
 285     }
 286     button .buttons.b2 -text "Reload" -command {
 287         read_prefs
 288         refresh
 289     }
 290     button .buttons.b3 -text "Save" -command write_prefs
 291     button .buttons.b4 -text "Quit" -command quit_save
 292
 293     grid .buttons.b1 -row 0 -column 1
 294     grid .buttons.b2 -row 0 -column 2
 295     grid .buttons.b3 -row 0 -column 3
 296     grid .buttons.b4 -row 0 -column 4
 297
 298     grid .boxes.c8 -row 0 -column 0 -sticky w
 299     grid .boxes.c9 -row 1 -column 0 -sticky w
 300     grid .boxes.c10 -row 2 -column 0 -sticky w
 301     grid .boxes.c11 -row 3 -column 0 -sticky w
 302     grid .boxes.c12 -row 4 -column 0 -sticky w
 303     grid .boxes.c13 -row 5 -column 0 -sticky w
 304     grid .boxes.c14 -row 6 -column 0 -sticky w
 305     grid .boxes.c15 -row 7 -column 0 -sticky w
 306     grid .boxes.c21 -row 8 -column 0 -sticky w
 307     grid .boxes.c16 -row 9 -column 0 -sticky w
 308     grid .boxes.c4 -row 0 -column 1 -sticky w
 309     grid .boxes.c5 -row 1 -column 1 -sticky w
 310     grid .boxes.c7 -row 2 -column 1 -sticky w
 311     grid .boxes.c17 -row 3 -column 1 -sticky w
 312     grid .boxes.c23 -row 4 -column 1 -sticky w
 313     grid .boxes.c18 -row 5 -column 1 -sticky w
 314     grid .boxes.c22 -row 6 -column 1 -sticky w
 315     grid .boxes.c19 -row 7 -column 1 -sticky w
 316     grid .boxes.c20 -row 8 -column 1 -sticky w
 317
 318     grid .entries.l1 -row 0 -column 0 -sticky e
 319     grid .entries.e1 -row 0 -column 1 -sticky w
 320     grid .entries.l2 -row 1 -column 0 -sticky e
 321     grid .entries.e2 -row 1 -column 1 -sticky w
 322     grid .entries.l3 -row 2 -column 0 -sticky e
 323     grid .entries.e3 -row 2 -column 1 -sticky w
 324     grid .entries.l22 -row 3 -column 0 -sticky e
 325     grid .entries.b18 -row 3 -column 1 -sticky w
 326     grid .entries.l23 -row 4 -column 0 -sticky e
 327     grid .entries.b19 -row 4 -column 1 -sticky w
 328     grid .entries.l24 -row 5 -column 0 -sticky e
 329     grid .entries.b20 -row 5 -column 1 -sticky w
 330     grid .entries.l25 -row 6 -column 0 -sticky e
 331     grid .entries.b21 -row 6 -column 1 -sticky w
 332     grid .entries.l29 -row 7 -column 0 -sticky e
 333     grid .entries.o1 -row 7 -column 1 -sticky w
 334
 335     grid .urls.l6 -row 0 -column 0 -sticky e
 336     grid .urls.e4 -row 0 -column 1 -sticky "ew"
 337     grid .urls.l26 -row 1 -column 0 -sticky e
 338     grid .urls.e27 -row 1 -column 1 -sticky "ew"
 339     grid .urls.l28 -row 2 -column 0 -sticky e
 340     grid .urls.e29 -row 2 -column 1 -sticky "ew"
 341
 342     grid .buttons -row 2 -column 0 -columnspan 2 -sticky "ew"
 343     grid .urls -row 1 -column 0 -columnspan 2 -sticky "ew"
 344     grid .boxes -row 0 -column 1 -sticky e
 345     grid .entries -row 0 -column 0 -sticky w
 346 #    pack .buttons -side bottom -fill x -expand 1
 347 #    pack .urls -side bottom -fill x -expand 1
 348 #    pack .boxes -side left
 349 #    pack .entries -side right
 350
 351 }
 352
 353 read_prefs
 354 build_window