dejagnu/tcl-mode.el

   1 ;; tcl.el --- Tcl code editing commands for Emacs
   2
   3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: Tom Tromey <tromey@busco.lanl.gov>
   6 ;; Author: Tom Tromey <tromey@busco.lanl.gov>
   7 ;;    Chris Lindblad <cjl@lcs.mit.edu>
   8 ;; Keywords: languages tcl modes
   9 ;; Version: 1.49
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 1, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;; HOW TO INSTALL:
  28 ;; Put the following forms in your .emacs to enable autoloading of Tcl
  29 ;; mode, and auto-recognition of ".tcl" files.
  30 ;;
  31 ;;   (autoload 'tcl-mode "tcl" "Tcl mode." t)
  32 ;;   (autoload 'inferior-tcl "tcl" "Run inferior Tcl process." t)
  33 ;;   (setq auto-mode-alist (append '(("\\.tcl$" . tcl-mode)) auto-mode-alist))
  34 ;;
  35 ;; If you plan to use the interface to the TclX help files, you must
  36 ;; set the variable tcl-help-directory-list to point to the topmost
  37 ;; directories containing the TclX help files.  Eg:
  38 ;;
  39 ;;   (setq tcl-help-directory-list '("/usr/local/lib/tclx/help"))
  40 ;;
  41 ;; Also you will want to add the following to your .emacs:
  42 ;;
  43 ;;   (autoload 'tcl-help-on-word "tcl" "Help on Tcl commands" t)
  44 ;;
  45 ;; FYI a *very* useful thing to do is nroff all the Tk man pages and
  46 ;; put them in a subdir of the help system.
  47 ;;
  48
  49 ;;; Commentary:
  50
  51 ;; LCD Archive Entry:
  52 ;; tcl|Tom Tromey|tromey@busco.lanl.gov|
  53 ;; Major mode for editing Tcl|
  54 ;; 1995/12/07 18:27:47|1.49|~/modes/tcl.el.Z|
  55
  56 ;; CUSTOMIZATION NOTES:
  57 ;; * tcl-proc-list can be used to customize a list of things that
  58 ;; "define" other things.  Eg in my project I put "defvar" in this
  59 ;; list.
  60 ;; * tcl-typeword-list is similar, but uses font-lock-type-face.
  61 ;; * tcl-keyword-list is a list of keywords.  I've generally used this
  62 ;; for flow-control words.  Eg I add "unwind_protect" to this list.
  63 ;; * tcl-type-alist can be used to minimally customize indentation
  64 ;; according to context.
  65
  66 ;; Change log:
  67 ;; tcl.el,v
  68 ;; Revision 1.49  1995/12/07  18:27:47  tromey
  69 ;; (add-log-tcl-defun): Don't use tcl-beginning-of-defun; just go to end
  70 ;; of line before searching.
  71 ;;
  72 ;; Revision 1.48  1995/12/07  18:18:21  tromey
  73 ;; (add-log-tcl-defun): Now uses tcl-beginning-of-defun.
  74 ;;
  75 ;; Revision 1.47  1995/08/22  17:49:45  tromey
  76 ;; (tcl-hilit): New function from "Chris Alfeld" <calfeld@math.utah.edu>
  77 ;; (tcl-mode): Call it
  78 ;;
  79 ;; Revision 1.46  1995/08/07  16:02:01  tromey
  80 ;; (tcl-do-auto-fill): Only fill past fill-column; for 19.29.
  81 ;; (tcl-auto-fill-mode): Use force-mode-line-update.
  82 ;;
  83 ;; Revision 1.45  1995/07/23  23:51:25  tromey
  84 ;; (tcl-word-no-props): New function.
  85 ;; (tcl-figure-type): Use it.
  86 ;; (tcl-current-word): Ditto.
  87 ;;
  88 ;; Revision 1.44  1995/07/23  20:26:47  tromey
  89 ;; Doc fixes.
  90 ;;
  91 ;; Revision 1.43  1995/07/17  19:59:49  tromey
  92 ;; (inferior-tcl-mode): Use modeline-process if it exists.
  93 ;;
  94 ;; Revision 1.42  1995/07/17  19:55:25  tromey
  95 ;; XEmacs currently must use tcl-internal-end-of-defun
  96 ;;
  97 ;; Revision 1.41  1995/07/14  21:54:56  tromey
  98 ;; Changes to make menus work in XEmacs.
  99 ;; From Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
 100 ;;
 101 ;; Revision 1.40  1995/07/11  03:13:15  tromey
 102 ;; (tcl-mode): Customize for new dabbrev.
 103 ;;
 104 ;; Revision 1.39  1995/07/09  21:58:03  tromey
 105 ;; (tcl-do-fill-paragraph): New function.
 106 ;; (tcl-mode): Set up for paragraph filling.
 107 ;;
 108 ;; Revision 1.38  1995/07/09  21:30:32  tromey
 109 ;; (tcl-mode): Fixes to 19.29 paragraph variables.
 110 ;;
 111 ;; Revision 1.37  1995/07/09  18:52:16  tromey
 112 ;; (tcl-do-auto-fill): Set fill-prefix.
 113 ;;
 114 ;; Revision 1.36  1995/07/09  01:07:57  tromey
 115 ;; (tcl-imenu-create-index-function): Work with imenu from Emacs 19.29
 116 ;;
 117 ;; Revision 1.35  1995/06/27  20:12:00  tromey
 118 ;; (tcl-type-alist): More itcl changes.
 119 ;;
 120 ;; Revision 1.34  1995/06/27  20:06:05  tromey
 121 ;; More changes for itcl.
 122 ;; Bug fixes for Emacs 19.29.
 123 ;;
 124 ;; Revision 1.33  1995/06/27  20:01:29  tromey
 125 ;; (tcl-set-proc-regexp): Allow leading spaces.
 126 ;; (tcl-proc-list): Changes for itcl.
 127 ;; (tcl-typeword-list): Ditto.
 128 ;; (tcl-keyword-list): Ditto.
 129 ;;
 130 ;; Revision 1.32  1995/05/11  22:12:49  tromey
 131 ;; (tcl-type-alist): Include entry for "proc".
 132 ;;
 133 ;; Revision 1.31  1995/05/10  23:38:12  tromey
 134 ;; (tcl-add-fsf-menu): Use make-lucid-menu-keymap, not
 135 ;; "make-xemacs-menu-keymap".
 136 ;;
 137 ;; Revision 1.30  1995/05/10  18:22:21  tromey
 138 ;; Bug fix in menu code for XEmacs.
 139 ;;
 140 ;; Revision 1.29  1995/05/09  21:36:53  tromey
 141 ;; Changed "Lucid Emacs" to "XEmacs".
 142 ;; Tcl's popup menu now added to existing one, courtesy
 143 ;; dfarmer@evolving.com (Doug Farmer)
 144 ;;
 145 ;; Revision 1.28  1995/04/08  19:52:50  tromey
 146 ;; (tcl-outline-level): New function
 147 ;; (tcl-mode): Added outline-handling stuff.
 148 ;; From Jesper Pedersen <blackie@imada.ou.dk>
 149 ;;
 150 ;; Revision 1.27  1994/10/11  02:01:27  tromey
 151 ;; (tcl-mode): imenu-create-index-function made buffer local.
 152 ;;
 153 ;; Revision 1.26  1994/09/01  18:06:24  tromey
 154 ;; Added filename completion in inferior tcl mode
 155 ;;
 156 ;; Revision 1.25  1994/08/22  15:56:24  tromey
 157 ;; tcl-load-file default to current buffer.
 158 ;;
 159 ;; Revision 1.24  1994/08/21  20:33:05  tromey
 160 ;; Fixed bug in tcl-guess-application.
 161 ;;
 162 ;; Revision 1.23  1994/08/21  03:54:45  tromey
 163 ;; Keybindings don't overshadown comint bindings.
 164 ;;
 165 ;; Revision 1.22  1994/07/26  00:46:07  tromey
 166 ;; Emacs 18 changes from Carl Witty.
 167 ;;
 168 ;; Revision 1.21  1994/07/14  22:49:21  tromey
 169 ;; Added ";;;###autoload" comments where appropriate.
 170 ;;
 171 ; Revision 1.20  1994/06/05  16:57:22  tromey
 172 ; tcl-current-word does the right thing in inferior-tcl-mode.
 173 ;
 174 ; Revision 1.19  1994/06/03  21:09:19  tromey
 175 ; Another menu fix.
 176 ;
 177 ; Revision 1.18  1994/06/03  20:39:14  tromey
 178 ; Fixed menu bug.
 179 ;
 180 ; Revision 1.17  1994/06/03  00:47:15  tromey
 181 ; Fixed bug in bug-reporting code.
 182 ;
 183 ; Revision 1.16  1994/05/26  05:06:14  tromey
 184 ; Menu items now sensitive as appropriate.
 185 ;
 186 ; Revision 1.15  1994/05/22  20:38:11  tromey
 187 ; Added bug-report keybindings and menu entries.
 188 ;
 189 ; Revision 1.14  1994/05/22  20:18:28  tromey
 190 ; Even more compile stuff.
 191 ;
 192 ; Revision 1.13  1994/05/22  20:17:15  tromey
 193 ; Moved emacs version checking code to very beginning.
 194 ;
 195 ; Revision 1.12  1994/05/22  20:14:59  tromey
 196 ; Compile fixes.
 197 ;
 198 ; Revision 1.11  1994/05/22  20:12:44  tromey
 199 ; Fixed mark-defun for 19.23.
 200 ; More menu fixes.
 201 ;
 202 ; Revision 1.10  1994/05/22  20:02:03  tromey
 203 ; Fixed bug with M-;.
 204 ; Wrote bug-reporting code.
 205 ;
 206 ; Revision 1.9  1994/05/22  05:26:51  tromey
 207 ; Fixes for imenu.
 208 ;
 209 ; Revision 1.8  1994/05/22  03:38:07  tromey
 210 ; Fixed menu support.
 211 ;
 212 ; Revision 1.7  1994/05/03  01:23:42  tromey
 213 ; *** empty log message ***
 214 ;
 215 ; Revision 1.6  1994/04/23  16:23:36  tromey
 216 ; Wrote tcl-indent-for-comment
 217 ;
 218 ;;
 219 ;; 18-Mar-1994          Tom Tromey      Fourth beta release.
 220 ;;    Added {un,}comment-region to menu.  Idea from
 221 ;;    Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
 222 ;; 17-Mar-1994          Tom Tromey
 223 ;;    Fixed tcl-restart-with-file.  Bug fix attempt in
 224 ;;    tcl-internal-end-of-defun.
 225 ;; 16-Mar-1994          Tom Tromey      Third beta release
 226 ;;    Added support code for menu (from Tcl mode written by
 227 ;;    schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)).
 228 ;; 12-Mar-1994          Tom Tromey
 229 ;;    Better documentation for inferior-tcl-buffer.  Wrote
 230 ;;    tcl-restart-with-file.  Wrote Lucid Emacs menu (but no
 231 ;;    code to install it).
 232 ;; 12-Mar-1994          Tom Tromey
 233 ;;    Wrote tcl-guess-application.  Another stab at making
 234 ;;    tcl-omit-ws-regexp work.
 235 ;; 10-Mar-1994          Tom Tromey      Second beta release
 236 ;;    Last Modified: Thu Mar 10 01:24:25 1994 (Tom Tromey)
 237 ;;    Wrote perl-mode style line indentation command.
 238 ;;    Wrote more documentation.  Added tcl-continued-indent-level.
 239 ;;    Integrated help code.
 240 ;; 8-Mar-1994           Tom Tromey
 241 ;;    Last Modified: Tue Mar  8 11:58:44 1994 (Tom Tromey)
 242 ;;    Bug fixes.
 243 ;; 6-Mar-1994           Tom Tromey
 244 ;;    Last Modified: Sun Mar  6 18:55:41 1994 (Tom Tromey)
 245 ;;    Updated auto-newline support.
 246 ;; 6-Mar-1994           Tom Tromey      Beta release
 247 ;;    Last Modified: Sat Mar  5 17:24:32 1994 (Tom Tromey)
 248 ;;    Wrote tcl-hashify-buffer.  Other minor bug fixes.
 249 ;; 5-Mar-1994           Tom Tromey
 250 ;;    Last Modified: Sat Mar  5 16:11:20 1994 (Tom Tromey)
 251 ;;    Wrote electric-hash code.
 252 ;; 3-Mar-1994           Tom Tromey
 253 ;;    Last Modified: Thu Mar  3 02:53:40 1994 (Tom Tromey)
 254 ;;    Added code to handle auto-fill in comments.
 255 ;;    Added imenu support code.
 256 ;;    Cleaned up code.
 257 ;;    Better font-lock support.
 258 ;; 28-Feb-1994          Tom Tromey
 259 ;;    Last Modified: Mon Feb 28 14:08:05 1994 (Tom Tromey)
 260 ;;    Made tcl-figure-type more easily configurable.
 261 ;; 28-Feb-1994          Tom Tromey
 262 ;;    Last Modified: Mon Feb 28 01:02:58 1994 (Tom Tromey)
 263 ;;    Wrote inferior-tcl mode.
 264 ;; 16-Feb-1994          Tom Tromey
 265 ;;    Last Modified: Wed Feb 16 17:05:19 1994 (Tom Tromey)
 266 ;;    Added support for font-lock-mode.
 267 ;; 29-Oct-1993          Tom Tromey
 268 ;;    Last Modified: Sun Oct 24 17:39:14 1993 (Tom Tromey)
 269 ;;    Patches from Guido Bosch to make things work with Lucid Emacs.
 270 ;; 22-Oct-1993          Tom Tromey
 271 ;;    Last Modified: Fri Oct 22 15:26:46 1993 (Tom Tromey)
 272 ;;    Made many characters have "_" syntax class; suggested by Guido
 273 ;;    Bosch <Guido.Bosch@loria.fr>.  Note that this includes the "$"
 274 ;;    character, which might be a change you'd notice.
 275 ;; 21-Oct-1993          Tom Tromey
 276 ;;    Last Modified: Thu Oct 21 20:28:40 1993 (Tom Tromey)
 277 ;;    More fixes for tcl-omit-ws-regexp.
 278 ;; 20-Oct-1993          Tom Tromey
 279 ;;    Started keeping history.  Fixed tcl-{beginning,end}-of-defun.
 280 ;;    Added some code to make things work with Emacs 18.
 281
 282 ;; THANKS TO:
 283 ;; Guido Bosch <Guido.Bosch@loria.fr>
 284 ;; pgs1002@esc.cam.ac.uk (Dr P.G. Sjoerdsma)
 285 ;; Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
 286 ;; Matt Newman <men@charney.colorado.edu>
 287 ;; rwhitby@research.canon.oz.au (Rod Whitby)
 288 ;; h9118101@hkuxa.hku.hk (Yip Chi Lap [Beta])
 289 ;; Pertti Tapio Kasanen <ptk@delta.hut.fi>
 290 ;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)
 291 ;; warsaw@nlm.nih.gov (Barry A. Warsaw)
 292 ;; Carl Witty <cwitty@ai.mit.edu>
 293 ;; T. V. Raman <raman@crl.dec.com>
 294 ;; Jesper Pedersen <blackie@imada.ou.dk>
 295 ;; dfarmer@evolving.com (Doug Farmer)
 296 ;; "Chris Alfeld" <calfeld@math.utah.edu>
 297
 298 ;; KNOWN BUGS:
 299 ;; * indent-region should skip blank lines.  (It does in v19, so I'm
 300 ;;   not motivated to fix it here).
 301 ;; * In Tcl "#" is not always a comment character.  This can confuse
 302 ;;   tcl.el in certain circumstances.  For now the only workaround is
 303 ;;   to enclose offending hash characters in quotes or precede it with
 304 ;;   a backslash.  Note that using braces won't work -- quotes change
 305 ;;   the syntax class of characters between them, while braces do not.
 306 ;;   The electric-# mode helps alleviate this problem somewhat.
 307 ;; * indent-tcl-exp is untested.
 308 ;; * Doesn't work under Emacs 18 yet.
 309 ;; * There's been a report that font-lock does strange things under
 310 ;;   Lucid Emacs 19.6.  For instance in "proc foobar", the space
 311 ;;   before "foobar" is highlighted.
 312
 313 ;; TODO:
 314 ;; * make add-log-tcl-defun smarter.  should notice if we are in the
 315 ;;   middle of a defun, or between defuns.  should notice if point is
 316 ;;   on first line of defun (or maybe even in comments before defun).
 317 ;; * Allow continuation lines to be indented under the first argument
 318 ;;   of the preceeding line, like this:
 319 ;;      [list something \
 320 ;;            something-else]
 321 ;; * There is a request that indentation work like this:
 322 ;;        button .fred -label Fred \
 323 ;;                     -command {puts fred}
 324 ;; * Should have tcl-complete-symbol that queries the inferior process.
 325 ;; * Should have describe-symbol that works by sending the magic
 326 ;;   command to a tclX process.
 327 ;; * Need C-x C-e binding (tcl-eval-last-exp).
 328 ;; * Write indent-region function that is faster than indenting each
 329 ;;   line individually.
 330 ;; * tcl-figure-type should stop at "beginning of line" (only ws
 331 ;;   before point, and no "\" on previous line).  (see tcl-real-command-p).
 332 ;; * overrides some comint keybindings; fix.
 333 ;; * Trailing \ will eat blank lines.  Should deal with this.
 334 ;;   (this would help catch some potential bugs).
 335 ;; * Inferior should display in half the screen, not the whole screen.
 336 ;; * Indentation should deal with "switch".
 337 ;; * Consider writing code to find help files automatically (for
 338 ;;   common cases).
 339 ;; * `#' shouldn't insert `\#' when point is in string.
 340
 341 \f
 342
 343 ;;; Code:
 344
 345 ;; I sure wish Emacs had a package that made it easy to extract this
 346 ;; sort of information.
 347 (defconst tcl-using-emacs-19 (string-match "19\\." emacs-version)
 348   "Nil unless using Emacs 19 (XEmacs or FSF).")
 349
 350 ;; FIXME this will break on Emacs 19.100.
 351 (defconst tcl-using-emacs-19-23
 352   (string-match "19\\.\\(2[3-9]\\|[3-9][0-9]\\)" emacs-version)
 353   "Nil unless using Emacs 19-23 or later.")
 354
 355 (defconst tcl-using-xemacs-19 (string-match "XEmacs" emacs-version)
 356   "Nil unless using XEmacs).")
 357
 358 (require 'comint)
 359
 360 ;; When compiling under GNU Emacs, load imenu during compilation.  If
 361 ;; you have 19.22 or earlier, comment this out, or get imenu.
 362 (and (fboundp 'eval-when-compile)
 363      (eval-when-compile
 364        (if (and (string-match "19\\." emacs-version)
 365                 (not (string-match "XEmacs" emacs-version)))
 366            (require 'imenu))
 367        ()))
 368
 369 (defconst tcl-version "1.49")
 370 (defconst tcl-maintainer "Tom Tromey <tromey@drip.colorado.edu>")
 371
 372 ;;
 373 ;; User variables.
 374 ;;
 375
 376 (defvar tcl-indent-level 4
 377   "*Indentation of Tcl statements with respect to containing block.")
 378
 379 (defvar tcl-continued-indent-level 4
 380   "*Indentation of continuation line relative to first line of command.")
 381
 382 (defvar tcl-auto-newline nil
 383   "*Non-nil means automatically newline before and after braces
 384 inserted in Tcl code.")
 385
 386 (defvar tcl-tab-always-indent t
 387   "*Control effect of TAB key.
 388 If t (the default), always indent current line.
 389 If nil and point is not in the indentation area at the beginning of
 390 the line, a TAB is inserted.
 391 Other values cause the first possible action from the following list
 392 to take place:
 393
 394   1. Move from beginning of line to correct indentation.
 395   2. Delete an empty comment.
 396   3. Move forward to start of comment, indenting if necessary.
 397   4. Move forward to end of line, indenting if necessary.
 398   5. Create an empty comment.
 399   6. Move backward to start of comment, indenting if necessary.")
 400
 401 (defvar tcl-use-hairy-comment-detector t
 402   "*If not `nil', the the more complicated, but slower, comment
 403 detecting function is used.  This variable is only used in GNU Emacs
 404 19 (the fast function is always used elsewhere).")
 405
 406 (defvar tcl-electric-hash-style 'smart
 407   "*Style of electric hash insertion to use.
 408 Possible values are 'backslash, meaning that `\\' quoting should be
 409 done; 'quote, meaning that `\"' quoting should be done; 'smart,
 410 meaning that the choice between 'backslash and 'quote should be
 411 made depending on the number of hashes inserted; or nil, meaning that
 412 no quoting should be done.  Any other value for this variable is
 413 taken to mean 'smart.  The default is 'smart.")
 414
 415 (defvar tcl-help-directory-list nil
 416   "*List of topmost directories containing TclX help files")
 417
 418 (defvar tcl-use-smart-word-finder t
 419   "*If not nil, use a better way of finding the current word when
 420 looking up help on a Tcl command.")
 421
 422 (defvar tcl-application "wish"
 423   "*Name of Tcl application to run in inferior Tcl mode.")
 424
 425 (defvar tcl-command-switches nil
 426   "*Switches to supply to `tcl-application'.")
 427
 428 (defvar tcl-prompt-regexp "^\\(% \\|\\)"
 429   "*If not nil, a regexp that will match the prompt in the inferior process.
 430 If nil, the prompt is the name of the application with \">\" appended.
 431
 432 The default is \"^\\(% \\|\\)\", which will match the default primary
 433 and secondary prompts for tclsh and wish.")
 434
 435 (defvar inferior-tcl-source-command "source %s\n"
 436   "*Format-string for building a Tcl command to load a file.
 437 This format string should use `%s' to substitute a file name
 438 and should result in a Tcl expression that will command the
 439 inferior Tcl to load that file.  The filename will be appropriately
 440 quoted for Tcl.")
 441
 442 ;;
 443 ;; Keymaps, abbrevs, syntax tables.
 444 ;;
 445
 446 (defvar tcl-mode-abbrev-table nil
 447   "Abbrev table in use in Tcl-mode buffers.")
 448 (if tcl-mode-abbrev-table
 449     ()
 450   (define-abbrev-table 'tcl-mode-abbrev-table ()))
 451
 452 (defvar tcl-mode-map ()
 453   "Keymap used in Tcl mode.")
 454
 455 (defvar tcl-mode-syntax-table nil
 456   "Syntax table in use in Tcl-mode buffers.")
 457 (if tcl-mode-syntax-table
 458     ()
 459   (setq tcl-mode-syntax-table (make-syntax-table))
 460   (modify-syntax-entry ?%  "_" tcl-mode-syntax-table)
 461   (modify-syntax-entry ?@  "_" tcl-mode-syntax-table)
 462   (modify-syntax-entry ?&  "_" tcl-mode-syntax-table)
 463   (modify-syntax-entry ?*  "_" tcl-mode-syntax-table)
 464   (modify-syntax-entry ?+  "_" tcl-mode-syntax-table)
 465   (modify-syntax-entry ?-  "_" tcl-mode-syntax-table)
 466   (modify-syntax-entry ?.  "_" tcl-mode-syntax-table)
 467   (modify-syntax-entry ?:  "_" tcl-mode-syntax-table)
 468   (modify-syntax-entry ?!  "_" tcl-mode-syntax-table)
 469   (modify-syntax-entry ?$  "_" tcl-mode-syntax-table) ; FIXME use "'"?
 470   (modify-syntax-entry ?/  "_" tcl-mode-syntax-table)
 471   (modify-syntax-entry ?~  "_" tcl-mode-syntax-table)
 472   (modify-syntax-entry ?<  "_" tcl-mode-syntax-table)
 473   (modify-syntax-entry ?=  "_" tcl-mode-syntax-table)
 474   (modify-syntax-entry ?>  "_" tcl-mode-syntax-table)
 475   (modify-syntax-entry ?|  "_" tcl-mode-syntax-table)
 476   (modify-syntax-entry ?\(  "()" tcl-mode-syntax-table)
 477   (modify-syntax-entry ?\)  ")(" tcl-mode-syntax-table)
 478   (modify-syntax-entry ?\;  "." tcl-mode-syntax-table)
 479   (modify-syntax-entry ?\n ">   " tcl-mode-syntax-table)
 480   (modify-syntax-entry ?\f ">   " tcl-mode-syntax-table)
 481   (modify-syntax-entry ?# "<   " tcl-mode-syntax-table))
 482
 483 (defvar inferior-tcl-mode-map nil
 484   "Keymap used in Inferior Tcl mode.")
 485
 486 ;; XEmacs menu.
 487 (defvar tcl-xemacs-menu
 488   '(["Beginning of function" tcl-beginning-of-defun t]
 489     ["End of function" tcl-end-of-defun t]
 490     ["Mark function" tcl-mark-defun t]
 491     ["Indent region" indent-region (tcl-mark)]
 492     ["Comment region" comment-region (tcl-mark)]
 493     ["Uncomment region" tcl-uncomment-region (tcl-mark)]
 494     "----"
 495     ["Show Tcl process buffer" inferior-tcl t]
 496     ["Send function to Tcl process" tcl-eval-defun
 497      (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
 498     ["Send region to Tcl process" tcl-eval-region
 499      (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
 500     ["Send file to Tcl process" tcl-load-file
 501      (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
 502     ["Restart Tcl process with file" tcl-restart-with-file t]
 503     "----"
 504     ["Tcl help" tcl-help-on-word tcl-help-directory-list]
 505     ["Send bug report" tcl-submit-bug-report t])
 506   "XEmacs menu for Tcl mode.")
 507
 508 ;; GNU Emacs does menus via keymaps.  Do it in a function in case we
 509 ;; later decide to add it to inferior Tcl mode as well.
 510 (defun tcl-add-fsf-menu (map)
 511   (define-key map [menu-bar] (make-sparse-keymap))
 512   ;; This fails in Emacs 19.22 and earlier.
 513   (require 'lmenu)
 514   (let ((menu (make-lucid-menu-keymap "Tcl" tcl-xemacs-menu)))
 515     (define-key map [menu-bar tcl] (cons "Tcl" menu))
 516     ;; The following is intended to compute the key sequence
 517     ;; information for the menu.  It doesn't work.
 518     (x-popup-menu nil menu)))
 519
 520 (defun tcl-fill-mode-map ()
 521   (define-key tcl-mode-map "{" 'tcl-electric-char)
 522   (define-key tcl-mode-map "}" 'tcl-electric-brace)
 523   (define-key tcl-mode-map "[" 'tcl-electric-char)
 524   (define-key tcl-mode-map "]" 'tcl-electric-char)
 525   (define-key tcl-mode-map ";" 'tcl-electric-char)
 526   (define-key tcl-mode-map "#" 'tcl-electric-hash)
 527   ;; FIXME.
 528   (define-key tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
 529   ;; FIXME.
 530   (define-key tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
 531   ;; FIXME.
 532   (define-key tcl-mode-map "\e\C-h" 'tcl-mark-defun)
 533   (define-key tcl-mode-map "\e\C-q" 'indent-tcl-exp)
 534   (define-key tcl-mode-map "\177" 'backward-delete-char-untabify)
 535   (define-key tcl-mode-map "\t" 'tcl-indent-command)
 536   (define-key tcl-mode-map "\M-;" 'tcl-indent-for-comment)
 537   (define-key tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
 538   (define-key tcl-mode-map "\C-c\C-b" 'tcl-submit-bug-report)
 539   (and (fboundp 'comment-region)
 540        (define-key tcl-mode-map "\C-c\C-c" 'comment-region))
 541   (define-key tcl-mode-map "\C-c\C-i" 'tcl-help-on-word)
 542   (define-key tcl-mode-map "\C-c\C-v" 'tcl-eval-defun)
 543   (define-key tcl-mode-map "\C-c\C-f" 'tcl-load-file)
 544   (define-key tcl-mode-map "\C-c\C-t" 'inferior-tcl)
 545   (define-key tcl-mode-map "\C-c\C-x" 'tcl-eval-region)
 546   (define-key tcl-mode-map "\C-c\C-s" 'switch-to-tcl)
 547
 548   ;; Make menus.
 549   (if (and tcl-using-emacs-19 (not tcl-using-xemacs-19))
 550       (progn
 551         (tcl-add-fsf-menu tcl-mode-map))))
 552
 553 (defun tcl-fill-inferior-map ()
 554   (define-key inferior-tcl-mode-map "\t" 'comint-dynamic-complete)
 555   (define-key inferior-tcl-mode-map "\M-?"
 556     'comint-dynamic-list-filename-completions)
 557   (define-key inferior-tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
 558   (define-key inferior-tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
 559   (define-key inferior-tcl-mode-map "\177" 'backward-delete-char-untabify)
 560   (define-key inferior-tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
 561   (define-key inferior-tcl-mode-map "\C-c\C-b" 'tcl-submit-bug-report)
 562   (define-key inferior-tcl-mode-map "\C-c\C-i" 'tcl-help-on-word)
 563   (define-key inferior-tcl-mode-map "\C-c\C-v" 'tcl-eval-defun)
 564   (define-key inferior-tcl-mode-map "\C-c\C-f" 'tcl-load-file)
 565   (define-key inferior-tcl-mode-map "\C-c\C-t" 'inferior-tcl)
 566   (define-key inferior-tcl-mode-map "\C-c\C-x" 'tcl-eval-region)
 567   (define-key inferior-tcl-mode-map "\C-c\C-s" 'switch-to-tcl))
 568
 569 (if tcl-mode-map
 570     ()
 571   (setq tcl-mode-map (make-sparse-keymap))
 572   (tcl-fill-mode-map))
 573
 574 (if inferior-tcl-mode-map
 575     ()
 576   ;; FIXME Use keymap inheritance here?  FIXME we override comint
 577   ;; keybindings here.  Maybe someone has a better set?
 578   (setq inferior-tcl-mode-map (copy-keymap comint-mode-map))
 579   (tcl-fill-inferior-map))
 580
 581
 582 (defvar inferior-tcl-buffer nil
 583   "*The current inferior-tcl process buffer.
 584
 585 MULTIPLE PROCESS SUPPORT
 586 ===========================================================================
 587 To run multiple Tcl processes, you start the first up with
 588 \\[inferior-tcl].  It will be in a buffer named `*inferior-tcl*'.
 589 Rename this buffer with \\[rename-buffer].  You may now start up a new
 590 process with another \\[inferior-tcl].  It will be in a new buffer,
 591 named `*inferior-tcl*'.  You can switch between the different process
 592 buffers with \\[switch-to-buffer].
 593
 594 Commands that send text from source buffers to Tcl processes -- like
 595 `tcl-eval-defun' or `tcl-load-file' -- have to choose a process to
 596 send to, when you have more than one Tcl process around.  This is
 597 determined by the global variable `inferior-tcl-buffer'.  Suppose you
 598 have three inferior Lisps running:
 599     Buffer              Process
 600     foo                 inferior-tcl
 601     bar                 inferior-tcl<2>
 602     *inferior-tcl*      inferior-tcl<3>
 603 If you do a \\[tcl-eval-defun] command on some Lisp source code, what
 604 process do you send it to?
 605
 606 - If you're in a process buffer (foo, bar, or *inferior-tcl*),
 607   you send it to that process.
 608 - If you're in some other buffer (e.g., a source file), you
 609   send it to the process attached to buffer `inferior-tcl-buffer'.
 610 This process selection is performed by function `inferior-tcl-proc'.
 611
 612 Whenever \\[inferior-tcl] fires up a new process, it resets
 613 `inferior-tcl-buffer' to be the new process's buffer.  If you only run
 614 one process, this does the right thing.  If you run multiple
 615 processes, you can change `inferior-tcl-buffer' to another process
 616 buffer with \\[set-variable].")
 617
 618 ;;
 619 ;; Hooks and other customization.
 620 ;;
 621
 622 (defvar tcl-mode-hook nil
 623   "Hook run on entry to Tcl mode.
 624
 625 Several functions exist which are useful to run from your
 626 `tcl-mode-hook' (see each function's documentation for more
 627 information):
 628
 629   tcl-guess-application
 630     Guesses a default setting for `tcl-application' based on any
 631     \"#!\" line at the top of the file.
 632   tcl-hashify-buffer
 633     Quotes all \"#\" characters that don't correspond to actual
 634     Tcl comments.  (Useful when editing code not originally created
 635     with this mode).
 636   tcl-auto-fill-mode
 637     Auto-filling of Tcl comments.
 638
 639 Emacs 19 users can add functions to the hook with `add-hook':
 640
 641    (add-hook 'tcl-mode-hook 'tcl-guess-application)
 642
 643 Emacs 18 users must use `setq':
 644
 645    (setq tcl-mode-hook (cons 'tcl-guess-application tcl-mode-hook))")
 646
 647
 648 (defvar inferior-tcl-mode-hook nil
 649   "Hook for customizing Inferior Tcl mode.")
 650
 651 (defvar tcl-proc-list
 652   '("proc" "method" "itcl_class")
 653   "List of commands whose first argument defines something.
 654 This exists because some people (eg, me) use \"defvar\" et al.
 655 Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords'
 656 after changing this list.")
 657
 658 (defvar tcl-proc-regexp nil
 659   "Regexp to use when matching proc headers.")
 660
 661 (defvar tcl-typeword-list
 662   '("global" "upvar" "inherit" "public" "protected" "common")
 663   "List of Tcl keywords denoting \"type\".  Used only for highlighting.
 664 Call `tcl-set-font-lock-keywords' after changing this list.")
 665
 666 ;; Generally I've picked control operators to be keywords.
 667 (defvar tcl-keyword-list
 668   '("if" "then" "else" "elseif" "for" "foreach" "break" "continue" "while"
 669     "eval" "case" "in" "switch" "default" "exit" "error" "proc" "return"
 670     "uplevel" "constructor" "destructor" "itcl_class" "loop" "for_array_keys"
 671     "for_recursive_glob" "for_file")
 672   "List of Tcl keywords.  Used only for highlighting.
 673 Default list includes some TclX keywords.
 674 Call `tcl-set-font-lock-keywords' after changing this list.")
 675
 676 (defvar tcl-font-lock-keywords nil
 677   "Keywords to highlight for Tcl.  See variable `font-lock-keywords'.
 678 This variable is generally set from `tcl-proc-regexp',
 679 `tcl-typeword-list', and `tcl-keyword-list' by the function
 680 `tcl-set-font-lock-keywords'.")
 681
 682 ;; FIXME need some way to recognize variables because array refs look
 683 ;; like 2 sexps.
 684 (defvar tcl-type-alist
 685   '(
 686     ("proc" nil tcl-expr tcl-commands)
 687     ("method" nil tcl-expr tcl-commands)
 688     ("destructor" tcl-commands)
 689     ("constructor" tcl-commands)
 690     ("expr" tcl-expr)
 691     ("catch" tcl-commands)
 692     ("if" tcl-expr "then" tcl-commands)
 693     ("elseif" tcl-expr "then" tcl-commands)
 694     ("elseif" tcl-expr tcl-commands)
 695     ("if" tcl-expr tcl-commands)
 696     ("while" tcl-expr tcl-commands)
 697     ("for" tcl-commands tcl-expr tcl-commands tcl-commands)
 698     ("foreach" nil nil tcl-commands)
 699     ("for_file" nil nil tcl-commands)
 700     ("for_array_keys" nil nil tcl-commands)
 701     ("for_recursive_glob" nil nil nil tcl-commands)
 702     ;; Loop handling is not perfect, because the third argument can be
 703     ;; either a command or an expr, and there is no real way to look
 704     ;; forward.
 705     ("loop" nil tcl-expr tcl-expr tcl-commands)
 706     ("loop" nil tcl-expr tcl-commands)
 707     )
 708   "Alist that controls indentation.
 709 \(Actually, this really only controls what happens on continuation lines).
 710 Each entry looks like `(KEYWORD TYPE ...)'.
 711 Each type entry describes a sexp after the keyword, and can be one of:
 712 * nil, meaning that this sexp has no particular type.
 713 * tcl-expr, meaning that this sexp is an arithmetic expression.
 714 * tcl-commands, meaning that this sexp holds Tcl commands.
 715 * a string, which must exactly match the string at the corresponding
 716   position for a match to be made.
 717
 718 For example, the entry for the \"loop\" command is:
 719
 720    (\"loop\" nil tcl-expr tcl-commands)
 721
 722 This means that the \"loop\" command has three arguments.  The first
 723 argument is ignored (for indentation purposes).  The second argument
 724 is a Tcl expression, and the last argument is Tcl commands.")
 725
 726 (defvar tcl-explain-indentation nil
 727   "If not `nil', debugging message will be printed during indentation.")
 728
 729 \f
 730
 731 ;;
 732 ;; Work around differences between various versions of Emacs.
 733 ;;
 734
 735 ;; We use this because Lemacs 19.9 has what we need.
 736 (defconst tcl-pps-has-arg-6
 737   (or tcl-using-emacs-19
 738       (and tcl-using-xemacs-19
 739            (condition-case nil
 740                (progn
 741                  (parse-partial-sexp (point) (point) nil nil nil t)
 742                  t)
 743              (error nil))))
 744   "t if using an emacs which supports sixth (\"commentstop\") argument
 745 to parse-partial-sexp.")
 746
 747 ;; Its pretty bogus to have to do this, but there is no easier way to
 748 ;; say "match not syntax-1 and not syntax-2".  Too bad you can't put
 749 ;; \s in [...].  This sickness is used in Emacs 19 to match a defun
 750 ;; starter.  (It is used for this in v18 as well).
 751 ;;(defconst tcl-omit-ws-regexp
 752 ;;  (concat "^\\(\\s"
 753 ;;        (mapconcat 'char-to-string "w_.()\"\\$'/" "\\|\\s")
 754 ;;        "\\)\\S(*")
 755 ;;  "Regular expression that matches everything except space, comment
 756 ;;starter, and comment ender syntax codes.")
 757
 758 ;; FIXME?  Instead of using the hairy regexp above, we just use a
 759 ;; simple one.
 760 ;;(defconst tcl-omit-ws-regexp "^[^] \t\n#}]\\S(*"
 761 ;;  "Regular expression used in locating function definitions.")
 762
 763 ;; Here's another stab.  I think this one actually works.  Now the
 764 ;; problem seems to be that there is a bug in Emacs 19.22 where
 765 ;; end-of-defun doesn't really use the brace matching the one that
 766 ;; trails defun-prompt-regexp.
 767 (defconst tcl-omit-ws-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+")
 768
 769 (defun tcl-internal-beginning-of-defun (&optional arg)
 770   "Move backward to next beginning-of-defun.
 771 With argument, do this that many times.
 772 Returns t unless search stops due to end of buffer."
 773   (interactive "p")
 774   (if (or (null arg) (= arg 0))
 775       (setq arg 1))
 776   (let (success)
 777     (while (progn
 778              (setq arg (1- arg))
 779              (and (>= arg 0)
 780                   (setq success
 781                         (re-search-backward tcl-omit-ws-regexp nil 'move 1))))
 782       (while (and (looking-at "[]#}]")
 783                   (setq success
 784                         (re-search-backward tcl-omit-ws-regexp nil 'move 1)))))
 785     (beginning-of-line)
 786     (not (null success))))
 787
 788 (defun tcl-internal-end-of-defun (&optional arg)
 789   "Move forward to next end of defun.
 790 An end of a defun is found by moving forward from the beginning of one."
 791   (interactive "p")
 792   (if (or (null arg) (= arg 0)) (setq arg 1))
 793   (let ((start (point)))
 794     ;; Was forward-char.  I think this works a little better.
 795     (forward-line)
 796     (tcl-beginning-of-defun)
 797     (while (> arg 0)
 798       (while (and (re-search-forward tcl-omit-ws-regexp nil 'move 1)
 799                   (progn (beginning-of-line) t)
 800                   (looking-at "[]#}]")
 801                   (progn (forward-line) t)))
 802       (let ((next-line (save-excursion
 803                          (forward-line)
 804                          (point))))
 805         (while (< (point) next-line)
 806           (forward-sexp)))
 807       (forward-line)
 808       (if (> (point) start) (setq arg (1- arg))))))
 809
 810 ;; In Emacs 19, we can use begining-of-defun as long as we set up a
 811 ;; certain regexp.  In Emacs 18, we need our own function.
 812 (fset 'tcl-beginning-of-defun
 813       (if tcl-using-emacs-19
 814           'beginning-of-defun
 815         'tcl-internal-beginning-of-defun))
 816
 817 ;; Ditto end-of-defun.
 818 (fset 'tcl-end-of-defun
 819       (if (and tcl-using-emacs-19 (not tcl-using-xemacs-19))
 820           'end-of-defun
 821         'tcl-internal-end-of-defun))
 822
 823 ;; Internal mark-defun that is used for losing Emacsen.
 824 (defun tcl-internal-mark-defun ()
 825   "Put mark at end of Tcl function, point at beginning."
 826   (interactive)
 827   (push-mark (point))
 828   (tcl-end-of-defun)
 829   (if tcl-using-emacs-19
 830       (push-mark (point) nil t)
 831     (push-mark (point)))
 832   (tcl-beginning-of-defun)
 833   (backward-paragraph))
 834
 835 ;; In GNU Emacs 19-23 and later, mark-defun works as advertised.  I
 836 ;; don't know about XEmacs, so for now it and Emacs 18 just lose.
 837 (fset 'tcl-mark-defun
 838       (if tcl-using-emacs-19-23
 839           'mark-defun
 840         'tcl-internal-mark-defun))
 841
 842 ;; In GNU Emacs 19, mark takes an additional "force" argument.  I
 843 ;; don't know about XEmacs, so I'm just assuming it is the same.
 844 ;; Emacs 18 doesn't have this argument.
 845 (defun tcl-mark ()
 846   "Return mark, or nil if none."
 847   (if tcl-using-emacs-19
 848       (mark t)
 849     (mark)))
 850
 851 \f
 852
 853 ;;
 854 ;; Some helper functions.
 855 ;;
 856
 857 (defun tcl-set-proc-regexp ()
 858   "Set `tcl-proc-regexp' from variable `tcl-proc-list'."
 859   (setq tcl-proc-regexp (concat "^\\s-*\\("
 860                                 (mapconcat 'identity tcl-proc-list "\\|")
 861                                 "\\)[ \t]+")))
 862
 863 (defun tcl-set-font-lock-keywords ()
 864   "Set `tcl-font-lock-keywords'.
 865 Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
 866   (setq tcl-font-lock-keywords
 867         (list
 868          ;; Names of functions (and other "defining things").
 869          (list (concat tcl-proc-regexp "\\([^ \t\n]+\\)")
 870                2 'font-lock-function-name-face)
 871
 872          ;; Names of type-defining things.
 873          (list (concat "\\(\\s-\\|^\\)\\("
 874                        ;; FIXME Use 'regexp-quote?
 875                        (mapconcat 'identity tcl-typeword-list "\\|")
 876                        "\\)\\(\\s-\\|$\\)")
 877                2 'font-lock-type-face)
 878
 879          ;; Keywords.  Only recognized if surrounded by whitespace.
 880          ;; FIXME consider using "not word or symbol", not
 881          ;; "whitespace".
 882          (cons (concat "\\(\\s-\\|^\\)\\("
 883                        ;; FIXME Use regexp-quote?
 884                        (mapconcat 'identity tcl-keyword-list "\\|")
 885                        "\\)\\(\\s-\\|$\\)")
 886                2)
 887          )))
 888
 889 (if tcl-proc-regexp
 890     ()
 891   (tcl-set-proc-regexp))
 892
 893 (if tcl-font-lock-keywords
 894     ()
 895   (tcl-set-font-lock-keywords))
 896
 897 \f
 898
 899 ;;
 900 ;; The mode itself.
 901 ;;
 902
 903 ;;;###autoload
 904 (defun tcl-mode ()
 905   "Major mode for editing Tcl code.
 906 Expression and list commands understand all Tcl brackets.
 907 Tab indents for Tcl code.
 908 Paragraphs are separated by blank lines only.
 909 Delete converts tabs to spaces as it moves back.
 910
 911 Variables controlling indentation style:
 912   tcl-indent-level
 913     Indentation of Tcl statements within surrounding block.
 914   tcl-continued-indent-level
 915     Indentation of continuation line relative to first line of command.
 916
 917 Variables controlling user interaction with mode (see variable
 918 documentation for details):
 919   tcl-tab-always-indent
 920     Controls action of TAB key.
 921   tcl-auto-newline
 922     Non-nil means automatically newline before and after braces, brackets,
 923     and semicolons inserted in Tcl code.
 924   tcl-electric-hash-style
 925     Controls action of `#' key.
 926   tcl-use-hairy-comment-detector
 927     If t, use more complicated, but slower, comment detector.
 928     This variable is only used in GNU Emacs 19.
 929   tcl-use-smart-word-finder
 930     If not nil, use a smarter, Tcl-specific way to find the current
 931     word when looking up help on a Tcl command.
 932
 933 Turning on Tcl mode calls the value of the variable `tcl-mode-hook'
 934 with no args, if that value is non-nil.  Read the documentation for
 935 `tcl-mode-hook' to see what kinds of interesting hook functions
 936 already exist.
 937
 938 Commands:
 939 \\{tcl-mode-map}"
 940   (interactive)
 941   (kill-all-local-variables)
 942   (use-local-map tcl-mode-map)
 943   (setq major-mode 'tcl-mode)
 944   (setq mode-name "Tcl")
 945   (setq local-abbrev-table tcl-mode-abbrev-table)
 946   (set-syntax-table tcl-mode-syntax-table)
 947
 948   (make-local-variable 'paragraph-start)
 949   (make-local-variable 'paragraph-separate)
 950   (if (and tcl-using-emacs-19-23
 951            (>= emacs-minor-version 29))
 952       (progn
 953         ;; In Emacs 19.29, you aren't supposed to start these with a
 954         ;; ^.
 955         (setq paragraph-start "$\\|\f")
 956         (setq paragraph-separate paragraph-start))
 957     (setq paragraph-start (concat "^$\\|" page-delimiter))
 958     (setq paragraph-separate paragraph-start))
 959   (make-local-variable 'paragraph-ignore-fill-prefix)
 960   (setq paragraph-ignore-fill-prefix t)
 961   (make-local-variable 'fill-paragraph-function)
 962   (setq fill-paragraph-function 'tcl-do-fill-paragraph)
 963
 964   (make-local-variable 'indent-line-function)
 965   (setq indent-line-function 'tcl-indent-line)
 966   ;; Tcl doesn't require a final newline.
 967   ;; (make-local-variable 'require-final-newline)
 968   ;; (setq require-final-newline t)
 969
 970   (make-local-variable 'comment-start)
 971   (setq comment-start "# ")
 972   (make-local-variable 'comment-start-skip)
 973   (setq comment-start-skip "#+ *")
 974   (make-local-variable 'comment-column)
 975   (setq comment-column 40)
 976   (make-local-variable 'comment-end)
 977   (setq comment-end "")
 978
 979   (make-local-variable 'outline-regexp)
 980   (setq outline-regexp "[^\n\^M]")
 981   (make-local-variable 'outline-level)
 982   (setq outline-level 'tcl-outline-level)
 983
 984   (make-local-variable 'font-lock-keywords)
 985   (setq font-lock-keywords tcl-font-lock-keywords)
 986
 987   ;; The following only really makes sense under GNU Emacs 19.
 988   (make-local-variable 'imenu-create-index-function)
 989   (setq imenu-create-index-function 'tcl-imenu-create-index-function)
 990   (make-local-variable 'parse-sexp-ignore-comments)
 991
 992   ;; Settings for new dabbrev code.
 993   (make-local-variable 'dabbrev-case-fold-search)
 994   (setq dabbrev-case-fold-search nil)
 995   (make-local-variable 'dabbrev-case-replace)
 996   (setq dabbrev-case-replace nil)
 997   (make-local-variable 'dabbrev-abbrev-skip-leading-regexp)
 998   (setq dabbrev-abbrev-skip-leading-regexp "[$!]")
 999   (make-local-variable 'dabbrev-abbrev-char-regexp)
1000   (setq dabbrev-abbrev-char-regexp "\\sw\\|\\s_")
1001
1002   (if tcl-using-emacs-19
1003       (progn
1004         ;; This can only be set to t in Emacs 19 and XEmacs.
1005         ;; Emacs 18 and Epoch lose.
1006         (setq parse-sexp-ignore-comments t)
1007         ;; XEmacs has defun-prompt-regexp, but I don't believe
1008         ;; that it works for end-of-defun -- only for
1009         ;; beginning-of-defun.
1010         (make-local-variable 'defun-prompt-regexp)
1011         (setq defun-prompt-regexp tcl-omit-ws-regexp)
1012         ;; The following doesn't work in Lucid Emacs 19.6, but maybe
1013         ;; it will appear in later versions.
1014         (make-local-variable 'add-log-current-defun-function)
1015         (setq add-log-current-defun-function 'add-log-tcl-defun))
1016     (setq parse-sexp-ignore-comments nil))
1017
1018   ;; Put Tcl menu into menubar for XEmacs.  This happens
1019   ;; automatically for GNU Emacs.
1020   (if (and tcl-using-xemacs-19
1021            current-menubar
1022            (not (assoc "Tcl" current-menubar)))
1023       (progn
1024         (set-buffer-menubar (copy-sequence current-menubar))
1025         (add-menu nil "Tcl" tcl-xemacs-menu)))
1026   ;; Append Tcl menu to popup menu for XEmacs.
1027   (if (and tcl-using-xemacs-19 (boundp 'mode-popup-menu))
1028       (setq mode-popup-menu
1029             (cons (concat mode-name " Mode Commands") tcl-xemacs-menu)))
1030
1031   ;; If hilit19 is loaded, add our stuff.
1032   (if (featurep 'hilit19)
1033       (tcl-hilit))
1034
1035   (run-hooks 'tcl-mode-hook))
1036
1037 \f
1038
1039 ;; This is used for braces, brackets, and semi (except for closing
1040 ;; braces, which are handled specially).
1041 (defun tcl-electric-char (arg)
1042   "Insert character and correct line's indentation."
1043   (interactive "p")
1044   ;; Indent line first; this looks better if parens blink.
1045   (tcl-indent-line)
1046   (self-insert-command arg)
1047   (if (and tcl-auto-newline (= last-command-char ?\;))
1048       (progn
1049         (newline)
1050         (tcl-indent-line))))
1051
1052 ;; This is used for closing braces.  If tcl-auto-newline is set, can
1053 ;; insert a newline both before and after the brace, depending on
1054 ;; context.  FIXME should this be configurable?  Does anyone use this?
1055 (defun tcl-electric-brace (arg)
1056   "Insert character and correct line's indentation."
1057   (interactive "p")
1058   ;; If auto-newlining and there is stuff on the same line, insert a
1059   ;; newline first.
1060   (if tcl-auto-newline
1061       (progn
1062         (if (save-excursion
1063               (skip-chars-backward " \t")
1064               (bolp))
1065             ()
1066           (tcl-indent-line)
1067           (newline))
1068         ;; In auto-newline case, must insert a newline after each
1069         ;; brace.  So an explicit loop is needed.
1070         (while (> arg 0)
1071           (insert last-command-char)
1072           (tcl-indent-line)
1073           (newline)
1074           (setq arg (1- arg))))
1075     (self-insert-command arg))
1076   (tcl-indent-line))
1077
1078 \f
1079
1080 (defun tcl-indent-command (&optional arg)
1081   "Indent current line as Tcl code, or in some cases insert a tab character.
1082 If tcl-tab-always-indent is t (the default), always indent current line.
1083 If tcl-tab-always-indent is nil and point is not in the indentation
1084 area at the beginning of the line, a TAB is inserted.
1085 Other values of tcl-tab-always-indent cause the first possible action
1086 from the following list to take place:
1087
1088   1. Move from beginning of line to correct indentation.
1089   2. Delete an empty comment.
1090   3. Move forward to start of comment, indenting if necessary.
1091   4. Move forward to end of line, indenting if necessary.
1092   5. Create an empty comment.
1093   6. Move backward to start of comment, indenting if necessary."
1094   (interactive "p")
1095   (cond
1096    ((not tcl-tab-always-indent)
1097     ;; Indent if in indentation area, otherwise insert TAB.
1098     (if (<= (current-column) (current-indentation))
1099         (tcl-indent-line)
1100       (self-insert-command arg)))
1101    ((eq tcl-tab-always-indent t)
1102     ;; Always indent.
1103     (tcl-indent-line))
1104    (t
1105     ;; "Perl-mode" style TAB command.
1106     (let* ((ipoint (point))
1107            (eolpoint (progn
1108                        (end-of-line)
1109                        (point)))
1110            (comment-p (tcl-in-comment)))
1111       (cond
1112        ((= ipoint (save-excursion
1113                     (beginning-of-line)
1114                     (point)))
1115         (beginning-of-line)
1116         (tcl-indent-line)
1117         ;; If indenting didn't leave us in column 0, go to the
1118         ;; indentation.  Otherwise leave point at end of line.  This
1119         ;; is a hack.
1120         (if (= (point) (save-excursion
1121                          (beginning-of-line)
1122                          (point)))
1123             (end-of-line)
1124           (back-to-indentation)))
1125        ((and comment-p (looking-at "[ \t]*$"))
1126         ;; Empty comment, so delete it.  We also delete any ";"
1127         ;; characters at the end of the line.  I think this is
1128         ;; friendlier, but I don't know how other people will feel.
1129         (backward-char)
1130         (skip-chars-backward " \t;")
1131         (delete-region (point) eolpoint))
1132        ((and comment-p (< ipoint (point)))
1133         ;; Before comment, so skip to it.
1134         (tcl-indent-line)
1135         (indent-for-comment))
1136        ((/= ipoint eolpoint)
1137         ;; Go to end of line (since we're not there yet).
1138         (goto-char eolpoint)
1139         (tcl-indent-line))
1140        ((not comment-p)
1141         (tcl-indent-line)
1142         (tcl-indent-for-comment))
1143        (t
1144         ;; Go to start of comment.  We don't leave point where it is
1145         ;; because we want to skip comment-start-skip.
1146         (tcl-indent-line)
1147         (indent-for-comment)))))))
1148
1149 (defun tcl-indent-line ()
1150   "Indent current line as Tcl code.
1151 Return the amount the indentation changed by."
1152   (let ((indent (calculate-tcl-indent nil))
1153         beg shift-amt
1154         (case-fold-search nil)
1155         (pos (- (point-max) (point))))
1156     (beginning-of-line)
1157     (setq beg (point))
1158     (cond ((eq indent nil)
1159            (setq indent (current-indentation)))
1160           (t
1161            (skip-chars-forward " \t")
1162            (if (listp indent) (setq indent (car indent)))
1163            (cond ((= (following-char) ?})
1164                   (setq indent (- indent tcl-indent-level)))
1165                  ((= (following-char) ?\])
1166                   (setq indent (- indent 1))))))
1167     (skip-chars-forward " \t")
1168     (setq shift-amt (- indent (current-column)))
1169     (if (zerop shift-amt)
1170         (if (> (- (point-max) pos) (point))
1171             (goto-char (- (point-max) pos)))
1172       (delete-region beg (point))
1173       (indent-to indent)
1174       ;; If initial point was within line's indentation,
1175       ;; position after the indentation.  Else stay at same point in text.
1176       (if (> (- (point-max) pos) (point))
1177           (goto-char (- (point-max) pos))))
1178     shift-amt))
1179
1180 (defun tcl-figure-type ()
1181   "Determine type of sexp at point.
1182 This is either 'tcl-expr, 'tcl-commands, or nil.  Puts point at start
1183 of sexp that indicates types.
1184
1185 See documentation for variable `tcl-type-alist' for more information."
1186   (let ((count 0)
1187         result
1188         word-stack)
1189     (while (and (< count 5)
1190                 (not result))
1191       (condition-case nil
1192           (progn
1193             ;; FIXME should use "tcl-backward-sexp", which would skip
1194             ;; over entire variables, etc.
1195             (backward-sexp)
1196             (if (looking-at "[a-zA-Z_]+")
1197                 (let ((list tcl-type-alist)
1198                       entry)
1199                   (setq word-stack (cons (tcl-word-no-props) word-stack))
1200                   (while (and list (not result))
1201                     (setq entry (car list))
1202                     (setq list (cdr list))
1203                     (let ((index 0))
1204                       (while (and entry (<= index count))
1205                         ;; Abort loop if string does not match word on
1206                         ;; stack.
1207                         (and (stringp (car entry))
1208                              (not (string= (car entry)
1209                                            (nth index word-stack)))
1210                              (setq entry nil))
1211                         (setq entry (cdr entry))
1212                         (setq index (1+ index)))
1213                       (and (> index count)
1214                            (not (stringp (car entry)))
1215                            (setq result (car entry)))
1216                       )))
1217               (setq word-stack (cons nil word-stack))))
1218         (error nil))
1219       (setq count (1+ count)))
1220     (and tcl-explain-indentation
1221          (message "Indentation type %s" result))
1222     result))
1223
1224 (defun calculate-tcl-indent (&optional parse-start)
1225   "Return appropriate indentation for current line as Tcl code.
1226 In usual case returns an integer: the column to indent to.
1227 Returns nil if line starts inside a string, t if in a comment."
1228   (save-excursion
1229     (beginning-of-line)
1230     (let* ((indent-point (point))
1231            (case-fold-search nil)
1232            (continued-line
1233             (save-excursion
1234               (if (bobp)
1235                   nil
1236                 (backward-char)
1237                 (= ?\\ (preceding-char)))))
1238            (continued-indent-value (if continued-line
1239                                        tcl-continued-indent-level
1240                                      0))
1241            state
1242            containing-sexp
1243            found-next-line)
1244       (if parse-start
1245           (goto-char parse-start)
1246         (tcl-beginning-of-defun))
1247       (while (< (point) indent-point)
1248         (setq parse-start (point))
1249         (setq state (parse-partial-sexp (point) indent-point 0))
1250         (setq containing-sexp (car (cdr state))))
1251       (cond ((or (nth 3 state) (nth 4 state))
1252              ;; Inside comment or string.  Return nil or t if should
1253              ;; not change this line
1254              (nth 4 state))
1255             ((null containing-sexp)
1256              ;; Line is at top level.
1257              continued-indent-value)
1258             (t
1259              ;; Set expr-p if we are looking at the expression part of
1260              ;; an "if", "expr", etc statement.  Set commands-p if we
1261              ;; are looking at the body part of an if, while, etc
1262              ;; statement.  FIXME Should check for "for" loops here.
1263              (goto-char containing-sexp)
1264              (let* ((sexpr-type (tcl-figure-type))
1265                     (expr-p (eq sexpr-type 'tcl-expr))
1266                     (commands-p (eq sexpr-type 'tcl-commands))
1267                     (expr-start (point)))
1268                ;; Find the first statement in the block and indent
1269                ;; like it.  The first statement in the block might be
1270                ;; on the same line, so what we do is skip all
1271                ;; "virtually blank" lines, looking for a non-blank
1272                ;; one.  A line is virtually blank if it only contains
1273                ;; a comment and whitespace.  FIXME continued comments
1274                ;; aren't supported.  They are a wart on Tcl anyway.
1275                ;; We do it this funky way because we want to know if
1276                ;; we've found a statement on some line _after_ the
1277                ;; line holding the sexp opener.
1278                (goto-char containing-sexp)
1279                (forward-char)
1280                (if (and (< (point) indent-point)
1281                         (looking-at "[ \t]*\\(#.*\\)?$"))
1282                    (progn
1283                      (forward-line)
1284                      (while (and (< (point) indent-point)
1285                                  (looking-at "[ \t]*\\(#.*\\)?$"))
1286                        (setq found-next-line t)
1287                        (forward-line))))
1288                (if (or continued-line
1289                        (/= (char-after containing-sexp) ?{)
1290                        expr-p)
1291                    (progn
1292                      ;; Line is continuation line, or the sexp opener
1293                      ;; is not a curly brace, or we are are looking at
1294                      ;; an `expr' expression (which must be split
1295                      ;; specially).  So indentation is column of first
1296                      ;; good spot after sexp opener (with some added
1297                      ;; in the continued-line case).  If there is no
1298                      ;; nonempty line before the indentation point, we
1299                      ;; use the column of the character after the sexp
1300                      ;; opener.
1301                      (if (>= (point) indent-point)
1302                          (progn
1303                            (goto-char containing-sexp)
1304                            (forward-char))
1305                        (skip-chars-forward " \t"))
1306                      (+ (current-column) continued-indent-value))
1307                  ;; After a curly brace, and not a continuation line.
1308                  ;; So take indentation from first good line after
1309                  ;; start of block, unless that line is on the same
1310                  ;; line as the opening brace.  In this case use the
1311                  ;; indentation of the opening brace's line, plus
1312                  ;; another indent step.  If we are in the body part
1313                  ;; of an "if" or "while" then the indentation is
1314                  ;; taken from the line holding the start of the
1315                  ;; statement.
1316                  (if (and (< (point) indent-point)
1317                           found-next-line)
1318                      (current-indentation)
1319                    (if commands-p
1320                        (goto-char expr-start)
1321                      (goto-char containing-sexp))
1322                    (+ (current-indentation) tcl-indent-level)))))))))
1323
1324 \f
1325
1326 (defun indent-tcl-exp ()
1327   "Indent each line of the Tcl grouping following point."
1328   (interactive)
1329   (let ((indent-stack (list nil))
1330         (contain-stack (list (point)))
1331         (case-fold-search nil)
1332         outer-loop-done inner-loop-done state ostate
1333         this-indent last-sexp continued-line
1334         (next-depth 0)
1335         last-depth)
1336     (save-excursion
1337       (forward-sexp 1))
1338     (save-excursion
1339       (setq outer-loop-done nil)
1340       (while (and (not (eobp)) (not outer-loop-done))
1341         (setq last-depth next-depth)
1342         ;; Compute how depth changes over this line
1343         ;; plus enough other lines to get to one that
1344         ;; does not end inside a comment or string.
1345         ;; Meanwhile, do appropriate indentation on comment lines.
1346         (setq inner-loop-done nil)
1347         (while (and (not inner-loop-done)
1348                     (not (and (eobp) (setq outer-loop-done t))))
1349           (setq ostate state)
1350           (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
1351                                           nil nil state))
1352           (setq next-depth (car state))
1353           (if (and (car (cdr (cdr state)))
1354                    (>= (car (cdr (cdr state))) 0))
1355               (setq last-sexp (car (cdr (cdr state)))))
1356           (if (or (nth 4 ostate))
1357               (tcl-indent-line))
1358           (if (or (nth 3 state))
1359               (forward-line 1)
1360             (setq inner-loop-done t)))
1361         (if (<= next-depth 0)
1362             (setq outer-loop-done t))
1363         (if outer-loop-done
1364             nil
1365           ;; If this line had ..))) (((.. in it, pop out of the levels
1366           ;; that ended anywhere in this line, even if the final depth
1367           ;; doesn't indicate that they ended.
1368           (while (> last-depth (nth 6 state))
1369             (setq indent-stack (cdr indent-stack)
1370                   contain-stack (cdr contain-stack)
1371                   last-depth (1- last-depth)))
1372           (if (/= last-depth next-depth)
1373               (setq last-sexp nil))
1374           ;; Add levels for any parens that were started in this line.
1375           (while (< last-depth next-depth)
1376             (setq indent-stack (cons nil indent-stack)
1377                   contain-stack (cons nil contain-stack)
1378                   last-depth (1+ last-depth)))
1379           (if (null (car contain-stack))
1380               (setcar contain-stack
1381                       (or (car (cdr state))
1382                           (save-excursion
1383                             (forward-sexp -1)
1384                             (point)))))
1385           (forward-line 1)
1386           (setq continued-line
1387                 (save-excursion
1388                   (backward-char)
1389                   (= (preceding-char) ?\\)))
1390           (skip-chars-forward " \t")
1391           (if (eolp)
1392               nil
1393             (if (and (car indent-stack)
1394                      (>= (car indent-stack) 0))
1395                 ;; Line is on an existing nesting level.
1396                 (setq this-indent (car indent-stack))
1397               ;; Just started a new nesting level.
1398               ;; Compute the standard indent for this level.
1399               (let ((val (calculate-tcl-indent
1400                           (if (car indent-stack)
1401                               (- (car indent-stack))))))
1402                 (setcar indent-stack
1403                         (setq this-indent val))
1404                 (setq continued-line nil)))
1405             (cond ((not (numberp this-indent)))
1406                   ((= (following-char) ?})
1407                    (setq this-indent (- this-indent tcl-indent-level)))
1408                   ((= (following-char) ?\])
1409                    (setq this-indent (- this-indent 1))))
1410             ;; Put chosen indentation into effect.
1411             (or (null this-indent)
1412                 (= (current-column)
1413                    (if continued-line
1414                        (+ this-indent tcl-indent-level)
1415                      this-indent))
1416                 (progn
1417                   (delete-region (point) (progn (beginning-of-line) (point)))
1418                   (indent-to
1419                    (if continued-line
1420                        (+ this-indent tcl-indent-level)
1421                      this-indent)))))))))
1422   )
1423
1424 \f
1425
1426 ;;
1427 ;; Interfaces to other packages.
1428 ;;
1429
1430 (defun tcl-imenu-create-index-function ()
1431   "Generate alist of indices for imenu."
1432   (let ((re (concat tcl-proc-regexp "\\([^ \t\n{]+\\)"))
1433         alist prev-pos)
1434     (goto-char (point-min))
1435     (imenu-progress-message prev-pos 0)
1436     (save-match-data
1437       (while (re-search-forward re nil t)
1438         (imenu-progress-message prev-pos)
1439         ;; Position on start of proc name, not beginning of line.
1440         (setq alist (cons
1441                      (cons (buffer-substring (match-beginning 2) (match-end 2))
1442                            (match-beginning 2))
1443                      alist))))
1444     (imenu-progress-message prev-pos 100)
1445     (nreverse alist)))
1446
1447 ;; FIXME Definition of function is very ad-hoc.  Should use
1448 ;; tcl-beginning-of-defun.  Also has incestuous knowledge about the
1449 ;; format of tcl-proc-regexp.
1450 (defun add-log-tcl-defun ()
1451   "Return name of Tcl function point is in, or nil."
1452   (save-excursion
1453     (end-of-line)
1454     (if (re-search-backward (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t)
1455         (buffer-substring (match-beginning 2)
1456                           (match-end 2)))))
1457
1458 (defun tcl-outline-level ()
1459   (save-excursion
1460     (skip-chars-forward " \t")
1461     (current-column)))
1462
1463 \f
1464
1465 ;;
1466 ;; Helper functions for inferior Tcl mode.
1467 ;;
1468
1469 ;; This exists to let us delete the prompt when commands are sent
1470 ;; directly to the inferior Tcl.  See gud.el for an explanation of how
1471 ;; it all works (I took it from there).  This stuff doesn't really
1472 ;; work as well as I'd like it to.  But I don't believe there is
1473 ;; anything useful that can be done.
1474 (defvar inferior-tcl-delete-prompt-marker nil)
1475
1476 (defun tcl-filter (proc string)
1477   (let ((inhibit-quit t))
1478     (save-excursion
1479       (set-buffer (process-buffer proc))
1480       (goto-char (process-mark proc))
1481       ;; Delete prompt if requested.
1482       (if (marker-buffer inferior-tcl-delete-prompt-marker)
1483           (progn
1484             (delete-region (point) inferior-tcl-delete-prompt-marker)
1485             (set-marker inferior-tcl-delete-prompt-marker nil)))))
1486   (if tcl-using-emacs-19
1487       (comint-output-filter proc string)
1488     (funcall comint-output-filter string)))
1489
1490 (defun tcl-send-string (proc string)
1491   (save-excursion
1492     (set-buffer (process-buffer proc))
1493     (goto-char (process-mark proc))
1494     (beginning-of-line)
1495     (if (looking-at comint-prompt-regexp)
1496         (set-marker inferior-tcl-delete-prompt-marker (point))))
1497   (comint-send-string proc string))
1498
1499 (defun tcl-send-region (proc start end)
1500   (save-excursion
1501     (set-buffer (process-buffer proc))
1502     (goto-char (process-mark proc))
1503     (beginning-of-line)
1504     (if (looking-at comint-prompt-regexp)
1505         (set-marker inferior-tcl-delete-prompt-marker (point))))
1506   (comint-send-region proc start end))
1507
1508 (defun switch-to-tcl (eob-p)
1509   "Switch to inferior Tcl process buffer.
1510 With argument, positions cursor at end of buffer."
1511   (interactive "P")
1512   (if (get-buffer inferior-tcl-buffer)
1513       (pop-to-buffer inferior-tcl-buffer)
1514     (error "No current inferior Tcl buffer"))
1515   (cond (eob-p
1516          (push-mark)
1517          (goto-char (point-max)))))
1518
1519 (defun inferior-tcl-proc ()
1520   "Return current inferior Tcl process.
1521 See variable `inferior-tcl-buffer'."
1522   (let ((proc (get-buffer-process (if (eq major-mode 'inferior-tcl-mode)
1523                                       (current-buffer)
1524                                     inferior-tcl-buffer))))
1525     (or proc
1526         (error "No Tcl process; see variable `inferior-tcl-buffer'"))))
1527
1528 (defun tcl-eval-region (start end &optional and-go)
1529   "Send the current region to the inferior Tcl process.
1530 Prefix argument means switch to the Tcl buffer afterwards."
1531   (interactive "r\nP")
1532   (let ((proc (inferior-tcl-proc)))
1533     (tcl-send-region proc start end)
1534     (tcl-send-string proc "\n")
1535     (if and-go (switch-to-tcl t))))
1536
1537 (defun tcl-eval-defun (&optional and-go)
1538   "Send the current defun to the inferior Tcl process.
1539 Prefix argument means switch to the Tcl buffer afterwards."
1540   (interactive "P")
1541   (save-excursion
1542     (tcl-end-of-defun)
1543     (let ((end (point)))
1544       (tcl-beginning-of-defun)
1545       (tcl-eval-region (point) end)))
1546   (if and-go (switch-to-tcl t)))
1547
1548 \f
1549
1550 ;;
1551 ;; Inferior Tcl mode itself.
1552 ;;
1553
1554 (defun inferior-tcl-mode ()
1555   "Major mode for interacting with Tcl interpreter.
1556
1557 A Tcl process can be started with M-x inferior-tcl.
1558
1559 Entry to this mode runs the hooks comint-mode-hook and
1560 inferior-tcl-mode-hook, in that order.
1561
1562 You can send text to the inferior Tcl process from other buffers
1563 containing Tcl source.
1564
1565 Variables controlling Inferior Tcl mode:
1566   tcl-application
1567     Name of program to run.
1568   tcl-command-switches
1569     Command line arguments to `tcl-application'.
1570   tcl-prompt-regexp
1571     Matches prompt.
1572   inferior-tcl-source-command
1573     Command to use to read Tcl file in running application.
1574   inferior-tcl-buffer
1575     The current inferior Tcl process buffer.  See variable
1576     documentation for details on multiple-process support.
1577
1578 The following commands are available:
1579 \\{inferior-tcl-mode-map}"
1580   (interactive)
1581   (comint-mode)
1582   (setq comint-prompt-regexp (or tcl-prompt-regexp
1583                                  (concat "^"
1584                                          (regexp-quote tcl-application)
1585                                          ">")))
1586   (setq major-mode 'inferior-tcl-mode)
1587   (setq mode-name "Inferior Tcl")
1588   (if (boundp 'modeline-process)
1589       (setq modeline-process '(": %s")) ; For XEmacs.
1590     (setq mode-line-process '(": %s")))
1591   (use-local-map inferior-tcl-mode-map)
1592   (setq local-abbrev-table tcl-mode-abbrev-table)
1593   (set-syntax-table tcl-mode-syntax-table)
1594   (if tcl-using-emacs-19
1595       (progn
1596         (make-local-variable 'defun-prompt-regexp)
1597         (setq defun-prompt-regexp tcl-omit-ws-regexp)))
1598   (make-local-variable 'inferior-tcl-delete-prompt-marker)
1599   (setq inferior-tcl-delete-prompt-marker (make-marker))
1600   (set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter)
1601   (run-hooks 'inferior-tcl-mode-hook))
1602
1603 ;;;###autoload
1604 (defun inferior-tcl (cmd)
1605   "Run inferior Tcl process.
1606 Prefix arg means enter program name interactively.
1607 See documentation for function `inferior-tcl-mode' for more information."
1608   (interactive
1609    (list (if current-prefix-arg
1610              (read-string "Run Tcl: " tcl-application)
1611            tcl-application)))
1612   (if (not (comint-check-proc "*inferior-tcl*"))
1613       (progn
1614         (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil
1615                            tcl-command-switches))
1616         (inferior-tcl-mode)))
1617   (make-local-variable 'tcl-application)
1618   (setq tcl-application cmd)
1619   (setq inferior-tcl-buffer "*inferior-tcl*")
1620   (switch-to-buffer "*inferior-tcl*"))
1621
1622 (and (fboundp 'defalias)
1623      (defalias 'run-tcl 'inferior-tcl))
1624
1625 \f
1626
1627 ;;
1628 ;; Auto-fill support.
1629 ;;
1630
1631 (defun tcl-real-command-p ()
1632   "Return nil if point is not at the beginning of a command.
1633 A command is the first word on an otherwise empty line, or the
1634 first word following a semicolon, opening brace, or opening bracket."
1635   (save-excursion
1636     (skip-chars-backward " \t")
1637     (cond
1638      ((bobp) t)
1639      ((bolp)
1640       (backward-char)
1641       ;; Note -- continued comments are not supported here.  I
1642       ;; consider those to be a wart on the language.
1643       (not (eq ?\\ (preceding-char))))
1644      (t
1645       (memq (preceding-char) '(?\; ?{ ?\[))))))
1646
1647 ;; FIXME doesn't actually return t.  See last case.
1648 (defun tcl-real-comment-p ()
1649   "Return t if point is just after the `#' beginning a real comment.
1650 Does not check to see if previous char is actually `#'.
1651 A real comment is either at the beginning of the buffer,
1652 preceeded only by whitespace on the line, or has a preceeding
1653 semicolon, opening brace, or opening bracket on the same line."
1654   (save-excursion
1655     (backward-char)
1656     (tcl-real-command-p)))
1657
1658 (defun tcl-hairy-scan-for-comment (state end always-stop)
1659   "Determine if point is in a comment.
1660 Returns a list of the form `(FLAG . STATE)'.  STATE can be used
1661 as input to future invocations.  FLAG is nil if not in comment,
1662 t otherwise.  If in comment, leaves point at beginning of comment.
1663 Only works in Emacs 19.  See also `tcl-simple-scan-for-comment', a
1664 simpler version that is often right, and works in Emacs 18."
1665   (let ((bol (save-excursion
1666                (goto-char end)
1667                (beginning-of-line)
1668                (point)))
1669         real-comment
1670         last-cstart)
1671     (while (and (not last-cstart) (< (point) end))
1672       (setq real-comment nil)           ;In case we've looped around and it is
1673                                         ;set.
1674       (setq state (parse-partial-sexp (point) end nil nil state t))
1675       (if (nth 4 state)
1676           (progn
1677             ;; If ALWAYS-STOP is set, stop even if we don't have a
1678             ;; real comment, or if the comment isn't on the same line
1679             ;; as the end.
1680             (if always-stop (setq last-cstart (point)))
1681             ;; If we have a real comment, then set the comment
1682             ;; starting point if we are on the same line as the ending
1683             ;; location.
1684             (setq real-comment (tcl-real-comment-p))
1685             (if real-comment
1686                 (progn
1687                   (and (> (point) bol) (setq last-cstart (point)))
1688                   ;; NOTE Emacs 19 has a misfeature whereby calling
1689                   ;; parse-partial-sexp with COMMENTSTOP set and with
1690                   ;; an initial list that says point is in a comment
1691                   ;; will cause an immediate return.  So we must skip
1692                   ;; over the comment ourselves.
1693                   (beginning-of-line 2)))
1694             ;; Frob the state to make it look like we aren't in a
1695             ;; comment.
1696             (setcar (nthcdr 4 state) nil))))
1697     (and last-cstart
1698          (goto-char last-cstart))
1699     (cons real-comment state)))
1700
1701 (defun tcl-hairy-in-comment ()
1702   "Return t if point is in a comment, and leave point at beginning
1703 of comment."
1704   (let ((save (point)))
1705     (tcl-beginning-of-defun)
1706     (car (tcl-hairy-scan-for-comment nil save nil))))
1707
1708 (defun tcl-simple-in-comment ()
1709   "Return t if point is in comment, and leave point at beginning
1710 of comment.  This is faster that `tcl-hairy-in-comment', but is
1711 correct less often."
1712   (let ((save (point))
1713         comment)
1714     (beginning-of-line)
1715     (while (and (< (point) save) (not comment))
1716       (search-forward "#" save 'move)
1717       (setq comment (tcl-real-comment-p)))
1718     comment))
1719
1720 (defun tcl-in-comment ()
1721   "Return t if point is in comment, and leave point at beginning
1722 of comment."
1723   (if (and tcl-pps-has-arg-6
1724            tcl-use-hairy-comment-detector)
1725       (tcl-hairy-in-comment)
1726     (tcl-simple-in-comment)))
1727
1728 (defun tcl-do-fill-paragraph (ignore)
1729   "fill-paragraph function for Tcl mode.  Only fills in a comment."
1730   (let (in-comment col where)
1731     (save-excursion
1732       (end-of-line)
1733       (setq in-comment (tcl-in-comment))
1734       (if in-comment
1735           (progn
1736             (setq where (1+ (point)))
1737             (setq col (1- (current-column))))))
1738     (and in-comment
1739          (save-excursion
1740            (back-to-indentation)
1741            (= col (current-column)))
1742          ;; In a comment.  Set the fill prefix, and find the paragraph
1743          ;; boundaries by searching for lines that look like
1744          ;; comment-only lines.
1745          (let ((fill-prefix (buffer-substring (progn
1746                                                 (beginning-of-line)
1747                                                 (point))
1748                                               where))
1749                p-start p-end)
1750            ;; Search backwards.
1751            (save-excursion
1752              (while (looking-at "^[ \t]*#")
1753                (forward-line -1))
1754              (forward-line)
1755              (setq p-start (point)))
1756
1757            ;; Search forwards.
1758            (save-excursion
1759              (while (looking-at "^[ \t]*#")
1760                (forward-line))
1761              (setq p-end (point)))
1762
1763            ;; Narrow and do the fill.
1764            (save-restriction
1765              (narrow-to-region p-start p-end)
1766              (fill-paragraph ignore)))))
1767   t)
1768
1769 (defun tcl-do-auto-fill ()
1770   "Auto-fill function for Tcl mode.  Only auto-fills in a comment."
1771   (if (> (current-column) fill-column)
1772       (let ((fill-prefix "# ")
1773             in-comment col)
1774         (save-excursion
1775           (setq in-comment (tcl-in-comment))
1776           (if in-comment
1777               (setq col (1- (current-column)))))
1778         (if in-comment
1779             (progn
1780               (do-auto-fill)
1781               (save-excursion
1782                 (back-to-indentation)
1783                 (delete-region (point) (save-excursion
1784                                          (beginning-of-line)
1785                                          (point)))
1786                 (indent-to-column col)))))))
1787
1788 \f
1789
1790 ;;
1791 ;; Help-related code.
1792 ;;
1793
1794 (defvar tcl-help-saved-dirs nil
1795   "Saved help directories.
1796 If `tcl-help-directory-list' changes, this allows `tcl-help-on-word'
1797 to update the alist.")
1798
1799 (defvar tcl-help-alist nil
1800   "Alist with command names as keys and filenames as values.")
1801
1802 (defun tcl-help-snarf-commands (dirlist)
1803   "Build alist of commands and filenames."
1804   (while dirlist
1805     (let ((files (directory-files (car dirlist) t)))
1806       (while files
1807         (if (and (file-directory-p (car files))
1808                  (not
1809                   (let ((fpart (file-name-nondirectory (car files))))
1810                     (or (equal fpart ".")
1811                         (equal fpart "..")))))
1812             (let ((matches (directory-files (car files) t)))
1813               (while matches
1814                 (or (file-directory-p (car matches))
1815                     (setq tcl-help-alist
1816                           (cons
1817                            (cons (file-name-nondirectory (car matches))
1818                                  (car matches))
1819                            tcl-help-alist)))
1820                 (setq matches (cdr matches)))))
1821         (setq files (cdr files))))
1822     (setq dirlist (cdr dirlist))))
1823
1824 (defun tcl-reread-help-files ()
1825   "Set up to re-read files, and then do it."
1826   (interactive)
1827   (message "Building Tcl help file index...")
1828   (setq tcl-help-saved-dirs tcl-help-directory-list)
1829   (setq tcl-help-alist nil)
1830   (tcl-help-snarf-commands tcl-help-directory-list)
1831   (message "Building Tcl help file index...done"))
1832
1833 (defun tcl-word-no-props ()
1834   "Like current-word, but strips properties."
1835   (let ((word (current-word)))
1836     (and (fboundp 'set-text-properties)
1837          (set-text-properties 0 (length word) nil word))
1838     word))
1839
1840 (defun tcl-current-word (flag)
1841   "Return current command word, or nil.
1842 If FLAG is nil, just uses `current-word'.
1843 Otherwise scans backward for most likely Tcl command word."
1844   (if (and flag
1845            (memq major-mode '(tcl-mode inferior-tcl-mode)))
1846       (condition-case nil
1847           (save-excursion
1848             ;; Look backward for first word actually in alist.
1849             (if (bobp)
1850                 ()
1851               (while (and (not (bobp))
1852                           (not (tcl-real-command-p)))
1853                 (backward-sexp)))
1854             (if (assoc (tcl-word-no-props) tcl-help-alist)
1855                 (tcl-word-no-props)))
1856         (error nil))
1857     (tcl-word-no-props)))
1858
1859 ;;;###autoload
1860 (defun tcl-help-on-word (command &optional arg)
1861   "Get help on Tcl command.  Default is word at point.
1862 Prefix argument means invert sense of `tcl-use-smart-word-finder'."
1863   (interactive
1864    (list
1865     (progn
1866       (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
1867           (tcl-reread-help-files))
1868       (let ((word (tcl-current-word
1869                    (if current-prefix-arg
1870                        (not tcl-use-smart-word-finder)
1871                      tcl-use-smart-word-finder))))
1872         (completing-read
1873          (if (or (null word) (string= word ""))
1874              "Help on Tcl command: "
1875            (format "Help on Tcl command (default %s): " word))
1876          tcl-help-alist nil t)))
1877     current-prefix-arg))
1878   (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
1879       (tcl-reread-help-files))
1880   (if (string= command "")
1881       (setq command (tcl-current-word
1882                      (if arg
1883                          (not tcl-use-smart-word-finder)
1884                        tcl-use-smart-word-finder))))
1885   (let* ((help (get-buffer-create "*Tcl help*"))
1886          (cell (assoc command tcl-help-alist))
1887          (file (and cell (cdr cell))))
1888     (set-buffer help)
1889     (delete-region (point-min) (point-max))
1890     (if file
1891         (progn
1892           (insert "*** " command "\n\n")
1893           (insert-file-contents file))
1894       (if (string= command "")
1895           (insert "Magical Pig!")
1896         (insert "Tcl command " command " not in help\n")))
1897     (set-buffer-modified-p nil)
1898     (goto-char (point-min))
1899     (display-buffer help)))
1900
1901 \f
1902
1903 ;;
1904 ;; Other interactive stuff.
1905 ;;
1906
1907 (defvar tcl-previous-dir/file nil
1908   "Record last directory and file used in loading.
1909 This holds a cons cell of the form `(DIRECTORY . FILE)'
1910 describing the last `tcl-load-file' command.")
1911
1912 (defun tcl-load-file (file &optional and-go)
1913   "Load a Tcl file into the inferior Tcl process.
1914 Prefix argument means switch to the Tcl buffer afterwards."
1915   (interactive
1916    (list
1917     ;; car because comint-get-source returns a list holding the
1918     ;; filename.
1919     (car (comint-get-source "Load Tcl file: "
1920                             (or (and
1921                                  (eq major-mode 'tcl-mode)
1922                                  (buffer-file-name))
1923                                 tcl-previous-dir/file)
1924                             '(tcl-mode) t))
1925     current-prefix-arg))
1926   (comint-check-source file)
1927   (setq tcl-previous-dir/file (cons (file-name-directory file)
1928                                     (file-name-nondirectory file)))
1929   (tcl-send-string (inferior-tcl-proc)
1930                    (format inferior-tcl-source-command (tcl-quote file)))
1931   (if and-go (switch-to-tcl t)))
1932
1933 (defun tcl-restart-with-file (file &optional and-go)
1934   "Restart inferior Tcl with file.
1935 If an inferior Tcl process exists, it is killed first.
1936 Prefix argument means switch to the Tcl buffer afterwards."
1937   (interactive
1938    (list
1939     (car (comint-get-source "Restart with Tcl file: "
1940                             (or (and
1941                                  (eq major-mode 'tcl-mode)
1942                                  (buffer-file-name))
1943                                 tcl-previous-dir/file)
1944                             '(tcl-mode) t))
1945     current-prefix-arg))
1946   (let* ((buf (if (eq major-mode 'inferior-tcl-mode)
1947                   (current-buffer)
1948                 inferior-tcl-buffer))
1949          (proc (and buf (get-process buf))))
1950     (cond
1951      ((not (and buf (get-buffer buf)))
1952       ;; I think this will be ok.
1953       (inferior-tcl tcl-application)
1954       (tcl-load-file file and-go))
1955      ((or
1956        (not (comint-check-proc buf))
1957        (yes-or-no-p
1958         "A Tcl process is running, are you sure you want to reset it? "))
1959       (save-excursion
1960         (comint-check-source file)
1961         (setq tcl-previous-dir/file (cons (file-name-directory file)
1962                                           (file-name-nondirectory file)))
1963         (comint-exec (get-buffer-create buf)
1964                      (if proc
1965                          (process-name proc)
1966                        "inferior-tcl")
1967                      tcl-application file tcl-command-switches)
1968         (if and-go (switch-to-tcl t)))))))
1969
1970 ;; FIXME I imagine you can do this under Emacs 18.  I just don't know
1971 ;; how.
1972 (defun tcl-auto-fill-mode (&optional arg)
1973   "Like `auto-fill-mode', but controls filling of Tcl comments."
1974   (interactive "P")
1975   (and (not tcl-using-emacs-19)
1976        (error "You must use Emacs 19 to get this feature."))
1977   ;; Following code taken from "auto-fill-mode" (simple.el).
1978   (prog1
1979       (setq auto-fill-function
1980             (if (if (null arg)
1981                     (not auto-fill-function)
1982                   (> (prefix-numeric-value arg) 0))
1983                 'tcl-do-auto-fill
1984               nil))
1985     (force-mode-line-update)))
1986
1987 ;; hilit19 support from "Chris Alfeld" <calfeld@math.utah.edu>
1988 (defun tcl-hilit ()
1989   (hilit-set-mode-patterns
1990    '(tcl-mode)
1991    '(
1992      ("\\(^ *\\|\; *\\)#.*$" nil comment)
1993      ("[^\\]\\(\\$[A-Za-z0-9\\-\\_./\\(\\)]+\\)" 1 label)
1994      ("[^_]\\<\\(append\\|array\\|auto_execok\\|auto_load\\|auto_mkindex\\|auto_reset\\|break\\|case\\|catch\\|cd\\|close\\|concat\\|continue\\|eof\\|error\\|eval\\|exec\\|exit\\|expr\\|file\\|flush\\|for\\|foreach\\|format\\|gets\\|glob\\|global\\|history\\|if\\|incr\\|info\\|join\\|lappend\\|lindex\\|linsert\\|list\\|llength\\|lrange\\|lreplace\\|lsearch\\|lsort\\|open\\|pid\\|proc\\|puts\\|pwd\\|read\\|regexp\\|regsub\\|rename\\|return\\|scan\\|seek\\|set\\|source\\|split\\|string\\|switch\\|tell\\|time\\|trace\\|unknown\\|unset\\|uplevel\\|upvar\\|while\\)\\>[^_]" 1 keyword) ; tcl keywords
1995      ("[^_]\\<\\(after\\|bell\\|bind\\|bindtags\\|clipboard\\|destroy\\|fileevent\\|focus\\|grab\\|image\\|lower\\|option\\|pack\\|place\\|raise\\|scale\\|selection\\|send\\|subst\\|tk\\|tk_popup\\|tkwait\\|update\\|winfo\\|wm\\)\\>[^_]" 1 define) ; tk keywords
1996      ("[^_]\\<\\(button\\|canvas\\|checkbutton\\|entry\\|frame\\|label\\|listbox\\|menu\\|menubutton\\|message\\|radiobutton\\|scrollbar\\|text\\|toplevel\\)\\>[^_]" 1 decl) ; tk widgets
1997      ("[^_]\\<\\(tix\\((ButtonBox\\|Baloon\\|Control\\|DirList\\|ExFileSelectBox\\|ExFileSelectDialog\\|FileEntry\\|HList\\|LabelEntry\\|LabelFrame\\|NoteBook\\|OptionMenu\\|PanedWindow\\|PopupMenu\\|ScrolledHList\\|ScrolledText\\|ScrolledWindow\\|Select\\|StdButtonBox\\)\\)\\>[^_]" 1 defun) ; tix widgets
1998      ("[{}\\\"\\(\\)]" nil include) ; misc punctuation
1999      )))
2000
2001 (defun tcl-electric-hash (&optional count)
2002   "Insert a `#' and quote if it does not start a real comment.
2003 Prefix arg is number of `#'s to insert.
2004 See variable `tcl-electric-hash-style' for description of quoting
2005 styles."
2006   (interactive "p")
2007   (or count (setq count 1))
2008   (if (> count 0)
2009       (let ((type
2010              (if (eq tcl-electric-hash-style 'smart)
2011                  (if (> count 3)        ; FIXME what is "smart"?
2012                      'quote
2013                    'backslash)
2014                tcl-electric-hash-style))
2015             comment)
2016         (if type
2017             (progn
2018               (save-excursion
2019                 (insert "#")
2020                 (setq comment (tcl-in-comment)))
2021               (delete-char 1)
2022               (and tcl-explain-indentation (message "comment: %s" comment))
2023               (cond
2024                ((eq type 'quote)
2025                 (if (not comment)
2026                     (insert "\"")))
2027                ((eq type 'backslash)
2028                 ;; The following will set count to 0, so the
2029                 ;; insert-char can still be run.
2030                 (if (not comment)
2031                     (while (> count 0)
2032                       (insert "\\#")
2033                       (setq count (1- count)))))
2034                (t nil))))
2035         (insert-char ?# count))))
2036
2037 (defun tcl-hashify-buffer ()
2038   "Quote all `#'s in current buffer that aren't Tcl comments."
2039   (interactive)
2040   (save-excursion
2041     (goto-char (point-min))
2042     (if (and tcl-pps-has-arg-6 tcl-use-hairy-comment-detector)
2043         (let (state
2044               result)
2045           (while (< (point) (point-max))
2046             (setq result (tcl-hairy-scan-for-comment state (point-max) t))
2047             (if (car result)
2048                 (beginning-of-line 2)
2049               (backward-char)
2050               (if (eq ?# (following-char))
2051                   (insert "\\"))
2052               (forward-char))
2053             (setq state (cdr result))))
2054       (while (and (< (point) (point-max))
2055                   (search-forward "#" nil 'move))
2056         (if (tcl-real-comment-p)
2057             (beginning-of-line 2)
2058           ;; There's really no good way for the simple converter to
2059           ;; work.  So we just quote # if it isn't already quoted.
2060           ;; Bogus, but it works.
2061           (backward-char)
2062           (if (not (eq ?\\ (preceding-char)))
2063               (insert "\\"))
2064           (forward-char))))))
2065
2066 (defun tcl-indent-for-comment ()
2067   "Indent this line's comment to comment column, or insert an empty comment.
2068 Is smart about syntax of Tcl comments.
2069 Parts of this were taken from indent-for-comment (simple.el)."
2070   (interactive "*")
2071   (end-of-line)
2072   (or (tcl-in-comment)
2073       (progn
2074         ;; Not in a comment, so we have to insert one.  Create an
2075         ;; empty comment (since there isn't one on this line).  If
2076         ;; line is not blank, make sure we insert a ";" first.
2077         (skip-chars-backward " \t")
2078         (let ((eolpoint (point)))
2079           (beginning-of-line)
2080           (if (/= (point) eolpoint)
2081               (progn
2082                 (goto-char eolpoint)
2083                 (insert
2084                  (if (tcl-real-command-p) "" ";")
2085                  "# ")
2086                 (backward-char))))))
2087   ;; Point is just after the "#" starting a comment.  Move it as
2088   ;; appropriate.
2089   (let* ((indent (if comment-indent-hook
2090                      (funcall comment-indent-hook)
2091                    (funcall comment-indent-function)))
2092          (begpos (progn
2093                    (backward-char)
2094                    (point))))
2095     (if (/= begpos indent)
2096         (progn
2097           (skip-chars-backward " \t" (save-excursion
2098                                        (beginning-of-line)
2099                                        (point)))
2100           (delete-region (point) begpos)
2101           (indent-to indent)))
2102     (looking-at comment-start-skip)     ; Always true.
2103     (goto-char (match-end 0))
2104     ;; I don't like the effect of the next two.
2105     ;;(skip-chars-backward " \t" (match-beginning 0))
2106     ;;(skip-chars-backward "^ \t" (match-beginning 0))
2107     ))
2108
2109 ;; The following was inspired by the Tcl editing mode written by
2110 ;; Gregor Schmid <schmid@fb3-s7.math.TU-Berlin.DE>.  His version also
2111 ;; attempts to snarf the command line options from the command line,
2112 ;; but I didn't think that would really be that helpful (doesn't seem
2113 ;; like it owould be right enough.  His version also looks for the
2114 ;; "#!/bin/csh ... exec" hack, but that seemed even less useful.
2115 ;; FIXME should make sure that the application mentioned actually
2116 ;; exists.
2117 (defun tcl-guess-application ()
2118   "Attempt to guess Tcl application by looking at first line.
2119 The first line is assumed to look like \"#!.../program ...\"."
2120   (save-excursion
2121     (goto-char (point-min))
2122     (if (looking-at "#![^ \t]*/\\([^ \t\n/]+\\)\\([ \t]\\|$\\)")
2123         (progn
2124           (make-local-variable 'tcl-application)
2125           (setq tcl-application (buffer-substring (match-beginning 1)
2126                                                   (match-end 1)))))))
2127
2128 ;; This only exists to put on the menubar.  I couldn't figure out any
2129 ;; other way to do it.  FIXME should take "number of #-marks"
2130 ;; argument.
2131 (defun tcl-uncomment-region (beg end)
2132   "Uncomment region."
2133   (interactive "r")
2134   (comment-region beg end -1))
2135
2136 \f
2137
2138 ;;
2139 ;; XEmacs menu support.
2140 ;; Taken from schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid),
2141 ;; who wrote a different Tcl mode.
2142 ;; We also have support for menus in FSF.  We do this by
2143 ;; loading the XEmacs menu emulation code.
2144 ;;
2145
2146 (defun tcl-popup-menu (e)
2147   (interactive "@e")
2148   (and tcl-using-emacs-19
2149        (not tcl-using-xemacs-19)
2150        (if tcl-using-emacs-19-23
2151            (require 'lmenu)
2152          ;; CAVEATS:
2153          ;; * lmenu.el provides 'menubar, which is bogus.
2154          ;; * lmenu.el causes menubars to be turned on everywhere.
2155          ;;   Doubly bogus!
2156          ;; Both of these problems are fixed in Emacs 19.23.  People
2157          ;; using an Emacs before that just suffer.
2158          (require 'menubar "lmenu")))  ;; This is annoying
2159   ;; IMHO popup-menu should be autoloaded in FSF Emacs.  Oh well.
2160   (popup-menu tcl-xemacs-menu))
2161
2162 \f
2163
2164 ;;
2165 ;; Quoting and unquoting functions.
2166 ;;
2167
2168 ;; This quoting is sufficient to protect eg a filename from any sort
2169 ;; of expansion or splitting.  Tcl quoting sure sucks.
2170 (defun tcl-quote (string)
2171   "Quote STRING according to Tcl rules."
2172   (mapconcat (function (lambda (char)
2173                          (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ?  ?\;))
2174                              (concat "\\" (char-to-string char))
2175                            (char-to-string char))))
2176              string ""))
2177
2178 \f
2179
2180 ;;
2181 ;; Bug reporting.
2182 ;;
2183
2184 (and (fboundp 'eval-when-compile)
2185      (eval-when-compile
2186        (require 'reporter)))
2187
2188 (defun tcl-submit-bug-report ()
2189   "Submit via mail a bug report on Tcl mode."
2190   (interactive)
2191   (require 'reporter)
2192   (and
2193    (y-or-n-p "Do you really want to submit a bug report on Tcl mode? ")
2194    (reporter-submit-bug-report
2195     tcl-maintainer
2196     (concat "Tcl mode " tcl-version)
2197     '(tcl-indent-level
2198       tcl-continued-indent-level
2199       tcl-auto-newline
2200       tcl-tab-always-indent
2201       tcl-use-hairy-comment-detector
2202       tcl-electric-hash-style
2203       tcl-help-directory-list
2204       tcl-use-smart-word-finder
2205       tcl-application
2206       tcl-command-switches
2207       tcl-prompt-regexp
2208       inferior-tcl-source-command
2209       tcl-using-emacs-19
2210       tcl-using-emacs-19-23
2211       tcl-using-xemacs-19
2212       tcl-proc-list
2213       tcl-proc-regexp
2214       tcl-typeword-list
2215       tcl-keyword-list
2216       tcl-font-lock-keywords
2217       tcl-pps-has-arg-6))))
2218
2219 \f
2220
2221 (provide 'tcl)
2222
2223 ;;; tcl.el ends here