aftcllib.tcl

一套客户/服务器模式的备份系统代码,跨平台,支持linux,AIX, IRIX, FreeBSD, Digital Unix (OSF1), Solaris and HP-UX.

  }
  $widget yview $p
}

#
# internal callback
proc CDIC_completeSelection { item list widget } {
  set l [ llength $list ]
  set sl [ string length $item ]
  set retitem $item

  incr sl -1
  for { set i 0 } { $i < $l } { incr i } {
    set element [ lindex [ lindex $list $i ] 0 ]
    if { [ string range $element 0 $sl] == $item } {
      set retitem $element
      break
    }
  }

  CDIC_showInsPos $list $item $widget

  return $retitem
}

#
# internal callback
proc CDIC_helpOnChoiceDialog { } {
  GGUI_genericDialog .help "Help on: Selection entry" "This field allows you to enter an item of the list above. When you hit <Return>, the approprite choice is made, if your input fits an item exactly. Otherwise nothing happens. When you press <Ctrl>-<space>, your input will be completed to the first matching item in the list. If there is none matching, the list is adjusted to the position of the list, where your input could be found, if it existed." "" 0 Ok
}

#
# Display a dialog to make the user select an item
# from the list passed in the 1st arg. The list must contain
# elements each being a combination of the item text to display
# and the value to be returned, e.g.:
# GGUI_selectionDialog { { one 1 } { two 2 } { three 3 } }
# It is that complicated, cause the displayed list will be sorted
# and so an index can be returned or whatever ...
# -1 is returned, if nothing has been selected i.e. Cancel has
# been pressed. The second arg is for the prompt to be displayed
#
proc GGUI_choiceDialog { list prompt { title "Choice" } } {
  global tkPriv GVar_cdicSelectionEntry GVar_cdicNumSelectionItems
  global GVar_cdicSelectionList Conf_listHeight

  set GVar_cdicNumSelectionItems [ llength $list ]
  if { $GVar_cdicNumSelectionItems == 0 } {
    return -5
  }
  if { $GVar_cdicNumSelectionItems == 1 } {
    return [ lindex [ lindex $list 0 ] 1 ]
  }
  set sorted_list [ lsort -command SDIC_compareListElements $list ]
  set GVar_cdicSelectionList $sorted_list
  set tkPriv(sel_marker) -2

  set w .seldialog

  catch { destroy $w }
  toplevel $w -class Dialog
  wm title $w $title
  wm protocol $w WM_DELETE_WINDOW "set tkPriv(sel_marker) -3"
  wm iconname $w $title
#  wm transient $w [ winfo toplevel [ winfo parent $w ] ]
  frame .seldialog.list
  frame .seldialog.entry
  frame .seldialog.cmds
  set scrollb 0
  set height $GVar_cdicNumSelectionItems
  if { $height > $Conf_listHeight } {
    set height $Conf_listHeight
    set scrollb 1
  }
  if { $scrollb } {
    listbox .seldialog.list.listbox -height $height -selectmode single -yscrollcommand ".seldialog.list.scrollbar set"
    scrollbar .seldialog.list.scrollbar -command ".seldialog.list.listbox yview"
  } else {
    listbox .seldialog.list.listbox -height $height -selectmode single
  }
  label .seldialog.entry.label -text $prompt
  entry .seldialog.entry.entry -width 15
  bind .seldialog.entry.entry <Return> { set val [ .seldialog.entry.entry get ] ; set sel [ CDIC_isItemInList $val $GVar_cdicSelectionList ] ; if { $sel >= 0 } { set tkPriv(sel_marker) $sel }}
  bind .seldialog.entry.entry <F1> CDIC_helpOnChoiceDialog
  bind .seldialog.entry.entry <Control-space> { set val [ .seldialog.entry.entry get ] ; .seldialog.entry.entry delete 0 end ; .seldialog.entry.entry insert 0 [ CDIC_completeSelection $val $GVar_cdicSelectionList .seldialog.list.listbox ] }
  button .seldialog.cmds.cancel -text Cancel -command "set tkPriv(sel_marker) -1"

  bind .seldialog.list.listbox <ButtonPress-1> { set tkPriv(sel_marker) sel_to_get }
  if { $scrollb } {
    pack .seldialog.list.listbox .seldialog.list.scrollbar -side left -fill both
    pack .seldialog.list.listbox -expand 1
  } else {
    pack .seldialog.list.listbox -fill both
    pack .seldialog.list.listbox -expand 1
  }
  foreach elem $sorted_list {
    .seldialog.list.listbox insert end [ lindex $elem 0 ]
  }
  pack .seldialog.entry.label .seldialog.entry.entry -side left -fill x
  pack .seldialog.entry.entry -expand 1
  pack .seldialog.cmds.cancel
  pack .seldialog.list .seldialog.entry .seldialog.cmds -side top -fill both

  wm withdraw $w
  GGUI_placeToplevel $w True
  update idletasks
  wm deiconify $w 
  set old_focus [focus]
  set old_grab [ grab current $w]
  if {$old_grab != ""} {
        set grab_status [grab status $old_grab]
  }
  grab $w
  tkwait variable tkPriv(sel_marker)

  if {$old_grab != ""} {
    if {$grabStatus == "global"} {
      grab -global $old_grab
    } else {
      grab $old_grab
    }
  }

  set sel $tkPriv(sel_marker)
  if { $sel == "sel_to_get" } {
    set sel [ .seldialog.list.listbox curselection ]
    if { $sel == "" } {
      set sel -4
    }
  }

  destroy $w

  if { $sel < 0 } {
    return $sel
  }

  return [ lindex [ lindex $sorted_list $sel ] 1 ]
}

