home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / elecCompletion.tcl < prev    next >
Encoding:
Text File  |  1999-04-17  |  15.8 KB  |  429 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "elecCompletion.tcl"
  6.  #                  created: 8/3/96 {12:06:40 pm}    
  7.  #                  last update: 17/4/1999 {4:13:15 pm}    
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #  modified by  rev reason
  15.  #  -------- --- --- -----------
  16.  #  8/3/96   VMD 1.0 original
  17.  #  20/11/96 VMD 1.1 many, many improvements.
  18.  #  24/2/97  VMD 1.2 added some support of trf's code, plus some fixes
  19.  #  1/9/97   VMD 1.5 added 'completion::contraction' and improved g-elec.
  20.  #  12/1/97  trf 1.6 added 'Tutorial Shell' stuff, bumped to 9.0b2
  21.  #  12/2/97  trf 1.7 corrected corrections, bumped to 9.0b3
  22.  #  4/12/97  VMD 1.8 various fixes, better tcl8 compatibility
  23.  # ###################################################################
  24.  ##
  25.  
  26. alpha::extension elecCompletions 9.0.1 {
  27.     alpha::package require elecBindings 9.0
  28.     alpha::package require -loose Alpha 7.1
  29.     menu::insert mode items end "completionsTutorial" "editCompletions" 
  30.     # load completion code for a mode the first time that mode is used
  31.     hook::register mode::init completion::load "*"
  32.     namespace eval completion {}
  33.     completion::initialise
  34. } maintainer {
  35.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  36. } uninstall this-file help {file "ElecCompletions Help"}
  37.  
  38. proc completion::initialise {} {}
  39.  
  40. namespace eval elec {}
  41.  
  42. proc completion::load {} {
  43.     global HOME
  44.     foreach f [glob -nocomplain [file join ${HOME} Tcl Completions [modeALike]Completions*.tcl]] {
  45.     message "loading [file tail $f]…"
  46.     namespace eval ::[modeALike]::Completion {}
  47.     uplevel \#0 [list source $f]
  48.     }
  49. }
  50.  
  51. ## 
  52.  # -------------------------------------------------------------------------
  53.  # 
  54.  #    "completion::cmd"    --
  55.  # 
  56.  #  General purpose proc for extending a given command to its full extent
  57.  #  in a mode-dependent fashion.  If we hit a unique match, we call
  58.  #  '${mode}completion::Electric'; if we can extend, we do so, and set
  59.  #  things up so the calling procedure '${mode}completion::Cmd' will be
  60.  #  called if the user tries to cmd-Tab again; if we don't recognise
  61.  #  anything, we return 0
  62.  #     
  63.  #  We normally use the list ${m}cmds to look for completions, but the
  64.  #  caller can supply a different name.  This is useful to prioritise
  65.  #  lists, so we first call with one, then another,...  I currently use
  66.  #  this feature for TeX-completions, in which I call with a second list,
  67.  #  containing fake commands, which expand into environments. 
  68.  # -------------------------------------------------------------------------
  69.  ##
  70. proc completion::cmd { {cmd ""} {listExt "cmds"} {prematch ""}} {
  71.     if {![string length $cmd]} { 
  72.     set cmd [completion::lastWord]
  73.     # if there's any whitespace in the command then it's no good to us
  74.     if {[containsSpace $cmd]} { return 0 }
  75.     }
  76.     
  77.     set m [modeALike]
  78.     # do an electric if we already match exactly
  79.     global ${m}electrics
  80.     if {[info exists ${m}electrics($cmd)]} {
  81.     return [completion ${m} Electric "${prematch}${cmd}"]
  82.     }
  83.     if {[llength [set matches [completion::fromList $cmd ${m}${listExt}]]] == 0} {
  84.     return 0
  85.     } else {
  86.     return [completion::matchUtil Cmd $cmd $matches $prematch]
  87.     }
  88. }
  89.  
  90. proc completion::matchUtil {proc what matches {prematch ""}} {
  91.     if {[llength $matches] == 0} { return 0 }
  92.     set match [completion::Find $what $matches]
  93.     if {[string length $match]} {
  94.     # we completed or cancelled, so move on
  95.     #completion::already error
  96.     if { $match == 1 } {
  97.         return 1
  98.     } else {
  99.         return [completion [modeALike] Electric "${prematch}${match}"]
  100.     }
  101.     } else {
  102.     completion::already $proc
  103.     return 1
  104.     }
  105. }
  106.  
  107. ## 
  108.  # -------------------------------------------------------------------------
  109.  #     
  110.  # "completion::ensemble"    --
  111.  #    
  112.  #  Complete and do electrics for commands which have two parts separated
  113.  #  by a space.  Very useful for Tcl's "string compare ..."  etc. 
  114.  # -------------------------------------------------------------------------
  115.  ##
  116. proc completion::ensemble {dummy} {
  117.     set lastword [completion::lastTwoWords prevword]
  118.     set prevword [string trim $prevword]
  119.     set m [modeALike]
  120.     # Need catch to avoid namespace problems
  121.     if {[catch {global ${m}${prevword}cmds}] || ![info exists ${m}${prevword}cmds]} {
  122.     return 0
  123.     } else {
  124.     return [completion::cmd $lastword "${prevword}cmds" "${prevword} "]
  125.     }
  126. }
  127.  
  128. ## 
  129.  # -------------------------------------------------------------------------
  130.  #     
  131.  #    "completion::electric" --
  132.  #    
  133.  #  Given a command, and an optional list of defaults, check the command is
  134.  #  ok and if so try and insert an electric entry. 
  135.  # -------------------------------------------------------------------------
  136.  ##
  137. proc completion::electric { {cmd ""} args } {
  138.     set m [modeALike]
  139.     if {![string length $cmd]} { 
  140.     set cmd [completion::lastWord] 
  141.     # only check for space if we're doing it
  142.     if {[containsSpace $cmd]} { return 0 }
  143.     }
  144.     
  145.     return [eval [list elec::findCmd $cmd ${m}electrics] $args]
  146. }
  147.  
  148. ## 
  149.  # -------------------------------------------------------------------------
  150.  #     
  151.  # "completion::contraction"    --
  152.  #    
  153.  #  Complete and do electrics for commands which have two parts separated
  154.  #  by a apostrophe.  Useful for making shortcuts to things.  ex: s'c Tcl's
  155.  #  "string compare ..."  etc. 
  156.  # -------------------------------------------------------------------------
  157.  ##
  158. proc completion::contraction {dummy} {
  159.     set lastword [completion::lastTwoWords hint]
  160.     if {![regexp "'\$" $hint]} {return 0}
  161.     append hint $lastword
  162.     return [completion::electric $hint]
  163. }
  164.  
  165. ## 
  166.  # -------------------------------------------------------------------------
  167.  # 
  168.  #    "elec::findCmd" --
  169.  # 
  170.  #  General purpose proc for extending a command in some predetermined
  171.  #  fashion (such as mapping 'for' to a template 'for (;;)…').  Mode
  172.  #  specific procedures may use this if desired.  The given command is
  173.  #  looked up in the given array '$arrayn', and if there is an entry, some
  174.  #  electric procedure happens.  By default, if an entry is '0', then '0'
  175.  #  is returned (which can be used by the calling procedure to take some
  176.  #  other action, usually more sophisticated such as TeX-ref- completion),
  177.  #  and if the entry is an integer corresponding to a list element of the
  178.  #  list 'args', then that element is inserted.  In this case list elements
  179.  #  start with '1' (because zero has a special meaning).  Template stops in
  180.  #  the electric completion are marked by pairs of bullets '••'.  If there
  181.  #  is any text between the bullets, that can be used to inform the user of
  182.  #  what ought to go there.  All strings must contain at least one such
  183.  #  template stop, to which the insertion point moves.
  184.  # 
  185.  #  '$arrayn' ought not to be a large array or this proc may be slow.  (we
  186.  #  first look for an exact array element match $arrayn($cmd), but if that
  187.  #  fails we look for a glob'ed match)
  188.  #  
  189.  #  The array element may contain control sequences.  These start with '◊',
  190.  #  and may be followed by:
  191.  #  
  192.  #  kill0 --- delete the string which triggered this template before
  193.  #            inserting anything.
  194.  #            
  195.  #  killN --- delete all except N characters of the string.
  196.  #  
  197.  #  N --- use the N'th element of 'args' for the template.
  198.  #  
  199.  #  [ --- the string must be evaluated first (usually triggering some proc
  200.  #        which perhaps interacts with the user a bit)
  201.  #  
  202.  #  » --- an indirection; use the template insertion corresponding to
  203.  #        the given text item instead.
  204.  #        
  205.  #  In order to provide backward compatiblity of this proc with any new 
  206.  #  control sequences that may be developed, any 'unknown' control 
  207.  #  sequence is just deleted, a package that deals with the new sequences 
  208.  #  thus has to overide this proc in order to make the now sequences 
  209.  #  functionality available.
  210.  #  
  211.  #  So, what are some of the possible future control sequences? Well, I've 
  212.  #  played with;
  213.  #  
  214.  #                 sequences bound to a stop
  215.  #  
  216.  #  « --- an extended prompt, provides a longer, more pedalogical explanation 
  217.  #        for a stop that the curt, fill in 'xxx' in the statusline.
  218.  #  ¶ --- a name that acts as an index into an array of code snippets, so a 
  219.  #        bit of code can be executed when visiting a stop, perhaps aiding 
  220.  #        in filling in options, validating entries, or anything else that 
  221.  #        makes sense.
  222.  #  ø --- marks a stop of such an obvious nature, that the marking of the 
  223.  #        stop with a dot, or and in-text prompt is superflous. In fact, such 
  224.  #        stops often have existing statements dragged into their position, 
  225.  #        so leaving them unmarked has a speed advantage. Perhaps this 
  226.  #        action is best toggled depending on a flag value.
  227.  #        
  228.  #     Any stop that falls in the above class, will occur after any regular 
  229.  #     prompting text, and should trigger the removal of itself and any 
  230.  #     other characters up until the occurrence of the stop ending bullet. 
  231.  #     That can be acomplished in one of two ways, here with a regsub of this 
  232.  #     form:
  233.  #     regsub -all {•([^◊]*)◊[^•]+•} <template> {•\1•} result 
  234.  #     or by applying the regsub to the entire set of electrics for a mode 
  235.  #     as soon as its completions are loaded. (first method implemented)
  236.  #        
  237.  #                 sequences that occurr at the start of a template
  238.  #                     and apply to the template as a whole
  239.  #  
  240.  #  < --- means that certain conditions that must be meet by the text 
  241.  #        proceeding where this template is to be inserted must be met 
  242.  #        before the insertion is allowed, (e.g. a tcl command must be 
  243.  #        proceeded by whitespace, a [, a ", or eval for the insertion 
  244.  #        to be syntactically correct and thus , allowable)
  245.  #        
  246.  #  Sequences in this class will have to be of a single character, as will
  247.  #  get rid of any unknown sequence by 
  248.  #    regsub {◊[^k0-9»\[]} [string range <template 0 
  249.  #      [string first • <template>]] head set <template> $head
  250.  #    append <template> rest
  251.  #
  252.  #  Includes some fixes by Tom Fetherston
  253.  # -------------------------------------------------------------------------
  254.  ##
  255. proc elec::findCmd { cmd arrayn args } {
  256.     if {[set action [elec::_findCmd $cmd $arrayn]] == ""} { return 0 }
  257.     # we have the action; check for control sequences
  258.     while {[string index $action 0] == "◊"} {
  259.     # control sequence: kill, procedure or choice of default value?
  260.     set action [string range $action 1 end]
  261.     if { [string range $action 0 3] == "kill" } {
  262.         set dpos [pos::math [getPos] - [expr {[string length $cmd] + [string index $action 4]}]] 
  263.         deleteText $dpos [getPos]
  264.         regsub -all "kill" [string range $action 5 end] $cmd action
  265.     } elseif {[string index $action 0] == "\[" } {
  266.         set action [subst $action]
  267.     } elseif {[string index $action 0] == "»" } {
  268.         set key [string range $action 1 end]
  269.         global $arrayn
  270.         set text [set ${arrayn}($key)]
  271.         set action "◊kill0${key}${text}" 
  272.     } elseif {([scan $action %d idx]) \
  273.       && (![ catch {lindex $args [expr {$idx-1}]} act]) } {
  274.         set action $act
  275.     } else {
  276.         if {[info commands [set proc elec::action::[string index $action 1]]] == $proc} {
  277.         set action [$proc $action]
  278.         } else {
  279.         set action [string range $action 2 end]
  280.         }
  281.     }
  282.     }
  283.     # then, we pull out any "bulleted-stop control sequences" that are 
  284.     # unknown to this version of elec::findCmd -trf
  285.     regsub -all {•([^◊]*)◊[^•]+•} $action {•\1•} action 
  286.     elec::Insertion $action
  287.     # The idea here is to continue with other completions (return 0)
  288.     # if the character before the insertion point is non white-space
  289.     global wordBreakPreface
  290.     if {![regexp $wordBreakPreface [lookAt [pos::math [getPos] - 1]]]} {
  291.     if {[isSelection]} {deleteText [getPos] [selEnd]}
  292.     return 0
  293.     } else {
  294.     return 1
  295.     }
  296. }
  297.  
  298. ## 
  299.  # -------------------------------------------------------------------------
  300.  # 
  301.  # "elec::_findCmd" --
  302.  # 
  303.  #  Find the electric command in the given array, or return ""
  304.  # -------------------------------------------------------------------------
  305.  ##
  306. proc elec::_findCmd {cmd arrayn} {
  307.     global $arrayn
  308.     if {[info exists ${arrayn}($cmd)]} {
  309.     return [set "${arrayn}($cmd)"]
  310.     } else {
  311.     if {[string first "*" [set elec_ar [array names $arrayn]]] != -1 } {
  312.         # some of the array matches are glob'ed; we must go one at a time
  313.         foreach elec $elec_ar {
  314.         if {[string match $elec $cmd]} {
  315.             return [set "${arrayn}($elec)"]
  316.         }
  317.         }
  318.     }
  319.     }
  320.     return ""
  321. }
  322.  
  323. # just so we have one!
  324. set userCompletions(date) {◊kill0◊[lindex [mtime [now]] 0]}
  325.  
  326. # ensure old version loaded:
  327. catch "completion::user"
  328. ## 
  329.  # -------------------------------------------------------------------------
  330.  # 
  331.  # "completion::user" --
  332.  # 
  333.  #   A user completion is used for small
  334.  #     mode-independent snippets, like your email address, name etc.
  335.  #     For instance I have the following defined:
  336.  #     
  337.  #     set userCompletions(vmd) "◊kill0Vince Darley"
  338.  #   set userCompletions(www) "◊kill0<[icGetPref WWWHomePage]>"
  339.  #   set userCompletions(e-) "◊kill0<[icGetPref Email]>"
  340.  #   
  341.  #   Here '◊kill0' is a control sequence which means kill exactly what
  342.  #   I just typed before carrying out this completion.
  343.  # -------------------------------------------------------------------------
  344.  ##
  345. proc completion::user { {cmd ""} } {
  346.     if {![string length $cmd]} { set cmd [completion::lastWord] }
  347.     if {[containsSpace $cmd]} { return 0 }
  348.     
  349.     return [elec::findCmd $cmd userCompletions]    
  350. }
  351.  
  352. proc mode::completionsTutorial {} {
  353.     global HOME
  354.     set f [file join ${HOME} Tcl Completions "[modeALike] Tutorial"]
  355.     set files [glob -nocomplain $f*]
  356.     if {[llength $files] == 1} {
  357.     set fName [lindex $files 0]
  358.     set mode [file::whichModeForWin "dummy[file extension $fName]"]
  359.     new -n "*Tutorial shell*" -m $mode \
  360.       -text [file::readAll $fName] -shell 1
  361.     goto [minPos]
  362.     Bind '`' vsp $mode
  363.     } else {
  364.     alertnote "No tutorial exists for this mode.  Why don't you write one?"
  365.     }
  366. }
  367.  
  368. proc vsp {} {
  369.     if {[win::Current] != "*Tutorial shell*"} {
  370.     typeText "`"
  371.     return
  372.     } 
  373.     searchString "◊" 
  374.     goto [pos::math [getPos] + 2] 
  375.     findAgain
  376.     centerRedraw
  377.     if {[isSelection]} {
  378.     deleteText [getPos] [selEnd]
  379.     # add the following to prevent the 'non-use' of a template from
  380.     # messing up the next completion
  381.     ring::clear
  382.     }    
  383. }
  384.  
  385. proc mode::editCompletions {} {
  386.     global HOME
  387.     set f [file join ${HOME} Tcl Completions [modeALike]Completions.tcl]
  388.     if {[catch {file::openQuietly $f}]} {
  389.     beep
  390.     if {[askyesno "No completions exist for this mode. Do you want to create some?"] == "yes"} {
  391.         set fd [open $f "w"]
  392.         close $fd
  393.         edit $f
  394.         insertText {## 
  395.  # This file will be sourced automatically, immediately after 
  396.  # the _first_ time the file which defines its mode is sourced.
  397.  # Use this file to declare completion items and procedures
  398.  # for this mode.
  399.  # 
  400.  # Some common defaults are included below.
  401.  ##
  402.  
  403. ## 
  404.  # These declare, in order, the names of the completion
  405.  # procedures for this mode.  The actual procedure
  406.  # must be named '${mode}Completion::${listItem}', unless
  407.  # the item is 'completion::*' in which case that actual
  408.  # procedure is called.  The procedure 'modeALike' will
  409.  # map modes to similar modes so procs don't need to be
  410.  # repeated.  However each mode requires its own array entry
  411.  # here.
  412.  ##
  413. set completions(<mode>) {contraction completion::cmd Ensemble completion::electric Var}
  414.  
  415. }\
  416.  {# ◊◊◊◊ Data for <mode> completions ◊◊◊◊ #
  417.  
  418. # cmds to be completed to full length (no need for short ones)
  419. set <mode>cmds { class default enum register return struct switch typedef volatile while }
  420. # electrics
  421. set <mode>electrics(for) " \{•start•\} \{•test•\} \{•increment•\} \{\r\t•body•\r\}\r••"
  422. set <mode>electrics(while) " \{•test•\} \{\r\t•body•\r\}\r••"
  423. # contractions
  424. set <mode>electrics(s'c) "◊»string compare"
  425. set <mode>electrics(s'f) "◊»string first"
  426. }}}            
  427. }
  428.  
  429.