home *** CD-ROM | disk | FTP | other *** search
/ Freesoft 1999 February / Freesoft_1999-02_cd.bin / Recenz / Utility / DisplayDoctorLinux / scitech-display-doctor-1.0beta-3.i386.rpm / scitech-display-doctor-1.0beta.3.cpio.gz / scitech-display-doctor-1.0beta.3.cpio / usr / lib / nucleus / XF86Setup / keyboard.tcl < prev    next >
Text File  |  1998-09-19  |  10KB  |  295 lines
  1. # $XConsortium: keyboard.tcl /main/2 1996/10/25 10:21:16 kaleb $
  2. #
  3. #
  4. #
  5. #
  6. # $XFree86: xc/programs/Xserver/hw/xfree86/XF86Setup/keyboard.tcl,v 3.9.2.2 1998/02/21 06:06:59 robin Exp $
  7. #
  8. # Copyright 1996 by Joseph V. Moss <joe@XFree86.Org>
  9. #
  10. # See the file "LICENSE" for information regarding redistribution terms,
  11. # and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13.  
  14. #
  15. # Keyboard configuration routines
  16. #
  17.  
  18. proc Keyboard_create_widgets { win } {
  19.     global XKBComponents XKBinserver XKBhandle
  20.     global pc98 messages
  21.  
  22.     set w [winpathprefix $win]
  23.         if !$pc98 {
  24.         frame $w.keyboard -width 640 -height 420 \
  25.             -relief ridge -borderwidth 5
  26.     } else {
  27.         frame $w.keyboard -width 640 -height 400 \
  28.             -relief ridge -borderwidth 5
  29.     }
  30.  
  31.     frame $w.keyboard.xkb
  32.     label $w.keyboard.xkb.text -text $messages(keyboard.4)
  33.     frame $w.keyboard.xkb.geom
  34.     label $w.keyboard.xkb.geom.title -text $messages(keyboard.1)
  35.     combobox $w.keyboard.xkb.geom.cbox -bd 2 -width 30
  36.     eval [list $w.keyboard.xkb.geom.cbox linsert end] \
  37.         $XKBComponents(models,descriptions)
  38.     pack  $w.keyboard.xkb.geom.title $w.keyboard.xkb.geom.cbox -side top
  39.     frame $w.keyboard.xkb.lang
  40.     label $w.keyboard.xkb.lang.title -text $messages(keyboard.2)
  41.     combobox $w.keyboard.xkb.lang.cbox -bd 2 -width 30
  42.     eval [list $w.keyboard.xkb.lang.cbox linsert end] \
  43.         $XKBComponents(layouts,descriptions)
  44.     pack  $w.keyboard.xkb.lang.title $w.keyboard.xkb.lang.cbox -side top
  45.     frame $w.keyboard.xkb.vari
  46.     label $w.keyboard.xkb.vari.title -text $messages(keyboard.6)
  47.     combobox $w.keyboard.xkb.vari.cbox -bd 2 -width 30
  48.     $w.keyboard.xkb.vari.cbox linsert end "<None>"
  49.     eval [list $w.keyboard.xkb.vari.cbox linsert end] \
  50.         $XKBComponents(variants,descriptions)
  51.     pack  $w.keyboard.xkb.vari.title $w.keyboard.xkb.vari.cbox -side top
  52.     pack $w.keyboard.xkb.text -side top -expand yes -fill both -padx 6m
  53.     pack $w.keyboard.xkb.geom -side top -expand yes -fill both -padx 6m
  54.     pack $w.keyboard.xkb.lang -side top -expand yes -fill both -padx 6m
  55.     pack $w.keyboard.xkb.vari -side top -expand yes -fill both -padx 6m
  56.     if { $XKBinserver } {
  57.         bind $w.keyboard.xkb.geom.cbox.popup.list <ButtonRelease-1> \
  58.         "+Keyboard_loadsettings $win noload"
  59.         bind $w.keyboard.xkb.geom.cbox.popup <Return> \
  60.         "+Keyboard_loadsettings $win noload"
  61.         bind $w.keyboard.xkb.lang.cbox.popup.list <ButtonRelease-1> \
  62.         "+Keyboard_loadsettings $win noload"
  63.         bind $w.keyboard.xkb.lang.cbox.popup <Return> \
  64.         "+Keyboard_loadsettings $win noload"
  65.         xkbview $w.keyboard.xkb.graphic -height 100 -kbd $XKBhandle \
  66.         -dbl 1 -bd 6 -relief ridge
  67.     } else {
  68.         frame $w.keyboard.xkb.graphic
  69.     }
  70.     pack $w.keyboard.xkb.graphic  -side top -expand yes -fill x
  71.     if { $XKBinserver } {
  72.         button $w.keyboard.xkb.apply -text $messages(keyboard.3) \
  73.         -command "Keyboard_loadsettings $win load"
  74.         pack $w.keyboard.xkb.apply -side top -expand yes -fill both
  75.     }
  76.     label $w.keyboard.xkb.message -text "" -foreground black
  77.     pack $w.keyboard.xkb.message  -side top -expand yes -fill x
  78.  
  79.     frame $w.keyboard.options -relief groove -bd 4
  80.     Keyboard_create_options_widgets $win
  81.     pack $w.keyboard.xkb -side left -fill both -expand yes -pady 10m
  82.     pack $w.keyboard.options -side left -fill both -expand no
  83.     Keyboard_initsettings $win
  84. }
  85.  
  86. proc Keyboard_create_options_widgets { win } {
  87.     global XKBComponents keyboardXkbOpts messages
  88.  
  89.     set w [winpathprefix $win]
  90.     set numopts [llength $XKBComponents(options,names)]
  91.     if { $numopts == 0 } {
  92.         set keyboardXkbOpts(noopts) -1
  93.         return
  94.     }
  95.  
  96.     label $w.keyboard.options.title -text $messages(keyboard.5)
  97.     pack  $w.keyboard.options.title -fill x \
  98.         -expand no -pady 3m -side top
  99.     frame $w.keyboard.options.line -relief sunken -height 2 -bd 3
  100.     pack  $w.keyboard.options.line -fill x \
  101.         -expand no -pady 3m -side top
  102.  
  103.     set canv $w.keyboard.options.canvas
  104.     canvas $canv
  105.     frame $canv.list
  106.     set id [$canv create window 0 0 -window $canv.list -anchor nw]
  107.     for {set idx 0} { $idx < $numopts } {incr idx} {
  108.         set name [lindex $XKBComponents(options,names) $idx]
  109.         set desc [lindex $XKBComponents(options,descriptions) $idx]
  110.         set tmp [split $name :]
  111.         set value $idx
  112.         if { [llength $tmp] != 2 } {
  113.             set next ""
  114.             if { [expr $idx+1] < $numopts } {
  115.             set next [lindex $XKBComponents(options,names) \
  116.                     [expr $idx+1] ]
  117.             }
  118.             if { [string match $name:* $next] } {
  119.             label $canv.list.$name -text $desc \
  120.                 -relief ridge -bd 3
  121.             pack $canv.list.$name -fill both -expand no
  122.             set tmp [list $name default]
  123.             set value -1
  124.             set desc $messages(keyboard.7)
  125.             set keyboardXkbOpts($name) -1
  126.             } else {
  127.             checkbutton $canv.list.$name \
  128.                 -variable keyboardXkbOpts($name) \
  129.                 -text $desc -highlightthickness 1 \
  130.                 -offvalue -1 -onvalue $idx -anchor w \
  131.                 -relief sunken -bd 1
  132.             pack $canv.list.$name -fill both -expand no
  133.             set keyboardXkbOpts($name) -1
  134.                 continue
  135.             }
  136.         }
  137.         set group  [lindex $tmp 0]
  138.         set option [lindex $tmp 1]
  139.         radiobutton $canv.list.$group-$option \
  140.             -variable keyboardXkbOpts($group) -value $value \
  141.             -text $desc -highlightthickness 1 -anchor w
  142.         pack $canv.list.$group-$option -fill both -expand no -padx 3
  143.     }
  144.     update idletasks
  145.     pack $canv -fill y -expand no -side left
  146.     scrollbar $w.keyboard.options.sb -command "$canv yview" -relief sunken
  147.     set bbox [$canv bbox $id]
  148.     $canv configure -yscrollcommand "$w.keyboard.options.sb set" \
  149.         -scrollregion $bbox -width [lindex $bbox 2]
  150.     if { [winfo reqheight $canv.list] > [winfo height $w]*.7 } {
  151.         pack $w.keyboard.options.sb -side left -fill y -expand yes
  152.     }
  153. }
  154.  
  155. proc Keyboard_initsettings { win } {
  156.     global Keyboard XKBComponents keyboardXkbOpts
  157.  
  158.     set w [winpathprefix $win]
  159.     set model    $Keyboard(XkbModel)
  160.     set layout    $Keyboard(XkbLayout)
  161.     set variant    $Keyboard(XkbVariant)
  162.     set options    $Keyboard(XkbOptions)
  163.  
  164.     set tmp [xkb_getrulesprop]
  165.     if { [llength $tmp] == 5 } {
  166.         set model    [lindex $tmp 1]
  167.         set layout    [lindex $tmp 2]
  168.         set variant    [lindex $tmp 3]
  169.         set options    [lindex $tmp 4]
  170.     }
  171.     set geomidx [lsearch -exact $XKBComponents(models,names) $model]
  172.     if { $geomidx == -1 } {set geomidx 0}
  173.     set langidx [lsearch -exact $XKBComponents(layouts,names) $layout]
  174.     if { $langidx == -1 } {set langidx 0}
  175.     set variidx [lsearch -exact $XKBComponents(variants,names) $variant]
  176.     incr variidx
  177.  
  178.     $w.keyboard.xkb.geom.cbox einsert 0 \
  179.         [lindex $XKBComponents(models,descriptions) $geomidx]
  180.     $w.keyboard.xkb.lang.cbox einsert 0 \
  181.         [lindex $XKBComponents(layouts,descriptions) $langidx]
  182.     if { $variidx } {
  183.         $w.keyboard.xkb.vari.cbox einsert 0 \
  184.         [lindex $XKBComponents(variants,descriptions) $variidx]
  185.     }
  186.     $w.keyboard.xkb.geom.cbox econfig -state disabled
  187.     $w.keyboard.xkb.lang.cbox econfig -state disabled
  188.     $w.keyboard.xkb.vari.cbox econfig -state disabled
  189.     $w.keyboard.xkb.geom.cbox lselection set $geomidx
  190.     $w.keyboard.xkb.lang.cbox lselection set $langidx
  191.     $w.keyboard.xkb.vari.cbox lselection set $variidx
  192.     $w.keyboard.xkb.geom.cbox activate $geomidx
  193.     $w.keyboard.xkb.lang.cbox activate $langidx
  194.     $w.keyboard.xkb.vari.cbox activate $variidx
  195.     $w.keyboard.xkb.geom.cbox see $geomidx
  196.     $w.keyboard.xkb.lang.cbox see $langidx
  197.     $w.keyboard.xkb.vari.cbox see $variidx
  198.  
  199.     set optlist [split $options ,]
  200.     set namelist $XKBComponents(options,names)
  201.     set cl $w.keyboard.options.canvas.list
  202.     foreach opt $optlist {
  203.         set tmp [split $opt :]
  204.         set idx [lsearch -exact $namelist $opt]
  205.         if { [llength $tmp] != 2 } {
  206.             if { [winfo exists $cl.$opt-default] } {
  207.                 set keyboardXkbOpts($opt) -1
  208.             } else {
  209.                 set keyboardXkbOpts($opt) $idx
  210.             }
  211.         } else {
  212.             set keyboardXkbOpts([lindex $tmp 0]) $idx
  213.         }
  214.     }
  215. }
  216.  
  217. proc Keyboard_activate { win } {
  218.     set w [winpathprefix $win]
  219.     pack $w.keyboard -side top -fill both -expand yes
  220. }
  221.  
  222. proc Keyboard_deactivate { win } {
  223.     set w [winpathprefix $win]
  224.     pack forget $w.keyboard
  225.     Keyboard_loadsettings $win setvars
  226. }
  227.  
  228. proc Keyboard_loadsettings { win loadflag } {
  229.     global XKBComponents XKBrules Keyboard XKBhandle keyboardXkbOpts
  230.     global messages
  231.  
  232.     set w [winpathprefix $win]
  233.     if { $loadflag == "load" } {
  234.         $w.keyboard.xkb.message configure -text $messages(keyboard.9)
  235.     }
  236.     if { $loadflag == "noload" } {
  237.         $w.keyboard.xkb.message configure -text $messages(keyboard.10)
  238.     }
  239.     update
  240.     set geom_idx [$w.keyboard.xkb.geom.cbox curselection]
  241.     set lang_idx [$w.keyboard.xkb.lang.cbox curselection]
  242.     set vari_idx [$w.keyboard.xkb.vari.cbox curselection]
  243.     incr vari_idx -1
  244.     set geom [lindex $XKBComponents(models,names)  $geom_idx]
  245.     set lang [lindex $XKBComponents(layouts,names) $lang_idx]
  246.     if { $vari_idx == -1 } {
  247.         set vari ""
  248.     } else {
  249.         set vari [lindex $XKBComponents(variants,names) $vari_idx]
  250.     }
  251.     set opts ""
  252.     foreach key [array names keyboardXkbOpts] {
  253.         if { $keyboardXkbOpts($key) == -1 } continue
  254.         set opt [lindex $XKBComponents(options,names) \
  255.                     $keyboardXkbOpts($key)]
  256.         if { ![string length $opts] } {
  257.             set opts $opt
  258.         } else {
  259.             append opts ",$opt"
  260.         }
  261.     }
  262.  
  263.     if { $loadflag != "setvars" } {
  264.         set comp [xkb_resolvecomponents \
  265.             $XKBrules $geom $lang $vari $opts]
  266.         set notloaded [catch {eval xkb_load $comp $loadflag} kbd]
  267.         if { $notloaded } {
  268.             $w.keyboard.xkb.message configure \
  269.                 -text $messages(keyboard.8)
  270.             bell
  271.             after 1000
  272.         } else {
  273.             xkb_free $XKBhandle
  274.             set XKBhandle $kbd
  275.             $w.keyboard.xkb.graphic configure -kbd $kbd
  276.             if { $loadflag != "noload" } {
  277.                 xkb_setrulesprop $XKBrules \
  278.                     $geom $lang $vari $opts
  279.                 set Keyboard(XkbModel)        $geom
  280.                 set Keyboard(XkbLayout)        $lang
  281.                 set Keyboard(XkbVariant)    $vari
  282.                 set Keyboard(XkbOptions)    $opts
  283.             }
  284.         }
  285.     } else {
  286.         set Keyboard(XkbModel)        $geom
  287.         set Keyboard(XkbLayout)        $lang
  288.         set Keyboard(XkbVariant)    $vari
  289.         set Keyboard(XkbOptions)    $opts
  290.     }
  291.     focus $w
  292.     $w.keyboard.xkb.message configure -text ""
  293. }
  294.  
  295.