pfm 2.0.8-1 / usr / share / pfm / options.tcl

# options.tcl


class PfmOptions {
	protected common optionStructure {
				general {browser tmpdir printcmd printencoding theme}
				postgresql {psql dblist dbname host port user usePGPASSWORD}
				geometry {main sql form text}
				}
	protected variable optionDict
	protected variable optionArray
	protected variable window

	constructor {} {
		set optionDict {}
		dict for {type list} $optionStructure {
			set subDict {}
			foreach option $list {
				dict append subDict $option {}
			}
			dict append optionDict $type $subDict
		}
		return
	}

	destructor {
		return
	}

	public method initOptions {} {
		global env
		global tcl_platform

		if {$tcl_platform(platform) eq {windows}} then {
			set filename [file join $env(APPDATA) pfm pfm2.conf]
		} else {
			set filename "~/.pfm2"
		}
		if {[file exists $filename]} then {
			set chan [open $filename r]
			set fileDict [chan read -nonewline $chan]
			chan close $chan
		} else {
			set fileDict {}
		}
		dict for {type list} $optionStructure {
			foreach option $list {
				if {[dict exists $fileDict $type $option]} then {
					dict set optionDict $type $option \
						[dict get $fileDict $type $option]
				} else {
					dict set optionDict $type $option \
						[getDefault $type $option]
				}
			}
		}
		saveOptions
		return
	}

	public method saveOptions {} {
		global env
		global tcl_platform

		if {$tcl_platform(platform) eq {windows}} then {
			set filename [file join $env(APPDATA) pfm pfm2.conf]
			set dirname [file join $env(APPDATA) pfm]
			if {![file exists $dirname]} then {
			file mkdir $dirname
			}
		} else {
			set filename "~/.pfm2"
		}
		set chan [open $filename w]
		chan puts $chan $optionDict
		chan close $chan
		return
	}

	public method getDefault {type option} {
		switch $type {
			general {
				set value [getGeneralDefault $option]
			}
			postgresql {
				set value [getPostgresqlDefault $option]
			}
			geometry {
				set value [getGeometryDefault $option]
			}
			default {
				set value {}
			}
		}
		return $value
	}

	protected method getGeneralDefault {option} {
		global env
		global tcl_platform
		variable ::config::defaultBrowser
		variable ::config::defaultPrintcmd

		switch -- $option {
			"browser" {
				switch -- $tcl_platform(platform) {
					"unix" {
						set value $defaultBrowser
					}
					"windows" {
						if {[info exists env(ProgramFiles)]} then {
							set iexplorer \
								[file normalize [file join $env(ProgramFiles) \
								 {Internet Explorer} \
								 {iexplore.exe}]]
							set value [list $iexplorer %s]
						} else {
							set value {iexplore.exe %s}
						}
					}
					default {
						set value {}
					}
				}
			}
			"printcmd" {
				switch -- $tcl_platform(platform) {
					"unix" {
						set value $defaultPrintcmd
					}
					"windows" {
						if {[info exists env(ProgramFiles)]} then {
							set wordpad \
							[file normalize [file join $env(ProgramFiles) \
								 {Windows NT} \
								 {Bureau-accessoires} \
								 {wordpad.exe}]]
							set value [list [list $wordpad %txt]]
						} else {
							set value [list [list wordpad.exe %txt]]
						}
					}
				}
			}
			"printencoding" {
				set value [encoding system]
			}
			"tmpdir" {
				switch -- $tcl_platform(platform) {
					"unix" {
						set value {/tmp}
					}
					"windows" {
						if {[info exists env(TEMP)]} then {
							set value [file normalize $env(TEMP)]
						} else {
							set value [file normalize "~/tmp"]
						}
					}
					default {
						set value {}
					}
				}
			}
			"theme" {
				switch -- $tcl_platform(platform) {
					"unix" {
						set value default
					}
					"windows" {
						set value xpnative
					}
					default {
						set value default
					}
				}
			}
			default {
				set value {}
			}
		}
		return $value
	}

