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:
Installation:
#!/bin/sh
# the next line restarts using wish \
exec /opt/usr/bin/tclsh8.5 "$0" ${1+"$@"}Troubleshooting:
(snippet-with-abbrev-table 'tcl-mode-abbrev-table
("<YOUR MACRO NAME HERE" . " <YOUR MACRO HERE>")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+\"$@\"}
~." )
("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} };
")
)