ENHANCED: emacs style guide key bindings for Tcl mode

[Jeffrey Hobbs]

I played around a little more with my key bindings to get the following
(documenteed above the functions). These have better prompting, plus
a couple more functions, than the last posting.

------8<------8<------8<------8<------8<------8<------8<------8<
(add-hook 'tcl-mode-hook
'(lambda ()
;; Yes, this really does improve debugging
(font-lock-mode 1)
(define-key tcl-mode-map "\C-cf" 'tcl-stub-file)
(define-key tcl-mode-map "\C-c\C-f" 'tcl-stub-file-exec)
(define-key tcl-mode-map "\C-cp" 'tcl-stub-proc)
(define-key tcl-mode-map "\C-cn" 'tcl-stub-namespace)
(define-key tcl-mode-map "\C-c\C-p" 'tcl-stub-pkgindex)
))

;; <Control-c><Control-f>
;; Create the magic #! headers for a Tcl file
;; This will always insert at the top, but will do nothing
;; if the file already has a #! header
(defun tcl-stub-file-exec ()
"Inserts proper headers for an executable tcl file."
(interactive)
(beginning-of-buffer)
;; if it already appears to have the #!, just stop
(if (looking-at "^#!")
()
(progn
(insert "#!/bin/sh\n"
"# The next line is executed by /bin/sh, but not tcl \\\n"
"exec " tcl-default-application " $0 ${1+\"$@\"}\n\n")
)))

;; <Control-c><f>
;; Create the file headers as per the style guide recommendations
;; This queries for a package name and version and insert the code
;; for package provision and namespace (thus Tcl8+ oriented)
(defun tcl-stub-file (pkgname pkgversion)
"Inserts proper headers in a Tcl file."
(interactive "sPackage Name: \nsPackage Version: ")
(beginning-of-buffer)
(if (looking-at "^#!")
;; If the file begins with "#!" (exec magic)
;; move forward to first empty line to avoid messing with it.
(search-forward "\n\n" (point-max) t)
)
(insert "# " (file-name-nondirectory buffer-file-name) " --\n#\n"
"#\tThis file implements package " pkgname ", which ...\n"
"#\n# Copyright (c) 1997 " user-full-name "\n#\n"
"# See the file \"license.terms\" for information on usage and\n"
"# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.\n"
"#\n"
"# SCCS: %Z% %M% %I% %E% %U% \n\n"
"#package require NAME VERSION\n"
"package provide " pkgname " " pkgversion
"namespace eval " pkgname " {;\n"
"#namespace export -clear *\n"
"\n\n}; # end of namespace " pkgname "\n")
(search-backward "\n};")
)

;; <Control-c><p>
;; Insert the stub headers for a proc with the style guide format
;; Queries for procedure name and args
(defun tcl-stub-proc (procname argnames)
"creates proper headers for a tcl proc"
(interactive "sProcedure Name: \nsArguments: ")
(let ((start (point)))
(insert "# " procname " --\n"
"#\n# ADD COMMENTS HERE\n"
"#\n# Arguments:\n"
"# args\tcomments\n"
"# Results:\n# Returns ...\n#\n"
"proc " procname " {" argnames "} {\n\n}\n")
(indent-region start (point) (tcl-calculate-indentation start))
;; move to body of proc
;; maybe should move to ADD to encourage commenting from the start
(search-backward "\n}")
))

;; <Control-c><Control-p>
;; Inserts a package ifneeded command, meant for pkgIndex.tcl
;; Queries for package name, version, tcl file and procedure names of
;; the package
(defun tcl-stub-pkgindex (pkgname pkgversion tclfile procnames)
"creates package ifneeded stub line proper for pkgIndex.tcl file"
(interactive "sPackage Name: \nsPackage Version: \nFTcl File: \nsProcedures: ")
(let ((start (point)))
(insert "package ifneeded " pkgname " " pkgversion
" [list tclPkgSetup $dir " pkgname " " pkgversion
" {\n {" (file-name-nondirectory tclfile)
" source {\n\t" procnames "\n}}}]\n"
)
(search-backward "\n}")
))

;; <Control-c><n>
;; Creates stub namespace headers
;; Queries for namespace name
(defun tcl-stub-namespace (namespace)
"creates proper headers for a tcl namespace"
(interactive "sNamespace Name: ")
(let ((start (point)))
(insert "# Namespace " namespace " --\n"
"#\n# ADD COMMENTS HERE\n#\n"
"namespace eval " namespace " {;\n"
"#namespace export -clear *\n"
"\n\n}; # end of nameespace " namespace "\n")
(indent-region start (point) (tcl-calculate-indentation start))
(search-backward "\n};")
))

--
Jeffrey Hobbs "I'm really just a Tcl-bot"
jeff.hobbs at acm.org | Jeffrey.Hobbs at oen.siemens.de