Updated 2007-11-20 00:05:42 by dcd

Templating system for Tcl in Emacs [Bezor] - updated with some new templates 11/15/2007

Snippet.el from various sources will have you quickly removing the drudgery out of the common chores you have to do when writing Tcl scripts. Let's face it; a lot of things that you write in scripts are repetitive, and this is where a templating system comes in handy.

Features:

  • Typing simple keywords and a space will expand to a template that you specify.
  • You can specify hot spots where you provide information that will change in your template.
  • hot spots can be linked so change in one hotspot will be reflected in all linked hot spots. Imagine filling out the comments at the top of the proc and having the proc arguments, global declaration, namespace and proc name all change as you progress through the template.
  • Easy to create more templates for how you use Tcl.

Installation:

  • Download snippet.el from [1] and put that either in your .emacs.d directory or any directory in your load path. The file is well commented and will inform you on how to create templates. What I include below will get you up and running quickly. You will need to read the comments at the top of this file if you want to add more or edit any more templates.
  • Edit your ~/.emacs initialization file to add the following text to add the abbrev hooks for Tcl and some sample templates.
  • Test by starting up emacs, press M-x tcl-mode (or, if emacs is correctly configured, load a file with .tcl extension and tcl-mode will be set) then type "scriptstart ". Note you must type the space at the end to get the template to appear.
 #!/bin/sh
 # the next line restarts using wish \
 exec /opt/usr/bin/tclsh8.5  "$0" ${1+"[email protected]"}

  • I provide a template that lists the abbrev that are provided. Type "help " and the list will appear. Just do an undo (typically a Ctrl-/ to remove it).