#
# help stuff
proc LDIC_helpOnListDialog { name { extended 0 } } {
  set text "This field allows you to enter an element to be added to the list above. Pressing the \n\"^ Add ^\"-button or hitting the Return-key performs the add-function. Selecting elements from the list and pressing the Remove-button removes the selected elements."
  if $extended {
    set text "This field allows you to enter an element to be added to the list on the left side above. Pressing the \n\"^ Add ^\"-button or hitting the Return-key performs the add-function. Selecting elements from the list and pressing the Remove-button removes the selected elements. You can also select elements from the list on the right side and then press \n\"< Add <\", what will copy your selection to the left side. Pressing \"Select all\" selects all elements in the right list."
  }

  GGUI_genericDialog .help "Help on: $name entry" $text "" 0 Ok
}

#
# internal callback
proc LDIC_selectAll { } {
  .seldialog.list.olistbox selection set 0 end
  .seldialog.moves.selall configure -text "Deselect all" -command LDIC_deselectAll
}

#
# internal callback
proc LDIC_deselectAll { } {
  .seldialog.list.olistbox selection clear 0 end
  .seldialog.moves.selall configure -text " Select all  " -command LDIC_selectAll
}

#
# internal callback
proc LDIC_addEntry { newname } {
  set newname [ string trim $newname ]
  set list [ .seldialog.list.listbox get 0 end ]
  if { $newname == "" } return
  set exists 0
  if { [ lsearch -exact $list $newname ] >= 0 } {
    set exists 1
  }
  if { [ llength $newname ] > 1 } {
    GIO_errorMessage "The entry must be a single word"
    return
  }
  set i 0
  foreach sel $list {
    if { $newname < $sel } break
    incr i
  }
  .seldialog.entry.entry delete 0 end
  .seldialog.list.listbox selection clear 0 end
  if { $exists } {
    return
  }
  .seldialog.list.listbox insert $i $newname
}

