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