home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jtextkeys.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  12.5 KB  |  436 lines
  1. # jtextkeys.tcl - support for Text keyboard bindings
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6.   
  7. ######################################################################
  8. # j:tkb:mkmap w map next {{key command ?args?}...} - set up pseudo-binding
  9. #   Note that key includes modifier
  10. ######################################################################
  11.  
  12. proc j:tkb:mkmap { w map next bindings } {
  13.   global j_teb
  14.   
  15.   set j_teb(tkm_next,$w,$map) $next
  16.   foreach list $bindings {
  17.     set key [lindex $list 0]
  18.     set command [lreplace $list 0 0]
  19.     
  20.     set j_teb(tkm,$w,$map,$key) $command
  21.   }
  22. }
  23.  
  24. ######################################################################
  25. # j:tkb:process_key W mod K A - process keystrokes
  26. ######################################################################
  27.  
  28. proc j:tkb:process_key {W mod K A} {
  29.   global j_teb
  30.   
  31.   set j_teb(next_keymap,$W) ""        ;# some bindings change this
  32.   
  33.   if {"x$mod" != "x"} {
  34.     set K "$mod-$K"
  35.     set default "$mod-DEFAULT"
  36.   } else {
  37.     set default "DEFAULT"
  38.   }
  39.   
  40.   # if this widget hasn't been used before, set its keymap from default
  41.   if {! [info exists j_teb(keymap,$W)]} {
  42.     set j_teb(keymap,$W) $j_teb(keymap,Text)
  43.   }
  44.   # if no last command, set it to {}
  45.   if {! [info exists j_teb(last_command,$W)]} {
  46.     set j_teb(last_command,$W) {}
  47.   }
  48.   set map $j_teb(keymap,$W)
  49.  
  50.   if [info exists j_teb(tkm,$W,$map,$K)] {
  51.     # specific action for this widget
  52.     set command $j_teb(tkm,$W,$map,$K)
  53.     eval $command [list $W $K $A]
  54.   } else {
  55.     if [info exists j_teb(tkm,Text,$map,$K)] {
  56.       # specific binding for all Text widgets
  57.       set command $j_teb(tkm,Text,$map,$K)
  58.       eval $command [list $W $K $A]
  59.     } else {
  60.       if [info exists j_teb(tkm,$W,$map,$default)] {
  61.         # default key action for this widget
  62.         set command $j_teb(tkm,$W,$map,$default)
  63.         eval $command [list $W $K $A]
  64.       } else {
  65.         # default key action for Text widgets
  66.         set command $j_teb(tkm,Text,$map,$default)
  67.         eval $command [list $W $K $A]
  68.       }
  69.     }
  70.   }
  71.   set j_teb(last_command,$W) $command
  72.   
  73.   # if a binding hasn't explicitly chosen a different keymap for the next
  74.   #   key, switch to the default next keymap for this keymap:
  75.   if {"x$j_teb(next_keymap,$W)" == "x"} {
  76.     if [info exists j_teb(tkm_next,$W,$map)] {
  77.       set j_teb(next_keymap,$W) $j_teb(tkm_next,$W,$map)
  78.     } else {
  79.       set j_teb(next_keymap,$W) $j_teb(tkm_next,Text,$map)
  80.     }
  81.   }
  82.   set j_teb(keymap,$W) $j_teb(next_keymap,$W)
  83. }
  84.  
  85. ######################################################################
  86. # j:tkb:new_mode mode W K A - change modes
  87. ######################################################################
  88.  
  89. proc j:tkb:new_mode { mode W K A } {
  90.   global j_teb
  91.   set j_teb(next_keymap,$W) $mode
  92. }
  93.  
  94. ######################################################################
  95. # j:tkb:repeatable tclcode W - execute tclcode one or more times
  96. ######################################################################
  97.  
  98. proc j:tkb:repeatable { tclcode W args } {
  99.   global j_teb
  100.   
  101.   # set up prefix/repeat information if this widget hasn't been used yet
  102.   if {! [info exists j_teb(prefix,$W)]} {
  103.     set j_teb(prefix,$W) 0
  104.   }
  105.   if {! [info exists j_teb(repeat_count,$W)]} {
  106.     set j_teb(repeat_count,$W) 1
  107.   }
  108.  
  109.   # special-case prefix == 1 and repeat_count == 0 for Emacs ^U:
  110.   #
  111.   if {$j_teb(prefix,$W) == 1 && $j_teb(repeat_count,$W) == 0} {
  112.     set j_teb(repeat_count,$W) 4
  113.   }
  114.   
  115.   set j_teb(prefix,$W) 0            ;# no longer collectig digits
  116.   for {set jri 0} {$jri < $j_teb(repeat_count,$W)} {incr jri} {
  117.     uplevel 1 "eval [list $tclcode]"        ;# variables in caller
  118.   }
  119.   set j_teb(repeat_count,$W) 1
  120. }
  121.  
  122. ######################################################################
  123. # j:tkb:clear_count W - clear argument count
  124. ######################################################################
  125.  
  126. proc j:tkb:clear_count { W args } {
  127.   global j_teb
  128.  
  129.   # set up prefix/repeat information if this widget hasn't been used yet
  130.   if {! [info exists j_teb(prefix,$W)]} {
  131.     set j_teb(prefix,$W) 0
  132.   }
  133.   if {! [info exists j_teb(repeat_count,$W)]} {
  134.     set j_teb(repeat_count,$W) 1
  135.   }
  136.  
  137.   set j_teb(repeat_count,$W) 1
  138.   set j_teb(prefix,$W) 0
  139. }
  140.  
  141. ######################################################################
  142. # j:tkb:start_number W K digit - start a numeric argument
  143. #   invalid if not bound to (a sequence ending in) a digit key
  144. ######################################################################
  145.  
  146. proc j:tkb:start_number { W K digit } {
  147.   global j_teb
  148.   
  149.   # set up prefix/repeat information if this widget hasn't been used yet
  150.   if {! [info exists j_teb(prefix,$W)]} {
  151.     set j_teb(prefix,$W) 0
  152.   }
  153.   if {! [info exists j_teb(repeat_count,$W)]} {
  154.     set j_teb(prefix,$W) 1
  155.   }
  156.  
  157.   set j_teb(prefix,$W) 1            ;# collecting # prefix
  158.   set j_teb(repeat_count,$W) [expr "$digit"]
  159. }
  160.  
  161. ######################################################################
  162. # j:tkb:continue_number digit - continue a numeric argument
  163. #   invalid if not bound to a digit key
  164. ######################################################################
  165.  
  166. proc j:tkb:continue_number { W K digit } {
  167.   global j_teb
  168.   
  169.   # set up prefix/repeat information if this widget hasn't been used yet
  170.   if {! [info exists j_teb(prefix,$W)]} {
  171.     set j_teb(prefix,$W) 0
  172.   }
  173.   if {! [info exists j_teb(repeat_count,$W)]} {
  174.     set j_teb(prefix,$W) 1
  175.   }
  176.  
  177.   if {! $j_teb(prefix,$W)} {        ;# (can start as well as continue)
  178.     set j_teb(prefix,$W) 1    
  179.     set j_teb(repeat_count,$W) 0
  180.   }
  181.   set j_teb(repeat_count,$W) [expr {($j_teb(repeat_count,$W)*10)+$digit}]
  182. }
  183.  
  184. ######################################################################
  185. # j:tkb:paste_selection W - insert X selection into W
  186. ######################################################################
  187.  
  188. # j:tkb:paste_selection W - insert selection into W
  189. #  (could also be used as mouse or key binding)
  190. proc j:tkb:paste_selection { W K A } {
  191.   set selection [j:selection_if_any]
  192.   
  193.   if {[string length $selection] != 0} {
  194.     j:text:insert_string $W $selection
  195.   }
  196. }
  197.  
  198. ######################################################################
  199. ###  TEXT SCROLLING COMMANDS - fragile - assume widget has a scrollbar
  200. ######################################################################
  201. # fragile---assumes first word of yscrollcommand is name of scrollbar!
  202. # should catch case of no yscrollcommand!
  203. # ALSO---should handle arguments (scroll by line rather than windowful)
  204.  
  205. proc j:tkb:scroll_down { W K A } {
  206.   global j_teb
  207.   j:tkb:clear_count $W
  208.   
  209.   set yscrollcommand [lindex [$W configure -yscrollcommand] 4]
  210.   set scrollbar [lindex $yscrollcommand 0]    ;# cross fingers and hope!
  211.   
  212.   j:tb:move $W "[lindex [$scrollbar get] 3].0"
  213.   $W yview insert                ;# this is essential!
  214. }
  215.  
  216. proc j:tkb:scroll_up { W K A } {
  217.   global j_teb
  218.   j:tkb:clear_count $W
  219.   
  220.    set yscrollcommand [lindex [$W configure -yscrollcommand] 4]
  221.    set scrollbar [lindex $yscrollcommand 0]    ;# cross fingers and hope!
  222.  
  223.    set currentstate [$scrollbar get]
  224.    # following is buggy if lines wrap:
  225.    set newlinepos [expr {[lindex $currentstate 2] - [lindex $currentstate 1]}]
  226.    j:tb:move $W "$newlinepos.0-2lines"
  227.    $W yview insert
  228. }
  229.  
  230.  
  231.  
  232. ######################################################################
  233. ### INSERTION COMMANDS
  234. ######################################################################
  235.  
  236. ######################################################################
  237. # j:tkb:insert_newline W K A - insert "\n" into W, clear arg flag
  238. ######################################################################
  239.  
  240. proc j:tkb:insert_newline { W K A } {
  241.   global j_teb
  242.  
  243.   j:tkb:repeatable {
  244.     j:text:insert_string $W "\n"
  245.   } $W
  246. }
  247.  
  248. ######################################################################
  249. # j:tkb:self_insert W K A - insert A into text widget W, clear arg flag
  250. ### (was j:tb:self_insert_nondigit
  251. ######################################################################
  252.  
  253. proc j:tkb:self_insert { W K A } {
  254.   global j_teb
  255.  
  256.   if {"x$A" != "x"} {
  257.     j:tkb:repeatable {
  258.       j:text:insert_string $W $A
  259.     } $W
  260.   }
  261. }
  262.  
  263. ######################################################################
  264. # j:tkb:self_insert_digit W K A - insert digit A into W, unless collecting arg
  265. ######################################################################
  266.  
  267. proc j:tkb:self_insert_digit { W K A } {
  268.   global j_teb
  269.     
  270.   # set up prefix/repeat information if this widget hasn't been used yet
  271.   if {! [info exists j_teb(prefix,$W)]} {
  272.     set j_teb(prefix,$W) 0
  273.   }
  274.  
  275.   if $j_teb(prefix,$W) {
  276.     j:tkb:continue_number $W $K $A
  277.     return 0
  278.   } else {
  279.     if {"x$A" != "x"} {
  280.       j:tkb:repeatable {
  281.         j:text:insert_string $W $A
  282.       } $W
  283.     }
  284.   }
  285. }
  286.  
  287. ######################################################################
  288. ###  TEXT MOVEMENT COMMANDS
  289. ######################################################################
  290.  
  291. # j:tkb:bol W K A - move to start of line (ignores count)
  292. proc j:tkb:bol { W K A } {
  293.   j:tkb:repeatable {j:tb:move $W {insert linestart}} $W
  294. }
  295.  
  296. # j:tkb:eol W K A - move to end of line (ignores count)
  297. proc j:tkb:eol { W K A } {
  298.   j:tkb:repeatable {j:tb:move $W {insert lineend}} $W
  299. }
  300.  
  301. # j:tkb:up W K A - move up
  302. proc j:tkb:up { W K A } {
  303.   j:tkb:repeatable {j:tb:move $W {insert - 1 line}} $W
  304. }
  305.  
  306. # j:tkb:down W K A - move down
  307. proc j:tkb:down { W K A } {
  308.   j:tkb:repeatable {j:tb:move $W {insert + 1 line}} $W
  309. }
  310.  
  311. # j:tkb:left W K A - move left
  312. proc j:tkb:left { W K A } {
  313.   j:tkb:repeatable {j:tb:move $W {insert - 1 char}} $W
  314. }
  315.  
  316. # j:tkb:right W K A - move right
  317. proc j:tkb:right { W K A } {
  318.   j:tkb:repeatable {j:tb:move $W {insert + 1 char}} $W
  319. }
  320.  
  321. # j:tkb:bof W K A - move to beginning of file (widget)
  322. proc j:tkb:bof { W K A } {
  323.   j:tkb:repeatable {
  324.     j:tb:move $W 0.0
  325.   } $W
  326. }
  327.  
  328. # j:tkb:eof W K A - move to end of file (widget)
  329. proc j:tkb:eof { W K A } {
  330.   j:tkb:repeatable {
  331.     j:tb:move $W end
  332.   } $W
  333. }
  334.  
  335. # j:tkb:word_left W K A - move back one word
  336. proc j:tkb:word_left { W K A } {
  337.   j:tkb:repeatable {
  338.     while {[$W compare insert != 1.0] &&
  339.            [string match "\[ \t\n\]" [$W get {insert - 1 char}]]} {
  340.       j:tb:move $W {insert - 1 char}
  341.     }
  342.     while {[$W compare insert != 1.0] &&
  343.            ![string match "\[ \t\n\]" [$W get {insert - 1 char}]]} {
  344.       j:tb:move $W {insert - 1 char}
  345.     }
  346.   } $W
  347. }
  348.  
  349. # j:tkb:word_right W K A - move forward one word
  350. proc j:tkb:word_right { W K A } {
  351.   j:tkb:repeatable {
  352.     while {[$W compare insert != end] &&
  353.            [string match "\[ \t\n\]" [$W get insert]]} {
  354.       j:tb:move $W {insert + 1 char}
  355.     }
  356.     while {[$W compare insert != end] &&
  357.            ![string match "\[ \t\n\]" [$W get insert]]} {
  358.       j:tb:move $W {insert + 1 char}
  359.     }
  360.   } $W
  361. }
  362.  
  363. ######################################################################
  364. ###  TEXT DELETION COMMANDS
  365. ######################################################################
  366.  
  367. # j:tkb:delete_right W K A - delete character at insert
  368. proc j:tkb:delete_right { W K A } {
  369.   global J_PREFS
  370.   
  371.   if [$W compare insert != end] {
  372.     global j_teb
  373.     set j_teb(modified,$W) 1
  374.     
  375.     if {[j:text:insert_touches_selection $W] && $J_PREFS(typeover)} {
  376.       j:text:delete $W sel.first sel.last
  377.       j:tkb:clear_count $W
  378.       return 0
  379.     }
  380.     
  381.     set delete_from [$W index insert]
  382.     j:tkb:right $W $K $A    ;# handles repeat count
  383.     set delete_to [$W index insert]
  384.     j:text:delete $W $delete_from $delete_to
  385.   }
  386. }
  387.  
  388. # j:tkb:delete_left W K A - delete character before insert
  389. proc j:tkb:delete_left { W K A } {
  390.   global J_PREFS
  391.   
  392.   if [$W compare insert != 1.0] {
  393.     global j_teb
  394.     set j_teb(modified,$W) 1
  395.     
  396.     if {[j:text:insert_touches_selection $W] && $J_PREFS(typeover)} {
  397.       j:text:delete $W sel.first sel.last
  398.       j:tkb:clear_count $W
  399.       return 0
  400.     }
  401.     
  402.     set delete_to [$W index insert]
  403.     j:tkb:left $W $K $A        ;# handles repeat count
  404.     set delete_from [$W index insert]
  405.     j:text:delete $W $delete_from $delete_to
  406.   }
  407. }
  408.  
  409. #### FOLLOWING TWO NEED TO HANDLE CUTBUFFER!
  410.  
  411. # j:tkb:delete_left_word W K A - move back one word
  412. proc j:tkb:delete_left_word { W K A } {
  413.   if [$W compare insert != 1.0] {
  414.     global j_teb
  415.     set j_teb(modified,$W) 1
  416.   
  417.     set delete_to [$W index insert]
  418.     j:tkb:word_left $W $K $A    ;# handles repeat count
  419.     set delete_from [$W index insert]
  420.     j:text:delete $W $delete_from $delete_to
  421.   }
  422. }
  423.  
  424. # j:tkb:delete_right_word W K A - move forward one word
  425. proc j:tkb:delete_right_word { W K A } {
  426.   if [$W compare insert != end] {
  427.     global j_teb
  428.     set j_teb(modified,$W) 1
  429.   
  430.     set delete_from [$W index insert]
  431.     j:tkb:word_right $W $K $A    ;# handles repeat count
  432.     set delete_to [$W index insert]
  433.     j:text:delete $W $delete_from $delete_to
  434.   }
  435. }
  436.