Tcl Elisp Macros

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."
   ;; if it already appears to have the #!, just stop
   (if (looking-at "^#!")
       (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: ")
   (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"
   "# 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."
   (re-search-forward "proc ")
   (goto-char (match-beginning 0))
   (recenter '(4)))

 (defun backward-tcl-definition ()
   "Move backward to the previous procedure definition."
   (re-search-backward "proc ")
   (goto-char (match-beginning 0))
   (recenter '(4)))

The direct URL, I think, is

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")
      (let ((end (point)))
        (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?