	protected method getGeometryDefault {option} {
		switch $option {
			main {
				set value {400 300}
			}
			sql {
				set value {600 700}
			}
			form {
				set value {640 480}
			}
			text {
				set value {600 400}
			}
			default {
				set value {600 400}
			}
		}
		return $value
	}

	public method getOption {type option} {
		return [dict get $optionDict $type $option]
	}

	public method setOption {type option newValue} {
		dict set optionDict $type $option $newValue
		return
	}

	public method editOptions {} {
		foreach type {general postgresql} {
			foreach option [dict get $optionStructure $type] {
				set optionArray($type,$option) [dict get $optionDict $type $option]
			}
		}
		set window [toplevel ".opt[namespace tail $this]"]
		wm transient $window {.}
		wm title $window [mc optionsTitle]
		set noteBook [ttk::notebook ${window}.nb -takefocus 0]
		set fGeneral [setupGeneral ${noteBook}.general]
		set fPostgresql [setupPostgresql ${noteBook}.postgresql]
		addNotebookTab $noteBook $fGeneral optTabGeneral
		addNotebookTab $noteBook $fPostgresql optTabPostgresql
		ttk::notebook::enableTraversal $noteBook
		pack $noteBook -side top -expand 1 -fill both
		set frmButtons [ttk::frame ${window}.frmbtns]
		set btnOK [defineButton ${frmButtons}.btnok $window btnOK \
			[list $this onOK]]
		set btnCancel [defineButton ${frmButtons}.btncancel $window \
			btnCancel [list destroy $window]]
		pack $btnCancel -side right
		pack $btnOK -side right
		pack $frmButtons -side top -fill x -pady {10 10} -padx {10 10}
		bindToplevelOnly $window <Destroy> [list $this onDestroyWindow]
		bind $window <KeyPress-Down> {focus [tk_focusNext [focus]]}
		bind $window <KeyPress-Up> {focus [tk_focusPrev [focus]]}
		bind $window <KeyPress-Escape> [list destroy $window]
		return
	}

	protected method setupGeneral {pathname} {
		set frm [ttk::frame $pathname]
		set idx 0
		foreach option [dict get $optionStructure general] {
			set lbl [ttk::label ${frm}.lb$idx -text $option]
			grid $lbl -column 0 -row $idx -sticky w
			switch -- $option {
				printencoding {
					set control [ttk::combobox ${frm}.con$idx \
						-textvariable [scope optionArray(general,$option)] \
						-values [lsort [encoding names]]]
					$control configure -state readonly
				}
				theme {
					set control [ttk::combobox ${frm}.con$idx \
						-textvariable [scope optionArray(general,$option)] \
						-values [ttk::style theme names]]
					$control configure -state readonly
				}
				default {
					set control [entry ${frm}.con$idx \
						-textvariable [scope optionArray(general,$option)]]
				}
			}
			if {$option in {tmpdir}} then {
				set btnSelect [defineButton ${frm}.sel$idx $control \
					btnSelect [list $this onSelect general $option]]
				$btnSelect configure -style SButton
				grid $control -column 1 -row $idx -sticky wens
				grid $btnSelect -column 2 -row $idx -sticky we
				$control configure -state {readonly}
			} else {
				grid $control -column 1 -columnspan 2 -row $idx \
					-sticky wens
			}
			set btnExpand [defineButton ${frm}.exp$idx $control \
				btnExpand [list $this onExpand general $option]]
			$btnExpand configure -style SButton
			grid $btnExpand -column 3 -row $idx -sticky we
			set btnDefault [defineButton ${frm}.def$idx $control \
				btnDefault [list $this onDefault general $option]]
			$btnDefault configure -style SButton
			grid $btnDefault -column 4 -row $idx -sticky we
			set btnHelp [defineButton ${frm}.help$idx $control \
				btnHelp [list $this onHelp general $option]]
			$btnHelp configure -style SButton
			grid $btnHelp -column 5 -row $idx -sticky we
			incr idx
		}
		grid columnconfigure $frm 1 -weight 1
		grid anchor $frm center
		return $frm
	}