#
# Prompts the user with a dialog with 1st arg as title, 2nd arg
# as prompt. The 3rd arg is an optional list, that represents
# a preset selection. 4th arg is an optional list containing
# more possible selections offered in an extra list. More items
# to be selected can be typed in. Return value is the list of
# selected items or -- if cancel button pressed or window destroyed
#
proc GGUI_listDialog { title prompt { list "" } { offered_list "" } } {
  global tkPriv

  set sdic_num_selection_items [ llength $list ]
  set sorted_list [ lsort $list ]
  set GVar_sdicSelectionList $sorted_list
  set tkPriv(sel_marker) -2
  if { $offered_list == "" } {
    set extended 0
  } else {
    set extended 1
  }

  set w .seldialog

  catch { destroy $w }
  toplevel $w -class Dialog
  wm title $w $title
  wm protocol $w WM_DELETE_WINDOW "set tkPriv(sel_marker) -3"
  wm iconname $w $title
#  wm transient $w [ winfo toplevel [ winfo parent $w ] ]
  frame .seldialog.labels
  frame .seldialog.list
  frame .seldialog.moves
  frame .seldialog.entry
  frame .seldialog.cmds
  set scrollb 0
  set height 20
  listbox .seldialog.list.listbox -height $height -selectmode multiple -yscrollcommand ".seldialog.list.scrollbar set"
  scrollbar .seldialog.list.scrollbar -command ".seldialog.list.listbox yview"
  button .seldialog.moves.add -text "^  Add  ^" -command { LDIC_addEntry [ .seldialog.entry.entry get ] }
  button .seldialog.moves.remove -text Remove -command {
			set list [ .seldialog.list.listbox curselection ]
			set l [ expr [ llength $list ] - 1 ]
			for { set i $l } { $i >= 0 } { incr i -1 } {
				set sel [ lindex $list $i ]
				.seldialog.list.listbox delete $sel
			}
			.seldialog.list.listbox selection clear 0 end }
  if $extended {
    set offered_list [ lsort $offered_list ]
    label .seldialog.labels.sel -text "Selected items"
    label .seldialog.labels.off -text "Some possible items"
    listbox .seldialog.list.olistbox -height $height -selectmode multiple -yscrollcommand ".seldialog.list.oscrollbar set"
    scrollbar .seldialog.list.oscrollbar -command ".seldialog.list.olistbox yview"
    button .seldialog.moves.move -text "< Add <" -command {
			foreach elem [ .seldialog.list.olistbox curselection ] {
				LDIC_addEntry [ .seldialog.list.olistbox get $elem ]
			}}
    button .seldialog.moves.selall -text " Select all  " -command LDIC_selectAll

    foreach elem $offered_list {
      .seldialog.list.olistbox insert end $elem
    }
  }
  label .seldialog.entry.label -text "$prompt"
  entry .seldialog.entry.entry
  bind .seldialog.entry.entry <F1> "LDIC_helpOnListDialog $prompt $extended"
  bind .seldialog.entry.entry <Return> { LDIC_addEntry [ .seldialog.entry.entry get ] }

  button .seldialog.cmds.cancel -text Cancel -command "set tkPriv(sel_marker) -1"
  button .seldialog.cmds.done -text Done -command "set tkPriv(sel_marker) 0"

  if { ! $extended } {
    pack .seldialog.list.listbox .seldialog.list.scrollbar -side left -fill both
  } else {
    pack .seldialog.list.listbox .seldialog.list.scrollbar .seldialog.list.olistbox .seldialog.list.oscrollbar -side left -fill both
    pack .seldialog.labels.sel .seldialog.labels.off -side left -expand 1
  }
  pack .seldialog.list.listbox -expand 1

  foreach listelem $sorted_list {
    .seldialog.list.listbox insert end $listelem
  }
  if { ! $extended } {
    pack .seldialog.moves.add .seldialog.moves.remove -side left -expand 1
  } else {
    pack .seldialog.moves.add .seldialog.moves.remove .seldialog.moves.move .seldialog.moves.selall -side left -expand 1
  }
  pack .seldialog.entry.label .seldialog.entry.entry -side left
  pack .seldialog.entry.entry -fill x -expand 1
  pack .seldialog.cmds.done .seldialog.cmds.cancel -side left -expand 1
  pack .seldialog.labels .seldialog.list .seldialog.moves .seldialog.entry .seldialog.cmds -side top -fill both -pady 2

  wm withdraw $w
  GGUI_placeToplevel $w 1
  update idletasks
  wm deiconify $w 
  set old_focus [focus]
  set old_grab [ grab current $w]
  if {$old_grab != ""} {
        set grab_status [grab status $old_grab]
  }
  grab $w
  tkwait variable tkPriv(sel_marker)

  if {$old_grab != ""} {
    if {$grabStatus == "global"} {
      grab -global $old_grab
    } else {
      grab $old_grab
    }
  }

  set sel $tkPriv(sel_marker)
  set selection ""
  if { $sel >= 0 } {
    set selection [ .seldialog.list.listbox get 0 end ]
  }

  destroy $w

  if { $sel < 0 } {
    return "--"
  }

  return $selection
}

