38436
|
1 ;;; tcl.el --- Tcl code editing commands for Emacs
|
6709
|
2
|
43437
|
3 ;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
|
6709
|
4
|
44320
|
5 ;; Maintainer: FSF
|
43437
|
6 ;; Author: Tom Tromey <tromey@redhat.com>
|
6710
|
7 ;; Chris Lindblad <cjl@lcs.mit.edu>
|
|
8 ;; Keywords: languages tcl modes
|
44320
|
9 ;; Version: $Revision: 1.68 $
|
6709
|
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
|
22662
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
6709
|
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
|
25163
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
26 ;; Boston, MA 02111-1307, USA.
|
6709
|
27
|
25163
|
28 ;; BEFORE USE:
|
6709
|
29 ;;
|
|
30 ;; If you plan to use the interface to the TclX help files, you must
|
7052
|
31 ;; set the variable tcl-help-directory-list to point to the topmost
|
|
32 ;; directories containing the TclX help files. Eg:
|
6709
|
33 ;;
|
7052
|
34 ;; (setq tcl-help-directory-list '("/usr/local/lib/tclx/help"))
|
6709
|
35 ;;
|
|
36 ;;; Commentary:
|
|
37
|
|
38 ;; CUSTOMIZATION NOTES:
|
|
39 ;; * tcl-proc-list can be used to customize a list of things that
|
|
40 ;; "define" other things. Eg in my project I put "defvar" in this
|
|
41 ;; list.
|
|
42 ;; * tcl-typeword-list is similar, but uses font-lock-type-face.
|
|
43 ;; * tcl-keyword-list is a list of keywords. I've generally used this
|
|
44 ;; for flow-control words. Eg I add "unwind_protect" to this list.
|
|
45 ;; * tcl-type-alist can be used to minimally customize indentation
|
|
46 ;; according to context.
|
|
47
|
25176
|
48 ;; THANKS FOR CRITICISM AND SUGGESTIONS TO:
|
6709
|
49 ;; Guido Bosch <Guido.Bosch@loria.fr>
|
|
50 ;; pgs1002@esc.cam.ac.uk (Dr P.G. Sjoerdsma)
|
|
51 ;; Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
|
|
52 ;; Matt Newman <men@charney.colorado.edu>
|
|
53 ;; rwhitby@research.canon.oz.au (Rod Whitby)
|
|
54 ;; h9118101@hkuxa.hku.hk (Yip Chi Lap [Beta])
|
|
55 ;; Pertti Tapio Kasanen <ptk@delta.hut.fi>
|
|
56 ;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)
|
8339
|
57 ;; warsaw@nlm.nih.gov (Barry A. Warsaw)
|
|
58 ;; Carl Witty <cwitty@ai.mit.edu>
|
8580
|
59 ;; T. V. Raman <raman@crl.dec.com>
|
11303
|
60 ;; Jesper Pedersen <blackie@imada.ou.dk>
|
11787
|
61 ;; dfarmer@evolving.com (Doug Farmer)
|
12924
8172973fd6e4
(tcl-hilit): New function from "Chris Alfeld" <calfeld@math.utah.edu>
Tom Tromey <tromey@redhat.com>
diff
changeset
|
62 ;; "Chris Alfeld" <calfeld@math.utah.edu>
|
44320
|
63 ;; Ben Wing <ben@xemacs.org>
|
6709
|
64
|
|
65 ;; KNOWN BUGS:
|
44320
|
66 ;; * In Tcl "#" is not always a comment character. This can confuse tcl.el
|
|
67 ;; in certain circumstances. For now the only workaround is to use
|
|
68 ;; font-lock which will mark the # chars accordingly or enclose offending
|
|
69 ;; hash characters in quotes or precede them with a backslash. Note that
|
|
70 ;; using braces won't work -- quotes change the syntax class of characters
|
|
71 ;; between them, while braces do not. If you don't use font-lock, the
|
|
72 ;; electric-# mode helps alleviate this problem somewhat.
|
6709
|
73 ;; * indent-tcl-exp is untested.
|
|
74
|
|
75 ;; TODO:
|
|
76 ;; * make add-log-tcl-defun smarter. should notice if we are in the
|
|
77 ;; middle of a defun, or between defuns. should notice if point is
|
|
78 ;; on first line of defun (or maybe even in comments before defun).
|
|
79 ;; * Allow continuation lines to be indented under the first argument
|
44227
|
80 ;; of the preceding line, like this:
|
6709
|
81 ;; [list something \
|
|
82 ;; something-else]
|
|
83 ;; * There is a request that indentation work like this:
|
|
84 ;; button .fred -label Fred \
|
|
85 ;; -command {puts fred}
|
|
86 ;; * Should have tcl-complete-symbol that queries the inferior process.
|
|
87 ;; * Should have describe-symbol that works by sending the magic
|
|
88 ;; command to a tclX process.
|
|
89 ;; * Need C-x C-e binding (tcl-eval-last-exp).
|
|
90 ;; * Write indent-region function that is faster than indenting each
|
|
91 ;; line individually.
|
|
92 ;; * tcl-figure-type should stop at "beginning of line" (only ws
|
|
93 ;; before point, and no "\" on previous line). (see tcl-real-command-p).
|
|
94 ;; * overrides some comint keybindings; fix.
|
|
95 ;; * Trailing \ will eat blank lines. Should deal with this.
|
|
96 ;; (this would help catch some potential bugs).
|
|
97 ;; * Inferior should display in half the screen, not the whole screen.
|
7052
|
98 ;; * Indentation should deal with "switch".
|
|
99 ;; * Consider writing code to find help files automatically (for
|
|
100 ;; common cases).
|
7628
|
101 ;; * `#' shouldn't insert `\#' when point is in string.
|
6709
|
102
|
|
103
|
|
104
|
|
105 ;;; Code:
|
|
106
|
35712
|
107 (eval-when-compile
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
108 (require 'imenu)
|
35712
|
109 (require 'outline)
|
|
110 (require 'dabbrev)
|
|
111 (require 'add-log))
|
|
112
|
6709
|
113 (require 'comint)
|
|
114
|
|
115 ;;
|
|
116 ;; User variables.
|
|
117 ;;
|
|
118
|
25176
|
119 (defgroup tcl nil
|
|
120 "Major mode for editing Tcl source in Emacs"
|
|
121 :group 'languages)
|
|
122
|
|
123 (defcustom tcl-indent-level 4
|
|
124 "*Indentation of Tcl statements with respect to containing block."
|
|
125 :group 'tcl
|
|
126 :type 'integer)
|
6709
|
127
|
25176
|
128 (defcustom tcl-continued-indent-level 4
|
|
129 "*Indentation of continuation line relative to first line of command."
|
|
130 :group 'tcl
|
|
131 :type 'integer)
|
6709
|
132
|
25176
|
133 (defcustom tcl-auto-newline nil
|
|
134 "*Non-nil means automatically newline before and after braces you insert."
|
|
135 :group 'tcl
|
|
136 :type 'boolean)
|
6709
|
137
|
25176
|
138 (defcustom tcl-tab-always-indent t
|
6709
|
139 "*Control effect of TAB key.
|
|
140 If t (the default), always indent current line.
|
|
141 If nil and point is not in the indentation area at the beginning of
|
|
142 the line, a TAB is inserted.
|
|
143 Other values cause the first possible action from the following list
|
|
144 to take place:
|
|
145
|
|
146 1. Move from beginning of line to correct indentation.
|
|
147 2. Delete an empty comment.
|
|
148 3. Move forward to start of comment, indenting if necessary.
|
|
149 4. Move forward to end of line, indenting if necessary.
|
|
150 5. Create an empty comment.
|
25176
|
151 6. Move backward to start of comment, indenting if necessary."
|
|
152 :group 'tcl
|
|
153 :type '(choice (const :tag "Always" t)
|
|
154 (const :tag "Beginning only" nil)
|
|
155 (const :tag "Maybe move or make or delete comment" 'tcl)))
|
|
156
|
6709
|
157
|
44320
|
158 (defcustom tcl-electric-hash-style nil ;; 'smart
|
6709
|
159 "*Style of electric hash insertion to use.
|
25163
|
160 Possible values are `backslash', meaning that `\\' quoting should be
|
|
161 done; `quote', meaning that `\"' quoting should be done; `smart',
|
|
162 meaning that the choice between `backslash' and `quote' should be
|
6709
|
163 made depending on the number of hashes inserted; or nil, meaning that
|
|
164 no quoting should be done. Any other value for this variable is
|
44320
|
165 taken to mean `smart'. The default is nil."
|
25176
|
166 :group 'tcl
|
|
167 :type '(choice (const backslash) (const quote) (const smart) (const nil)))
|
6709
|
168
|
25176
|
169 (defcustom tcl-help-directory-list nil
|
|
170 "*List of topmost directories containing TclX help files."
|
|
171 :group 'tcl
|
35712
|
172 :type '(repeat directory))
|
6709
|
173
|
25176
|
174 (defcustom tcl-use-smart-word-finder t
|
|
175 "*If not nil, use smart way to find current word, for Tcl help feature."
|
|
176 :group 'tcl
|
|
177 :type 'boolean)
|
6709
|
178
|
25176
|
179 (defcustom tcl-application "wish"
|
|
180 "*Name of Tcl program to run in inferior Tcl mode."
|
|
181 :group 'tcl
|
|
182 :type 'string)
|
6709
|
183
|
25176
|
184 (defcustom tcl-command-switches nil
|
|
185 "*List of switches to supply to the `tcl-application' program."
|
|
186 :group 'tcl
|
35712
|
187 :type '(repeat string))
|
25176
|
188
|
|
189 (defcustom tcl-prompt-regexp "^\\(% \\|\\)"
|
6709
|
190 "*If not nil, a regexp that will match the prompt in the inferior process.
|
|
191 If nil, the prompt is the name of the application with \">\" appended.
|
|
192
|
|
193 The default is \"^\\(% \\|\\)\", which will match the default primary
|
25176
|
194 and secondary prompts for tclsh and wish."
|
|
195 :group 'tcl
|
|
196 :type 'regexp)
|
6709
|
197
|
25176
|
198 (defcustom inferior-tcl-source-command "source %s\n"
|
6709
|
199 "*Format-string for building a Tcl command to load a file.
|
|
200 This format string should use `%s' to substitute a file name
|
|
201 and should result in a Tcl expression that will command the
|
|
202 inferior Tcl to load that file. The filename will be appropriately
|
25176
|
203 quoted for Tcl."
|
|
204 :group 'tcl
|
|
205 :type 'string)
|
6709
|
206
|
|
207 ;;
|
|
208 ;; Keymaps, abbrevs, syntax tables.
|
|
209 ;;
|
|
210
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
211 (defvar tcl-mode-map
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
212 (let ((map (make-sparse-keymap)))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
213 (define-key map "{" 'tcl-electric-char)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
214 (define-key map "}" 'tcl-electric-brace)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
215 (define-key map "[" 'tcl-electric-char)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
216 (define-key map "]" 'tcl-electric-char)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
217 (define-key map ";" 'tcl-electric-char)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
218 (define-key map "#" 'tcl-electric-hash) ;Remove? -stef
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
219 (define-key map "\e\C-q" 'tcl-indent-exp)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
220 (define-key map "\177" 'backward-delete-char-untabify)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
221 (define-key map "\t" 'tcl-indent-command)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
222 (define-key map "\M-\C-x" 'tcl-eval-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
223 (define-key map "\C-c\C-i" 'tcl-help-on-word)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
224 (define-key map "\C-c\C-v" 'tcl-eval-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
225 (define-key map "\C-c\C-f" 'tcl-load-file)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
226 (define-key map "\C-c\C-t" 'inferior-tcl)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
227 (define-key map "\C-c\C-x" 'tcl-eval-region)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
228 (define-key map "\C-c\C-s" 'switch-to-tcl)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
229 map)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
230 "Keymap used in `tcl-mode'.")
|
6709
|
231
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
232 (defvar tcl-mode-syntax-table
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
233 (let ((st (make-syntax-table)))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
234 (modify-syntax-entry ?% "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
235 (modify-syntax-entry ?@ "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
236 (modify-syntax-entry ?& "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
237 (modify-syntax-entry ?* "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
238 (modify-syntax-entry ?+ "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
239 (modify-syntax-entry ?- "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
240 (modify-syntax-entry ?. "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
241 (modify-syntax-entry ?: "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
242 (modify-syntax-entry ?! "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
243 (modify-syntax-entry ?$ "_" st) ; FIXME use "'"?
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
244 (modify-syntax-entry ?/ "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
245 (modify-syntax-entry ?~ "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
246 (modify-syntax-entry ?< "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
247 (modify-syntax-entry ?= "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
248 (modify-syntax-entry ?> "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
249 (modify-syntax-entry ?| "_" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
250 (modify-syntax-entry ?\( "()" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
251 (modify-syntax-entry ?\) ")(" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
252 (modify-syntax-entry ?\; "." st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
253 (modify-syntax-entry ?\n ">" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
254 ;; (modify-syntax-entry ?\f ">" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
255 (modify-syntax-entry ?# "<" st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
256 st)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
257 "Syntax table in use in `tcl-mode' buffers.")
|
6709
|
258
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
259 (defvar inferior-tcl-mode-map
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
260 ;; FIXME we override comint keybindings here.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
261 ;; Maybe someone has a better set?
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
262 (let ((map (make-sparse-keymap)))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
263 ;; Will inherit from `comint-mode-map' thanks to define-derived-mode.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
264 (define-key map "\t" 'comint-dynamic-complete)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
265 (define-key map "\M-?" 'comint-dynamic-list-filename-completions)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
266 (define-key map "\177" 'backward-delete-char-untabify)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
267 (define-key map "\M-\C-x" 'tcl-eval-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
268 (define-key map "\C-c\C-i" 'tcl-help-on-word)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
269 (define-key map "\C-c\C-v" 'tcl-eval-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
270 (define-key map "\C-c\C-f" 'tcl-load-file)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
271 (define-key map "\C-c\C-t" 'inferior-tcl)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
272 (define-key map "\C-c\C-x" 'tcl-eval-region)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
273 (define-key map "\C-c\C-s" 'switch-to-tcl)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
274 map)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
275 "Keymap used in `inferior-tcl-mode'.")
|
6709
|
276
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
277 (easy-menu-define tcl-mode-menu tcl-mode-map "Menu used in `tcl-mode'."
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
278 '("Tcl"
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
279 ["Beginning of function" beginning-of-defun t]
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
280 ["End of function" end-of-defun t]
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
281 ["Mark function" mark-defun t]
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
282 ["Indent region" indent-region (mark t)]
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
283 ["Comment region" comment-region (mark t)]
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
284 ["Uncomment region" uncomment-region (mark t)]
|
6709
|
285 "----"
|
|
286 ["Show Tcl process buffer" inferior-tcl t]
|
7687
|
287 ["Send function to Tcl process" tcl-eval-defun
|
7781
|
288 (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
|
7687
|
289 ["Send region to Tcl process" tcl-eval-region
|
7781
|
290 (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
|
7687
|
291 ["Send file to Tcl process" tcl-load-file
|
7781
|
292 (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
|
6709
|
293 ["Restart Tcl process with file" tcl-restart-with-file t]
|
|
294 "----"
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
295 ["Tcl help" tcl-help-on-word tcl-help-directory-list]))
|
6709
|
296
|
|
297 (defvar inferior-tcl-buffer nil
|
|
298 "*The current inferior-tcl process buffer.
|
|
299
|
|
300 MULTIPLE PROCESS SUPPORT
|
|
301 ===========================================================================
|
|
302 To run multiple Tcl processes, you start the first up with
|
|
303 \\[inferior-tcl]. It will be in a buffer named `*inferior-tcl*'.
|
|
304 Rename this buffer with \\[rename-buffer]. You may now start up a new
|
|
305 process with another \\[inferior-tcl]. It will be in a new buffer,
|
|
306 named `*inferior-tcl*'. You can switch between the different process
|
|
307 buffers with \\[switch-to-buffer].
|
|
308
|
|
309 Commands that send text from source buffers to Tcl processes -- like
|
|
310 `tcl-eval-defun' or `tcl-load-file' -- have to choose a process to
|
|
311 send to, when you have more than one Tcl process around. This is
|
|
312 determined by the global variable `inferior-tcl-buffer'. Suppose you
|
|
313 have three inferior Lisps running:
|
|
314 Buffer Process
|
|
315 foo inferior-tcl
|
|
316 bar inferior-tcl<2>
|
|
317 *inferior-tcl* inferior-tcl<3>
|
|
318 If you do a \\[tcl-eval-defun] command on some Lisp source code, what
|
|
319 process do you send it to?
|
|
320
|
|
321 - If you're in a process buffer (foo, bar, or *inferior-tcl*),
|
|
322 you send it to that process.
|
|
323 - If you're in some other buffer (e.g., a source file), you
|
|
324 send it to the process attached to buffer `inferior-tcl-buffer'.
|
|
325 This process selection is performed by function `inferior-tcl-proc'.
|
|
326
|
|
327 Whenever \\[inferior-tcl] fires up a new process, it resets
|
|
328 `inferior-tcl-buffer' to be the new process's buffer. If you only run
|
|
329 one process, this does the right thing. If you run multiple
|
|
330 processes, you can change `inferior-tcl-buffer' to another process
|
|
331 buffer with \\[set-variable].")
|
|
332
|
|
333 ;;
|
|
334 ;; Hooks and other customization.
|
|
335 ;;
|
|
336
|
|
337 (defvar tcl-mode-hook nil
|
|
338 "Hook run on entry to Tcl mode.
|
|
339
|
|
340 Several functions exist which are useful to run from your
|
|
341 `tcl-mode-hook' (see each function's documentation for more
|
|
342 information):
|
|
343
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
344 `tcl-guess-application'
|
6709
|
345 Guesses a default setting for `tcl-application' based on any
|
|
346 \"#!\" line at the top of the file.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
347 `tcl-hashify-buffer'
|
6709
|
348 Quotes all \"#\" characters that don't correspond to actual
|
|
349 Tcl comments. (Useful when editing code not originally created
|
|
350 with this mode).
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
351 `tcl-auto-fill-mode'
|
6709
|
352 Auto-filling of Tcl comments.
|
|
353
|
25163
|
354 Add functions to the hook with `add-hook':
|
6709
|
355
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
356 (add-hook 'tcl-mode-hook 'tcl-guess-application)")
|
6709
|
357
|
|
358
|
|
359 (defvar tcl-proc-list
|
24954
|
360 '("proc" "method" "itcl_class" "body" "configbody" "class")
|
6709
|
361 "List of commands whose first argument defines something.
|
25163
|
362 This exists because some people (eg, me) use `defvar' et al.
|
6709
|
363 Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords'
|
|
364 after changing this list.")
|
|
365
|
|
366 (defvar tcl-proc-regexp nil
|
|
367 "Regexp to use when matching proc headers.")
|
|
368
|
|
369 (defvar tcl-typeword-list
|
22662
|
370 '("global" "upvar" "inherit" "public" "protected" "private"
|
24957
|
371 "common" "itk_option" "variable")
|
7612
|
372 "List of Tcl keywords denoting \"type\". Used only for highlighting.
|
6709
|
373 Call `tcl-set-font-lock-keywords' after changing this list.")
|
|
374
|
|
375 ;; Generally I've picked control operators to be keywords.
|
|
376 (defvar tcl-keyword-list
|
|
377 '("if" "then" "else" "elseif" "for" "foreach" "break" "continue" "while"
|
|
378 "eval" "case" "in" "switch" "default" "exit" "error" "proc" "return"
|
12403
|
379 "uplevel" "constructor" "destructor" "itcl_class" "loop" "for_array_keys"
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
380 "for_recursive_glob" "for_file" "method" "body" "configbody" "class"
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
381 "chain")
|
6709
|
382 "List of Tcl keywords. Used only for highlighting.
|
|
383 Default list includes some TclX keywords.
|
|
384 Call `tcl-set-font-lock-keywords' after changing this list.")
|
|
385
|
|
386 (defvar tcl-font-lock-keywords nil
|
|
387 "Keywords to highlight for Tcl. See variable `font-lock-keywords'.
|
|
388 This variable is generally set from `tcl-proc-regexp',
|
|
389 `tcl-typeword-list', and `tcl-keyword-list' by the function
|
|
390 `tcl-set-font-lock-keywords'.")
|
|
391
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
392 (defvar tcl-font-lock-syntactic-keywords
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
393 ;; Mark the few `#' that are not comment-markers.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
394 '(("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
395 "Syntactic keywords for `tcl-mode'.")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
396
|
6709
|
397 ;; FIXME need some way to recognize variables because array refs look
|
|
398 ;; like 2 sexps.
|
|
399 (defvar tcl-type-alist
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
400 '(("proc" nil tcl-expr tcl-commands)
|
12404
|
401 ("method" nil tcl-expr tcl-commands)
|
12405
|
402 ("destructor" tcl-commands)
|
|
403 ("constructor" tcl-commands)
|
6709
|
404 ("expr" tcl-expr)
|
|
405 ("catch" tcl-commands)
|
|
406 ("if" tcl-expr "then" tcl-commands)
|
|
407 ("elseif" tcl-expr "then" tcl-commands)
|
|
408 ("elseif" tcl-expr tcl-commands)
|
|
409 ("if" tcl-expr tcl-commands)
|
|
410 ("while" tcl-expr tcl-commands)
|
|
411 ("for" tcl-commands tcl-expr tcl-commands tcl-commands)
|
|
412 ("foreach" nil nil tcl-commands)
|
|
413 ("for_file" nil nil tcl-commands)
|
|
414 ("for_array_keys" nil nil tcl-commands)
|
|
415 ("for_recursive_glob" nil nil nil tcl-commands)
|
|
416 ;; Loop handling is not perfect, because the third argument can be
|
|
417 ;; either a command or an expr, and there is no real way to look
|
|
418 ;; forward.
|
|
419 ("loop" nil tcl-expr tcl-expr tcl-commands)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
420 ("loop" nil tcl-expr tcl-commands))
|
6709
|
421 "Alist that controls indentation.
|
|
422 \(Actually, this really only controls what happens on continuation lines).
|
|
423 Each entry looks like `(KEYWORD TYPE ...)'.
|
|
424 Each type entry describes a sexp after the keyword, and can be one of:
|
|
425 * nil, meaning that this sexp has no particular type.
|
|
426 * tcl-expr, meaning that this sexp is an arithmetic expression.
|
|
427 * tcl-commands, meaning that this sexp holds Tcl commands.
|
|
428 * a string, which must exactly match the string at the corresponding
|
|
429 position for a match to be made.
|
|
430
|
|
431 For example, the entry for the \"loop\" command is:
|
|
432
|
|
433 (\"loop\" nil tcl-expr tcl-commands)
|
|
434
|
|
435 This means that the \"loop\" command has three arguments. The first
|
|
436 argument is ignored (for indentation purposes). The second argument
|
|
437 is a Tcl expression, and the last argument is Tcl commands.")
|
|
438
|
|
439 (defvar tcl-explain-indentation nil
|
|
440 "If not `nil', debugging message will be printed during indentation.")
|
|
441
|
|
442
|
|
443
|
|
444 ;; Its pretty bogus to have to do this, but there is no easier way to
|
|
445 ;; say "match not syntax-1 and not syntax-2". Too bad you can't put
|
|
446 ;; \s in [...]. This sickness is used in Emacs 19 to match a defun
|
|
447 ;; starter. (It is used for this in v18 as well).
|
|
448 ;;(defconst tcl-omit-ws-regexp
|
|
449 ;; (concat "^\\(\\s"
|
|
450 ;; (mapconcat 'char-to-string "w_.()\"\\$'/" "\\|\\s")
|
|
451 ;; "\\)\\S(*")
|
|
452 ;; "Regular expression that matches everything except space, comment
|
|
453 ;;starter, and comment ender syntax codes.")
|
|
454
|
|
455 ;; FIXME? Instead of using the hairy regexp above, we just use a
|
|
456 ;; simple one.
|
|
457 ;;(defconst tcl-omit-ws-regexp "^[^] \t\n#}]\\S(*"
|
|
458 ;; "Regular expression used in locating function definitions.")
|
|
459
|
|
460 ;; Here's another stab. I think this one actually works. Now the
|
|
461 ;; problem seems to be that there is a bug in Emacs 19.22 where
|
|
462 ;; end-of-defun doesn't really use the brace matching the one that
|
|
463 ;; trails defun-prompt-regexp.
|
25176
|
464 ;; ?? Is there a bug now ??
|
6709
|
465 (defconst tcl-omit-ws-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+")
|
|
466
|
|
467
|
|
468
|
|
469 ;;
|
|
470 ;; Some helper functions.
|
|
471 ;;
|
|
472
|
|
473 (defun tcl-set-proc-regexp ()
|
|
474 "Set `tcl-proc-regexp' from variable `tcl-proc-list'."
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
475 (setq tcl-proc-regexp
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
476 (concat "^\\s-*" (regexp-opt tcl-proc-list t) "[ \t]+")))
|
6709
|
477
|
|
478 (defun tcl-set-font-lock-keywords ()
|
|
479 "Set `tcl-font-lock-keywords'.
|
|
480 Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
|
|
481 (setq tcl-font-lock-keywords
|
|
482 (list
|
|
483 ;; Names of functions (and other "defining things").
|
|
484 (list (concat tcl-proc-regexp "\\([^ \t\n]+\\)")
|
|
485 2 'font-lock-function-name-face)
|
|
486
|
|
487 ;; Names of type-defining things.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
488 (list (concat "\\(\\s-\\|^\\)"
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
489 (regexp-opt tcl-typeword-list t)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
490 "\\(\\s-\\|$\\)")
|
6709
|
491 2 'font-lock-type-face)
|
|
492
|
|
493 ;; Keywords. Only recognized if surrounded by whitespace.
|
|
494 ;; FIXME consider using "not word or symbol", not
|
|
495 ;; "whitespace".
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
496 (cons (concat "\\(\\s-\\|^\\)"
|
6709
|
497 ;; FIXME Use regexp-quote?
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
498 (regexp-opt tcl-keyword-list t)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
499 "\\(\\s-\\|$\\)")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
500 2))))
|
6709
|
501
|
|
502 (if tcl-proc-regexp
|
|
503 ()
|
|
504 (tcl-set-proc-regexp))
|
|
505
|
|
506 (if tcl-font-lock-keywords
|
|
507 ()
|
|
508 (tcl-set-font-lock-keywords))
|
|
509
|
44316
|
510
|
|
511 (defvar tcl-imenu-generic-expression
|
44320
|
512 `((nil ,(concat tcl-proc-regexp "\\([-A-Za-z0-9_:+*]+\\)") 2))
|
44316
|
513 "Imenu generic expression for `tcl-mode'. See `imenu-generic-expression'.")
|
|
514
|
6709
|
515
|
|
516
|
|
517 ;;
|
|
518 ;; The mode itself.
|
|
519 ;;
|
|
520
|
8252
|
521 ;;;###autoload
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
522 (define-derived-mode tcl-mode nil "Tcl"
|
6709
|
523 "Major mode for editing Tcl code.
|
|
524 Expression and list commands understand all Tcl brackets.
|
|
525 Tab indents for Tcl code.
|
|
526 Paragraphs are separated by blank lines only.
|
|
527 Delete converts tabs to spaces as it moves back.
|
|
528
|
|
529 Variables controlling indentation style:
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
530 `tcl-indent-level'
|
6709
|
531 Indentation of Tcl statements within surrounding block.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
532 `tcl-continued-indent-level'
|
6709
|
533 Indentation of continuation line relative to first line of command.
|
|
534
|
|
535 Variables controlling user interaction with mode (see variable
|
|
536 documentation for details):
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
537 `tcl-tab-always-indent'
|
6709
|
538 Controls action of TAB key.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
539 `tcl-auto-newline'
|
6709
|
540 Non-nil means automatically newline before and after braces, brackets,
|
|
541 and semicolons inserted in Tcl code.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
542 `tcl-use-smart-word-finder'
|
12644
|
543 If not nil, use a smarter, Tcl-specific way to find the current
|
|
544 word when looking up help on a Tcl command.
|
6709
|
545
|
|
546 Turning on Tcl mode calls the value of the variable `tcl-mode-hook'
|
|
547 with no args, if that value is non-nil. Read the documentation for
|
|
548 `tcl-mode-hook' to see what kinds of interesting hook functions
|
|
549 already exist.
|
|
550
|
|
551 Commands:
|
|
552 \\{tcl-mode-map}"
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
553 (set (make-local-variable 'paragraph-start) "$\\|")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
554 (set (make-local-variable 'paragraph-separate) paragraph-start)
|
7612
|
555
|
44316
|
556 (unless (and (boundp 'filladapt-mode) filladapt-mode)
|
|
557 (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
|
|
558 (set (make-local-variable 'fill-paragraph-function)
|
|
559 'tcl-do-fill-paragraph))
|
7612
|
560
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
561 (set (make-local-variable 'indent-line-function) 'tcl-indent-line)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
562 (set (make-local-variable 'comment-indent-function) 'tcl-comment-indent)
|
6709
|
563 ;; Tcl doesn't require a final newline.
|
|
564 ;; (make-local-variable 'require-final-newline)
|
|
565 ;; (setq require-final-newline t)
|
7612
|
566
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
567 (set (make-local-variable 'comment-start) "# ")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
568 (set (make-local-variable 'comment-start-skip) "#+ *")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
569 (set (make-local-variable 'comment-column) 40) ;why? -stef
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
570 (set (make-local-variable 'comment-end) "")
|
11303
|
571
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
572 (set (make-local-variable 'outline-regexp) "[^\n\^M]")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
573 (set (make-local-variable 'outline-level) 'tcl-outline-level)
|
7612
|
574
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
575 (set (make-local-variable 'font-lock-defaults)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
576 '(tcl-font-lock-keywords nil nil nil beginning-of-defun
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
577 (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
578 (parse-sexp-lookup-properties . t)))
|
12517
|
579
|
44316
|
580 (set (make-local-variable 'imenu-generic-expression)
|
|
581 'tcl-imenu-generic-expression)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
582
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
583 ;; Settings for new dabbrev code.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
584 (set (make-local-variable 'dabbrev-case-fold-search) nil)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
585 (set (make-local-variable 'dabbrev-case-replace) nil)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
586 (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "[$!]")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
587 (set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|\\s_")
|
7612
|
588
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
589 ;; This can only be set to t in Emacs 19 and XEmacs.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
590 ;; Emacs 18 and Epoch lose.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
591 (set (make-local-variable 'parse-sexp-ignore-comments) t)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
592 ;; XEmacs has defun-prompt-regexp, but I don't believe
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
593 ;; that it works for end-of-defun -- only for
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
594 ;; beginning-of-defun.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
595 (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
596 ;; The following doesn't work in Lucid Emacs 19.6, but maybe
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
597 ;; it will appear in later versions.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
598 (set (make-local-variable 'add-log-current-defun-function)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
599 'tcl-add-log-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
600
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
601 (easy-menu-add tcl-mode-menu)
|
11787
|
602 ;; Append Tcl menu to popup menu for XEmacs.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
603 (if (boundp 'mode-popup-menu)
|
12520
|
604 (setq mode-popup-menu
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
605 (cons (concat mode-name " Mode Commands") tcl-mode-menu))))
|
6709
|
606
|
|
607
|
|
608
|
|
609 ;; This is used for braces, brackets, and semi (except for closing
|
|
610 ;; braces, which are handled specially).
|
|
611 (defun tcl-electric-char (arg)
|
|
612 "Insert character and correct line's indentation."
|
|
613 (interactive "p")
|
|
614 ;; Indent line first; this looks better if parens blink.
|
|
615 (tcl-indent-line)
|
|
616 (self-insert-command arg)
|
|
617 (if (and tcl-auto-newline (= last-command-char ?\;))
|
|
618 (progn
|
|
619 (newline)
|
|
620 (tcl-indent-line))))
|
|
621
|
|
622 ;; This is used for closing braces. If tcl-auto-newline is set, can
|
|
623 ;; insert a newline both before and after the brace, depending on
|
|
624 ;; context. FIXME should this be configurable? Does anyone use this?
|
|
625 (defun tcl-electric-brace (arg)
|
|
626 "Insert character and correct line's indentation."
|
|
627 (interactive "p")
|
|
628 ;; If auto-newlining and there is stuff on the same line, insert a
|
|
629 ;; newline first.
|
|
630 (if tcl-auto-newline
|
|
631 (progn
|
|
632 (if (save-excursion
|
|
633 (skip-chars-backward " \t")
|
|
634 (bolp))
|
|
635 ()
|
|
636 (tcl-indent-line)
|
|
637 (newline))
|
|
638 ;; In auto-newline case, must insert a newline after each
|
|
639 ;; brace. So an explicit loop is needed.
|
|
640 (while (> arg 0)
|
|
641 (insert last-command-char)
|
|
642 (tcl-indent-line)
|
|
643 (newline)
|
|
644 (setq arg (1- arg))))
|
|
645 (self-insert-command arg))
|
|
646 (tcl-indent-line))
|
|
647
|
|
648
|
|
649
|
|
650 (defun tcl-indent-command (&optional arg)
|
|
651 "Indent current line as Tcl code, or in some cases insert a tab character.
|
25163
|
652 If `tcl-tab-always-indent' is t (the default), always indent current line.
|
|
653 If `tcl-tab-always-indent' is nil and point is not in the indentation
|
6709
|
654 area at the beginning of the line, a TAB is inserted.
|
25163
|
655 Other values of `tcl-tab-always-indent' cause the first possible action
|
6709
|
656 from the following list to take place:
|
|
657
|
|
658 1. Move from beginning of line to correct indentation.
|
|
659 2. Delete an empty comment.
|
|
660 3. Move forward to start of comment, indenting if necessary.
|
|
661 4. Move forward to end of line, indenting if necessary.
|
|
662 5. Create an empty comment.
|
|
663 6. Move backward to start of comment, indenting if necessary."
|
|
664 (interactive "p")
|
|
665 (cond
|
|
666 ((not tcl-tab-always-indent)
|
7052
|
667 ;; Indent if in indentation area, otherwise insert TAB.
|
6709
|
668 (if (<= (current-column) (current-indentation))
|
|
669 (tcl-indent-line)
|
16170
|
670 (insert-tab arg)))
|
6709
|
671 ((eq tcl-tab-always-indent t)
|
|
672 ;; Always indent.
|
|
673 (tcl-indent-line))
|
|
674 (t
|
|
675 ;; "Perl-mode" style TAB command.
|
|
676 (let* ((ipoint (point))
|
|
677 (eolpoint (progn
|
|
678 (end-of-line)
|
|
679 (point)))
|
|
680 (comment-p (tcl-in-comment)))
|
|
681 (cond
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
682 ((= ipoint (line-beginning-position))
|
6709
|
683 (beginning-of-line)
|
|
684 (tcl-indent-line)
|
|
685 ;; If indenting didn't leave us in column 0, go to the
|
|
686 ;; indentation. Otherwise leave point at end of line. This
|
|
687 ;; is a hack.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
688 (if (= (point) (line-beginning-position))
|
6709
|
689 (end-of-line)
|
|
690 (back-to-indentation)))
|
|
691 ((and comment-p (looking-at "[ \t]*$"))
|
|
692 ;; Empty comment, so delete it. We also delete any ";"
|
|
693 ;; characters at the end of the line. I think this is
|
|
694 ;; friendlier, but I don't know how other people will feel.
|
|
695 (backward-char)
|
|
696 (skip-chars-backward " \t;")
|
|
697 (delete-region (point) eolpoint))
|
|
698 ((and comment-p (< ipoint (point)))
|
|
699 ;; Before comment, so skip to it.
|
|
700 (tcl-indent-line)
|
|
701 (indent-for-comment))
|
|
702 ((/= ipoint eolpoint)
|
|
703 ;; Go to end of line (since we're not there yet).
|
|
704 (goto-char eolpoint)
|
|
705 (tcl-indent-line))
|
|
706 ((not comment-p)
|
|
707 (tcl-indent-line)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
708 (comment-indent))
|
6709
|
709 (t
|
|
710 ;; Go to start of comment. We don't leave point where it is
|
|
711 ;; because we want to skip comment-start-skip.
|
|
712 (tcl-indent-line)
|
|
713 (indent-for-comment)))))))
|
|
714
|
|
715 (defun tcl-indent-line ()
|
|
716 "Indent current line as Tcl code.
|
|
717 Return the amount the indentation changed by."
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
718 (let ((indent (tcl-calculate-indent nil))
|
6709
|
719 beg shift-amt
|
|
720 (case-fold-search nil)
|
|
721 (pos (- (point-max) (point))))
|
|
722 (beginning-of-line)
|
|
723 (setq beg (point))
|
|
724 (cond ((eq indent nil)
|
|
725 (setq indent (current-indentation)))
|
|
726 (t
|
|
727 (skip-chars-forward " \t")
|
|
728 (if (listp indent) (setq indent (car indent)))
|
|
729 (cond ((= (following-char) ?})
|
|
730 (setq indent (- indent tcl-indent-level)))
|
|
731 ((= (following-char) ?\])
|
|
732 (setq indent (- indent 1))))))
|
|
733 (skip-chars-forward " \t")
|
|
734 (setq shift-amt (- indent (current-column)))
|
|
735 (if (zerop shift-amt)
|
|
736 (if (> (- (point-max) pos) (point))
|
|
737 (goto-char (- (point-max) pos)))
|
|
738 (delete-region beg (point))
|
|
739 (indent-to indent)
|
|
740 ;; If initial point was within line's indentation,
|
|
741 ;; position after the indentation. Else stay at same point in text.
|
|
742 (if (> (- (point-max) pos) (point))
|
|
743 (goto-char (- (point-max) pos))))
|
|
744 shift-amt))
|
|
745
|
|
746 (defun tcl-figure-type ()
|
|
747 "Determine type of sexp at point.
|
25163
|
748 This is either `tcl-expr', `tcl-commands', or nil. Puts point at start
|
6709
|
749 of sexp that indicates types.
|
|
750
|
|
751 See documentation for variable `tcl-type-alist' for more information."
|
|
752 (let ((count 0)
|
|
753 result
|
|
754 word-stack)
|
|
755 (while (and (< count 5)
|
|
756 (not result))
|
|
757 (condition-case nil
|
|
758 (progn
|
|
759 ;; FIXME should use "tcl-backward-sexp", which would skip
|
|
760 ;; over entire variables, etc.
|
|
761 (backward-sexp)
|
|
762 (if (looking-at "[a-zA-Z_]+")
|
|
763 (let ((list tcl-type-alist)
|
|
764 entry)
|
12645
|
765 (setq word-stack (cons (tcl-word-no-props) word-stack))
|
6709
|
766 (while (and list (not result))
|
|
767 (setq entry (car list))
|
|
768 (setq list (cdr list))
|
|
769 (let ((index 0))
|
|
770 (while (and entry (<= index count))
|
|
771 ;; Abort loop if string does not match word on
|
|
772 ;; stack.
|
|
773 (and (stringp (car entry))
|
|
774 (not (string= (car entry)
|
|
775 (nth index word-stack)))
|
|
776 (setq entry nil))
|
|
777 (setq entry (cdr entry))
|
|
778 (setq index (1+ index)))
|
|
779 (and (> index count)
|
|
780 (not (stringp (car entry)))
|
|
781 (setq result (car entry)))
|
|
782 )))
|
|
783 (setq word-stack (cons nil word-stack))))
|
|
784 (error nil))
|
|
785 (setq count (1+ count)))
|
|
786 (and tcl-explain-indentation
|
|
787 (message "Indentation type %s" result))
|
|
788 result))
|
|
789
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
790 (defun tcl-calculate-indent (&optional parse-start)
|
6709
|
791 "Return appropriate indentation for current line as Tcl code.
|
|
792 In usual case returns an integer: the column to indent to.
|
|
793 Returns nil if line starts inside a string, t if in a comment."
|
|
794 (save-excursion
|
|
795 (beginning-of-line)
|
|
796 (let* ((indent-point (point))
|
|
797 (case-fold-search nil)
|
|
798 (continued-line
|
|
799 (save-excursion
|
|
800 (if (bobp)
|
|
801 nil
|
|
802 (backward-char)
|
|
803 (= ?\\ (preceding-char)))))
|
|
804 (continued-indent-value (if continued-line
|
|
805 tcl-continued-indent-level
|
|
806 0))
|
|
807 state
|
|
808 containing-sexp
|
|
809 found-next-line)
|
|
810 (if parse-start
|
|
811 (goto-char parse-start)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
812 (beginning-of-defun))
|
6709
|
813 (while (< (point) indent-point)
|
|
814 (setq parse-start (point))
|
|
815 (setq state (parse-partial-sexp (point) indent-point 0))
|
|
816 (setq containing-sexp (car (cdr state))))
|
|
817 (cond ((or (nth 3 state) (nth 4 state))
|
|
818 ;; Inside comment or string. Return nil or t if should
|
|
819 ;; not change this line
|
|
820 (nth 4 state))
|
|
821 ((null containing-sexp)
|
|
822 ;; Line is at top level.
|
|
823 continued-indent-value)
|
|
824 (t
|
|
825 ;; Set expr-p if we are looking at the expression part of
|
|
826 ;; an "if", "expr", etc statement. Set commands-p if we
|
|
827 ;; are looking at the body part of an if, while, etc
|
|
828 ;; statement. FIXME Should check for "for" loops here.
|
|
829 (goto-char containing-sexp)
|
|
830 (let* ((sexpr-type (tcl-figure-type))
|
|
831 (expr-p (eq sexpr-type 'tcl-expr))
|
|
832 (commands-p (eq sexpr-type 'tcl-commands))
|
|
833 (expr-start (point)))
|
|
834 ;; Find the first statement in the block and indent
|
|
835 ;; like it. The first statement in the block might be
|
|
836 ;; on the same line, so what we do is skip all
|
|
837 ;; "virtually blank" lines, looking for a non-blank
|
|
838 ;; one. A line is virtually blank if it only contains
|
|
839 ;; a comment and whitespace. FIXME continued comments
|
|
840 ;; aren't supported. They are a wart on Tcl anyway.
|
|
841 ;; We do it this funky way because we want to know if
|
|
842 ;; we've found a statement on some line _after_ the
|
|
843 ;; line holding the sexp opener.
|
|
844 (goto-char containing-sexp)
|
|
845 (forward-char)
|
|
846 (if (and (< (point) indent-point)
|
|
847 (looking-at "[ \t]*\\(#.*\\)?$"))
|
|
848 (progn
|
|
849 (forward-line)
|
|
850 (while (and (< (point) indent-point)
|
|
851 (looking-at "[ \t]*\\(#.*\\)?$"))
|
|
852 (setq found-next-line t)
|
|
853 (forward-line))))
|
|
854 (if (or continued-line
|
|
855 (/= (char-after containing-sexp) ?{)
|
|
856 expr-p)
|
|
857 (progn
|
|
858 ;; Line is continuation line, or the sexp opener
|
|
859 ;; is not a curly brace, or we are are looking at
|
|
860 ;; an `expr' expression (which must be split
|
|
861 ;; specially). So indentation is column of first
|
|
862 ;; good spot after sexp opener (with some added
|
|
863 ;; in the continued-line case). If there is no
|
|
864 ;; nonempty line before the indentation point, we
|
|
865 ;; use the column of the character after the sexp
|
|
866 ;; opener.
|
|
867 (if (>= (point) indent-point)
|
|
868 (progn
|
|
869 (goto-char containing-sexp)
|
|
870 (forward-char))
|
|
871 (skip-chars-forward " \t"))
|
|
872 (+ (current-column) continued-indent-value))
|
|
873 ;; After a curly brace, and not a continuation line.
|
|
874 ;; So take indentation from first good line after
|
|
875 ;; start of block, unless that line is on the same
|
|
876 ;; line as the opening brace. In this case use the
|
|
877 ;; indentation of the opening brace's line, plus
|
|
878 ;; another indent step. If we are in the body part
|
|
879 ;; of an "if" or "while" then the indentation is
|
|
880 ;; taken from the line holding the start of the
|
|
881 ;; statement.
|
|
882 (if (and (< (point) indent-point)
|
|
883 found-next-line)
|
|
884 (current-indentation)
|
|
885 (if commands-p
|
|
886 (goto-char expr-start)
|
|
887 (goto-char containing-sexp))
|
|
888 (+ (current-indentation) tcl-indent-level)))))))))
|
|
889
|
|
890
|
|
891
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
892 (defun tcl-indent-exp ()
|
6709
|
893 "Indent each line of the Tcl grouping following point."
|
|
894 (interactive)
|
|
895 (let ((indent-stack (list nil))
|
|
896 (contain-stack (list (point)))
|
|
897 (case-fold-search nil)
|
|
898 outer-loop-done inner-loop-done state ostate
|
|
899 this-indent last-sexp continued-line
|
|
900 (next-depth 0)
|
|
901 last-depth)
|
|
902 (save-excursion
|
|
903 (forward-sexp 1))
|
|
904 (save-excursion
|
|
905 (setq outer-loop-done nil)
|
|
906 (while (and (not (eobp)) (not outer-loop-done))
|
|
907 (setq last-depth next-depth)
|
|
908 ;; Compute how depth changes over this line
|
|
909 ;; plus enough other lines to get to one that
|
|
910 ;; does not end inside a comment or string.
|
|
911 ;; Meanwhile, do appropriate indentation on comment lines.
|
|
912 (setq inner-loop-done nil)
|
|
913 (while (and (not inner-loop-done)
|
|
914 (not (and (eobp) (setq outer-loop-done t))))
|
|
915 (setq ostate state)
|
|
916 (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
|
|
917 nil nil state))
|
|
918 (setq next-depth (car state))
|
|
919 (if (and (car (cdr (cdr state)))
|
|
920 (>= (car (cdr (cdr state))) 0))
|
|
921 (setq last-sexp (car (cdr (cdr state)))))
|
|
922 (if (or (nth 4 ostate))
|
|
923 (tcl-indent-line))
|
|
924 (if (or (nth 3 state))
|
|
925 (forward-line 1)
|
|
926 (setq inner-loop-done t)))
|
|
927 (if (<= next-depth 0)
|
|
928 (setq outer-loop-done t))
|
|
929 (if outer-loop-done
|
|
930 nil
|
|
931 ;; If this line had ..))) (((.. in it, pop out of the levels
|
|
932 ;; that ended anywhere in this line, even if the final depth
|
|
933 ;; doesn't indicate that they ended.
|
|
934 (while (> last-depth (nth 6 state))
|
|
935 (setq indent-stack (cdr indent-stack)
|
|
936 contain-stack (cdr contain-stack)
|
|
937 last-depth (1- last-depth)))
|
|
938 (if (/= last-depth next-depth)
|
|
939 (setq last-sexp nil))
|
|
940 ;; Add levels for any parens that were started in this line.
|
|
941 (while (< last-depth next-depth)
|
|
942 (setq indent-stack (cons nil indent-stack)
|
|
943 contain-stack (cons nil contain-stack)
|
|
944 last-depth (1+ last-depth)))
|
|
945 (if (null (car contain-stack))
|
|
946 (setcar contain-stack
|
|
947 (or (car (cdr state))
|
|
948 (save-excursion
|
|
949 (forward-sexp -1)
|
|
950 (point)))))
|
|
951 (forward-line 1)
|
|
952 (setq continued-line
|
|
953 (save-excursion
|
|
954 (backward-char)
|
|
955 (= (preceding-char) ?\\)))
|
|
956 (skip-chars-forward " \t")
|
|
957 (if (eolp)
|
|
958 nil
|
|
959 (if (and (car indent-stack)
|
|
960 (>= (car indent-stack) 0))
|
|
961 ;; Line is on an existing nesting level.
|
|
962 (setq this-indent (car indent-stack))
|
|
963 ;; Just started a new nesting level.
|
|
964 ;; Compute the standard indent for this level.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
965 (let ((val (tcl-calculate-indent
|
6709
|
966 (if (car indent-stack)
|
|
967 (- (car indent-stack))))))
|
|
968 (setcar indent-stack
|
|
969 (setq this-indent val))
|
|
970 (setq continued-line nil)))
|
|
971 (cond ((not (numberp this-indent)))
|
|
972 ((= (following-char) ?})
|
|
973 (setq this-indent (- this-indent tcl-indent-level)))
|
|
974 ((= (following-char) ?\])
|
|
975 (setq this-indent (- this-indent 1))))
|
|
976 ;; Put chosen indentation into effect.
|
|
977 (or (null this-indent)
|
|
978 (= (current-column)
|
|
979 (if continued-line
|
|
980 (+ this-indent tcl-indent-level)
|
|
981 this-indent))
|
|
982 (progn
|
|
983 (delete-region (point) (progn (beginning-of-line) (point)))
|
|
984 (indent-to
|
|
985 (if continued-line
|
|
986 (+ this-indent tcl-indent-level)
|
|
987 this-indent)))))))))
|
|
988 )
|
|
989
|
|
990
|
|
991
|
|
992 ;;
|
|
993 ;; Interfaces to other packages.
|
|
994 ;;
|
|
995
|
|
996 ;; FIXME Definition of function is very ad-hoc. Should use
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
997 ;; beginning-of-defun. Also has incestuous knowledge about the
|
6709
|
998 ;; format of tcl-proc-regexp.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
999 (defun tcl-add-log-defun ()
|
6709
|
1000 "Return name of Tcl function point is in, or nil."
|
|
1001 (save-excursion
|
13698
a5b05f960c30
(add-log-tcl-defun): Don't use tcl-beginning-of-defun; just go to end
Tom Tromey <tromey@redhat.com>
diff
changeset
|
1002 (end-of-line)
|
a5b05f960c30
(add-log-tcl-defun): Don't use tcl-beginning-of-defun; just go to end
Tom Tromey <tromey@redhat.com>
diff
changeset
|
1003 (if (re-search-backward (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1004 (match-string 2))))
|
6709
|
1005
|
11303
|
1006 (defun tcl-outline-level ()
|
|
1007 (save-excursion
|
|
1008 (skip-chars-forward " \t")
|
|
1009 (current-column)))
|
|
1010
|
6709
|
1011
|
|
1012
|
|
1013 ;;
|
|
1014 ;; Helper functions for inferior Tcl mode.
|
|
1015 ;;
|
|
1016
|
|
1017 ;; This exists to let us delete the prompt when commands are sent
|
|
1018 ;; directly to the inferior Tcl. See gud.el for an explanation of how
|
|
1019 ;; it all works (I took it from there). This stuff doesn't really
|
|
1020 ;; work as well as I'd like it to. But I don't believe there is
|
|
1021 ;; anything useful that can be done.
|
|
1022 (defvar inferior-tcl-delete-prompt-marker nil)
|
|
1023
|
|
1024 (defun tcl-filter (proc string)
|
|
1025 (let ((inhibit-quit t))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1026 (with-current-buffer (process-buffer proc)
|
6709
|
1027 (goto-char (process-mark proc))
|
|
1028 ;; Delete prompt if requested.
|
|
1029 (if (marker-buffer inferior-tcl-delete-prompt-marker)
|
|
1030 (progn
|
|
1031 (delete-region (point) inferior-tcl-delete-prompt-marker)
|
|
1032 (set-marker inferior-tcl-delete-prompt-marker nil)))))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1033 (comint-output-filter proc string))
|
6709
|
1034
|
|
1035 (defun tcl-send-string (proc string)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1036 (with-current-buffer (process-buffer proc)
|
6709
|
1037 (goto-char (process-mark proc))
|
|
1038 (beginning-of-line)
|
|
1039 (if (looking-at comint-prompt-regexp)
|
|
1040 (set-marker inferior-tcl-delete-prompt-marker (point))))
|
|
1041 (comint-send-string proc string))
|
|
1042
|
|
1043 (defun tcl-send-region (proc start end)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1044 (with-current-buffer (process-buffer proc)
|
6709
|
1045 (goto-char (process-mark proc))
|
|
1046 (beginning-of-line)
|
|
1047 (if (looking-at comint-prompt-regexp)
|
|
1048 (set-marker inferior-tcl-delete-prompt-marker (point))))
|
|
1049 (comint-send-region proc start end))
|
|
1050
|
|
1051 (defun switch-to-tcl (eob-p)
|
|
1052 "Switch to inferior Tcl process buffer.
|
|
1053 With argument, positions cursor at end of buffer."
|
|
1054 (interactive "P")
|
|
1055 (if (get-buffer inferior-tcl-buffer)
|
|
1056 (pop-to-buffer inferior-tcl-buffer)
|
|
1057 (error "No current inferior Tcl buffer"))
|
|
1058 (cond (eob-p
|
|
1059 (push-mark)
|
|
1060 (goto-char (point-max)))))
|
|
1061
|
|
1062 (defun inferior-tcl-proc ()
|
|
1063 "Return current inferior Tcl process.
|
|
1064 See variable `inferior-tcl-buffer'."
|
|
1065 (let ((proc (get-buffer-process (if (eq major-mode 'inferior-tcl-mode)
|
|
1066 (current-buffer)
|
|
1067 inferior-tcl-buffer))))
|
|
1068 (or proc
|
|
1069 (error "No Tcl process; see variable `inferior-tcl-buffer'"))))
|
|
1070
|
|
1071 (defun tcl-eval-region (start end &optional and-go)
|
|
1072 "Send the current region to the inferior Tcl process.
|
|
1073 Prefix argument means switch to the Tcl buffer afterwards."
|
|
1074 (interactive "r\nP")
|
|
1075 (let ((proc (inferior-tcl-proc)))
|
|
1076 (tcl-send-region proc start end)
|
|
1077 (tcl-send-string proc "\n")
|
|
1078 (if and-go (switch-to-tcl t))))
|
|
1079
|
|
1080 (defun tcl-eval-defun (&optional and-go)
|
|
1081 "Send the current defun to the inferior Tcl process.
|
|
1082 Prefix argument means switch to the Tcl buffer afterwards."
|
|
1083 (interactive "P")
|
|
1084 (save-excursion
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1085 (end-of-defun)
|
6709
|
1086 (let ((end (point)))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1087 (beginning-of-defun)
|
6709
|
1088 (tcl-eval-region (point) end)))
|
|
1089 (if and-go (switch-to-tcl t)))
|
|
1090
|
|
1091
|
|
1092
|
|
1093 ;;
|
|
1094 ;; Inferior Tcl mode itself.
|
|
1095 ;;
|
|
1096
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1097 (define-derived-mode inferior-tcl-mode comint-mode "Inferior Tcl"
|
6709
|
1098 "Major mode for interacting with Tcl interpreter.
|
|
1099
|
44316
|
1100 You can start a Tcl process with \\[inferior-tcl].
|
6709
|
1101
|
25163
|
1102 Entry to this mode runs the normal hooks `comint-mode-hook' and
|
|
1103 `inferior-tcl-mode-hook', in that order.
|
6709
|
1104
|
|
1105 You can send text to the inferior Tcl process from other buffers
|
|
1106 containing Tcl source.
|
|
1107
|
|
1108 Variables controlling Inferior Tcl mode:
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1109 `tcl-application'
|
6709
|
1110 Name of program to run.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1111 `tcl-command-switches'
|
6709
|
1112 Command line arguments to `tcl-application'.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1113 `tcl-prompt-regexp'
|
6709
|
1114 Matches prompt.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1115 `inferior-tcl-source-command'
|
6709
|
1116 Command to use to read Tcl file in running application.
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1117 `inferior-tcl-buffer'
|
6709
|
1118 The current inferior Tcl process buffer. See variable
|
|
1119 documentation for details on multiple-process support.
|
|
1120
|
|
1121 The following commands are available:
|
|
1122 \\{inferior-tcl-mode-map}"
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1123 (set (make-local-variable 'comint-prompt-regexp)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1124 (or tcl-prompt-regexp
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1125 (concat "^" (regexp-quote tcl-application) ">")))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1126 (setq mode-line-process '(": %s"))
|
6709
|
1127 (setq local-abbrev-table tcl-mode-abbrev-table)
|
|
1128 (set-syntax-table tcl-mode-syntax-table)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1129 (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1130 (set (make-local-variable 'inferior-tcl-delete-prompt-marker) (make-marker))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1131 (set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter))
|
6709
|
1132
|
8252
|
1133 ;;;###autoload
|
6709
|
1134 (defun inferior-tcl (cmd)
|
|
1135 "Run inferior Tcl process.
|
|
1136 Prefix arg means enter program name interactively.
|
|
1137 See documentation for function `inferior-tcl-mode' for more information."
|
|
1138 (interactive
|
|
1139 (list (if current-prefix-arg
|
|
1140 (read-string "Run Tcl: " tcl-application)
|
|
1141 tcl-application)))
|
|
1142 (if (not (comint-check-proc "*inferior-tcl*"))
|
|
1143 (progn
|
|
1144 (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil
|
|
1145 tcl-command-switches))
|
|
1146 (inferior-tcl-mode)))
|
|
1147 (make-local-variable 'tcl-application)
|
|
1148 (setq tcl-application cmd)
|
|
1149 (setq inferior-tcl-buffer "*inferior-tcl*")
|
|
1150 (switch-to-buffer "*inferior-tcl*"))
|
|
1151
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1152 (defalias 'run-tcl 'inferior-tcl)
|
6709
|
1153
|
|
1154
|
|
1155
|
|
1156 ;;
|
|
1157 ;; Auto-fill support.
|
|
1158 ;;
|
|
1159
|
|
1160 (defun tcl-real-command-p ()
|
|
1161 "Return nil if point is not at the beginning of a command.
|
|
1162 A command is the first word on an otherwise empty line, or the
|
|
1163 first word following a semicolon, opening brace, or opening bracket."
|
|
1164 (save-excursion
|
|
1165 (skip-chars-backward " \t")
|
|
1166 (cond
|
|
1167 ((bobp) t)
|
|
1168 ((bolp)
|
|
1169 (backward-char)
|
|
1170 ;; Note -- continued comments are not supported here. I
|
|
1171 ;; consider those to be a wart on the language.
|
|
1172 (not (eq ?\\ (preceding-char))))
|
|
1173 (t
|
|
1174 (memq (preceding-char) '(?\; ?{ ?\[))))))
|
|
1175
|
|
1176 ;; FIXME doesn't actually return t. See last case.
|
|
1177 (defun tcl-real-comment-p ()
|
|
1178 "Return t if point is just after the `#' beginning a real comment.
|
|
1179 Does not check to see if previous char is actually `#'.
|
|
1180 A real comment is either at the beginning of the buffer,
|
44227
|
1181 preceded only by whitespace on the line, or has a preceding
|
6709
|
1182 semicolon, opening brace, or opening bracket on the same line."
|
|
1183 (save-excursion
|
|
1184 (backward-char)
|
|
1185 (tcl-real-command-p)))
|
|
1186
|
|
1187 (defun tcl-hairy-scan-for-comment (state end always-stop)
|
|
1188 "Determine if point is in a comment.
|
|
1189 Returns a list of the form `(FLAG . STATE)'. STATE can be used
|
|
1190 as input to future invocations. FLAG is nil if not in comment,
|
|
1191 t otherwise. If in comment, leaves point at beginning of comment.
|
25163
|
1192
|
|
1193 This function does not work in Emacs 18.
|
|
1194 See also `tcl-simple-scan-for-comment', a
|
6709
|
1195 simpler version that is often right, and works in Emacs 18."
|
|
1196 (let ((bol (save-excursion
|
|
1197 (goto-char end)
|
|
1198 (beginning-of-line)
|
|
1199 (point)))
|
|
1200 real-comment
|
|
1201 last-cstart)
|
|
1202 (while (and (not last-cstart) (< (point) end))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1203 (setq real-comment nil) ;In case we've looped around and it is set.
|
6709
|
1204 (setq state (parse-partial-sexp (point) end nil nil state t))
|
|
1205 (if (nth 4 state)
|
|
1206 (progn
|
|
1207 ;; If ALWAYS-STOP is set, stop even if we don't have a
|
|
1208 ;; real comment, or if the comment isn't on the same line
|
|
1209 ;; as the end.
|
|
1210 (if always-stop (setq last-cstart (point)))
|
|
1211 ;; If we have a real comment, then set the comment
|
|
1212 ;; starting point if we are on the same line as the ending
|
|
1213 ;; location.
|
|
1214 (setq real-comment (tcl-real-comment-p))
|
|
1215 (if real-comment
|
|
1216 (progn
|
|
1217 (and (> (point) bol) (setq last-cstart (point)))
|
|
1218 ;; NOTE Emacs 19 has a misfeature whereby calling
|
|
1219 ;; parse-partial-sexp with COMMENTSTOP set and with
|
|
1220 ;; an initial list that says point is in a comment
|
|
1221 ;; will cause an immediate return. So we must skip
|
|
1222 ;; over the comment ourselves.
|
|
1223 (beginning-of-line 2)))
|
|
1224 ;; Frob the state to make it look like we aren't in a
|
|
1225 ;; comment.
|
|
1226 (setcar (nthcdr 4 state) nil))))
|
|
1227 (and last-cstart
|
|
1228 (goto-char last-cstart))
|
|
1229 (cons real-comment state)))
|
|
1230
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1231 (defun tcl-in-comment ()
|
25163
|
1232 "Return t if point is in a comment, and leave point at beginning of comment."
|
6709
|
1233 (let ((save (point)))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1234 (beginning-of-defun)
|
6709
|
1235 (car (tcl-hairy-scan-for-comment nil save nil))))
|
7628
|
1236
|
12515
|
1237 (defun tcl-do-fill-paragraph (ignore)
|
|
1238 "fill-paragraph function for Tcl mode. Only fills in a comment."
|
|
1239 (let (in-comment col where)
|
|
1240 (save-excursion
|
|
1241 (end-of-line)
|
|
1242 (setq in-comment (tcl-in-comment))
|
|
1243 (if in-comment
|
|
1244 (progn
|
|
1245 (setq where (1+ (point)))
|
|
1246 (setq col (1- (current-column))))))
|
|
1247 (and in-comment
|
|
1248 (save-excursion
|
|
1249 (back-to-indentation)
|
|
1250 (= col (current-column)))
|
|
1251 ;; In a comment. Set the fill prefix, and find the paragraph
|
|
1252 ;; boundaries by searching for lines that look like
|
|
1253 ;; comment-only lines.
|
|
1254 (let ((fill-prefix (buffer-substring (progn
|
|
1255 (beginning-of-line)
|
|
1256 (point))
|
|
1257 where))
|
|
1258 p-start p-end)
|
|
1259 ;; Search backwards.
|
|
1260 (save-excursion
|
43437
|
1261 (while (and (looking-at "^[ \t]*#[ \t]*[^ \t\n]")
|
|
1262 (not (bobp)))
|
12515
|
1263 (forward-line -1))
|
|
1264 (setq p-start (point)))
|
|
1265
|
|
1266 ;; Search forwards.
|
|
1267 (save-excursion
|
43437
|
1268 (while (looking-at "^[ \t]*#[ \t]*[^ \t\n]")
|
12515
|
1269 (forward-line))
|
|
1270 (setq p-end (point)))
|
|
1271
|
|
1272 ;; Narrow and do the fill.
|
|
1273 (save-restriction
|
|
1274 (narrow-to-region p-start p-end)
|
|
1275 (fill-paragraph ignore)))))
|
|
1276 t)
|
|
1277
|
6709
|
1278
|
|
1279
|
|
1280 ;;
|
|
1281 ;; Help-related code.
|
|
1282 ;;
|
|
1283
|
7052
|
1284 (defvar tcl-help-saved-dirs nil
|
|
1285 "Saved help directories.
|
|
1286 If `tcl-help-directory-list' changes, this allows `tcl-help-on-word'
|
|
1287 to update the alist.")
|
6709
|
1288
|
|
1289 (defvar tcl-help-alist nil
|
|
1290 "Alist with command names as keys and filenames as values.")
|
|
1291
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1292 (defun tcl-files-alist (dir &optional alist)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1293 "Recursively add all pairs (FILE . PATH) under DIR to ALIST."
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1294 (dolist (file (directory-files dir t) alist)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1295 (cond
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1296 ((not (file-directory-p file))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1297 (push (cons (file-name-nondirectory file) file) alist))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1298 ((member (file-name-nondirectory file) '("." "..")))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1299 (t (setq alist (tcl-files-alist file alist))))))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1300
|
7052
|
1301 (defun tcl-help-snarf-commands (dirlist)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1302 "Return alist of commands and filenames."
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1303 (let ((alist nil))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1304 (dolist (dir dirlist alist)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1305 (when (file-directory-p dir)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1306 (setq alist (tcl-files-alist dir alist))))))
|
6709
|
1307
|
|
1308 (defun tcl-reread-help-files ()
|
|
1309 "Set up to re-read files, and then do it."
|
|
1310 (interactive)
|
|
1311 (message "Building Tcl help file index...")
|
7052
|
1312 (setq tcl-help-saved-dirs tcl-help-directory-list)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1313 (setq tcl-help-alist (tcl-help-snarf-commands tcl-help-directory-list))
|
6709
|
1314 (message "Building Tcl help file index...done"))
|
|
1315
|
12645
|
1316 (defun tcl-word-no-props ()
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1317 "Like `current-word', but strips properties."
|
12645
|
1318 (let ((word (current-word)))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1319 (set-text-properties 0 (length word) nil word)
|
12645
|
1320 word))
|
|
1321
|
6709
|
1322 (defun tcl-current-word (flag)
|
|
1323 "Return current command word, or nil.
|
|
1324 If FLAG is nil, just uses `current-word'.
|
|
1325 Otherwise scans backward for most likely Tcl command word."
|
7799
|
1326 (if (and flag
|
|
1327 (memq major-mode '(tcl-mode inferior-tcl-mode)))
|
6709
|
1328 (condition-case nil
|
|
1329 (save-excursion
|
|
1330 ;; Look backward for first word actually in alist.
|
|
1331 (if (bobp)
|
|
1332 ()
|
|
1333 (while (and (not (bobp))
|
|
1334 (not (tcl-real-command-p)))
|
|
1335 (backward-sexp)))
|
12645
|
1336 (if (assoc (tcl-word-no-props) tcl-help-alist)
|
|
1337 (tcl-word-no-props)))
|
6709
|
1338 (error nil))
|
12645
|
1339 (tcl-word-no-props)))
|
6709
|
1340
|
8252
|
1341 ;;;###autoload
|
6709
|
1342 (defun tcl-help-on-word (command &optional arg)
|
|
1343 "Get help on Tcl command. Default is word at point.
|
|
1344 Prefix argument means invert sense of `tcl-use-smart-word-finder'."
|
|
1345 (interactive
|
|
1346 (list
|
|
1347 (progn
|
7052
|
1348 (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
|
6709
|
1349 (tcl-reread-help-files))
|
|
1350 (let ((word (tcl-current-word
|
|
1351 (if current-prefix-arg
|
|
1352 (not tcl-use-smart-word-finder)
|
|
1353 tcl-use-smart-word-finder))))
|
|
1354 (completing-read
|
|
1355 (if (or (null word) (string= word ""))
|
|
1356 "Help on Tcl command: "
|
|
1357 (format "Help on Tcl command (default %s): " word))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1358 tcl-help-alist nil t nil nil word)))
|
6709
|
1359 current-prefix-arg))
|
7052
|
1360 (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
|
6709
|
1361 (tcl-reread-help-files))
|
|
1362 (if (string= command "")
|
|
1363 (setq command (tcl-current-word
|
|
1364 (if arg
|
|
1365 (not tcl-use-smart-word-finder)
|
|
1366 tcl-use-smart-word-finder))))
|
|
1367 (let* ((help (get-buffer-create "*Tcl help*"))
|
|
1368 (cell (assoc command tcl-help-alist))
|
|
1369 (file (and cell (cdr cell))))
|
|
1370 (set-buffer help)
|
|
1371 (delete-region (point-min) (point-max))
|
|
1372 (if file
|
|
1373 (progn
|
|
1374 (insert "*** " command "\n\n")
|
|
1375 (insert-file-contents file))
|
|
1376 (if (string= command "")
|
|
1377 (insert "Magical Pig!")
|
|
1378 (insert "Tcl command " command " not in help\n")))
|
|
1379 (set-buffer-modified-p nil)
|
|
1380 (goto-char (point-min))
|
|
1381 (display-buffer help)))
|
|
1382
|
|
1383
|
|
1384
|
|
1385 ;;
|
|
1386 ;; Other interactive stuff.
|
|
1387 ;;
|
|
1388
|
|
1389 (defvar tcl-previous-dir/file nil
|
|
1390 "Record last directory and file used in loading.
|
|
1391 This holds a cons cell of the form `(DIRECTORY . FILE)'
|
|
1392 describing the last `tcl-load-file' command.")
|
|
1393
|
|
1394 (defun tcl-load-file (file &optional and-go)
|
|
1395 "Load a Tcl file into the inferior Tcl process.
|
|
1396 Prefix argument means switch to the Tcl buffer afterwards."
|
|
1397 (interactive
|
|
1398 (list
|
|
1399 ;; car because comint-get-source returns a list holding the
|
|
1400 ;; filename.
|
8581
|
1401 (car (comint-get-source "Load Tcl file: "
|
|
1402 (or (and
|
|
1403 (eq major-mode 'tcl-mode)
|
|
1404 (buffer-file-name))
|
|
1405 tcl-previous-dir/file)
|
6709
|
1406 '(tcl-mode) t))
|
|
1407 current-prefix-arg))
|
|
1408 (comint-check-source file)
|
|
1409 (setq tcl-previous-dir/file (cons (file-name-directory file)
|
|
1410 (file-name-nondirectory file)))
|
|
1411 (tcl-send-string (inferior-tcl-proc)
|
|
1412 (format inferior-tcl-source-command (tcl-quote file)))
|
|
1413 (if and-go (switch-to-tcl t)))
|
|
1414
|
|
1415 (defun tcl-restart-with-file (file &optional and-go)
|
|
1416 "Restart inferior Tcl with file.
|
|
1417 If an inferior Tcl process exists, it is killed first.
|
|
1418 Prefix argument means switch to the Tcl buffer afterwards."
|
|
1419 (interactive
|
|
1420 (list
|
|
1421 (car (comint-get-source "Restart with Tcl file: "
|
|
1422 (or (and
|
|
1423 (eq major-mode 'tcl-mode)
|
|
1424 (buffer-file-name))
|
|
1425 tcl-previous-dir/file)
|
|
1426 '(tcl-mode) t))
|
|
1427 current-prefix-arg))
|
|
1428 (let* ((buf (if (eq major-mode 'inferior-tcl-mode)
|
|
1429 (current-buffer)
|
|
1430 inferior-tcl-buffer))
|
|
1431 (proc (and buf (get-process buf))))
|
|
1432 (cond
|
|
1433 ((not (and buf (get-buffer buf)))
|
|
1434 ;; I think this will be ok.
|
|
1435 (inferior-tcl tcl-application)
|
|
1436 (tcl-load-file file and-go))
|
|
1437 ((or
|
|
1438 (not (comint-check-proc buf))
|
|
1439 (yes-or-no-p
|
|
1440 "A Tcl process is running, are you sure you want to reset it? "))
|
|
1441 (save-excursion
|
|
1442 (comint-check-source file)
|
|
1443 (setq tcl-previous-dir/file (cons (file-name-directory file)
|
|
1444 (file-name-nondirectory file)))
|
|
1445 (comint-exec (get-buffer-create buf)
|
|
1446 (if proc
|
|
1447 (process-name proc)
|
|
1448 "inferior-tcl")
|
|
1449 tcl-application file tcl-command-switches)
|
|
1450 (if and-go (switch-to-tcl t)))))))
|
|
1451
|
|
1452 (defun tcl-auto-fill-mode (&optional arg)
|
44320
|
1453 "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'."
|
6709
|
1454 (interactive "P")
|
44320
|
1455 (auto-fill-mode arg)
|
|
1456 (if auto-fill-function
|
|
1457 (set (make-local-variable 'comment-auto-fill-only-comments) t)
|
|
1458 (kill-local-variable 'comment-auto-fill-only-comments)))
|
6709
|
1459
|
|
1460 (defun tcl-electric-hash (&optional count)
|
|
1461 "Insert a `#' and quote if it does not start a real comment.
|
|
1462 Prefix arg is number of `#'s to insert.
|
|
1463 See variable `tcl-electric-hash-style' for description of quoting
|
|
1464 styles."
|
|
1465 (interactive "p")
|
|
1466 (or count (setq count 1))
|
|
1467 (if (> count 0)
|
|
1468 (let ((type
|
|
1469 (if (eq tcl-electric-hash-style 'smart)
|
|
1470 (if (> count 3) ; FIXME what is "smart"?
|
|
1471 'quote
|
|
1472 'backslash)
|
|
1473 tcl-electric-hash-style))
|
|
1474 comment)
|
|
1475 (if type
|
|
1476 (progn
|
|
1477 (save-excursion
|
|
1478 (insert "#")
|
|
1479 (setq comment (tcl-in-comment)))
|
|
1480 (delete-char 1)
|
|
1481 (and tcl-explain-indentation (message "comment: %s" comment))
|
|
1482 (cond
|
|
1483 ((eq type 'quote)
|
|
1484 (if (not comment)
|
|
1485 (insert "\"")))
|
|
1486 ((eq type 'backslash)
|
|
1487 ;; The following will set count to 0, so the
|
|
1488 ;; insert-char can still be run.
|
|
1489 (if (not comment)
|
|
1490 (while (> count 0)
|
|
1491 (insert "\\#")
|
|
1492 (setq count (1- count)))))
|
|
1493 (t nil))))
|
|
1494 (insert-char ?# count))))
|
|
1495
|
|
1496 (defun tcl-hashify-buffer ()
|
|
1497 "Quote all `#'s in current buffer that aren't Tcl comments."
|
|
1498 (interactive)
|
|
1499 (save-excursion
|
|
1500 (goto-char (point-min))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1501 (let (state
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1502 result)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1503 (while (< (point) (point-max))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1504 (setq result (tcl-hairy-scan-for-comment state (point-max) t))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1505 (if (car result)
|
6709
|
1506 (beginning-of-line 2)
|
|
1507 (backward-char)
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1508 (if (eq ?# (following-char))
|
6709
|
1509 (insert "\\"))
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1510 (forward-char))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1511 (setq state (cdr result))))))
|
6709
|
1512
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1513 (defun tcl-comment-indent ()
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1514 "Return the desired indentation, but be careful to add a `;' if needed."
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1515 (save-excursion
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1516 ;; If line is not blank, make sure we insert a ";" first.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1517 (skip-chars-backward " \t")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1518 (unless (or (bolp) (tcl-real-command-p))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1519 (insert ";")
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1520 ;; Try and erase a non-significant char to keep charpos identical.
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1521 (if (memq (char-after) '(?\t ?\ )) (delete-char 1))))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1522 (funcall (default-value 'comment-indent-function)))
|
7052
|
1523
|
6709
|
1524 ;; The following was inspired by the Tcl editing mode written by
|
|
1525 ;; Gregor Schmid <schmid@fb3-s7.math.TU-Berlin.DE>. His version also
|
|
1526 ;; attempts to snarf the command line options from the command line,
|
|
1527 ;; but I didn't think that would really be that helpful (doesn't seem
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1528 ;; like it would be right enough. His version also looks for the
|
6709
|
1529 ;; "#!/bin/csh ... exec" hack, but that seemed even less useful.
|
7052
|
1530 ;; FIXME should make sure that the application mentioned actually
|
|
1531 ;; exists.
|
6709
|
1532 (defun tcl-guess-application ()
|
|
1533 "Attempt to guess Tcl application by looking at first line.
|
|
1534 The first line is assumed to look like \"#!.../program ...\"."
|
|
1535 (save-excursion
|
|
1536 (goto-char (point-min))
|
8580
|
1537 (if (looking-at "#![^ \t]*/\\([^ \t\n/]+\\)\\([ \t]\\|$\\)")
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1538 (set (make-local-variable 'tcl-application) (match-string 1)))))
|
6709
|
1539
|
|
1540
|
|
1541
|
|
1542 ;;
|
11787
|
1543 ;; XEmacs menu support.
|
6709
|
1544 ;; Taken from schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid),
|
|
1545 ;; who wrote a different Tcl mode.
|
25163
|
1546 ;; We also have support for menus in Emacs. We do this by
|
11787
|
1547 ;; loading the XEmacs menu emulation code.
|
6709
|
1548 ;;
|
|
1549
|
|
1550 (defun tcl-popup-menu (e)
|
7612
|
1551 (interactive "@e")
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1552 (popup-menu tcl-mode-menu))
|
6709
|
1553
|
|
1554
|
|
1555
|
|
1556 ;;
|
|
1557 ;; Quoting and unquoting functions.
|
|
1558 ;;
|
|
1559
|
|
1560 ;; This quoting is sufficient to protect eg a filename from any sort
|
|
1561 ;; of expansion or splitting. Tcl quoting sure sucks.
|
|
1562 (defun tcl-quote (string)
|
|
1563 "Quote STRING according to Tcl rules."
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1564 (mapconcat (lambda (char)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1565 (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ? ?\;))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1566 (concat "\\" (char-to-string char))
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1567 (char-to-string char)))
|
6709
|
1568 string ""))
|
|
1569
|
7628
|
1570 ;;
|
|
1571 ;; Bug reporting.
|
|
1572 ;;
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1573
|
7628
|
1574
|
39754
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1575 ;; These are relics kept "just in case".
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1576 (defalias 'tcl-uncomment-region 'uncomment-region)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1577 (defalias 'tcl-indent-for-comment 'comment-indent)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1578 (defalias 'add-log-tcl-defun 'tcl-add-log-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1579 (defalias 'indent-tcl-exp 'tcl-indent-exp)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1580 (defalias 'calculate-tcl-indent 'tcl-calculate-indent)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1581 (defalias 'tcl-beginning-of-defun 'beginning-of-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1582 (defalias 'tcl-end-of-defun 'end-of-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1583 (defalias 'tcl-mark-defun 'mark-defun)
|
6a46751c85df
Change maintainer to FSF and remove loads of compatibility cruft.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1584 (defun tcl-mark () (mark t))
|
7628
|
1585
|
6709
|
1586 (provide 'tcl)
|
|
1587
|
|
1588 ;;; tcl.el ends here
|