	protected method setupPostgresql {pathname} {
		set frm [ttk::frame $pathname]
		set idx 0
		foreach option [dict get $optionStructure postgresql] {
			set lbl [ttk::label ${frm}.lb$idx -text $option]
			grid $lbl -column 0 -row $idx -sticky w
			switch -- $option {
				usePGPASSWORD {
					set control [ttk::checkbutton ${frm}.con$idx \
						-text {} \
						-variable [scope optionArray(postgresql,$option)] \
						-onvalue 1 -offvalue 0]
				}
				default {
					set control [entry ${frm}.con$idx \
						-textvariable [scope optionArray(postgresql,$option)]]
				}
			}
			if {$option in {psql}} then {
				set btnSelect [defineButton ${frm}.sel$idx $control \
					btnSelect [list $this onSelect postgresql $option]]
				$btnSelect configure -style SButton
				grid $control -column 1 -row $idx -sticky wens
				grid $btnSelect -column 2 -row $idx -sticky we
				$control configure -state {readonly}
			} else {
				grid $control -column 1 -columnspan 2 -row $idx \
					-sticky wens
			}
			set btnExpand [defineButton ${frm}.exp$idx $control \
				btnExpand [list $this onExpand postgresql $option]]
			$btnExpand configure -style SButton
			grid $btnExpand -column 3 -row $idx -sticky we
			set btnDefault [defineButton ${frm}.def$idx $control \
				btnDefault [list $this onDefault postgresql $option]]
			$btnDefault configure -style SButton
			grid $btnDefault -column 4 -row $idx -sticky we
			set btnHelp [defineButton ${frm}.help$idx $control \
				btnHelp [list $this onHelp postgresql $option]]
			$btnHelp configure -style SButton
			grid $btnHelp -column 5 -row $idx -sticky we
			incr idx
		}
		grid columnconfigure $frm 1 -weight 1
		grid anchor $frm center
		return $frm
	}

	public method onOK {} {
		foreach type {general postgresql} {
			foreach option [dict get $optionStructure $type] {
				dict set optionDict $type $option $optionArray($type,$option)
			}
		}
		saveOptions
		destroy $window
		installTheme [getOption general theme]
		return
	}

	public method onDestroyWindow {} {
		array unset optionArray
		return
	}

	public method onExpand {type option} {
		set textEdit [TextEdit "#auto" $window $option \
			$optionArray($type,$option) 0]
		if {$option in {browser printcmd}} then {
			$textEdit addMenuItem [mc optPasteFilename] command {
				%T insert insert [tk_getOpenFile \
					-parent [winfo toplevel %T]]
			}
		}
		if {[$textEdit wait result]} then {
			set optionArray($type,$option) $result
		}
		return
	}

	public method onDefault {type option} {
		set optionArray($type,$option) [getDefault $type $option]
		return
	}

	public method onHelp {type option} {
		set textEdit [TextEdit "#auto" $window [mc optHelpTitle $option] \
				[mc optHelp_${option}] 1]
		return
	}

	public method onSelect {type option} {
		global env
		global tcl_platform
		switch -- $type {
			general {
				switch -- $option {
					tmpdir {
						set dirname [tk_chooseDirectory \
							-initialdir $optionArray($type,$option) \
							-parent $window]
						if {$dirname ne {}} then {
							set optionArray($type,$option) $dirname
						}
					}
				}
			}
			postgresql {
				switch -- $option {
					psql {
						if {$tcl_platform(platform) eq {windows}} then {
							set filetypes {
								{{Executables} {.exe}}
								{{All files} *}
							}
							set initialdir $env(ProgramFiles)
						} else {
							set filetypes {}
							set initialdir {/usr/bin}
						}
						set psqlLoc [tk_getOpenFile \
							-filetypes $filetypes \
							-initialdir $initialdir \
							-parent $window]
						if {$psqlLoc ne {}} then {
							set optionArray($type,$option) $psqlLoc
						}
					}
				}
			}
		}
		return
	}

}