#
# Pop up dialog with 1st arg as window title for entering a value.
# The entry is preceded by the 2nd arg as prompt. 3rd arg determines
# entry width in characters. 4th arg is the variable the entry value
# is taken from and stored in afterwards. Return value is 0, if ok.
#
proc GGUI_enterDialog { title prompt width val } {
  global tkPriv GVar_edicEntry
  upvar $val value

  set tkPriv(sel_marker) -2

  set w .enterdialog

  catch { destroy $w }
  toplevel $w -class Dialog
  wm title $w $title
  wm protocol $w WM_DELETE_WINDOW "set tkPriv(sel_marker) -3"
  wm iconname $w $title
#  wm transient $w [ winfo toplevel [ winfo parent $w ] ]
  frame .enterdialog.entry
  frame .enterdialog.cmds
  label .enterdialog.entry.label -text $prompt
  entry .enterdialog.entry.entry -width $width
  if { [ info exists value ] } {
    .enterdialog.entry.entry insert end $value
  }
  bind .enterdialog.entry.entry <Return> { set GVar_edicEntry [ .enterdialog.entry.entry get ] ; set tkPriv(sel_marker) 0 }
#  bind .enterdialog.entry.entry <F1> help_on_edic
  button .enterdialog.cmds.do -text Done -command { set GVar_edicEntry [ .enterdialog.entry.entry get ] ; set tkPriv(sel_marker) 0 }
  button .enterdialog.cmds.cancel -text Cancel -command "set tkPriv(sel_marker) -1"

  pack .enterdialog.entry.label .enterdialog.entry.entry -side top -anchor w
  pack .enterdialog.cmds.do .enterdialog.cmds.cancel -side left -expand 1
  pack .enterdialog.entry .enterdialog.cmds -side top -fill both -pady 2

  wm withdraw $w
  GGUI_placeToplevel $w
  update idletasks
  wm deiconify $w 
  set old_focus [focus]
  set old_grab [ grab current $w]
  if {$old_grab != ""} {
        set grab_status [grab status $old_grab]
  }
  grab $w
  tkwait variable tkPriv(sel_marker)

  if {$old_grab != ""} {
    if {$grabStatus == "global"} {
      grab -global $old_grab
    } else {
      grab $old_grab
    }
  }

  destroy $w

  set sel $tkPriv(sel_marker)
  if { $sel < 0 } {
    return 1
  }

  set value $GVar_edicEntry

  return 0
}

#
# generic dialog like basic TCL/TK-tk_dialog
#
# toplevel widget name, title, displayed text, displayed bitmap, default idx,
#   button texts
#
proc GGUI_genericDialog {w title text bitmap default args} {
    global tkPriv genericDialogWidth

    if { [ info exists genericDialogWidth ] } {
	set dialogWidth $genericDialogWidth
    } else {
	set dialogWidth [ expr sqrt([ string length $text ]) * 15 ]
	if { $dialogWidth < 150 } {
	  set dialogWidth 150
	}
    }

    catch {destroy $w}
    toplevel $w -class Dialog
    wm title $w $title
    wm iconname $w Dialog
    wm protocol $w WM_DELETE_WINDOW { }

    frame $w.bot -relief raised -bd 1
    pack $w.bot -side bottom -fill both
    frame $w.top -relief raised -bd 1
    pack $w.top -side top -fill both -expand 1

    option add *Dialog.msg.wrapLength $dialogWidth widgetDefault
    label $w.msg -justify left -text $text
    catch {$w.msg configure -font \
		-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
    }
    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    if {$bitmap != ""} {
	label $w.bitmap -bitmap $bitmap
	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
    }

    set i 0
    foreach but $args {
	button $w.button$i -text $but -command "set tkPriv(button) $i"
	if {$i == $default} {
	    frame $w.default -relief sunken -bd 1
	    raise $w.button$i $w.default
	    pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
	    pack $w.button$i -in $w.default -padx 2m -pady 2m
	} else {
	    pack $w.button$i -in $w.bot -side left -expand 1 \
		    -padx 3m -pady 2m
	}
	incr i
    }

    if {$default >= 0} {
	bind $w <Return> "
	    $w.button$default configure -state active -relief sunken
	    update idletasks
	    after 100
	    set tkPriv(button) $default
	"
    }

    wm withdraw $w
    GGUI_placeToplevel $w
    update idletasks
    wm deiconify $w

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    if {$default >= 0} {
	focus $w.button$default
    } else {
	focus $w
    }

    tkwait variable tkPriv(button)
    catch {focus $oldFocus}
    destroy $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(button)
}

#
# internal callback
proc LDIC_set_filename_from_list { w y } {
  global	GGUI_fileSelDialog_filename GGUI_fileSelDialog_actpath
  set sel [ $w get [ $w nearest $y ] ]

  if { $sel == ".." } {
    return
  }

  set GGUI_fileSelDialog_filename [ GFile_cleanPath "$GGUI_fileSelDialog_actpath/$sel" ]
}

#
# internal callback
proc LDIC_set_lists_from_filter { w w2 } {
  global	GGUI_fileSelDialog_filter

  $w delete 0 end
  $w2 delete 0 end
  set entries [ GFile_matchPath $GGUI_fileSelDialog_filter ]
  foreach dir ".. [ lsort [ lindex $entries 1 ] ]" {
    $w inse