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