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