2003-12-21 VI Just a messenger. JH's post to comp.lang.tcl on useful Emacs Macros
(setq tcl-default-application "tclsh")
(add-hook 'tcl-mode-hook
'(lambda ()
;; Yes, this really does improve debugging
(font-lock-mode 1)
(setq show-trailing-whitespace 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) " copyright-current-year " " 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"
"# RCS: @(#) $Id: 10593,v 1.1 2003-12-22 07:00:46 jcw Exp $ \n\n"
"#package require NAME VERSION\n"
"package provide " pkgname " " pkgversion
"\n\nnamespace 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};")
))
(defun tcl-mode-customize ()
(auto-fill-mode 1)
(setq fill-column 79)
;; This is "^C^C" for comment-region
(define-key tcl-mode-map "\C-c\C-c" 'comment-region)
(define-key tcl-mode-map [C-next] 'forward-tcl-definition)
(define-key tcl-mode-map [C-prior] 'backward-tcl-definition)
(define-key tcl-mode-map [menu-bar tcl-mode insert-header]
'("Insert Header" . insert-header))
(define-key tcl-mode-map [menu-bar tcl-mode insert-function]
'("Insert Function" . insert-function))
(define-key tcl-mode-map [menu-bar c core-headers]
'("Use Tcl Core Header Templates" . core-headers))
(define-key tcl-mode-map [menu-bar c scriptics-headers]
'("Use Scriptics Header Templates" . scriptics-headers))
)
(add-hook 'tcl-mode-hook 'tcl-mode-customize)
(defun forward-tcl-definition ()
"Move forward to the next procedure definition."
(interactive)
(forward-char)
(re-search-forward "proc ")
(goto-char (match-beginning 0))
(recenter '(4)))
(defun backward-tcl-definition ()
"Move backward to the previous procedure definition."
(interactive)
(re-search-backward "proc ")
(goto-char (match-beginning 0))
(recenter '(4)))The direct URL, I think, is http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&oe=UTF-8&selm=3FD55159.9050008%40activestate.com&rnum=12
daapp I use this code to copy current procedure to clipboard to paste it later in already running application:
(defun my-tcl-copy-defun (&optional and-op)
"Copy the current defun to the clipboard.
Prefix argument means switch to the Tcl buffer afterwards."
(interactive "P")
(save-excursion
(end-of-defun)
(let ((end (point)))
(beginning-of-defun)
(copy-region-as-kill (point) end))))I have some ideas about slime like mode for emacs/tcl development using comm package from tcllib. Does anybody interesting?