1994-04-06 22:12:42 +00:00
|
|
|
|
;; tcl.el --- Tcl code editing commands for Emacs
|
1994-04-06 22:10:06 +00:00
|
|
|
|
|
|
|
|
|
|
;; Copyright (C) 1994 Free Software Foundation, Inc.
|
|
|
|
|
|
|
1994-04-06 22:12:42 +00:00
|
|
|
|
;; Maintainer: Tom Tromey <tromey@busco.lanl.gov>
|
|
|
|
|
|
;; Author: Tom Tromey <tromey@busco.lanl.gov>
|
|
|
|
|
|
;; Chris Lindblad <cjl@lcs.mit.edu>
|
|
|
|
|
|
;; Keywords: languages tcl modes
|
1994-04-07 17:11:03 +00:00
|
|
|
|
;; Version: $Revision: 1.4 $
|
1994-04-06 22:10:06 +00:00
|
|
|
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
|
|
;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
|
|
|
;; any later version.
|
|
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
|
|
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
|
|
|
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
|
|
|
|
|
|
|
|
;; HOW TO INSTALL:
|
|
|
|
|
|
;; Put the following forms in your .emacs to enable autoloading of Tcl
|
|
|
|
|
|
;; mode, and auto-recognition of ".tcl" files.
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; (autoload 'tcl-mode "tcl" "Tcl mode." t)
|
|
|
|
|
|
;; (autoload 'inferior-tcl "tcl" "Run inferior Tcl process." t)
|
|
|
|
|
|
;; (setq auto-mode-alist (append '(("\\.tcl$" . tcl-mode)) auto-mode-alist))
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; If you plan to use the interface to the TclX help files, you must
|
|
|
|
|
|
;; set the variable tcl-help-directory to point to the topmost
|
|
|
|
|
|
;; directory containing the TclX help files. Eg:
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; (setq tcl-help-directory "/usr/local/lib/tclx/help")
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Also you will want to add the following to your .emacs:
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; (autoload 'tcl-help-on-word "tcl" "Help on Tcl commands" t)
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; FYI a *very* useful thing to do is nroff all the Tk man pages and
|
|
|
|
|
|
;; put them in a subdir of the help system.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
|
|
;; LCD Archive Entry:
|
|
|
|
|
|
;; tcl|Tom Tromey|tromey@busco.lanl.gov|
|
|
|
|
|
|
;; Major mode for editing Tcl|
|
1994-04-07 17:11:03 +00:00
|
|
|
|
;; $Date: 1994/04/07 00:23:36 $|$Revision: 1.4 $|~/modes/tcl.el.Z|
|
1994-04-06 22:10:06 +00:00
|
|
|
|
|
|
|
|
|
|
;; CUSTOMIZATION NOTES:
|
|
|
|
|
|
;; * tcl-proc-list can be used to customize a list of things that
|
|
|
|
|
|
;; "define" other things. Eg in my project I put "defvar" in this
|
|
|
|
|
|
;; list.
|
|
|
|
|
|
;; * tcl-typeword-list is similar, but uses font-lock-type-face.
|
|
|
|
|
|
;; * tcl-keyword-list is a list of keywords. I've generally used this
|
|
|
|
|
|
;; for flow-control words. Eg I add "unwind_protect" to this list.
|
|
|
|
|
|
;; * tcl-type-alist can be used to minimally customize indentation
|
|
|
|
|
|
;; according to context.
|
|
|
|
|
|
|
|
|
|
|
|
;; Change log:
|
|
|
|
|
|
;; 18-Mar-1994 Tom Tromey Fourth beta release.
|
|
|
|
|
|
;; Added {un,}comment-region to menu. Idea from
|
|
|
|
|
|
;; Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
|
|
|
|
|
|
;; 17-Mar-1994 Tom Tromey
|
|
|
|
|
|
;; Fixed tcl-restart-with-file. Bug fix attempt in
|
|
|
|
|
|
;; tcl-internal-end-of-defun.
|
|
|
|
|
|
;; 16-Mar-1994 Tom Tromey Third beta release
|
|
|
|
|
|
;; Added support code for menu (from Tcl mode written by
|
|
|
|
|
|
;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)).
|
|
|
|
|
|
;; 12-Mar-1994 Tom Tromey
|
|
|
|
|
|
;; Better documentation for inferior-tcl-buffer. Wrote
|
|
|
|
|
|
;; tcl-restart-with-file. Wrote Lucid Emacs menu (but no
|
|
|
|
|
|
;; code to install it).
|
|
|
|
|
|
;; 12-Mar-1994 Tom Tromey
|
|
|
|
|
|
;; Wrote tcl-guess-application. Another stab at making
|
|
|
|
|
|
;; tcl-omit-ws-regexp work.
|
|
|
|
|
|
;; 10-Mar-1994 Tom Tromey Second beta release
|
|
|
|
|
|
;; Last Modified: Thu Mar 10 01:24:25 1994 (Tom Tromey)
|
|
|
|
|
|
;; Wrote perl-mode style line indentation command.
|
|
|
|
|
|
;; Wrote more documentation. Added tcl-continued-indent-level.
|
|
|
|
|
|
;; Integrated help code.
|
|
|
|
|
|
;; 8-Mar-1994 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Tue Mar 8 11:58:44 1994 (Tom Tromey)
|
|
|
|
|
|
;; Bug fixes.
|
|
|
|
|
|
;; 6-Mar-1994 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Sun Mar 6 18:55:41 1994 (Tom Tromey)
|
|
|
|
|
|
;; Updated auto-newline support.
|
|
|
|
|
|
;; 6-Mar-1994 Tom Tromey Beta release
|
|
|
|
|
|
;; Last Modified: Sat Mar 5 17:24:32 1994 (Tom Tromey)
|
|
|
|
|
|
;; Wrote tcl-hashify-buffer. Other minor bug fixes.
|
|
|
|
|
|
;; 5-Mar-1994 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Sat Mar 5 16:11:20 1994 (Tom Tromey)
|
|
|
|
|
|
;; Wrote electric-hash code.
|
|
|
|
|
|
;; 3-Mar-1994 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Thu Mar 3 02:53:40 1994 (Tom Tromey)
|
|
|
|
|
|
;; Added code to handle auto-fill in comments.
|
|
|
|
|
|
;; Added imenu support code.
|
|
|
|
|
|
;; Cleaned up code.
|
|
|
|
|
|
;; Better font-lock support.
|
|
|
|
|
|
;; 28-Feb-1994 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Mon Feb 28 14:08:05 1994 (Tom Tromey)
|
|
|
|
|
|
;; Made tcl-figure-type more easily configurable.
|
|
|
|
|
|
;; 28-Feb-1994 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Mon Feb 28 01:02:58 1994 (Tom Tromey)
|
|
|
|
|
|
;; Wrote inferior-tcl mode.
|
|
|
|
|
|
;; 16-Feb-1994 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Wed Feb 16 17:05:19 1994 (Tom Tromey)
|
|
|
|
|
|
;; Added support for font-lock-mode.
|
|
|
|
|
|
;; 29-Oct-1993 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Sun Oct 24 17:39:14 1993 (Tom Tromey)
|
|
|
|
|
|
;; Patches from Guido Bosch to make things work with Lucid Emacs.
|
|
|
|
|
|
;; 22-Oct-1993 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Fri Oct 22 15:26:46 1993 (Tom Tromey)
|
|
|
|
|
|
;; Made many characters have "_" syntax class; suggested by Guido
|
|
|
|
|
|
;; Bosch <Guido.Bosch@loria.fr>. Note that this includes the "$"
|
|
|
|
|
|
;; character, which might be a change you'd notice.
|
|
|
|
|
|
;; 21-Oct-1993 Tom Tromey
|
|
|
|
|
|
;; Last Modified: Thu Oct 21 20:28:40 1993 (Tom Tromey)
|
|
|
|
|
|
;; More fixes for tcl-omit-ws-regexp.
|
|
|
|
|
|
;; 20-Oct-1993 Tom Tromey
|
|
|
|
|
|
;; Started keeping history. Fixed tcl-{beginning,end}-of-defun.
|
|
|
|
|
|
;; Added some code to make things work with Emacs 18.
|
|
|
|
|
|
|
|
|
|
|
|
;; THANKS TO:
|
|
|
|
|
|
;; Guido Bosch <Guido.Bosch@loria.fr>
|
|
|
|
|
|
;; pgs1002@esc.cam.ac.uk (Dr P.G. Sjoerdsma)
|
|
|
|
|
|
;; Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
|
|
|
|
|
|
;; Matt Newman <men@charney.colorado.edu>
|
|
|
|
|
|
;; rwhitby@research.canon.oz.au (Rod Whitby)
|
|
|
|
|
|
;; h9118101@hkuxa.hku.hk (Yip Chi Lap [Beta])
|
|
|
|
|
|
;; Pertti Tapio Kasanen <ptk@delta.hut.fi>
|
|
|
|
|
|
;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)
|
|
|
|
|
|
|
|
|
|
|
|
;; KNOWN BUGS:
|
|
|
|
|
|
;; * indent-region should skip blank lines. (It does in v19, so I'm
|
|
|
|
|
|
;; not motivated to fix it here).
|
|
|
|
|
|
;; * In Tcl "#" is not always a comment character. This can confuse
|
|
|
|
|
|
;; tcl.el in certain circumstances. For now the only workaround is
|
|
|
|
|
|
;; to enclose offending hash characters in quotes or precede it with
|
|
|
|
|
|
;; a backslash. Note that using braces won't work -- quotes change
|
|
|
|
|
|
;; the syntax class of characters between them, while braces do not.
|
|
|
|
|
|
;; The electric-# mode helps alleviate this problem somewhat.
|
|
|
|
|
|
;; * indent-tcl-exp is untested.
|
|
|
|
|
|
;; * Doesn't work under Emacs 18 yet.
|
|
|
|
|
|
;; * There's been a report that font-lock does strange things under
|
|
|
|
|
|
;; Lucid Emacs 19.6. For instance in "proc foobar", the space
|
|
|
|
|
|
;; before "foobar" is highlighted.
|
|
|
|
|
|
|
|
|
|
|
|
;; TODO:
|
|
|
|
|
|
;; * make add-log-tcl-defun smarter. should notice if we are in the
|
|
|
|
|
|
;; middle of a defun, or between defuns. should notice if point is
|
|
|
|
|
|
;; on first line of defun (or maybe even in comments before defun).
|
|
|
|
|
|
;; * Allow continuation lines to be indented under the first argument
|
|
|
|
|
|
;; of the preceeding line, like this:
|
|
|
|
|
|
;; [list something \
|
|
|
|
|
|
;; something-else]
|
|
|
|
|
|
;; * There is a request that indentation work like this:
|
|
|
|
|
|
;; button .fred -label Fred \
|
|
|
|
|
|
;; -command {puts fred}
|
|
|
|
|
|
;; * Should have tcl-complete-symbol that queries the inferior process.
|
|
|
|
|
|
;; * Should have describe-symbol that works by sending the magic
|
|
|
|
|
|
;; command to a tclX process.
|
|
|
|
|
|
;; * Need C-x C-e binding (tcl-eval-last-exp).
|
|
|
|
|
|
;; * Write indent-region function that is faster than indenting each
|
|
|
|
|
|
;; line individually.
|
|
|
|
|
|
;; * tcl-figure-type should stop at "beginning of line" (only ws
|
|
|
|
|
|
;; before point, and no "\" on previous line). (see tcl-real-command-p).
|
|
|
|
|
|
;; * Fix beginning-of-defun. I believe this will be fully possible in
|
|
|
|
|
|
;; FSF Emacs 19.23
|
|
|
|
|
|
;; * overrides some comint keybindings; fix.
|
|
|
|
|
|
;; * Trailing \ will eat blank lines. Should deal with this.
|
|
|
|
|
|
;; (this would help catch some potential bugs).
|
|
|
|
|
|
;; * Inferior should display in half the screen, not the whole screen.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
|
|
(require 'comint)
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; User variables.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-indent-level 4
|
|
|
|
|
|
"*Indentation of Tcl statements with respect to containing block.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-continued-indent-level 4
|
|
|
|
|
|
"*Indentation of continuation line relative to first line of command.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-auto-newline nil
|
|
|
|
|
|
"*Non-nil means automatically newline before and after braces
|
|
|
|
|
|
inserted in Tcl code.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-tab-always-indent t
|
|
|
|
|
|
"*Control effect of TAB key.
|
|
|
|
|
|
If t (the default), always indent current line.
|
|
|
|
|
|
If nil and point is not in the indentation area at the beginning of
|
|
|
|
|
|
the line, a TAB is inserted.
|
|
|
|
|
|
Other values cause the first possible action from the following list
|
|
|
|
|
|
to take place:
|
|
|
|
|
|
|
|
|
|
|
|
1. Move from beginning of line to correct indentation.
|
|
|
|
|
|
2. Delete an empty comment.
|
|
|
|
|
|
3. Move forward to start of comment, indenting if necessary.
|
|
|
|
|
|
4. Move forward to end of line, indenting if necessary.
|
|
|
|
|
|
5. Create an empty comment.
|
|
|
|
|
|
6. Move backward to start of comment, indenting if necessary.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-use-hairy-comment-detector t
|
|
|
|
|
|
"*If not `nil', the the more complicated, but slower, comment
|
|
|
|
|
|
detecting function is used. This variable is only used in GNU Emacs
|
|
|
|
|
|
19 (the fast function is always used elsewhere).")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-electric-hash-style 'smart
|
|
|
|
|
|
"*Style of electric hash insertion to use.
|
|
|
|
|
|
Possible values are 'backslash, meaning that `\\' quoting should be
|
|
|
|
|
|
done; `quote, meaning that `\"' quoting should be done; 'smart,
|
|
|
|
|
|
meaning that the choice between 'backslash and 'quote should be
|
|
|
|
|
|
made depending on the number of hashes inserted; or nil, meaning that
|
|
|
|
|
|
no quoting should be done. Any other value for this variable is
|
|
|
|
|
|
taken to mean 'smart. The default is 'smart.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-help-directory nil
|
|
|
|
|
|
"*Name of topmost directory containing TclX help files")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-use-smart-word-finder t
|
|
|
|
|
|
"*If not nil, use a better way of finding the current word when
|
|
|
|
|
|
looking up help on a Tcl command.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-application "wish"
|
|
|
|
|
|
"*Name of Tcl application to run in inferior Tcl mode.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-command-switches nil
|
|
|
|
|
|
"*Switches to supply to `tcl-application'.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-prompt-regexp "^\\(% \\|\\)"
|
|
|
|
|
|
"*If not nil, a regexp that will match the prompt in the inferior process.
|
|
|
|
|
|
If nil, the prompt is the name of the application with \">\" appended.
|
|
|
|
|
|
|
|
|
|
|
|
The default is \"^\\(% \\|\\)\", which will match the default primary
|
|
|
|
|
|
and secondary prompts for tclsh and wish.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar inferior-tcl-source-command "source %s\n"
|
|
|
|
|
|
"*Format-string for building a Tcl command to load a file.
|
|
|
|
|
|
This format string should use `%s' to substitute a file name
|
|
|
|
|
|
and should result in a Tcl expression that will command the
|
|
|
|
|
|
inferior Tcl to load that file. The filename will be appropriately
|
|
|
|
|
|
quoted for Tcl.")
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Keymaps, abbrevs, syntax tables.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-mode-abbrev-table nil
|
|
|
|
|
|
"Abbrev table in use in Tcl-mode buffers.")
|
|
|
|
|
|
(if tcl-mode-abbrev-table
|
|
|
|
|
|
()
|
|
|
|
|
|
(define-abbrev-table 'tcl-mode-abbrev-table ()))
|
|
|
|
|
|
|
|
|
|
|
|
;; I sure wish Emacs had a package that made it easy to extract this
|
|
|
|
|
|
;; sort of information.
|
|
|
|
|
|
(defconst tcl-using-emacs-19 (string-match "19\\." emacs-version)
|
|
|
|
|
|
"Nil unless using Emacs 19 (Lucid or FSF).")
|
|
|
|
|
|
|
|
|
|
|
|
;; FIXME this will break on Emacs 19.100.
|
|
|
|
|
|
(defconst tcl-using-emacs-19.23
|
|
|
|
|
|
(string-match "19\\.\\(2[3-9]\\|[3-9][0-9]\\)" emacs-version)
|
|
|
|
|
|
"Nil unless using Emacs 19.23 or later.")
|
|
|
|
|
|
|
|
|
|
|
|
(defconst tcl-using-lemacs-19 (string-match "Lucid" emacs-version)
|
|
|
|
|
|
"Nil unless using Lucid Emacs).")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-mode-map ()
|
|
|
|
|
|
"Keymap used in Tcl mode.")
|
|
|
|
|
|
(if tcl-mode-map
|
|
|
|
|
|
()
|
|
|
|
|
|
(setq tcl-mode-map (make-sparse-keymap))
|
|
|
|
|
|
(define-key tcl-mode-map "{" 'tcl-electric-char)
|
|
|
|
|
|
(define-key tcl-mode-map "}" 'tcl-electric-brace)
|
|
|
|
|
|
(define-key tcl-mode-map "[" 'tcl-electric-char)
|
|
|
|
|
|
(define-key tcl-mode-map "]" 'tcl-electric-char)
|
|
|
|
|
|
(define-key tcl-mode-map ";" 'tcl-electric-char)
|
|
|
|
|
|
(define-key tcl-mode-map "#" 'tcl-electric-hash)
|
|
|
|
|
|
;; FIXME.
|
|
|
|
|
|
(define-key tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
|
|
|
|
|
|
;; FIXME.
|
|
|
|
|
|
(define-key tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
|
|
|
|
|
|
;; FIXME.
|
|
|
|
|
|
(define-key tcl-mode-map "\e\C-h" 'mark-tcl-function)
|
|
|
|
|
|
(define-key tcl-mode-map "\e\C-q" 'indent-tcl-exp)
|
|
|
|
|
|
(define-key tcl-mode-map "\177" 'backward-delete-char-untabify)
|
|
|
|
|
|
(define-key tcl-mode-map "\t" 'tcl-indent-command)
|
|
|
|
|
|
(define-key tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
|
|
|
|
|
|
(and (fboundp 'comment-region)
|
|
|
|
|
|
(define-key tcl-mode-map "\C-c\C-c" 'comment-region))
|
|
|
|
|
|
(define-key tcl-mode-map "\C-c\C-d" 'tcl-help-on-word)
|
|
|
|
|
|
(define-key tcl-mode-map "\C-c\C-e" 'tcl-eval-defun)
|
|
|
|
|
|
(define-key tcl-mode-map "\C-c\C-l" 'tcl-load-file)
|
|
|
|
|
|
(define-key tcl-mode-map "\C-c\C-p" 'inferior-tcl)
|
|
|
|
|
|
(define-key tcl-mode-map "\C-c\C-r" 'tcl-eval-region)
|
|
|
|
|
|
(define-key tcl-mode-map "\C-c\C-z" 'switch-to-tcl))
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-mode-syntax-table nil
|
|
|
|
|
|
"Syntax table in use in Tcl-mode buffers.")
|
|
|
|
|
|
(if tcl-mode-syntax-table
|
|
|
|
|
|
()
|
|
|
|
|
|
(setq tcl-mode-syntax-table (make-syntax-table))
|
|
|
|
|
|
(modify-syntax-entry ?% "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?@ "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?& "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?* "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?+ "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?- "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?. "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?: "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?! "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?$ "_" tcl-mode-syntax-table) ; FIXME use "'"?
|
|
|
|
|
|
(modify-syntax-entry ?/ "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?~ "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?< "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?= "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?> "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?| "_" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?\( "()" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?\) ")(" tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?\; "." tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?\n "> " tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?\f "> " tcl-mode-syntax-table)
|
|
|
|
|
|
(modify-syntax-entry ?# "< " tcl-mode-syntax-table))
|
|
|
|
|
|
|
|
|
|
|
|
(defvar inferior-tcl-mode-map nil
|
|
|
|
|
|
"Keymap used in Inferior Tcl mode.")
|
|
|
|
|
|
(if inferior-tcl-mode-map
|
|
|
|
|
|
()
|
|
|
|
|
|
;; FIXME Use keymap inheritance here? FIXME we override comint
|
|
|
|
|
|
;; keybindings here. Maybe someone has a better set?
|
|
|
|
|
|
(setq inferior-tcl-mode-map (copy-keymap comint-mode-map))
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\177" 'backward-delete-char-untabify)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\C-c\C-d" 'tcl-help-on-word)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\C-c\C-e" 'tcl-eval-defun)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\C-c\C-l" 'tcl-load-file)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\C-c\C-p" 'inferior-tcl)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\C-c\C-r" 'tcl-eval-region)
|
|
|
|
|
|
(define-key inferior-tcl-mode-map "\C-c\C-z" 'switch-to-tcl))
|
|
|
|
|
|
|
|
|
|
|
|
;; Lucid Emacs menu.
|
|
|
|
|
|
(defvar tcl-lucid-menu
|
|
|
|
|
|
'("Tcl"
|
|
|
|
|
|
["Beginning of function" tcl-beginning-of-defun t]
|
|
|
|
|
|
["End of function" tcl-end-of-defun t]
|
|
|
|
|
|
["Mark function" mark-tcl-function t]
|
|
|
|
|
|
["Indent region" indent-region t]
|
|
|
|
|
|
["Comment region" comment-region t]
|
|
|
|
|
|
["Uncomment region" tcl-uncomment-region t]
|
|
|
|
|
|
"----"
|
|
|
|
|
|
["Show Tcl process buffer" inferior-tcl t]
|
|
|
|
|
|
["Send function to Tcl process" tcl-eval-defun t]
|
|
|
|
|
|
["Send region to Tcl process" tcl-eval-region t]
|
|
|
|
|
|
["Send file to Tcl process" tcl-load-file t]
|
|
|
|
|
|
["Restart Tcl process with file" tcl-restart-with-file t]
|
|
|
|
|
|
"----"
|
|
|
|
|
|
["Tcl help" tcl-help-on-word t]))
|
|
|
|
|
|
|
|
|
|
|
|
(defvar inferior-tcl-buffer nil
|
|
|
|
|
|
"*The current inferior-tcl process buffer.
|
|
|
|
|
|
|
|
|
|
|
|
MULTIPLE PROCESS SUPPORT
|
|
|
|
|
|
===========================================================================
|
|
|
|
|
|
To run multiple Tcl processes, you start the first up with
|
|
|
|
|
|
\\[inferior-tcl]. It will be in a buffer named `*inferior-tcl*'.
|
|
|
|
|
|
Rename this buffer with \\[rename-buffer]. You may now start up a new
|
|
|
|
|
|
process with another \\[inferior-tcl]. It will be in a new buffer,
|
|
|
|
|
|
named `*inferior-tcl*'. You can switch between the different process
|
|
|
|
|
|
buffers with \\[switch-to-buffer].
|
|
|
|
|
|
|
|
|
|
|
|
Commands that send text from source buffers to Tcl processes -- like
|
|
|
|
|
|
`tcl-eval-defun' or `tcl-load-file' -- have to choose a process to
|
|
|
|
|
|
send to, when you have more than one Tcl process around. This is
|
|
|
|
|
|
determined by the global variable `inferior-tcl-buffer'. Suppose you
|
|
|
|
|
|
have three inferior Lisps running:
|
|
|
|
|
|
Buffer Process
|
|
|
|
|
|
foo inferior-tcl
|
|
|
|
|
|
bar inferior-tcl<2>
|
|
|
|
|
|
*inferior-tcl* inferior-tcl<3>
|
|
|
|
|
|
If you do a \\[tcl-eval-defun] command on some Lisp source code, what
|
|
|
|
|
|
process do you send it to?
|
|
|
|
|
|
|
|
|
|
|
|
- If you're in a process buffer (foo, bar, or *inferior-tcl*),
|
|
|
|
|
|
you send it to that process.
|
|
|
|
|
|
- If you're in some other buffer (e.g., a source file), you
|
|
|
|
|
|
send it to the process attached to buffer `inferior-tcl-buffer'.
|
|
|
|
|
|
This process selection is performed by function `inferior-tcl-proc'.
|
|
|
|
|
|
|
|
|
|
|
|
Whenever \\[inferior-tcl] fires up a new process, it resets
|
|
|
|
|
|
`inferior-tcl-buffer' to be the new process's buffer. If you only run
|
|
|
|
|
|
one process, this does the right thing. If you run multiple
|
|
|
|
|
|
processes, you can change `inferior-tcl-buffer' to another process
|
|
|
|
|
|
buffer with \\[set-variable].")
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Hooks and other customization.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-mode-hook nil
|
|
|
|
|
|
"Hook run on entry to Tcl mode.
|
|
|
|
|
|
|
|
|
|
|
|
Several functions exist which are useful to run from your
|
|
|
|
|
|
`tcl-mode-hook' (see each function's documentation for more
|
|
|
|
|
|
information):
|
|
|
|
|
|
|
|
|
|
|
|
tcl-install-menubar
|
|
|
|
|
|
Puts a \"Tcl\" menu on the menubar. Doesn't work in Emacs 18.
|
|
|
|
|
|
tcl-guess-application
|
|
|
|
|
|
Guesses a default setting for `tcl-application' based on any
|
|
|
|
|
|
\"#!\" line at the top of the file.
|
|
|
|
|
|
tcl-hashify-buffer
|
|
|
|
|
|
Quotes all \"#\" characters that don't correspond to actual
|
|
|
|
|
|
Tcl comments. (Useful when editing code not originally created
|
|
|
|
|
|
with this mode).
|
|
|
|
|
|
tcl-auto-fill-mode
|
|
|
|
|
|
Auto-filling of Tcl comments.
|
|
|
|
|
|
|
|
|
|
|
|
Emacs 19 users can add functions to the hook with `add-hook':
|
|
|
|
|
|
|
|
|
|
|
|
(add-hook 'tcl-mode-hook 'tcl-guess-application)
|
|
|
|
|
|
|
|
|
|
|
|
Emacs 18 users must use `setq':
|
|
|
|
|
|
|
|
|
|
|
|
(setq tcl-mode-hook (cons 'tcl-guess-application tcl-mode-hook))")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defvar inferior-tcl-mode-hook nil
|
|
|
|
|
|
"Hook for customizing Inferior Tcl mode.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-proc-list
|
|
|
|
|
|
'("proc")
|
|
|
|
|
|
"List of commands whose first argument defines something.
|
|
|
|
|
|
This exists because some people (eg, me) use \"defvar\" et al.
|
|
|
|
|
|
Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords'
|
|
|
|
|
|
after changing this list.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-proc-regexp nil
|
|
|
|
|
|
"Regexp to use when matching proc headers.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-typeword-list
|
|
|
|
|
|
'("global" "upvar")
|
|
|
|
|
|
"List of Tcl keywords deonting \"type\". Used only for highlighting.
|
|
|
|
|
|
Call `tcl-set-font-lock-keywords' after changing this list.")
|
|
|
|
|
|
|
|
|
|
|
|
;; Generally I've picked control operators to be keywords.
|
|
|
|
|
|
(defvar tcl-keyword-list
|
|
|
|
|
|
'("if" "then" "else" "elseif" "for" "foreach" "break" "continue" "while"
|
|
|
|
|
|
"eval" "case" "in" "switch" "default" "exit" "error" "proc" "return"
|
|
|
|
|
|
"uplevel" "loop" "for_array_keys" "for_recursive_glob" "for_file")
|
|
|
|
|
|
"List of Tcl keywords. Used only for highlighting.
|
|
|
|
|
|
Default list includes some TclX keywords.
|
|
|
|
|
|
Call `tcl-set-font-lock-keywords' after changing this list.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-font-lock-keywords nil
|
|
|
|
|
|
"Keywords to highlight for Tcl. See variable `font-lock-keywords'.
|
|
|
|
|
|
This variable is generally set from `tcl-proc-regexp',
|
|
|
|
|
|
`tcl-typeword-list', and `tcl-keyword-list' by the function
|
|
|
|
|
|
`tcl-set-font-lock-keywords'.")
|
|
|
|
|
|
|
|
|
|
|
|
;; FIXME need some way to recognize variables because array refs look
|
|
|
|
|
|
;; like 2 sexps.
|
|
|
|
|
|
(defvar tcl-type-alist
|
|
|
|
|
|
'(
|
|
|
|
|
|
("expr" tcl-expr)
|
|
|
|
|
|
("catch" tcl-commands)
|
|
|
|
|
|
("if" tcl-expr "then" tcl-commands)
|
|
|
|
|
|
("elseif" tcl-expr "then" tcl-commands)
|
|
|
|
|
|
("elseif" tcl-expr tcl-commands)
|
|
|
|
|
|
("if" tcl-expr tcl-commands)
|
|
|
|
|
|
("while" tcl-expr tcl-commands)
|
|
|
|
|
|
("for" tcl-commands tcl-expr tcl-commands tcl-commands)
|
|
|
|
|
|
("foreach" nil nil tcl-commands)
|
|
|
|
|
|
("for_file" nil nil tcl-commands)
|
|
|
|
|
|
("for_array_keys" nil nil tcl-commands)
|
|
|
|
|
|
("for_recursive_glob" nil nil nil tcl-commands)
|
|
|
|
|
|
;; Loop handling is not perfect, because the third argument can be
|
|
|
|
|
|
;; either a command or an expr, and there is no real way to look
|
|
|
|
|
|
;; forward.
|
|
|
|
|
|
("loop" nil tcl-expr tcl-expr tcl-commands)
|
|
|
|
|
|
("loop" nil tcl-expr tcl-commands)
|
|
|
|
|
|
)
|
|
|
|
|
|
"Alist that controls indentation.
|
|
|
|
|
|
\(Actually, this really only controls what happens on continuation lines).
|
|
|
|
|
|
Each entry looks like `(KEYWORD TYPE ...)'.
|
|
|
|
|
|
Each type entry describes a sexp after the keyword, and can be one of:
|
|
|
|
|
|
* nil, meaning that this sexp has no particular type.
|
|
|
|
|
|
* tcl-expr, meaning that this sexp is an arithmetic expression.
|
|
|
|
|
|
* tcl-commands, meaning that this sexp holds Tcl commands.
|
|
|
|
|
|
* a string, which must exactly match the string at the corresponding
|
|
|
|
|
|
position for a match to be made.
|
|
|
|
|
|
|
|
|
|
|
|
For example, the entry for the \"loop\" command is:
|
|
|
|
|
|
|
|
|
|
|
|
(\"loop\" nil tcl-expr tcl-commands)
|
|
|
|
|
|
|
|
|
|
|
|
This means that the \"loop\" command has three arguments. The first
|
|
|
|
|
|
argument is ignored (for indentation purposes). The second argument
|
|
|
|
|
|
is a Tcl expression, and the last argument is Tcl commands.")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-explain-indentation nil
|
|
|
|
|
|
"If not `nil', debugging message will be printed during indentation.")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Work around differences between various versions of Emacs.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
;; We use this because Lemacs 19.9 has what we need.
|
|
|
|
|
|
(defconst tcl-pps-has-arg-6
|
|
|
|
|
|
(or tcl-using-emacs-19
|
|
|
|
|
|
(and tcl-using-lemacs-19
|
|
|
|
|
|
(condition-case nil
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(parse-partial-sexp (point) (point) nil nil nil t)
|
|
|
|
|
|
t)
|
|
|
|
|
|
(error nil))))
|
|
|
|
|
|
"t if using an emacs which supports sixth (\"commentstop\") argument
|
|
|
|
|
|
to parse-partial-sexp.")
|
|
|
|
|
|
|
|
|
|
|
|
;; Its pretty bogus to have to do this, but there is no easier way to
|
|
|
|
|
|
;; say "match not syntax-1 and not syntax-2". Too bad you can't put
|
|
|
|
|
|
;; \s in [...]. This sickness is used in Emacs 19 to match a defun
|
|
|
|
|
|
;; starter. (It is used for this in v18 as well).
|
|
|
|
|
|
;;(defconst tcl-omit-ws-regexp
|
|
|
|
|
|
;; (concat "^\\(\\s"
|
|
|
|
|
|
;; (mapconcat 'char-to-string "w_.()\"\\$'/" "\\|\\s")
|
|
|
|
|
|
;; "\\)\\S(*")
|
|
|
|
|
|
;; "Regular expression that matches everything except space, comment
|
|
|
|
|
|
;;starter, and comment ender syntax codes.")
|
|
|
|
|
|
|
|
|
|
|
|
;; FIXME? Instead of using the hairy regexp above, we just use a
|
|
|
|
|
|
;; simple one.
|
|
|
|
|
|
;;(defconst tcl-omit-ws-regexp "^[^] \t\n#}]\\S(*"
|
|
|
|
|
|
;; "Regular expression used in locating function definitions.")
|
|
|
|
|
|
|
|
|
|
|
|
;; Here's another stab. I think this one actually works. Now the
|
|
|
|
|
|
;; problem seems to be that there is a bug in Emacs 19.22 where
|
|
|
|
|
|
;; end-of-defun doesn't really use the brace matching the one that
|
|
|
|
|
|
;; trails defun-prompt-regexp.
|
|
|
|
|
|
(defconst tcl-omit-ws-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+")
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-internal-beginning-of-defun (&optional arg)
|
|
|
|
|
|
"Move backward to next beginning-of-defun.
|
|
|
|
|
|
With argument, do this that many times.
|
|
|
|
|
|
Returns t unless search stops due to end of buffer."
|
|
|
|
|
|
(interactive "p")
|
|
|
|
|
|
(if (or (null arg) (= arg 0))
|
|
|
|
|
|
(setq arg 1))
|
|
|
|
|
|
(let (success)
|
|
|
|
|
|
(while (progn
|
|
|
|
|
|
(setq arg (1- arg))
|
|
|
|
|
|
(and (>= arg 0)
|
|
|
|
|
|
(setq success
|
|
|
|
|
|
(re-search-backward tcl-omit-ws-regexp nil 'move 1))))
|
|
|
|
|
|
(while (and (looking-at "[]#}]")
|
|
|
|
|
|
(setq success
|
|
|
|
|
|
(re-search-backward tcl-omit-ws-regexp nil 'move 1)))))
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(not (null success))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-internal-end-of-defun (&optional arg)
|
|
|
|
|
|
"Move forward to next end of defun.
|
|
|
|
|
|
An end of a defun is found by moving forward from the beginning of one."
|
|
|
|
|
|
(interactive "p")
|
|
|
|
|
|
(if (or (null arg) (= arg 0)) (setq arg 1))
|
|
|
|
|
|
(let ((start (point)))
|
|
|
|
|
|
;; Was forward-char. I think this works a little better.
|
|
|
|
|
|
(forward-line)
|
|
|
|
|
|
(tcl-beginning-of-defun)
|
|
|
|
|
|
(while (> arg 0)
|
|
|
|
|
|
(while (and (re-search-forward tcl-omit-ws-regexp nil 'move 1)
|
|
|
|
|
|
(progn (beginning-of-line) t)
|
|
|
|
|
|
(looking-at "[]#}]")
|
|
|
|
|
|
(progn (forward-line) t)))
|
|
|
|
|
|
(let ((next-line (save-excursion
|
|
|
|
|
|
(forward-line)
|
|
|
|
|
|
(point))))
|
|
|
|
|
|
(while (< (point) next-line)
|
|
|
|
|
|
(forward-sexp)))
|
|
|
|
|
|
(forward-line)
|
|
|
|
|
|
(if (> (point) start) (setq arg (1- arg))))))
|
|
|
|
|
|
|
|
|
|
|
|
;; In Emacs 19, we can use begining-of-defun as long as we set up a
|
|
|
|
|
|
;; certain regexp. In Emacs 18, we need our own function.
|
|
|
|
|
|
(fset 'tcl-beginning-of-defun
|
|
|
|
|
|
(if tcl-using-emacs-19
|
|
|
|
|
|
'beginning-of-defun
|
|
|
|
|
|
'tcl-internal-beginning-of-defun))
|
|
|
|
|
|
|
|
|
|
|
|
;; Only FSF Emacs 19 works correctly using end-of-defun. Emacs 18 and
|
|
|
|
|
|
;; Lucid need our own function.
|
|
|
|
|
|
(fset 'tcl-end-of-defun
|
|
|
|
|
|
(if (and tcl-using-emacs-19 (not tcl-using-lemacs-19))
|
|
|
|
|
|
'end-of-defun
|
|
|
|
|
|
'tcl-internal-end-of-defun))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Some helper functions.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-set-proc-regexp ()
|
|
|
|
|
|
"Set `tcl-proc-regexp' from variable `tcl-proc-list'."
|
|
|
|
|
|
(setq tcl-proc-regexp (concat "^\\("
|
|
|
|
|
|
(mapconcat 'identity tcl-proc-list "\\|")
|
|
|
|
|
|
"\\)[ \t]+")))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-set-font-lock-keywords ()
|
|
|
|
|
|
"Set `tcl-font-lock-keywords'.
|
|
|
|
|
|
Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
|
|
|
|
|
|
(setq tcl-font-lock-keywords
|
|
|
|
|
|
(list
|
|
|
|
|
|
;; Names of functions (and other "defining things").
|
|
|
|
|
|
(list (concat tcl-proc-regexp "\\([^ \t\n]+\\)")
|
|
|
|
|
|
2 'font-lock-function-name-face)
|
|
|
|
|
|
|
|
|
|
|
|
;; Names of type-defining things.
|
|
|
|
|
|
(list (concat "\\(\\s-\\|^\\)\\("
|
|
|
|
|
|
;; FIXME Use 'regexp-quote?
|
|
|
|
|
|
(mapconcat 'identity tcl-typeword-list "\\|")
|
|
|
|
|
|
"\\)\\(\\s-\\|$\\)")
|
|
|
|
|
|
2 'font-lock-type-face)
|
|
|
|
|
|
|
|
|
|
|
|
;; Keywords. Only recognized if surrounded by whitespace.
|
|
|
|
|
|
;; FIXME consider using "not word or symbol", not
|
|
|
|
|
|
;; "whitespace".
|
|
|
|
|
|
(cons (concat "\\(\\s-\\|^\\)\\("
|
|
|
|
|
|
;; FIXME Use regexp-quote?
|
|
|
|
|
|
(mapconcat 'identity tcl-keyword-list "\\|")
|
|
|
|
|
|
"\\)\\(\\s-\\|$\\)")
|
|
|
|
|
|
2)
|
|
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
|
|
(if tcl-proc-regexp
|
|
|
|
|
|
()
|
|
|
|
|
|
(tcl-set-proc-regexp))
|
|
|
|
|
|
|
|
|
|
|
|
(if tcl-font-lock-keywords
|
|
|
|
|
|
()
|
|
|
|
|
|
(tcl-set-font-lock-keywords))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; The mode itself.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-mode ()
|
|
|
|
|
|
"Major mode for editing Tcl code.
|
|
|
|
|
|
Expression and list commands understand all Tcl brackets.
|
|
|
|
|
|
Tab indents for Tcl code.
|
|
|
|
|
|
Paragraphs are separated by blank lines only.
|
|
|
|
|
|
Delete converts tabs to spaces as it moves back.
|
|
|
|
|
|
|
|
|
|
|
|
Variables controlling indentation style:
|
|
|
|
|
|
tcl-indent-level
|
|
|
|
|
|
Indentation of Tcl statements within surrounding block.
|
|
|
|
|
|
tcl-continued-indent-level
|
|
|
|
|
|
Indentation of continuation line relative to first line of command.
|
|
|
|
|
|
|
|
|
|
|
|
Variables controlling user interaction with mode (see variable
|
|
|
|
|
|
documentation for details):
|
|
|
|
|
|
tcl-tab-always-indent
|
|
|
|
|
|
Controls action of TAB key.
|
|
|
|
|
|
tcl-auto-newline
|
|
|
|
|
|
Non-nil means automatically newline before and after braces, brackets,
|
|
|
|
|
|
and semicolons inserted in Tcl code.
|
|
|
|
|
|
tcl-electric-hash-style
|
|
|
|
|
|
Controls action of `#' key.
|
|
|
|
|
|
tcl-use-hairy-comment-detector
|
|
|
|
|
|
If t, use more complicated, but slower, comment detector.
|
|
|
|
|
|
This variable is only used in GNU Emacs 19.
|
|
|
|
|
|
|
|
|
|
|
|
Turning on Tcl mode calls the value of the variable `tcl-mode-hook'
|
|
|
|
|
|
with no args, if that value is non-nil. Read the documentation for
|
|
|
|
|
|
`tcl-mode-hook' to see what kinds of interesting hook functions
|
|
|
|
|
|
already exist.
|
|
|
|
|
|
|
|
|
|
|
|
Commands:
|
|
|
|
|
|
\\{tcl-mode-map}"
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(kill-all-local-variables)
|
|
|
|
|
|
(use-local-map tcl-mode-map)
|
|
|
|
|
|
(setq major-mode 'tcl-mode)
|
|
|
|
|
|
(setq mode-name "Tcl")
|
|
|
|
|
|
(setq local-abbrev-table tcl-mode-abbrev-table)
|
|
|
|
|
|
(set-syntax-table tcl-mode-syntax-table)
|
|
|
|
|
|
(make-local-variable 'paragraph-start)
|
|
|
|
|
|
(setq paragraph-start (concat "^$\\|" page-delimiter))
|
|
|
|
|
|
(make-local-variable 'paragraph-separate)
|
|
|
|
|
|
(setq paragraph-separate paragraph-start)
|
|
|
|
|
|
(make-local-variable 'paragraph-ignore-fill-prefix)
|
|
|
|
|
|
(setq paragraph-ignore-fill-prefix t)
|
|
|
|
|
|
(make-local-variable 'indent-line-function)
|
|
|
|
|
|
(setq indent-line-function 'tcl-indent-line)
|
|
|
|
|
|
;; Tcl doesn't require a final newline.
|
|
|
|
|
|
;; (make-local-variable 'require-final-newline)
|
|
|
|
|
|
;; (setq require-final-newline t)
|
|
|
|
|
|
(make-local-variable 'comment-start)
|
|
|
|
|
|
(setq comment-start "# ")
|
|
|
|
|
|
(make-local-variable 'comment-start-skip)
|
|
|
|
|
|
(setq comment-start-skip "#+ *")
|
|
|
|
|
|
(make-local-variable 'comment-column)
|
|
|
|
|
|
(setq comment-column 40)
|
|
|
|
|
|
(make-local-variable 'comment-end)
|
|
|
|
|
|
(setq comment-end "")
|
|
|
|
|
|
(make-local-variable 'font-lock-keywords)
|
|
|
|
|
|
(setq font-lock-keywords tcl-font-lock-keywords)
|
|
|
|
|
|
(setq imenu-create-index-function 'tcl-imenu-create-index-function)
|
|
|
|
|
|
(make-local-variable 'parse-sexp-ignore-comments)
|
|
|
|
|
|
(if tcl-using-emacs-19
|
|
|
|
|
|
(progn
|
|
|
|
|
|
;; This can only be set to t in Emacs 19 and Lucid Emacs.
|
|
|
|
|
|
;; Emacs 18 and Epoch lose.
|
|
|
|
|
|
(setq parse-sexp-ignore-comments t)
|
|
|
|
|
|
;; Lucid Emacs has defun-prompt-regexp, but I don't believe
|
|
|
|
|
|
;; that it works for end-of-defun -- only for
|
|
|
|
|
|
;; beginning-of-defun.
|
|
|
|
|
|
(make-local-variable 'defun-prompt-regexp)
|
|
|
|
|
|
(setq defun-prompt-regexp tcl-omit-ws-regexp)
|
|
|
|
|
|
;; The following doesn't work in Lucid Emacs 19.6, but maybe
|
|
|
|
|
|
;; it will appear in later versions.
|
|
|
|
|
|
(make-local-variable 'add-log-current-defun-function)
|
|
|
|
|
|
(setq add-log-current-defun-function 'add-log-tcl-defun))
|
|
|
|
|
|
(setq parse-sexp-ignore-comments nil))
|
|
|
|
|
|
(run-hooks 'tcl-mode-hook))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; This is used for braces, brackets, and semi (except for closing
|
|
|
|
|
|
;; braces, which are handled specially).
|
|
|
|
|
|
(defun tcl-electric-char (arg)
|
|
|
|
|
|
"Insert character and correct line's indentation."
|
|
|
|
|
|
(interactive "p")
|
|
|
|
|
|
;; Indent line first; this looks better if parens blink.
|
|
|
|
|
|
(tcl-indent-line)
|
|
|
|
|
|
(self-insert-command arg)
|
|
|
|
|
|
(if (and tcl-auto-newline (= last-command-char ?\;))
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(newline)
|
|
|
|
|
|
(tcl-indent-line))))
|
|
|
|
|
|
|
|
|
|
|
|
;; This is used for closing braces. If tcl-auto-newline is set, can
|
|
|
|
|
|
;; insert a newline both before and after the brace, depending on
|
|
|
|
|
|
;; context. FIXME should this be configurable? Does anyone use this?
|
|
|
|
|
|
(defun tcl-electric-brace (arg)
|
|
|
|
|
|
"Insert character and correct line's indentation."
|
|
|
|
|
|
(interactive "p")
|
|
|
|
|
|
;; If auto-newlining and there is stuff on the same line, insert a
|
|
|
|
|
|
;; newline first.
|
|
|
|
|
|
(if tcl-auto-newline
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(if (save-excursion
|
|
|
|
|
|
(skip-chars-backward " \t")
|
|
|
|
|
|
(bolp))
|
|
|
|
|
|
()
|
|
|
|
|
|
(tcl-indent-line)
|
|
|
|
|
|
(newline))
|
|
|
|
|
|
;; In auto-newline case, must insert a newline after each
|
|
|
|
|
|
;; brace. So an explicit loop is needed.
|
|
|
|
|
|
(while (> arg 0)
|
|
|
|
|
|
(insert last-command-char)
|
|
|
|
|
|
(tcl-indent-line)
|
|
|
|
|
|
(newline)
|
|
|
|
|
|
(setq arg (1- arg))))
|
|
|
|
|
|
(self-insert-command arg))
|
|
|
|
|
|
(tcl-indent-line))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-indent-command (&optional arg)
|
|
|
|
|
|
"Indent current line as Tcl code, or in some cases insert a tab character.
|
|
|
|
|
|
If tcl-tab-always-indent is t (the default), always indent current line.
|
|
|
|
|
|
If tcl-tab-always-indent is nil and point is not in the indentation
|
|
|
|
|
|
area at the beginning of the line, a TAB is inserted.
|
|
|
|
|
|
Other values of tcl-tab-always-indent cause the first possible action
|
|
|
|
|
|
from the following list to take place:
|
|
|
|
|
|
|
|
|
|
|
|
1. Move from beginning of line to correct indentation.
|
|
|
|
|
|
2. Delete an empty comment.
|
|
|
|
|
|
3. Move forward to start of comment, indenting if necessary.
|
|
|
|
|
|
4. Move forward to end of line, indenting if necessary.
|
|
|
|
|
|
5. Create an empty comment.
|
|
|
|
|
|
6. Move backward to start of comment, indenting if necessary."
|
|
|
|
|
|
(interactive "p")
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((not tcl-tab-always-indent)
|
|
|
|
|
|
;; Indent if in identation area, otherwise insert TAB.
|
|
|
|
|
|
(if (<= (current-column) (current-indentation))
|
|
|
|
|
|
(tcl-indent-line)
|
|
|
|
|
|
(self-insert-command arg)))
|
|
|
|
|
|
((eq tcl-tab-always-indent t)
|
|
|
|
|
|
;; Always indent.
|
|
|
|
|
|
(tcl-indent-line))
|
|
|
|
|
|
(t
|
|
|
|
|
|
;; "Perl-mode" style TAB command.
|
|
|
|
|
|
(let* ((ipoint (point))
|
|
|
|
|
|
(eolpoint (progn
|
|
|
|
|
|
(end-of-line)
|
|
|
|
|
|
(point)))
|
|
|
|
|
|
(comment-p (tcl-in-comment)))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((= ipoint (save-excursion
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(point)))
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(tcl-indent-line)
|
|
|
|
|
|
;; If indenting didn't leave us in column 0, go to the
|
|
|
|
|
|
;; indentation. Otherwise leave point at end of line. This
|
|
|
|
|
|
;; is a hack.
|
|
|
|
|
|
(if (= (point) (save-excursion
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(point)))
|
|
|
|
|
|
(end-of-line)
|
|
|
|
|
|
(back-to-indentation)))
|
|
|
|
|
|
((and comment-p (looking-at "[ \t]*$"))
|
|
|
|
|
|
;; Empty comment, so delete it. We also delete any ";"
|
|
|
|
|
|
;; characters at the end of the line. I think this is
|
|
|
|
|
|
;; friendlier, but I don't know how other people will feel.
|
|
|
|
|
|
(backward-char)
|
|
|
|
|
|
(skip-chars-backward " \t;")
|
|
|
|
|
|
(delete-region (point) eolpoint))
|
|
|
|
|
|
((and comment-p (< ipoint (point)))
|
|
|
|
|
|
;; Before comment, so skip to it.
|
|
|
|
|
|
(tcl-indent-line)
|
|
|
|
|
|
(indent-for-comment))
|
|
|
|
|
|
((/= ipoint eolpoint)
|
|
|
|
|
|
;; Go to end of line (since we're not there yet).
|
|
|
|
|
|
(goto-char eolpoint)
|
|
|
|
|
|
(tcl-indent-line))
|
|
|
|
|
|
((not comment-p)
|
|
|
|
|
|
;; Create an empty comment (since there isn't one on this
|
|
|
|
|
|
;; line). If line is not blank, make sure we insert a ";"
|
|
|
|
|
|
;; first.
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(if (/= (point) eolpoint)
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(goto-char eolpoint)
|
|
|
|
|
|
(or (tcl-real-command-p)
|
|
|
|
|
|
(insert ";"))))
|
|
|
|
|
|
(tcl-indent-line)
|
|
|
|
|
|
(indent-for-comment))
|
|
|
|
|
|
(t
|
|
|
|
|
|
;; Go to start of comment. We don't leave point where it is
|
|
|
|
|
|
;; because we want to skip comment-start-skip.
|
|
|
|
|
|
(tcl-indent-line)
|
|
|
|
|
|
(indent-for-comment)))))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-indent-line ()
|
|
|
|
|
|
"Indent current line as Tcl code.
|
|
|
|
|
|
Return the amount the indentation changed by."
|
|
|
|
|
|
(let ((indent (calculate-tcl-indent nil))
|
|
|
|
|
|
beg shift-amt
|
|
|
|
|
|
(case-fold-search nil)
|
|
|
|
|
|
(pos (- (point-max) (point))))
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(setq beg (point))
|
|
|
|
|
|
(cond ((eq indent nil)
|
|
|
|
|
|
(setq indent (current-indentation)))
|
|
|
|
|
|
(t
|
|
|
|
|
|
(skip-chars-forward " \t")
|
|
|
|
|
|
(if (listp indent) (setq indent (car indent)))
|
|
|
|
|
|
(cond ((= (following-char) ?})
|
|
|
|
|
|
(setq indent (- indent tcl-indent-level)))
|
|
|
|
|
|
((= (following-char) ?\])
|
|
|
|
|
|
(setq indent (- indent 1))))))
|
|
|
|
|
|
(skip-chars-forward " \t")
|
|
|
|
|
|
(setq shift-amt (- indent (current-column)))
|
|
|
|
|
|
(if (zerop shift-amt)
|
|
|
|
|
|
(if (> (- (point-max) pos) (point))
|
|
|
|
|
|
(goto-char (- (point-max) pos)))
|
|
|
|
|
|
(delete-region beg (point))
|
|
|
|
|
|
(indent-to indent)
|
|
|
|
|
|
;; If initial point was within line's indentation,
|
|
|
|
|
|
;; position after the indentation. Else stay at same point in text.
|
|
|
|
|
|
(if (> (- (point-max) pos) (point))
|
|
|
|
|
|
(goto-char (- (point-max) pos))))
|
|
|
|
|
|
shift-amt))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-figure-type ()
|
|
|
|
|
|
"Determine type of sexp at point.
|
|
|
|
|
|
This is either 'tcl-expr, 'tcl-commands, or nil. Puts point at start
|
|
|
|
|
|
of sexp that indicates types.
|
|
|
|
|
|
|
|
|
|
|
|
See documentation for variable `tcl-type-alist' for more information."
|
|
|
|
|
|
(let ((count 0)
|
|
|
|
|
|
result
|
|
|
|
|
|
word-stack)
|
|
|
|
|
|
(while (and (< count 5)
|
|
|
|
|
|
(not result))
|
|
|
|
|
|
(condition-case nil
|
|
|
|
|
|
(progn
|
|
|
|
|
|
;; FIXME should use "tcl-backward-sexp", which would skip
|
|
|
|
|
|
;; over entire variables, etc.
|
|
|
|
|
|
(backward-sexp)
|
|
|
|
|
|
(if (looking-at "[a-zA-Z_]+")
|
|
|
|
|
|
(let ((list tcl-type-alist)
|
|
|
|
|
|
entry)
|
|
|
|
|
|
(setq word-stack (cons (current-word) word-stack))
|
|
|
|
|
|
(while (and list (not result))
|
|
|
|
|
|
(setq entry (car list))
|
|
|
|
|
|
(setq list (cdr list))
|
|
|
|
|
|
(let ((index 0))
|
|
|
|
|
|
(while (and entry (<= index count))
|
|
|
|
|
|
;; Abort loop if string does not match word on
|
|
|
|
|
|
;; stack.
|
|
|
|
|
|
(and (stringp (car entry))
|
|
|
|
|
|
(not (string= (car entry)
|
|
|
|
|
|
(nth index word-stack)))
|
|
|
|
|
|
(setq entry nil))
|
|
|
|
|
|
(setq entry (cdr entry))
|
|
|
|
|
|
(setq index (1+ index)))
|
|
|
|
|
|
(and (> index count)
|
|
|
|
|
|
(not (stringp (car entry)))
|
|
|
|
|
|
(setq result (car entry)))
|
|
|
|
|
|
)))
|
|
|
|
|
|
(setq word-stack (cons nil word-stack))))
|
|
|
|
|
|
(error nil))
|
|
|
|
|
|
(setq count (1+ count)))
|
|
|
|
|
|
(and tcl-explain-indentation
|
|
|
|
|
|
(message "Indentation type %s" result))
|
|
|
|
|
|
result))
|
|
|
|
|
|
|
|
|
|
|
|
(defun calculate-tcl-indent (&optional parse-start)
|
|
|
|
|
|
"Return appropriate indentation for current line as Tcl code.
|
|
|
|
|
|
In usual case returns an integer: the column to indent to.
|
|
|
|
|
|
Returns nil if line starts inside a string, t if in a comment."
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(let* ((indent-point (point))
|
|
|
|
|
|
(case-fold-search nil)
|
|
|
|
|
|
(continued-line
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(if (bobp)
|
|
|
|
|
|
nil
|
|
|
|
|
|
(backward-char)
|
|
|
|
|
|
(= ?\\ (preceding-char)))))
|
|
|
|
|
|
(continued-indent-value (if continued-line
|
|
|
|
|
|
tcl-continued-indent-level
|
|
|
|
|
|
0))
|
|
|
|
|
|
state
|
|
|
|
|
|
containing-sexp
|
|
|
|
|
|
found-next-line)
|
|
|
|
|
|
(if parse-start
|
|
|
|
|
|
(goto-char parse-start)
|
|
|
|
|
|
(tcl-beginning-of-defun))
|
|
|
|
|
|
(while (< (point) indent-point)
|
|
|
|
|
|
(setq parse-start (point))
|
|
|
|
|
|
(setq state (parse-partial-sexp (point) indent-point 0))
|
|
|
|
|
|
(setq containing-sexp (car (cdr state))))
|
|
|
|
|
|
(cond ((or (nth 3 state) (nth 4 state))
|
|
|
|
|
|
;; Inside comment or string. Return nil or t if should
|
|
|
|
|
|
;; not change this line
|
|
|
|
|
|
(nth 4 state))
|
|
|
|
|
|
((null containing-sexp)
|
|
|
|
|
|
;; Line is at top level.
|
|
|
|
|
|
continued-indent-value)
|
|
|
|
|
|
(t
|
|
|
|
|
|
;; Set expr-p if we are looking at the expression part of
|
|
|
|
|
|
;; an "if", "expr", etc statement. Set commands-p if we
|
|
|
|
|
|
;; are looking at the body part of an if, while, etc
|
|
|
|
|
|
;; statement. FIXME Should check for "for" loops here.
|
|
|
|
|
|
(goto-char containing-sexp)
|
|
|
|
|
|
(let* ((sexpr-type (tcl-figure-type))
|
|
|
|
|
|
(expr-p (eq sexpr-type 'tcl-expr))
|
|
|
|
|
|
(commands-p (eq sexpr-type 'tcl-commands))
|
|
|
|
|
|
(expr-start (point)))
|
|
|
|
|
|
;; Find the first statement in the block and indent
|
|
|
|
|
|
;; like it. The first statement in the block might be
|
|
|
|
|
|
;; on the same line, so what we do is skip all
|
|
|
|
|
|
;; "virtually blank" lines, looking for a non-blank
|
|
|
|
|
|
;; one. A line is virtually blank if it only contains
|
|
|
|
|
|
;; a comment and whitespace. FIXME continued comments
|
|
|
|
|
|
;; aren't supported. They are a wart on Tcl anyway.
|
|
|
|
|
|
;; We do it this funky way because we want to know if
|
|
|
|
|
|
;; we've found a statement on some line _after_ the
|
|
|
|
|
|
;; line holding the sexp opener.
|
|
|
|
|
|
(goto-char containing-sexp)
|
|
|
|
|
|
(forward-char)
|
|
|
|
|
|
(if (and (< (point) indent-point)
|
|
|
|
|
|
(looking-at "[ \t]*\\(#.*\\)?$"))
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(forward-line)
|
|
|
|
|
|
(while (and (< (point) indent-point)
|
|
|
|
|
|
(looking-at "[ \t]*\\(#.*\\)?$"))
|
|
|
|
|
|
(setq found-next-line t)
|
|
|
|
|
|
(forward-line))))
|
|
|
|
|
|
(if (or continued-line
|
|
|
|
|
|
(/= (char-after containing-sexp) ?{)
|
|
|
|
|
|
expr-p)
|
|
|
|
|
|
(progn
|
|
|
|
|
|
;; Line is continuation line, or the sexp opener
|
|
|
|
|
|
;; is not a curly brace, or we are are looking at
|
|
|
|
|
|
;; an `expr' expression (which must be split
|
|
|
|
|
|
;; specially). So indentation is column of first
|
|
|
|
|
|
;; good spot after sexp opener (with some added
|
|
|
|
|
|
;; in the continued-line case). If there is no
|
|
|
|
|
|
;; nonempty line before the indentation point, we
|
|
|
|
|
|
;; use the column of the character after the sexp
|
|
|
|
|
|
;; opener.
|
|
|
|
|
|
(if (>= (point) indent-point)
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(goto-char containing-sexp)
|
|
|
|
|
|
(forward-char))
|
|
|
|
|
|
(skip-chars-forward " \t"))
|
|
|
|
|
|
(+ (current-column) continued-indent-value))
|
|
|
|
|
|
;; After a curly brace, and not a continuation line.
|
|
|
|
|
|
;; So take indentation from first good line after
|
|
|
|
|
|
;; start of block, unless that line is on the same
|
|
|
|
|
|
;; line as the opening brace. In this case use the
|
|
|
|
|
|
;; indentation of the opening brace's line, plus
|
|
|
|
|
|
;; another indent step. If we are in the body part
|
|
|
|
|
|
;; of an "if" or "while" then the indentation is
|
|
|
|
|
|
;; taken from the line holding the start of the
|
|
|
|
|
|
;; statement.
|
|
|
|
|
|
(if (and (< (point) indent-point)
|
|
|
|
|
|
found-next-line)
|
|
|
|
|
|
(current-indentation)
|
|
|
|
|
|
(if commands-p
|
|
|
|
|
|
(goto-char expr-start)
|
|
|
|
|
|
(goto-char containing-sexp))
|
|
|
|
|
|
(+ (current-indentation) tcl-indent-level)))))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun mark-tcl-function ()
|
|
|
|
|
|
"Put mark at end of Tcl function, point at beginning."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(push-mark (point))
|
|
|
|
|
|
(tcl-end-of-defun)
|
|
|
|
|
|
(if tcl-using-emacs-19
|
|
|
|
|
|
(push-mark (point) nil t)
|
|
|
|
|
|
(push-mark (point)))
|
|
|
|
|
|
(tcl-beginning-of-defun)
|
|
|
|
|
|
(backward-paragraph))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun indent-tcl-exp ()
|
|
|
|
|
|
"Indent each line of the Tcl grouping following point."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(let ((indent-stack (list nil))
|
|
|
|
|
|
(contain-stack (list (point)))
|
|
|
|
|
|
(case-fold-search nil)
|
|
|
|
|
|
outer-loop-done inner-loop-done state ostate
|
|
|
|
|
|
this-indent last-sexp continued-line
|
|
|
|
|
|
(next-depth 0)
|
|
|
|
|
|
last-depth)
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(forward-sexp 1))
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(setq outer-loop-done nil)
|
|
|
|
|
|
(while (and (not (eobp)) (not outer-loop-done))
|
|
|
|
|
|
(setq last-depth next-depth)
|
|
|
|
|
|
;; Compute how depth changes over this line
|
|
|
|
|
|
;; plus enough other lines to get to one that
|
|
|
|
|
|
;; does not end inside a comment or string.
|
|
|
|
|
|
;; Meanwhile, do appropriate indentation on comment lines.
|
|
|
|
|
|
(setq inner-loop-done nil)
|
|
|
|
|
|
(while (and (not inner-loop-done)
|
|
|
|
|
|
(not (and (eobp) (setq outer-loop-done t))))
|
|
|
|
|
|
(setq ostate state)
|
|
|
|
|
|
(setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
|
|
|
|
|
|
nil nil state))
|
|
|
|
|
|
(setq next-depth (car state))
|
|
|
|
|
|
(if (and (car (cdr (cdr state)))
|
|
|
|
|
|
(>= (car (cdr (cdr state))) 0))
|
|
|
|
|
|
(setq last-sexp (car (cdr (cdr state)))))
|
|
|
|
|
|
(if (or (nth 4 ostate))
|
|
|
|
|
|
(tcl-indent-line))
|
|
|
|
|
|
(if (or (nth 3 state))
|
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
|
(setq inner-loop-done t)))
|
|
|
|
|
|
(if (<= next-depth 0)
|
|
|
|
|
|
(setq outer-loop-done t))
|
|
|
|
|
|
(if outer-loop-done
|
|
|
|
|
|
nil
|
|
|
|
|
|
;; If this line had ..))) (((.. in it, pop out of the levels
|
|
|
|
|
|
;; that ended anywhere in this line, even if the final depth
|
|
|
|
|
|
;; doesn't indicate that they ended.
|
|
|
|
|
|
(while (> last-depth (nth 6 state))
|
|
|
|
|
|
(setq indent-stack (cdr indent-stack)
|
|
|
|
|
|
contain-stack (cdr contain-stack)
|
|
|
|
|
|
last-depth (1- last-depth)))
|
|
|
|
|
|
(if (/= last-depth next-depth)
|
|
|
|
|
|
(setq last-sexp nil))
|
|
|
|
|
|
;; Add levels for any parens that were started in this line.
|
|
|
|
|
|
(while (< last-depth next-depth)
|
|
|
|
|
|
(setq indent-stack (cons nil indent-stack)
|
|
|
|
|
|
contain-stack (cons nil contain-stack)
|
|
|
|
|
|
last-depth (1+ last-depth)))
|
|
|
|
|
|
(if (null (car contain-stack))
|
|
|
|
|
|
(setcar contain-stack
|
|
|
|
|
|
(or (car (cdr state))
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(forward-sexp -1)
|
|
|
|
|
|
(point)))))
|
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
|
(setq continued-line
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(backward-char)
|
|
|
|
|
|
(= (preceding-char) ?\\)))
|
|
|
|
|
|
(skip-chars-forward " \t")
|
|
|
|
|
|
(if (eolp)
|
|
|
|
|
|
nil
|
|
|
|
|
|
(if (and (car indent-stack)
|
|
|
|
|
|
(>= (car indent-stack) 0))
|
|
|
|
|
|
;; Line is on an existing nesting level.
|
|
|
|
|
|
(setq this-indent (car indent-stack))
|
|
|
|
|
|
;; Just started a new nesting level.
|
|
|
|
|
|
;; Compute the standard indent for this level.
|
|
|
|
|
|
(let ((val (calculate-tcl-indent
|
|
|
|
|
|
(if (car indent-stack)
|
|
|
|
|
|
(- (car indent-stack))))))
|
|
|
|
|
|
(setcar indent-stack
|
|
|
|
|
|
(setq this-indent val))
|
|
|
|
|
|
(setq continued-line nil)))
|
|
|
|
|
|
(cond ((not (numberp this-indent)))
|
|
|
|
|
|
((= (following-char) ?})
|
|
|
|
|
|
(setq this-indent (- this-indent tcl-indent-level)))
|
|
|
|
|
|
((= (following-char) ?\])
|
|
|
|
|
|
(setq this-indent (- this-indent 1))))
|
|
|
|
|
|
;; Put chosen indentation into effect.
|
|
|
|
|
|
(or (null this-indent)
|
|
|
|
|
|
(= (current-column)
|
|
|
|
|
|
(if continued-line
|
|
|
|
|
|
(+ this-indent tcl-indent-level)
|
|
|
|
|
|
this-indent))
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(delete-region (point) (progn (beginning-of-line) (point)))
|
|
|
|
|
|
(indent-to
|
|
|
|
|
|
(if continued-line
|
|
|
|
|
|
(+ this-indent tcl-indent-level)
|
|
|
|
|
|
this-indent)))))))))
|
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Interfaces to other packages.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-imenu-create-index-function ()
|
|
|
|
|
|
"Generate alist of indices for imenu."
|
|
|
|
|
|
(let ((re (concat tcl-proc-regexp "\\([^ \t\n{]+\\)"))
|
|
|
|
|
|
alist)
|
|
|
|
|
|
(imenu-progress-message 0)
|
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
|
(while (re-search-forward re nil t)
|
|
|
|
|
|
(imenu-progress-message nil)
|
|
|
|
|
|
;; Position on start of proc name, not beginning of line.
|
|
|
|
|
|
(setq alist (cons
|
|
|
|
|
|
(cons (buffer-substring (match-beginning 2) (match-end 2))
|
|
|
|
|
|
(match-beginning 2))
|
|
|
|
|
|
alist)))
|
|
|
|
|
|
(imenu-progress-message 100)
|
|
|
|
|
|
(nreverse alist)))
|
|
|
|
|
|
|
|
|
|
|
|
;; FIXME Definition of function is very ad-hoc. Should use
|
|
|
|
|
|
;; tcl-beginning-of-defun. Also has incestuous knowledge about the
|
|
|
|
|
|
;; format of tcl-proc-regexp.
|
|
|
|
|
|
(defun add-log-tcl-defun ()
|
|
|
|
|
|
"Return name of Tcl function point is in, or nil."
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(if (re-search-backward
|
|
|
|
|
|
(concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t)
|
|
|
|
|
|
(buffer-substring (match-beginning 2)
|
|
|
|
|
|
(match-end 2)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Helper functions for inferior Tcl mode.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
;; This exists to let us delete the prompt when commands are sent
|
|
|
|
|
|
;; directly to the inferior Tcl. See gud.el for an explanation of how
|
|
|
|
|
|
;; it all works (I took it from there). This stuff doesn't really
|
|
|
|
|
|
;; work as well as I'd like it to. But I don't believe there is
|
|
|
|
|
|
;; anything useful that can be done.
|
|
|
|
|
|
(defvar inferior-tcl-delete-prompt-marker nil)
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-filter (proc string)
|
|
|
|
|
|
(let ((inhibit-quit t))
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(set-buffer (process-buffer proc))
|
|
|
|
|
|
(goto-char (process-mark proc))
|
|
|
|
|
|
;; Delete prompt if requested.
|
|
|
|
|
|
(if (marker-buffer inferior-tcl-delete-prompt-marker)
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(delete-region (point) inferior-tcl-delete-prompt-marker)
|
|
|
|
|
|
(set-marker inferior-tcl-delete-prompt-marker nil)))))
|
|
|
|
|
|
(comint-output-filter proc string))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-send-string (proc string)
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(set-buffer (process-buffer proc))
|
|
|
|
|
|
(goto-char (process-mark proc))
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(if (looking-at comint-prompt-regexp)
|
|
|
|
|
|
(set-marker inferior-tcl-delete-prompt-marker (point))))
|
|
|
|
|
|
(comint-send-string proc string))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-send-region (proc start end)
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(set-buffer (process-buffer proc))
|
|
|
|
|
|
(goto-char (process-mark proc))
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(if (looking-at comint-prompt-regexp)
|
|
|
|
|
|
(set-marker inferior-tcl-delete-prompt-marker (point))))
|
|
|
|
|
|
(comint-send-region proc start end))
|
|
|
|
|
|
|
|
|
|
|
|
(defun switch-to-tcl (eob-p)
|
|
|
|
|
|
"Switch to inferior Tcl process buffer.
|
|
|
|
|
|
With argument, positions cursor at end of buffer."
|
|
|
|
|
|
(interactive "P")
|
|
|
|
|
|
(if (get-buffer inferior-tcl-buffer)
|
|
|
|
|
|
(pop-to-buffer inferior-tcl-buffer)
|
|
|
|
|
|
(error "No current inferior Tcl buffer"))
|
|
|
|
|
|
(cond (eob-p
|
|
|
|
|
|
(push-mark)
|
|
|
|
|
|
(goto-char (point-max)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun inferior-tcl-proc ()
|
|
|
|
|
|
"Return current inferior Tcl process.
|
|
|
|
|
|
See variable `inferior-tcl-buffer'."
|
|
|
|
|
|
(let ((proc (get-buffer-process (if (eq major-mode 'inferior-tcl-mode)
|
|
|
|
|
|
(current-buffer)
|
|
|
|
|
|
inferior-tcl-buffer))))
|
|
|
|
|
|
(or proc
|
|
|
|
|
|
(error "No Tcl process; see variable `inferior-tcl-buffer'"))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-eval-region (start end &optional and-go)
|
|
|
|
|
|
"Send the current region to the inferior Tcl process.
|
|
|
|
|
|
Prefix argument means switch to the Tcl buffer afterwards."
|
|
|
|
|
|
(interactive "r\nP")
|
|
|
|
|
|
(let ((proc (inferior-tcl-proc)))
|
|
|
|
|
|
(tcl-send-region proc start end)
|
|
|
|
|
|
(tcl-send-string proc "\n")
|
|
|
|
|
|
(if and-go (switch-to-tcl t))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-eval-defun (&optional and-go)
|
|
|
|
|
|
"Send the current defun to the inferior Tcl process.
|
|
|
|
|
|
Prefix argument means switch to the Tcl buffer afterwards."
|
|
|
|
|
|
(interactive "P")
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(tcl-end-of-defun)
|
|
|
|
|
|
(let ((end (point)))
|
|
|
|
|
|
(tcl-beginning-of-defun)
|
|
|
|
|
|
(tcl-eval-region (point) end)))
|
|
|
|
|
|
(if and-go (switch-to-tcl t)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Inferior Tcl mode itself.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defun inferior-tcl-mode ()
|
|
|
|
|
|
"Major mode for interacting with Tcl interpreter.
|
|
|
|
|
|
|
|
|
|
|
|
A Tcl process can be started with M-x inferior-tcl.
|
|
|
|
|
|
|
|
|
|
|
|
Entry to this mode runs the hooks comint-mode-hook and
|
|
|
|
|
|
inferior-tcl-mode-hook, in that order.
|
|
|
|
|
|
|
|
|
|
|
|
You can send text to the inferior Tcl process from other buffers
|
|
|
|
|
|
containing Tcl source.
|
|
|
|
|
|
|
|
|
|
|
|
Variables controlling Inferior Tcl mode:
|
|
|
|
|
|
tcl-application
|
|
|
|
|
|
Name of program to run.
|
|
|
|
|
|
tcl-command-switches
|
|
|
|
|
|
Command line arguments to `tcl-application'.
|
|
|
|
|
|
tcl-prompt-regexp
|
|
|
|
|
|
Matches prompt.
|
|
|
|
|
|
inferior-tcl-source-command
|
|
|
|
|
|
Command to use to read Tcl file in running application.
|
|
|
|
|
|
inferior-tcl-buffer
|
|
|
|
|
|
The current inferior Tcl process buffer. See variable
|
|
|
|
|
|
documentation for details on multiple-process support.
|
|
|
|
|
|
|
|
|
|
|
|
The following commands are available:
|
|
|
|
|
|
\\{inferior-tcl-mode-map}"
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(comint-mode)
|
|
|
|
|
|
(setq comint-prompt-regexp (or tcl-prompt-regexp
|
|
|
|
|
|
(concat "^"
|
|
|
|
|
|
(regexp-quote tcl-application)
|
|
|
|
|
|
">")))
|
|
|
|
|
|
(setq major-mode 'inferior-tcl-mode)
|
|
|
|
|
|
(setq mode-name "Inferior Tcl")
|
|
|
|
|
|
(setq mode-line-process '(": %s"))
|
|
|
|
|
|
(use-local-map inferior-tcl-mode-map)
|
|
|
|
|
|
(setq local-abbrev-table tcl-mode-abbrev-table)
|
|
|
|
|
|
(set-syntax-table tcl-mode-syntax-table)
|
|
|
|
|
|
(if tcl-using-emacs-19
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(make-local-variable 'defun-prompt-regexp)
|
|
|
|
|
|
(setq defun-prompt-regexp tcl-omit-ws-regexp)))
|
|
|
|
|
|
(make-local-variable 'inferior-tcl-delete-prompt-marker)
|
|
|
|
|
|
(setq inferior-tcl-delete-prompt-marker (make-marker))
|
|
|
|
|
|
(set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter)
|
|
|
|
|
|
(run-hooks 'inferior-tcl-mode-hook))
|
|
|
|
|
|
|
|
|
|
|
|
(defun inferior-tcl (cmd)
|
|
|
|
|
|
"Run inferior Tcl process.
|
|
|
|
|
|
Prefix arg means enter program name interactively.
|
|
|
|
|
|
See documentation for function `inferior-tcl-mode' for more information."
|
|
|
|
|
|
(interactive
|
|
|
|
|
|
(list (if current-prefix-arg
|
|
|
|
|
|
(read-string "Run Tcl: " tcl-application)
|
|
|
|
|
|
tcl-application)))
|
|
|
|
|
|
(if (not (comint-check-proc "*inferior-tcl*"))
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(set-buffer (apply (function make-comint) "inferior-tcl" cmd nil
|
|
|
|
|
|
tcl-command-switches))
|
|
|
|
|
|
(inferior-tcl-mode)))
|
|
|
|
|
|
(make-local-variable 'tcl-application)
|
|
|
|
|
|
(setq tcl-application cmd)
|
|
|
|
|
|
(setq inferior-tcl-buffer "*inferior-tcl*")
|
|
|
|
|
|
(switch-to-buffer "*inferior-tcl*"))
|
|
|
|
|
|
|
|
|
|
|
|
(and (fboundp 'defalias)
|
|
|
|
|
|
(defalias 'run-tcl 'inferior-tcl))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Auto-fill support.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-real-command-p ()
|
|
|
|
|
|
"Return nil if point is not at the beginning of a command.
|
|
|
|
|
|
A command is the first word on an otherwise empty line, or the
|
|
|
|
|
|
first word following a semicolon, opening brace, or opening bracket."
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(skip-chars-backward " \t")
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((bobp) t)
|
|
|
|
|
|
((bolp)
|
|
|
|
|
|
(backward-char)
|
|
|
|
|
|
;; Note -- continued comments are not supported here. I
|
|
|
|
|
|
;; consider those to be a wart on the language.
|
|
|
|
|
|
(not (eq ?\\ (preceding-char))))
|
|
|
|
|
|
(t
|
|
|
|
|
|
(memq (preceding-char) '(?\; ?{ ?\[))))))
|
|
|
|
|
|
|
|
|
|
|
|
;; FIXME doesn't actually return t. See last case.
|
|
|
|
|
|
(defun tcl-real-comment-p ()
|
|
|
|
|
|
"Return t if point is just after the `#' beginning a real comment.
|
|
|
|
|
|
Does not check to see if previous char is actually `#'.
|
|
|
|
|
|
A real comment is either at the beginning of the buffer,
|
|
|
|
|
|
preceeded only by whitespace on the line, or has a preceeding
|
|
|
|
|
|
semicolon, opening brace, or opening bracket on the same line."
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(backward-char)
|
|
|
|
|
|
(tcl-real-command-p)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-hairy-scan-for-comment (state end always-stop)
|
|
|
|
|
|
"Determine if point is in a comment.
|
|
|
|
|
|
Returns a list of the form `(FLAG . STATE)'. STATE can be used
|
|
|
|
|
|
as input to future invocations. FLAG is nil if not in comment,
|
|
|
|
|
|
t otherwise. If in comment, leaves point at beginning of comment.
|
|
|
|
|
|
Only works in Emacs 19. See also `tcl-simple-scan-for-comment', a
|
|
|
|
|
|
simpler version that is often right, and works in Emacs 18."
|
|
|
|
|
|
(let ((bol (save-excursion
|
|
|
|
|
|
(goto-char end)
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(point)))
|
|
|
|
|
|
real-comment
|
|
|
|
|
|
last-cstart)
|
|
|
|
|
|
(while (and (not last-cstart) (< (point) end))
|
|
|
|
|
|
(setq real-comment nil) ;In case we've looped around and it is
|
|
|
|
|
|
;set.
|
|
|
|
|
|
(setq state (parse-partial-sexp (point) end nil nil state t))
|
|
|
|
|
|
(if (nth 4 state)
|
|
|
|
|
|
(progn
|
|
|
|
|
|
;; If ALWAYS-STOP is set, stop even if we don't have a
|
|
|
|
|
|
;; real comment, or if the comment isn't on the same line
|
|
|
|
|
|
;; as the end.
|
|
|
|
|
|
(if always-stop (setq last-cstart (point)))
|
|
|
|
|
|
;; If we have a real comment, then set the comment
|
|
|
|
|
|
;; starting point if we are on the same line as the ending
|
|
|
|
|
|
;; location.
|
|
|
|
|
|
(setq real-comment (tcl-real-comment-p))
|
|
|
|
|
|
(if real-comment
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(and (> (point) bol) (setq last-cstart (point)))
|
|
|
|
|
|
;; NOTE Emacs 19 has a misfeature whereby calling
|
|
|
|
|
|
;; parse-partial-sexp with COMMENTSTOP set and with
|
|
|
|
|
|
;; an initial list that says point is in a comment
|
|
|
|
|
|
;; will cause an immediate return. So we must skip
|
|
|
|
|
|
;; over the comment ourselves.
|
|
|
|
|
|
(beginning-of-line 2)))
|
|
|
|
|
|
;; Frob the state to make it look like we aren't in a
|
|
|
|
|
|
;; comment.
|
|
|
|
|
|
(setcar (nthcdr 4 state) nil))))
|
|
|
|
|
|
(and last-cstart
|
|
|
|
|
|
(goto-char last-cstart))
|
|
|
|
|
|
(cons real-comment state)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-hairy-in-comment ()
|
|
|
|
|
|
"Return t if point is in a comment, and leave point at beginning
|
|
|
|
|
|
of comment."
|
|
|
|
|
|
(let ((save (point)))
|
|
|
|
|
|
(tcl-beginning-of-defun)
|
|
|
|
|
|
(car (tcl-hairy-scan-for-comment nil save nil))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-simple-in-comment ()
|
|
|
|
|
|
"Return t if point is in comment, and leave point at beginning
|
|
|
|
|
|
of comment. This is faster that `tcl-hairy-in-comment', but is
|
|
|
|
|
|
correct less often."
|
|
|
|
|
|
(let ((save (point))
|
|
|
|
|
|
comment)
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(while (and (< (point) save) (not comment))
|
|
|
|
|
|
(search-forward "#" save 'move)
|
|
|
|
|
|
(setq comment (tcl-real-comment-p)))
|
|
|
|
|
|
comment))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-in-comment ()
|
|
|
|
|
|
"Return t if point is in comment, and leave point at beginning
|
|
|
|
|
|
of comment."
|
|
|
|
|
|
(if (and tcl-pps-has-arg-6
|
|
|
|
|
|
tcl-use-hairy-comment-detector)
|
|
|
|
|
|
(tcl-hairy-in-comment)
|
|
|
|
|
|
(tcl-simple-in-comment)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-do-auto-fill ()
|
|
|
|
|
|
"Auto-fill function for Tcl mode. Only auto-fills in a comment."
|
|
|
|
|
|
(let (in-comment
|
|
|
|
|
|
col)
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(setq in-comment (tcl-in-comment))
|
|
|
|
|
|
(if in-comment
|
|
|
|
|
|
(setq col (1- (current-column)))))
|
|
|
|
|
|
(if in-comment
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(do-auto-fill)
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(back-to-indentation)
|
|
|
|
|
|
(delete-region (point) (save-excursion
|
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
|
(point)))
|
|
|
|
|
|
(indent-to-column col))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Help-related code.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-help-saved-dir nil
|
|
|
|
|
|
"Saved help directory. If `tcl-help-directory' changes, this allows
|
|
|
|
|
|
tcl-help-on-word to update the alist")
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-help-alist nil
|
|
|
|
|
|
"Alist with command names as keys and filenames as values.")
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-help-snarf-commands (dir)
|
|
|
|
|
|
"Build alist of commands and filenames. There is probably a much
|
|
|
|
|
|
better implementation of this, but I'm too tired to think of it right
|
|
|
|
|
|
now."
|
|
|
|
|
|
(let ((files (directory-files dir t)))
|
|
|
|
|
|
(while files
|
|
|
|
|
|
(if (and (file-directory-p (car files))
|
|
|
|
|
|
(not
|
|
|
|
|
|
(let ((fpart (file-name-nondirectory (car files))))
|
|
|
|
|
|
(or (equal fpart ".")
|
|
|
|
|
|
(equal fpart "..")))))
|
|
|
|
|
|
(let ((matches (directory-files (car files) t)))
|
|
|
|
|
|
(while matches
|
|
|
|
|
|
(or (file-directory-p (car matches))
|
|
|
|
|
|
(setq tcl-help-alist
|
|
|
|
|
|
(cons
|
|
|
|
|
|
(cons (file-name-nondirectory (car matches))
|
|
|
|
|
|
(car matches))
|
|
|
|
|
|
tcl-help-alist)))
|
|
|
|
|
|
(setq matches (cdr matches)))))
|
|
|
|
|
|
(setq files (cdr files)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-reread-help-files ()
|
|
|
|
|
|
"Set up to re-read files, and then do it."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(message "Building Tcl help file index...")
|
|
|
|
|
|
(setq tcl-help-saved-dir tcl-help-directory)
|
|
|
|
|
|
(setq tcl-help-alist nil)
|
|
|
|
|
|
(tcl-help-snarf-commands tcl-help-directory)
|
|
|
|
|
|
(message "Building Tcl help file index...done"))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-current-word (flag)
|
|
|
|
|
|
"Return current command word, or nil.
|
|
|
|
|
|
If FLAG is nil, just uses `current-word'.
|
|
|
|
|
|
Otherwise scans backward for most likely Tcl command word."
|
|
|
|
|
|
(if (and flag (eq major-mode 'tcl-mode))
|
|
|
|
|
|
(condition-case nil
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
;; Look backward for first word actually in alist.
|
|
|
|
|
|
(if (bobp)
|
|
|
|
|
|
()
|
|
|
|
|
|
(while (and (not (bobp))
|
|
|
|
|
|
(not (tcl-real-command-p)))
|
|
|
|
|
|
(backward-sexp)))
|
|
|
|
|
|
(if (assoc (current-word) tcl-help-alist)
|
|
|
|
|
|
(current-word)))
|
|
|
|
|
|
(error nil))
|
|
|
|
|
|
(current-word)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-help-on-word (command &optional arg)
|
|
|
|
|
|
"Get help on Tcl command. Default is word at point.
|
|
|
|
|
|
Prefix argument means invert sense of `tcl-use-smart-word-finder'."
|
|
|
|
|
|
(interactive
|
|
|
|
|
|
(list
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(if (not (string= tcl-help-directory tcl-help-saved-dir))
|
|
|
|
|
|
(tcl-reread-help-files))
|
|
|
|
|
|
(let ((word (tcl-current-word
|
|
|
|
|
|
(if current-prefix-arg
|
|
|
|
|
|
(not tcl-use-smart-word-finder)
|
|
|
|
|
|
tcl-use-smart-word-finder))))
|
|
|
|
|
|
(completing-read
|
|
|
|
|
|
(if (or (null word) (string= word ""))
|
|
|
|
|
|
"Help on Tcl command: "
|
|
|
|
|
|
(format "Help on Tcl command (default %s): " word))
|
|
|
|
|
|
tcl-help-alist nil t)))
|
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
|
(if (not (string= tcl-help-directory tcl-help-saved-dir))
|
|
|
|
|
|
(tcl-reread-help-files))
|
|
|
|
|
|
(if (string= command "")
|
|
|
|
|
|
(setq command (tcl-current-word
|
|
|
|
|
|
(if arg
|
|
|
|
|
|
(not tcl-use-smart-word-finder)
|
|
|
|
|
|
tcl-use-smart-word-finder))))
|
|
|
|
|
|
(let* ((help (get-buffer-create "*Tcl help*"))
|
|
|
|
|
|
(cell (assoc command tcl-help-alist))
|
|
|
|
|
|
(file (and cell (cdr cell))))
|
|
|
|
|
|
(set-buffer help)
|
|
|
|
|
|
(delete-region (point-min) (point-max))
|
|
|
|
|
|
(if file
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(insert "*** " command "\n\n")
|
|
|
|
|
|
(insert-file-contents file))
|
|
|
|
|
|
(if (string= command "")
|
|
|
|
|
|
(insert "Magical Pig!")
|
|
|
|
|
|
(insert "Tcl command " command " not in help\n")))
|
|
|
|
|
|
(set-buffer-modified-p nil)
|
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
|
(display-buffer help)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Other interactive stuff.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
(defvar tcl-previous-dir/file nil
|
|
|
|
|
|
"Record last directory and file used in loading.
|
|
|
|
|
|
This holds a cons cell of the form `(DIRECTORY . FILE)'
|
|
|
|
|
|
describing the last `tcl-load-file' command.")
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-load-file (file &optional and-go)
|
|
|
|
|
|
"Load a Tcl file into the inferior Tcl process.
|
|
|
|
|
|
Prefix argument means switch to the Tcl buffer afterwards."
|
|
|
|
|
|
(interactive
|
|
|
|
|
|
(list
|
|
|
|
|
|
;; car because comint-get-source returns a list holding the
|
|
|
|
|
|
;; filename.
|
|
|
|
|
|
(car (comint-get-source "Load Tcl file: " tcl-previous-dir/file
|
|
|
|
|
|
'(tcl-mode) t))
|
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
|
(comint-check-source file)
|
|
|
|
|
|
(setq tcl-previous-dir/file (cons (file-name-directory file)
|
|
|
|
|
|
(file-name-nondirectory file)))
|
|
|
|
|
|
(tcl-send-string (inferior-tcl-proc)
|
|
|
|
|
|
(format inferior-tcl-source-command (tcl-quote file)))
|
|
|
|
|
|
(if and-go (switch-to-tcl t)))
|
|
|
|
|
|
|
|
|
|
|
|
;; Maybe this should work just like tcl-load-file. But I think what
|
|
|
|
|
|
;; I've implemented will turn out to be more useful.
|
|
|
|
|
|
(defun tcl-restart-with-file (file &optional and-go)
|
|
|
|
|
|
"Restart inferior Tcl with file.
|
|
|
|
|
|
If an inferior Tcl process exists, it is killed first.
|
|
|
|
|
|
Prefix argument means switch to the Tcl buffer afterwards."
|
|
|
|
|
|
(interactive
|
|
|
|
|
|
(list
|
|
|
|
|
|
(car (comint-get-source "Restart with Tcl file: "
|
|
|
|
|
|
(or (and
|
|
|
|
|
|
(eq major-mode 'tcl-mode)
|
|
|
|
|
|
(buffer-file-name))
|
|
|
|
|
|
tcl-previous-dir/file)
|
|
|
|
|
|
'(tcl-mode) t))
|
|
|
|
|
|
current-prefix-arg))
|
|
|
|
|
|
(let* ((buf (if (eq major-mode 'inferior-tcl-mode)
|
|
|
|
|
|
(current-buffer)
|
|
|
|
|
|
inferior-tcl-buffer))
|
|
|
|
|
|
(proc (and buf (get-process buf))))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((not (and buf (get-buffer buf)))
|
|
|
|
|
|
;; I think this will be ok.
|
|
|
|
|
|
(inferior-tcl tcl-application)
|
|
|
|
|
|
(tcl-load-file file and-go))
|
|
|
|
|
|
((or
|
|
|
|
|
|
(not (comint-check-proc buf))
|
|
|
|
|
|
(yes-or-no-p
|
|
|
|
|
|
"A Tcl process is running, are you sure you want to reset it? "))
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(comint-check-source file)
|
|
|
|
|
|
(setq tcl-previous-dir/file (cons (file-name-directory file)
|
|
|
|
|
|
(file-name-nondirectory file)))
|
|
|
|
|
|
(comint-exec (get-buffer-create buf)
|
|
|
|
|
|
(if proc
|
|
|
|
|
|
(process-name proc)
|
|
|
|
|
|
"inferior-tcl")
|
|
|
|
|
|
tcl-application file tcl-command-switches)
|
|
|
|
|
|
(if and-go (switch-to-tcl t)))))))
|
|
|
|
|
|
|
|
|
|
|
|
;; FIXME I imagine you can do this under Emacs 18. I just don't know
|
|
|
|
|
|
;; how.
|
|
|
|
|
|
(defun tcl-auto-fill-mode (&optional arg)
|
|
|
|
|
|
"Like `auto-fill-mode', but controls filling of Tcl comments."
|
|
|
|
|
|
(interactive "P")
|
|
|
|
|
|
(and (not tcl-using-emacs-19)
|
|
|
|
|
|
(error "You must use Emacs 19 to get this feature."))
|
|
|
|
|
|
;; Following code taken from "auto-fill-mode" (simple.el).
|
|
|
|
|
|
(prog1
|
|
|
|
|
|
(setq auto-fill-function
|
|
|
|
|
|
(if (if (null arg)
|
|
|
|
|
|
(not auto-fill-function)
|
|
|
|
|
|
(> (prefix-numeric-value arg) 0))
|
|
|
|
|
|
'tcl-do-auto-fill
|
|
|
|
|
|
nil))
|
|
|
|
|
|
;; Update mode line. FIXME I'd use force-mode-line-update, but I
|
|
|
|
|
|
;; don't know if it exists in v18.
|
|
|
|
|
|
(set-buffer-modified-p (buffer-modified-p))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-electric-hash (&optional count)
|
|
|
|
|
|
"Insert a `#' and quote if it does not start a real comment.
|
|
|
|
|
|
Prefix arg is number of `#'s to insert.
|
|
|
|
|
|
See variable `tcl-electric-hash-style' for description of quoting
|
|
|
|
|
|
styles."
|
|
|
|
|
|
(interactive "p")
|
|
|
|
|
|
(or count (setq count 1))
|
|
|
|
|
|
(if (> count 0)
|
|
|
|
|
|
(let ((type
|
|
|
|
|
|
(if (eq tcl-electric-hash-style 'smart)
|
|
|
|
|
|
(if (> count 3) ; FIXME what is "smart"?
|
|
|
|
|
|
'quote
|
|
|
|
|
|
'backslash)
|
|
|
|
|
|
tcl-electric-hash-style))
|
|
|
|
|
|
comment)
|
|
|
|
|
|
(if type
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(insert "#")
|
|
|
|
|
|
(setq comment (tcl-in-comment)))
|
|
|
|
|
|
(delete-char 1)
|
|
|
|
|
|
(and tcl-explain-indentation (message "comment: %s" comment))
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((eq type 'quote)
|
|
|
|
|
|
(if (not comment)
|
|
|
|
|
|
(insert "\"")))
|
|
|
|
|
|
((eq type 'backslash)
|
|
|
|
|
|
;; The following will set count to 0, so the
|
|
|
|
|
|
;; insert-char can still be run.
|
|
|
|
|
|
(if (not comment)
|
|
|
|
|
|
(while (> count 0)
|
|
|
|
|
|
(insert "\\#")
|
|
|
|
|
|
(setq count (1- count)))))
|
|
|
|
|
|
(t nil))))
|
|
|
|
|
|
(insert-char ?# count))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-hashify-buffer ()
|
|
|
|
|
|
"Quote all `#'s in current buffer that aren't Tcl comments."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
|
(if (and tcl-pps-has-arg-6 tcl-use-hairy-comment-detector)
|
|
|
|
|
|
(let (state
|
|
|
|
|
|
result)
|
|
|
|
|
|
(while (< (point) (point-max))
|
|
|
|
|
|
(setq result (tcl-hairy-scan-for-comment state (point-max) t))
|
|
|
|
|
|
(if (car result)
|
|
|
|
|
|
(beginning-of-line 2)
|
|
|
|
|
|
(backward-char)
|
|
|
|
|
|
(if (eq ?# (following-char))
|
|
|
|
|
|
(insert "\\"))
|
|
|
|
|
|
(forward-char))
|
|
|
|
|
|
(setq state (cdr result))))
|
|
|
|
|
|
(while (and (< (point) (point-max))
|
|
|
|
|
|
(search-forward "#" nil 'move))
|
|
|
|
|
|
(if (tcl-real-comment-p)
|
|
|
|
|
|
(beginning-of-line 2)
|
|
|
|
|
|
;; There's really no good way for the simple converter to
|
|
|
|
|
|
;; work. So we just quote # if it isn't already quoted.
|
|
|
|
|
|
;; Bogus, but it works.
|
|
|
|
|
|
(backward-char)
|
|
|
|
|
|
(if (not (eq ?\\ (preceding-char)))
|
|
|
|
|
|
(insert "\\"))
|
|
|
|
|
|
(forward-char))))))
|
|
|
|
|
|
|
|
|
|
|
|
;; The following was inspired by the Tcl editing mode written by
|
|
|
|
|
|
;; Gregor Schmid <schmid@fb3-s7.math.TU-Berlin.DE>. His version also
|
|
|
|
|
|
;; attempts to snarf the command line options from the command line,
|
|
|
|
|
|
;; but I didn't think that would really be that helpful (doesn't seem
|
|
|
|
|
|
;; like it owould be right enough. His version also looks for the
|
|
|
|
|
|
;; "#!/bin/csh ... exec" hack, but that seemed even less useful.
|
|
|
|
|
|
(defun tcl-guess-application ()
|
|
|
|
|
|
"Attempt to guess Tcl application by looking at first line.
|
|
|
|
|
|
The first line is assumed to look like \"#!.../program ...\"."
|
|
|
|
|
|
(save-excursion
|
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
|
(if (looking-at "#![^ \t]*/\\([^ \t/]+\\)\\([ \t]\\|$\\)")
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(make-local-variable 'tcl-application)
|
|
|
|
|
|
(setq tcl-application (buffer-substring (match-beginning 1)
|
|
|
|
|
|
(match-end 1)))))))
|
|
|
|
|
|
|
|
|
|
|
|
;; This only exists to put on the menubar. I couldn't figure out any
|
|
|
|
|
|
;; other way to do it. FIXME should take "number of #-marks"
|
|
|
|
|
|
;; argument.
|
|
|
|
|
|
(defun tcl-uncomment-region (beg end)
|
|
|
|
|
|
"Uncomment region."
|
|
|
|
|
|
(interactive "r")
|
|
|
|
|
|
(comment-region beg end -1))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Lucid menu support.
|
|
|
|
|
|
;; Taken from schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid),
|
|
|
|
|
|
;; who wrote a different Tcl mode.
|
|
|
|
|
|
;; We also have simple support for menus in FSF. We do this by
|
|
|
|
|
|
;; loading the Lucid menu emulation code.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
;; Put this into your tcl-mode-hook.
|
|
|
|
|
|
(defun tcl-install-menubar ()
|
|
|
|
|
|
(and tcl-using-emacs-19
|
|
|
|
|
|
(not tcl-using-lemacs-19)
|
|
|
|
|
|
(if tcl-using-emacs-19.23
|
1994-04-06 22:17:36 +00:00
|
|
|
|
(require 'lmenu)
|
1994-04-06 22:10:06 +00:00
|
|
|
|
;; CAVEATS:
|
|
|
|
|
|
;; * lmenu.el provides 'menubar, which is bogus.
|
|
|
|
|
|
;; * lmenu.el causes menubars to be turned on everywhere.
|
|
|
|
|
|
;; Doubly bogus!
|
|
|
|
|
|
;; Both of these problems are fixed in Emacs 19.23. People
|
|
|
|
|
|
;; using an Emacs before that just suffer.
|
|
|
|
|
|
(require 'menubar "lmenu")))
|
|
|
|
|
|
(if (not (assoc "Tcl" current-menubar))
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(set-buffer-menubar (copy-sequence current-menubar))
|
|
|
|
|
|
(add-menu nil "Tcl" (cdr tcl-lucid-menu))))
|
|
|
|
|
|
;; You might want to do something like the below. I have it
|
|
|
|
|
|
;; commented out because it overrides existing bindings.
|
|
|
|
|
|
;; For Lucid:
|
|
|
|
|
|
;; (define-key tcl-mode-map 'button3 'tcl-popup-menu)
|
|
|
|
|
|
;; For FSF:
|
|
|
|
|
|
;; (define-key tcl-mode-map [down-mouse-3] 'tcl-popup-menu)
|
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
(defun tcl-popup-menu (e)
|
|
|
|
|
|
(interactive "e")
|
|
|
|
|
|
(and tcl-using-emacs-19
|
|
|
|
|
|
(not tcl-using-lemacs-19)
|
|
|
|
|
|
(if tcl-using-emacs-19.23
|
1994-04-06 22:17:36 +00:00
|
|
|
|
(require 'lmenu)
|
1994-04-06 22:10:06 +00:00
|
|
|
|
;; CAVEATS:
|
|
|
|
|
|
;; * lmenu.el provides 'menubar, which is bogus.
|
|
|
|
|
|
;; * lmenu.el causes menubars to be turned on everywhere.
|
|
|
|
|
|
;; Doubly bogus!
|
|
|
|
|
|
;; Both of these problems are fixed in Emacs 19.23. People
|
|
|
|
|
|
;; using an Emacs before that just suffer.
|
|
|
|
|
|
(require 'menubar "lmenu"))) ;; This is annoying
|
|
|
|
|
|
;;(mouse-set-point e)
|
|
|
|
|
|
;; IMHO popup-menu should be autoloaded. Oh well.
|
|
|
|
|
|
(popup-menu tcl-lucid-menu))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; Quoting and unquoting functions.
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
|
|
;; This quoting is sufficient to protect eg a filename from any sort
|
|
|
|
|
|
;; of expansion or splitting. Tcl quoting sure sucks.
|
|
|
|
|
|
(defun tcl-quote (string)
|
|
|
|
|
|
"Quote STRING according to Tcl rules."
|
|
|
|
|
|
(mapconcat (function (lambda (char)
|
|
|
|
|
|
(if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ? ?\;))
|
|
|
|
|
|
(concat "\\" (char-to-string char))
|
|
|
|
|
|
(char-to-string char))))
|
|
|
|
|
|
string ""))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide 'tcl)
|
|
|
|
|
|
|
|
|
|
|
|
;;; tcl.el ends here
|