Troubleshooting:

  • Test each macro as you go. Copy the code snippet below to the scratch buffer, replace <YOUR MACRO NAME HERE> and <YOUR MACRO HERE> with a name and some macro code, respectively, then run M-x eval-buffer on it ( or highlight and run M-x eval-region). If it has no errors then switch to a buffer where tcl-mode is active and try it out. Iterate till you are satisfied and there are no errors and add the macro to your main list.
 (snippet-with-abbrev-table 'tcl-mode-abbrev-table
 ("<YOUR MACRO NAME HERE" .  " <YOUR MACRO HERE>")

  • If you get an error like "Invalid read syntax: ". in wrong context" then you have either NOT escaped a double quote (e.g " instead of \" ) in your macro or you have unbalanced parenthesis.

Enjoy. I Bezoar would like to see other emacsen add their own templates and improvements!

dcd Works now. I'll play with it; thanks!
 (load-file (expand-file-name "~/.emacs.d/snippet.el" ) )
 (custom-set-variables
   ;; custom-set-variables was added by Custom -- don't edit or cut/paste it!
   ;; Your init file should contain only one such instance.
  '(abbrev-mode t)
  '(save-abbrevs t)
  '(snippet-exit-identifier "~.")
  '(snippet-field-identifier "~~"))

 (defun inside-comment-p (&optional on)
   "Is the point inside a comment?
 Optional ON means to also count being on a comment start."
   ;; Note: this only handles single-character commenting, as in lisp.
   (or (and on (looking-at "\\s<"))
       (save-excursion
 	(skip-syntax-backward "^><")
 	(and (not (bobp))
 	     (eq (char-syntax (preceding-char)) ?\<)))))

; this is not necessary for snippet but helps keep common misspellings down
 (define-abbrev-table 'text-mode-abbrev-table '(
     ("teh" "the" nil 6)
     ("fo" "of" nil 4)
     ("taht" "that" nil 3)
     ("alos" "also" nil 0)
     ("ign" "ing" nil 2)
     ("adn" "and" nil 1)
     ))
 ; make sure the abrev table exists
 (define-abbrev-table 'tcl-mode-abbrev-table '(
     ("teh" "the" nil 6)
      ))

 (add-hook 'pre-abbrev-expand-hook
              (lambda ()
                (setq local-abbrev-table
                      (if (inside-comment-p)
                          text-mode-abbrev-table)))
              nil t)

 (snippet-with-abbrev-table 'tcl-mode-abbrev-table
 ("forf" .  "for { set ~~{variable} 0 } { $~~{variable} < ~~{limit} } {incr ~~{variable} } {
 ~.
 }")
 ("reqf"  .  "if { [ catch {package require ~~{package} } err ] != 0 } {
 $>puts stderr \"Unable to find package ~~{package} ... adjust your auto_path!\";
 }
 ~.")
 ("choicef"      . "[expr {( ~~{boolean} )  ? ~~{iftrue} : ~~{iffalse} } ] ~." )
 ("ifstreq"  .  "if { [ string equal ~~{str1} ~~{str2} ] }  {
   ~.
 }")
 ("openfile"  . "$>set fname ~~{fname}
 $>if { [catch {open $fname ~~{r} ~~{0666} } err ] != 0 } {
 $>    error \"Unable to open $fname because $err\"
 $>}")
 ("whilef"  .  "while { ~~{True} } {
 $>~.
 }")
 ("iff"  .  "if { ~~{True} } {
 $>~.
 } ")
 ("execf"    . "if { [ catch { exec ~~{program} } ~~{buffer} ] != 0 } {
 $>error \"Unable to execute ~~{program} : $~~{buffer}\"
 } else {
 $>~.
 }")
 ("tryf"    . "try {
 $>~.
 } catch {
 $>puts \"$errorResult\\n$errorInfo\"
 }")
 ("scriptstart"  . "#!/bin/sh
  # the next line restarts using wish \\
  exec /opt/usr/bin/tclsh8.5  \"$0\" ${1+\"[email protected]\"}
  ~." )
 ("cmdlinef" . "package require cmdline;
 package require log
 global usage options
 set options {
  $>{~~{flag}          \"~~{flag_description}\"}
  $>{~~{opt}.arg  ~~{defaultValue}  \"~~{option_description}\"}
  $>{ v         \"verbose\" }
  $>{ vv        \"double verbose\" }
  $>{ vvv       \"debug level verboseness\" }
 }
 }
 $> set usage \": $argv0 \\[options\\]  ...\\noptions:\"
 $> array set params [::cmdline::getoptions argv $options $usage]
 foreach level [ log::levels ] {
       log::lvSuppress $level 1
 }
 if { $params(v)  } {
 $>    foreach level { notice warning error } {
 $>          log::lvSuppress $level 0
 $>    }
 } elseif { $params(vv) } {
 $>    foreach level { notice info  warning error } {
 $>          log::lvSuppress $level 0
 $>    }
 } elseif { $params(vvv) } {
 $>    foreach level { notice info debug warning error } {
 $>          log::lvSuppress $level 0
 $>    }
 } else {
 $>    foreach level {  warning error } {
 $>          log::lvSuppress $level 0
 $>    }
 }
 proc logproc { level message } {
    log::Puts $level \"[clock format [clock seconds] -format \"%D %T\"] - $message\"
 }
 log::lvCmdForall logproc
 log::lvChannelForall stdout
 # adjust your cmd flags and args here
 $> if {  $params(~~{flag}) } {
 $>~.
 } ")
 ("procf" . "#-------------------------------------------------------------------------
 # ProcName: ~~{myproc}
 # Description: ~~{description}
 # Arglist :  ~~{arglist}
 # Globals :  ~~{globals}
 # namespace: ~~{namespace}
 # returns:   ~~{ 1 on success, 0 on failure}
 #-------------------------------------------------------------------------
 proc ~~{namespace}::~~{myproc} { ~~{arglist} } {
     $>global ~~{globals} ; # delete me if no globals
     $>set retval 1
     ~.
     $>return $retval;
 }" )
 ("objcommand" . "package provide ~~{name} ~~{version}
 #################################################################
 #  Command : ~~{name} ~~{version}
 #  SubCommands: ~~{command} ~~{add more here}
 #  Description: ~~{description}
 #################################################################
 namespace eval ~~{name}  {
     # counter is used to give a unique name for unnamed trees
     variable counter 0
     namespace export ~~{name} ~~{command} ~~{add more here}
 }
 ##################################################################
 # Constructor:
 # Description:	Create a new ~~{name} with a given name. If no name
 #               is given, use ~~{name}X, where X is a number.
 # Arguments:
 #	?name?	Optional name of the ~~{name}. If not given or \"\"
 #               then generate one.
 #
 # Results:
 #	name	Name of the ~~{name} created
 ##################################################################

 proc ~~{name}::~~{name} {args} {
     variable counter
     # add additional switches if you wish to add more args to the constructor
     switch -exact -- [llength [info level 0]] {
 	1 {
 	    # Standard call. New empty ~~{name}.
 	    incr counter
 	    set name \"~~{name}${counter}\"
 	}
 	2 {
 	    # Standard call. New empty ~~{name} with user provided name
 	    set name [lindex $args 0 ]
 	    incr counter
 	}
 	default {
 	    # Error.
 	    return -code error \
 		    \"wrong # args: should be \\\"~~{name} ?name?\\\"\"
 	}
     }

     # FIRST, qualify the name.
     if {![string match \"::*\" $name]} {
         # Get caller's namespace  append :: if not global namespace.
         set ns [uplevel 1 namespace current]
         if {\"::\" != $ns} {
             append ns \"::\"
         }

         set name \"$ns$name\"
     }
     if {[llength [info commands $name]]} {
 	return -code error \
 		\"command \\\"$name\\\" already exists, unable to create ~~{name}\"
     }

     # Set up the namespace for the object,
     # identical to the object command. Note if you construct with more than
     # a user provided name you will need to add the values to the internal
     # array.
     eval \"namespace eval $name \{ \
 	variable internal \
         array set internal {}  \
     \}\"
     # Create the command to manipulate the ~~{name}
     interp alias {} ::$name {} ~~{name}::~~{name}Proc $name
     # Give object to caller for use.
     return $name
 }

 ##########################
 # Private functions follow
 #
 # ~~{name}::~~{name}Proc --
 #
 #	Command that processes all ~~{name} object commands.
 #
 # Arguments:
 #	name	Name of the ~~{name} object to manipulate.
 #	cmd	Subcommand to invoke.
 #	args	Arguments for subcommand.
 #
 # Results:
 #	Varies based on command to perform
 proc ~~{name}::~~{name}Proc {name {cmd \"\" } args} {
 # Do minimal args checks here
     if { [llength [info level 0]] == 2 } {
 	return -code error \"wrong \# args: should be \\\"$name subcommand \?arg arg \?\\\"\"
     }

     # Split the args into command and args components
     set sub _$cmd
     if { [llength [info commands ::~~{name}::$sub]] == 0 } {
 	set optlist [lsort [info commands ~~{name}::_*]]
 	set xlist {}
 	foreach p $optlist {
 	    set p [namespace tail $p]
 	    lappend xlist [string range $p 1 end]
 	}
 	set optlist [linsert [join $xlist \", \"] \"end-1\" \"or\"]
 	return -code error \
 		\"bad option \\\"$cmd\\\": must be $optlist\"
     }

     set code [catch {uplevel 1 [linsert $args 0 ~~{name}::$sub $name]} result]
     switch -exact -- $code {
 	1 {
 	    return -errorinfo [ErrorInfoAsCaller uplevel $sub]  \
 		    -errorcode $::errorCode -code error $result
 	}
 	2 {
 	    return -code $code $result
 	}
     }
     return $result
 }

 proc ~~{name}::ErrorInfoAsCaller {find replace} {
 $>set info $::errorInfo
 $>set i [string last \"\\n    (\\\"$find\" $info]
 $>if {$i == -1} {return $info}
 $>set result [string range $info 0 [incr i 6]]
 $>$>append result $replace
 $>incr i [string length $find]
 $>set j [string first ) $info [incr i]]
 $>append result [string range $info $i $j]
 $>return $result
 }
 #-------------------------------------------------------------------------
 # ProcName: ~~{command}
 # Syntax  : objname ~~{command} ~~{arglist}
 # Description: ~~{description}
 # Arglist :  ~~{arglist}
 # Globals : ~~{globals}
 # namespace: ~~{name}
 # variables: internalState ~~{variables}
 # returns:   ~~{ 1 on success, 0 on failure}
 #-------------------------------------------------------------------------
 proc ~~{name}::_~~{command} {name ~~{arglist} } {
     # do not remove name from args it must be there
     global ~~{globals} ; # delete me if no globals
     variable internalState ; # use this array to hold data between invocations
     variable ~~{variables} ;
     set retval 1
     # add code here
     ~.
     return $retval;
 }")
 ("subprocf" . "#-------------------------------------------------------------------------
 # ProcName: ~~{command}
 # Syntax  : objname ~~{command} ~~{arglist}
 # Description: ~~{description}
 # Arglist :  ~~{arglist}
 # Globals : ~~{globals}
 # namespace: ~~{name}
 # variables: internalState ~~{variables}
 # returns:   ~~{ 1 on success, 0 on failure}
 #-------------------------------------------------------------------------
 proc ~~{name}::_~~{command} {name ~~{arglist} } {
     # do not remove name from args it must be there
     global ~~{globals} ; # delete me if no globals
     variable internalState ; # use this array to hold data between invocations
     variable ~~{variables} ;
     set retval 1
     # add code here
     ~.
     return $retval;
 }" )
 ("catchf"    . "catch {~.} err")
 ("ifcatch"  . "if { [ catch {~.} err ] !=0 } {
 } else {
 }")
 ("exprf"    . "[expr {~.}]")
 ("runf"     . "[~.]")
 ("slen"  . "[string length ~~{first} ] ~.")
 ("seq"  . "[string equal ~~{first} ~~{second} ] ~.")
 ("sfirst"  . "[string first ~~{searchfor} ~~{inthisstring} ~~{?startindex?} ] ~." )
 ("sidx"  .  "[string index ~~{string} ~~{index}] ~.")
 ("getsetf"  .  "
  $>variable {}
  $>array set {} ~~{array value list}
  $>proc _get { name } {
  $> variable {}
  $> if { [ info exists ($name) ] } { return $name }
  $> return \"\";
  $>}
  $>proc _set { name value } {
  $>   variable {}
  $>   ::set ($name) $value
  $>}
  $>foreach name [ array names {} ] {
  $> eval \" proc set$name \\{ value \\} \\{
  $>         _set $name \$value
  $>       \\}
  $>       proc get$name \\{ \\} \\{
  $>         return [_get $name ]
  $>      \\}\"
  $>}")
 ("ifelse" . "if { ~~{arg} } {

 } else {

 }" )
 ( "help" . "# ------------------ Emacs snippets for tcl -----
 #-----------------------------------------
 #toplevel templates
 #-----------------------------------------
 # procf       - documentation and proc header line with namespace support
 # cmdlinef    - create option processing for commandline
 # scriptstart - Start code for script file
 # req         - package require xxx
 # objcmd      - create an object command package
 # subprocf    - like procf but speciallized for objcmd
 #-----------------------------------------
 # Code level Templates
 #-----------------------------------------
 # execf       - exec with error catching
 # expectf     - full expect loop
 # forf        - forloop with body
 # ifstreq       - if { [ string equal XX YY ] }
 # ifelse      - if { } { } else { }
 # openfile    - open file with catch
 # ifcatch     - if with catch block
 # catchf      - catch
 # iff         - same as if but with complete body
 # choicef     - expr (bool) ? iftrue : iffalse
 # getsetf     - use {} array to store variables in namespace
 #               provides getters and setters.
 # run         - [ ]
 # seq         - [string equal XX YY ]
 # slen        - [string first XXX YYYY ]
 # sfirst      - [string first XXX YYYY start at ]
 # sidx        - [string index XXX num ]
 # tryf        - Tclx try/catch complete with body
 # whilef      - while { XXX } { }
 \#------------------------------------------------------------" )
 ("expectf" . "set ~~{spawn_id} $spawn_id;
 set bad 0;
 set done 0;
 exp_internal 0; \# set to one for extensive debug
 log_user 0; \# set to one to watch action
 expect {
 $>-i $~~{spawn_id}
 $>-re {~.} {
 $>    exp_continue;
 $>  }
 $>timeout {
 $>   puts \"timeout\"
 $>   set bad 1
 $>}
 $>fullbuffer {
 $>  puts \" buffer is full\"
 $>  exp_continue;
 $>}
 $>eof {
 $>     puts \"Eof detected \"
 $>     set done 1 ;
 $>}
 }
 set exitstatus [ exp_wait -i $~~{spawn_id} ];
 catch { exp_close -i $~~{spawn_id} };
 ")
 )