X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/524587f216a9d1a09f19fc8f72741e195f3a9493..577bf5d26e8835144005a0505e2ecc611369f92f:/lisp/progmodes/tcl.el diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 98aa190a22..6965dea9fc 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1,18 +1,17 @@ -;; tcl.el --- Tcl code editing commands for Emacs +;;; tcl.el --- Tcl code editing commands for Emacs -;; Copyright (C) 1994 Free Software Foundation, Inc. +;; Copyright (C) 1994,98,1999,2000,01,02,2003,2004 Free Software Foundation, Inc. -;; Maintainer: Tom Tromey -;; Author: Tom Tromey +;; Maintainer: FSF +;; Author: Tom Tromey ;; Chris Lindblad ;; Keywords: languages tcl modes -;; Version: $Revision: 1.14 $ ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) +;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -21,16 +20,11 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -;; HOW TO INSTALL: -;; Put the following forms in your .emacs to enable autoloading of Tcl -;; mode, and auto-recognition of ".tcl" files. -;; -;; (autoload 'tcl-mode "tcl" "Tcl mode." t) -;; (autoload 'inferior-tcl "tcl" "Run inferior Tcl process." t) -;; (setq auto-mode-alist (append '(("\\.tcl$" . tcl-mode)) auto-mode-alist)) +;; BEFORE USE: ;; ;; If you plan to use the interface to the TclX help files, you must ;; set the variable tcl-help-directory-list to point to the topmost @@ -38,21 +32,8 @@ ;; ;; (setq tcl-help-directory-list '("/usr/local/lib/tclx/help")) ;; -;; Also you will want to add the following to your .emacs: -;; -;; (autoload 'tcl-help-on-word "tcl" "Help on Tcl commands" t) -;; -;; FYI a *very* useful thing to do is nroff all the Tk man pages and -;; put them in a subdir of the help system. -;; - ;;; Commentary: -;; LCD Archive Entry: -;; tcl|Tom Tromey|tromey@busco.lanl.gov| -;; Major mode for editing Tcl| -;; $Date: 1994/05/22 20:18:28 $|$Revision: 1.14 $|~/modes/tcl.el.Z| - ;; CUSTOMIZATION NOTES: ;; * tcl-proc-list can be used to customize a list of things that ;; "define" other things. Eg in my project I put "defvar" in this @@ -63,102 +44,7 @@ ;; * tcl-type-alist can be used to minimally customize indentation ;; according to context. -;; Change log: -;; $Log: tcl.el,v $ -; Revision 1.14 1994/05/22 20:18:28 tromey -; Even more compile stuff. -; -; Revision 1.13 1994/05/22 20:17:15 tromey -; Moved emacs version checking code to very beginning. -; -; Revision 1.12 1994/05/22 20:14:59 tromey -; Compile fixes. -; -; Revision 1.11 1994/05/22 20:12:44 tromey -; Fixed mark-defun for 19.23. -; More menu fixes. -; -; Revision 1.10 1994/05/22 20:02:03 tromey -; Fixed bug with M-;. -; Wrote bug-reporting code. -; -; Revision 1.9 1994/05/22 05:26:51 tromey -; Fixes for imenu. -; -; Revision 1.8 1994/05/22 03:38:07 tromey -; Fixed menu support. -; -; Revision 1.7 1994/05/03 01:23:42 tromey -; *** empty log message *** -; -; Revision 1.6 1994/04/23 16:23:36 tromey -; Wrote tcl-indent-for-comment -; -;; -;; 18-Mar-1994 Tom Tromey Fourth beta release. -;; Added {un,}comment-region to menu. Idea from -;; Mike Scheidler -;; 17-Mar-1994 Tom Tromey -;; Fixed tcl-restart-with-file. Bug fix attempt in -;; tcl-internal-end-of-defun. -;; 16-Mar-1994 Tom Tromey Third beta release -;; Added support code for menu (from Tcl mode written by -;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)). -;; 12-Mar-1994 Tom Tromey -;; Better documentation for inferior-tcl-buffer. Wrote -;; tcl-restart-with-file. Wrote Lucid Emacs menu (but no -;; code to install it). -;; 12-Mar-1994 Tom Tromey -;; Wrote tcl-guess-application. Another stab at making -;; tcl-omit-ws-regexp work. -;; 10-Mar-1994 Tom Tromey Second beta release -;; Last Modified: Thu Mar 10 01:24:25 1994 (Tom Tromey) -;; Wrote perl-mode style line indentation command. -;; Wrote more documentation. Added tcl-continued-indent-level. -;; Integrated help code. -;; 8-Mar-1994 Tom Tromey -;; Last Modified: Tue Mar 8 11:58:44 1994 (Tom Tromey) -;; Bug fixes. -;; 6-Mar-1994 Tom Tromey -;; Last Modified: Sun Mar 6 18:55:41 1994 (Tom Tromey) -;; Updated auto-newline support. -;; 6-Mar-1994 Tom Tromey Beta release -;; Last Modified: Sat Mar 5 17:24:32 1994 (Tom Tromey) -;; Wrote tcl-hashify-buffer. Other minor bug fixes. -;; 5-Mar-1994 Tom Tromey -;; Last Modified: Sat Mar 5 16:11:20 1994 (Tom Tromey) -;; Wrote electric-hash code. -;; 3-Mar-1994 Tom Tromey -;; Last Modified: Thu Mar 3 02:53:40 1994 (Tom Tromey) -;; Added code to handle auto-fill in comments. -;; Added imenu support code. -;; Cleaned up code. -;; Better font-lock support. -;; 28-Feb-1994 Tom Tromey -;; Last Modified: Mon Feb 28 14:08:05 1994 (Tom Tromey) -;; Made tcl-figure-type more easily configurable. -;; 28-Feb-1994 Tom Tromey -;; Last Modified: Mon Feb 28 01:02:58 1994 (Tom Tromey) -;; Wrote inferior-tcl mode. -;; 16-Feb-1994 Tom Tromey -;; Last Modified: Wed Feb 16 17:05:19 1994 (Tom Tromey) -;; Added support for font-lock-mode. -;; 29-Oct-1993 Tom Tromey -;; Last Modified: Sun Oct 24 17:39:14 1993 (Tom Tromey) -;; Patches from Guido Bosch to make things work with Lucid Emacs. -;; 22-Oct-1993 Tom Tromey -;; Last Modified: Fri Oct 22 15:26:46 1993 (Tom Tromey) -;; Made many characters have "_" syntax class; suggested by Guido -;; Bosch . Note that this includes the "$" -;; character, which might be a change you'd notice. -;; 21-Oct-1993 Tom Tromey -;; Last Modified: Thu Oct 21 20:28:40 1993 (Tom Tromey) -;; More fixes for tcl-omit-ws-regexp. -;; 20-Oct-1993 Tom Tromey -;; Started keeping history. Fixed tcl-{beginning,end}-of-defun. -;; Added some code to make things work with Emacs 18. - -;; THANKS TO: +;; THANKS FOR CRITICISM AND SUGGESTIONS TO: ;; Guido Bosch ;; pgs1002@esc.cam.ac.uk (Dr P.G. Sjoerdsma) ;; Mike Scheidler @@ -167,28 +53,30 @@ ;; h9118101@hkuxa.hku.hk (Yip Chi Lap [Beta]) ;; Pertti Tapio Kasanen ;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid) +;; warsaw@nlm.nih.gov (Barry A. Warsaw) +;; Carl Witty +;; T. V. Raman +;; Jesper Pedersen +;; dfarmer@evolving.com (Doug Farmer) +;; "Chris Alfeld" +;; Ben Wing ;; KNOWN BUGS: -;; * indent-region should skip blank lines. (It does in v19, so I'm -;; not motivated to fix it here). -;; * In Tcl "#" is not always a comment character. This can confuse -;; tcl.el in certain circumstances. For now the only workaround is -;; to enclose offending hash characters in quotes or precede it with -;; a backslash. Note that using braces won't work -- quotes change -;; the syntax class of characters between them, while braces do not. -;; The electric-# mode helps alleviate this problem somewhat. +;; * In Tcl "#" is not always a comment character. This can confuse tcl.el +;; in certain circumstances. For now the only workaround is to use +;; font-lock which will mark the # chars accordingly or enclose offending +;; hash characters in quotes or precede them with a backslash. Note that +;; using braces won't work -- quotes change the syntax class of characters +;; between them, while braces do not. If you don't use font-lock, the +;; electric-# mode helps alleviate this problem somewhat. ;; * indent-tcl-exp is untested. -;; * Doesn't work under Emacs 18 yet. -;; * There's been a report that font-lock does strange things under -;; Lucid Emacs 19.6. For instance in "proc foobar", the space -;; before "foobar" is highlighted. ;; TODO: ;; * make add-log-tcl-defun smarter. should notice if we are in the ;; middle of a defun, or between defuns. should notice if point is ;; on first line of defun (or maybe even in comments before defun). ;; * Allow continuation lines to be indented under the first argument -;; of the preceeding line, like this: +;; of the preceding line, like this: ;; [list something \ ;; something-else] ;; * There is a request that indentation work like this: @@ -215,48 +103,35 @@ ;;; Code: -;; I sure wish Emacs had a package that made it easy to extract this -;; sort of information. -(defconst tcl-using-emacs-19 (string-match "19\\." emacs-version) - "Nil unless using Emacs 19 (Lucid or FSF).") - -;; FIXME this will break on Emacs 19.100. -(defconst tcl-using-emacs-19.23 - (string-match "19\\.\\(2[3-9]\\|[3-9][0-9]\\)" emacs-version) - "Nil unless using Emacs 19.23 or later.") - -(defconst tcl-using-lemacs-19 (string-match "Lucid" emacs-version) - "Nil unless using Lucid Emacs).") +(eval-when-compile + (require 'imenu) + (require 'outline) + (require 'dabbrev) + (require 'add-log)) (require 'comint) -;; When compiling under GNU Emacs, load imenu during compilation. If -;; you have 19.22 or earlier, comment this out, or get imenu. -(and (fboundp 'eval-when-compile) - (eval-when-compile - (if (and (string-match "19\\." emacs-version) - (not (string-match "Lucid" emacs-version))) - (require 'imenu)) - ())) - -(defconst tcl-version "$Revision: 1.14 $") -(defconst tcl-maintainer "Tom Tromey ") - ;; ;; User variables. ;; -(defvar tcl-indent-level 4 - "*Indentation of Tcl statements with respect to containing block.") +(defgroup tcl nil + "Major mode for editing Tcl source in Emacs" + :group 'languages) -(defvar tcl-continued-indent-level 4 - "*Indentation of continuation line relative to first line of command.") +(defcustom tcl-indent-level 4 + "*Indentation of Tcl statements with respect to containing block." + :type 'integer) -(defvar tcl-auto-newline nil - "*Non-nil means automatically newline before and after braces -inserted in Tcl code.") +(defcustom tcl-continued-indent-level 4 + "*Indentation of continuation line relative to first line of command." + :type 'integer) -(defvar tcl-tab-always-indent t +(defcustom tcl-auto-newline nil + "*Non-nil means automatically newline before and after braces you insert." + :type 'boolean) + +(defcustom tcl-tab-always-indent tab-always-indent "*Control effect of TAB key. If t (the default), always indent current line. If nil and point is not in the indentation area at the beginning of @@ -269,187 +144,143 @@ to take place: 3. Move forward to start of comment, indenting if necessary. 4. Move forward to end of line, indenting if necessary. 5. Create an empty comment. - 6. Move backward to start of comment, indenting if necessary.") + 6. Move backward to start of comment, indenting if necessary." + :type '(choice (const :tag "Always" t) + (const :tag "Beginning only" nil) + (const :tag "Maybe move or make or delete comment" 'tcl))) -(defvar tcl-use-hairy-comment-detector t - "*If not `nil', the the more complicated, but slower, comment -detecting function is used. This variable is only used in GNU Emacs -19 (the fast function is always used elsewhere).") -(defvar tcl-electric-hash-style 'smart +(defcustom tcl-electric-hash-style nil ;; 'smart "*Style of electric hash insertion to use. -Possible values are 'backslash, meaning that `\\' quoting should be -done; `quote, meaning that `\"' quoting should be done; 'smart, -meaning that the choice between 'backslash and 'quote should be +Possible values are `backslash', meaning that `\\' quoting should be +done; `quote', meaning that `\"' quoting should be done; `smart', +meaning that the choice between `backslash' and `quote' should be made depending on the number of hashes inserted; or nil, meaning that no quoting should be done. Any other value for this variable is -taken to mean 'smart. The default is 'smart.") +taken to mean `smart'. The default is nil." + :type '(choice (const backslash) (const quote) (const smart) (const nil))) -(defvar tcl-help-directory-list nil - "*List of topmost directories containing TclX help files") +(defcustom tcl-help-directory-list nil + "*List of topmost directories containing TclX help files." + :type '(repeat directory)) -(defvar tcl-use-smart-word-finder t - "*If not nil, use a better way of finding the current word when -looking up help on a Tcl command.") +(defcustom tcl-use-smart-word-finder t + "*If not nil, use smart way to find current word, for Tcl help feature." + :type 'boolean) -(defvar tcl-application "wish" - "*Name of Tcl application to run in inferior Tcl mode.") +(defcustom tcl-application "wish" + "*Name of Tcl program to run in inferior Tcl mode." + :type 'string) -(defvar tcl-command-switches nil - "*Switches to supply to `tcl-application'.") +(defcustom tcl-command-switches nil + "*List of switches to supply to the `tcl-application' program." + :type '(repeat string)) -(defvar tcl-prompt-regexp "^\\(% \\|\\)" +(defcustom tcl-prompt-regexp "^\\(% \\|\\)" "*If not nil, a regexp that will match the prompt in the inferior process. If nil, the prompt is the name of the application with \">\" appended. The default is \"^\\(% \\|\\)\", which will match the default primary -and secondary prompts for tclsh and wish.") +and secondary prompts for tclsh and wish." + :type 'regexp) -(defvar inferior-tcl-source-command "source %s\n" +(defcustom inferior-tcl-source-command "source %s\n" "*Format-string for building a Tcl command to load a file. This format string should use `%s' to substitute a file name and should result in a Tcl expression that will command the inferior Tcl to load that file. The filename will be appropriately -quoted for Tcl.") +quoted for Tcl." + :type 'string) ;; ;; Keymaps, abbrevs, syntax tables. ;; -(defvar tcl-mode-abbrev-table nil - "Abbrev table in use in Tcl-mode buffers.") -(if tcl-mode-abbrev-table - () - (define-abbrev-table 'tcl-mode-abbrev-table ())) - -(defvar tcl-mode-map () - "Keymap used in Tcl mode.") - -(defvar tcl-mode-syntax-table nil - "Syntax table in use in Tcl-mode buffers.") -(if tcl-mode-syntax-table - () - (setq tcl-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?% "_" tcl-mode-syntax-table) - (modify-syntax-entry ?@ "_" tcl-mode-syntax-table) - (modify-syntax-entry ?& "_" tcl-mode-syntax-table) - (modify-syntax-entry ?* "_" tcl-mode-syntax-table) - (modify-syntax-entry ?+ "_" tcl-mode-syntax-table) - (modify-syntax-entry ?- "_" tcl-mode-syntax-table) - (modify-syntax-entry ?. "_" tcl-mode-syntax-table) - (modify-syntax-entry ?: "_" tcl-mode-syntax-table) - (modify-syntax-entry ?! "_" tcl-mode-syntax-table) - (modify-syntax-entry ?$ "_" tcl-mode-syntax-table) ; FIXME use "'"? - (modify-syntax-entry ?/ "_" tcl-mode-syntax-table) - (modify-syntax-entry ?~ "_" tcl-mode-syntax-table) - (modify-syntax-entry ?< "_" tcl-mode-syntax-table) - (modify-syntax-entry ?= "_" tcl-mode-syntax-table) - (modify-syntax-entry ?> "_" tcl-mode-syntax-table) - (modify-syntax-entry ?| "_" tcl-mode-syntax-table) - (modify-syntax-entry ?\( "()" tcl-mode-syntax-table) - (modify-syntax-entry ?\) ")(" tcl-mode-syntax-table) - (modify-syntax-entry ?\; "." tcl-mode-syntax-table) - (modify-syntax-entry ?\n "> " tcl-mode-syntax-table) - (modify-syntax-entry ?\f "> " tcl-mode-syntax-table) - (modify-syntax-entry ?# "< " tcl-mode-syntax-table)) - -(defvar inferior-tcl-mode-map nil - "Keymap used in Inferior Tcl mode.") - -;; Lucid Emacs menu. -(defvar tcl-lucid-menu +(defvar tcl-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "{" 'tcl-electric-char) + (define-key map "}" 'tcl-electric-brace) + (define-key map "[" 'tcl-electric-char) + (define-key map "]" 'tcl-electric-char) + (define-key map ";" 'tcl-electric-char) + (define-key map "#" 'tcl-electric-hash) ;Remove? -stef + (define-key map "\e\C-q" 'tcl-indent-exp) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map "\t" 'tcl-indent-command) + (define-key map "\M-\C-x" 'tcl-eval-defun) + (define-key map "\C-c\C-i" 'tcl-help-on-word) + (define-key map "\C-c\C-v" 'tcl-eval-defun) + (define-key map "\C-c\C-f" 'tcl-load-file) + (define-key map "\C-c\C-t" 'inferior-tcl) + (define-key map "\C-c\C-x" 'tcl-eval-region) + (define-key map "\C-c\C-s" 'switch-to-tcl) + map) + "Keymap used in `tcl-mode'.") + +(defvar tcl-mode-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?% "_" st) + (modify-syntax-entry ?@ "_" st) + (modify-syntax-entry ?& "_" st) + (modify-syntax-entry ?* "_" st) + (modify-syntax-entry ?+ "_" st) + (modify-syntax-entry ?- "_" st) + (modify-syntax-entry ?. "_" st) + (modify-syntax-entry ?: "_" st) + (modify-syntax-entry ?! "_" st) + (modify-syntax-entry ?$ "_" st) ; FIXME use "'"? + (modify-syntax-entry ?/ "_" st) + (modify-syntax-entry ?~ "_" st) + (modify-syntax-entry ?< "_" st) + (modify-syntax-entry ?= "_" st) + (modify-syntax-entry ?> "_" st) + (modify-syntax-entry ?| "_" st) + (modify-syntax-entry ?\( "()" st) + (modify-syntax-entry ?\) ")(" st) + (modify-syntax-entry ?\; "." st) + (modify-syntax-entry ?\n ">" st) + ;; (modify-syntax-entry ?\f ">" st) + (modify-syntax-entry ?# "<" st) + st) + "Syntax table in use in `tcl-mode' buffers.") + +(defvar inferior-tcl-mode-map + ;; FIXME we override comint keybindings here. + ;; Maybe someone has a better set? + (let ((map (make-sparse-keymap))) + ;; Will inherit from `comint-mode-map' thanks to define-derived-mode. + (define-key map "\t" 'comint-dynamic-complete) + (define-key map "\M-?" 'comint-dynamic-list-filename-completions) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map "\M-\C-x" 'tcl-eval-defun) + (define-key map "\C-c\C-i" 'tcl-help-on-word) + (define-key map "\C-c\C-v" 'tcl-eval-defun) + (define-key map "\C-c\C-f" 'tcl-load-file) + (define-key map "\C-c\C-t" 'inferior-tcl) + (define-key map "\C-c\C-x" 'tcl-eval-region) + (define-key map "\C-c\C-s" 'switch-to-tcl) + map) + "Keymap used in `inferior-tcl-mode'.") + +(easy-menu-define tcl-mode-menu tcl-mode-map "Menu used in `tcl-mode'." '("Tcl" - ["Beginning of function" tcl-beginning-of-defun t] - ["End of function" tcl-end-of-defun t] - ["Mark function" tcl-mark-defun t] - ["Indent region" indent-region t] - ["Comment region" comment-region t] - ["Uncomment region" tcl-uncomment-region t] + ["Beginning of function" beginning-of-defun t] + ["End of function" end-of-defun t] + ["Mark function" mark-defun t] + ["Indent region" indent-region (mark t)] + ["Comment region" comment-region (mark t)] + ["Uncomment region" uncomment-region (mark t)] "----" ["Show Tcl process buffer" inferior-tcl t] - ["Send function to Tcl process" tcl-eval-defun t] - ["Send region to Tcl process" tcl-eval-region t] - ["Send file to Tcl process" tcl-load-file t] + ["Send function to Tcl process" tcl-eval-defun + (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))] + ["Send region to Tcl process" tcl-eval-region + (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))] + ["Send file to Tcl process" tcl-load-file + (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))] ["Restart Tcl process with file" tcl-restart-with-file t] "----" - ["Tcl help" tcl-help-on-word t] - ["Send bug report" tcl-submit-bug-report t]) - "Lucid Emacs menu for Tcl mode.") - -;; GNU Emacs does menus via keymaps. Do it in a function in case we -;; later decide to add it to inferior Tcl mode as well. -(defun tcl-add-fsf-menu (map) - (define-key map [menu-bar] (make-sparse-keymap)) - ;; This fails in Emacs 19.22 and earlier. - (require 'lmenu) - (let ((menu (make-lucid-menu-keymap "Tcl" (cdr tcl-lucid-menu)))) - (define-key map [menu-bar tcl] (cons "Tcl" menu)) - ;; The following is intended to compute the key sequence - ;; information for the menu. It doesn't work. - (x-popup-menu nil menu))) - -(defun tcl-fill-mode-map () - (define-key tcl-mode-map "{" 'tcl-electric-char) - (define-key tcl-mode-map "}" 'tcl-electric-brace) - (define-key tcl-mode-map "[" 'tcl-electric-char) - (define-key tcl-mode-map "]" 'tcl-electric-char) - (define-key tcl-mode-map ";" 'tcl-electric-char) - (define-key tcl-mode-map "#" 'tcl-electric-hash) - ;; FIXME. - (define-key tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun) - ;; FIXME. - (define-key tcl-mode-map "\e\C-e" 'tcl-end-of-defun) - ;; FIXME. - (define-key tcl-mode-map "\e\C-h" 'tcl-mark-defun) - (define-key tcl-mode-map "\e\C-q" 'indent-tcl-exp) - (define-key tcl-mode-map "\177" 'backward-delete-char-untabify) - (define-key tcl-mode-map "\t" 'tcl-indent-command) - (define-key tcl-mode-map "\M-;" 'tcl-indent-for-comment) - (define-key tcl-mode-map "\M-\C-x" 'tcl-eval-defun) - (define-key tcl-mode-map "\C-c\C-b" 'tcl-submit-bug-report) - (and (fboundp 'comment-region) - (define-key tcl-mode-map "\C-c\C-c" 'comment-region)) - (define-key tcl-mode-map "\C-c\C-d" 'tcl-help-on-word) - (define-key tcl-mode-map "\C-c\C-e" 'tcl-eval-defun) - (define-key tcl-mode-map "\C-c\C-l" 'tcl-load-file) - (define-key tcl-mode-map "\C-c\C-p" 'inferior-tcl) - (define-key tcl-mode-map "\C-c\C-r" 'tcl-eval-region) - (define-key tcl-mode-map "\C-c\C-z" 'switch-to-tcl) - - ;; Make menus. - (if tcl-using-emacs-19 - (if tcl-using-lemacs-19 - ;; In Lucid, button 3 seems to be the standard for this. - (define-key tcl-mode-map 'button3 'tcl-popup-menu) - ;; In FSF 19, there is no standard, so I use shift-button2. - (tcl-add-fsf-menu tcl-mode-map) - (define-key tcl-mode-map [S-down-mouse-2] 'tcl-popup-menu)))) - -(defun tcl-fill-inferior-map () - (define-key inferior-tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun) - (define-key inferior-tcl-mode-map "\e\C-e" 'tcl-end-of-defun) - (define-key inferior-tcl-mode-map "\177" 'backward-delete-char-untabify) - (define-key inferior-tcl-mode-map "\M-\C-x" 'tcl-eval-defun) - (define-key inferior-tcl-mode-map "\C-c\C-b" 'tcl-submit-bug-report) - (define-key inferior-tcl-mode-map "\C-c\C-d" 'tcl-help-on-word) - (define-key inferior-tcl-mode-map "\C-c\C-e" 'tcl-eval-defun) - (define-key inferior-tcl-mode-map "\C-c\C-l" 'tcl-load-file) - (define-key inferior-tcl-mode-map "\C-c\C-p" 'inferior-tcl) - (define-key inferior-tcl-mode-map "\C-c\C-r" 'tcl-eval-region) - (define-key inferior-tcl-mode-map "\C-c\C-z" 'switch-to-tcl)) - -(if tcl-mode-map - () - (setq tcl-mode-map (make-sparse-keymap)) - (tcl-fill-mode-map)) - -(if inferior-tcl-mode-map - () - ;; FIXME Use keymap inheritance here? FIXME we override comint - ;; keybindings here. Maybe someone has a better set? - (setq inferior-tcl-mode-map (copy-keymap comint-mode-map)) - (tcl-fill-inferior-map)) - + ["Tcl help" tcl-help-on-word tcl-help-directory-list])) (defvar inferior-tcl-buffer nil "*The current inferior-tcl process buffer. @@ -475,7 +306,7 @@ have three inferior Lisps running: If you do a \\[tcl-eval-defun] command on some Lisp source code, what process do you send it to? -- If you're in a process buffer (foo, bar, or *inferior-tcl*), +- If you're in a process buffer (foo, bar, or *inferior-tcl*), you send it to that process. - If you're in some other buffer (e.g., a source file), you send it to the process attached to buffer `inferior-tcl-buffer'. @@ -498,32 +329,25 @@ Several functions exist which are useful to run from your `tcl-mode-hook' (see each function's documentation for more information): - tcl-guess-application + `tcl-guess-application' Guesses a default setting for `tcl-application' based on any \"#!\" line at the top of the file. - tcl-hashify-buffer + `tcl-hashify-buffer' Quotes all \"#\" characters that don't correspond to actual Tcl comments. (Useful when editing code not originally created with this mode). - tcl-auto-fill-mode + `tcl-auto-fill-mode' Auto-filling of Tcl comments. -Emacs 19 users can add functions to the hook with `add-hook': - - (add-hook 'tcl-mode-hook 'tcl-guess-application) +Add functions to the hook with `add-hook': -Emacs 18 users must use `setq': + (add-hook 'tcl-mode-hook 'tcl-guess-application)") - (setq tcl-mode-hook (cons 'tcl-guess-application tcl-mode-hook))") - - -(defvar inferior-tcl-mode-hook nil - "Hook for customizing Inferior Tcl mode.") (defvar tcl-proc-list - '("proc") + '("proc" "method" "itcl_class" "body" "configbody" "class") "List of commands whose first argument defines something. -This exists because some people (eg, me) use \"defvar\" et al. +This exists because some people (eg, me) use `defvar' et al. Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords' after changing this list.") @@ -531,7 +355,8 @@ after changing this list.") "Regexp to use when matching proc headers.") (defvar tcl-typeword-list - '("global" "upvar") + '("global" "upvar" "inherit" "public" "protected" "private" + "common" "itk_option" "variable") "List of Tcl keywords denoting \"type\". Used only for highlighting. Call `tcl-set-font-lock-keywords' after changing this list.") @@ -539,7 +364,9 @@ Call `tcl-set-font-lock-keywords' after changing this list.") (defvar tcl-keyword-list '("if" "then" "else" "elseif" "for" "foreach" "break" "continue" "while" "eval" "case" "in" "switch" "default" "exit" "error" "proc" "return" - "uplevel" "loop" "for_array_keys" "for_recursive_glob" "for_file") + "uplevel" "constructor" "destructor" "itcl_class" "loop" "for_array_keys" + "for_recursive_glob" "for_file" "method" "body" "configbody" "class" + "chain") "List of Tcl keywords. Used only for highlighting. Default list includes some TclX keywords. Call `tcl-set-font-lock-keywords' after changing this list.") @@ -550,10 +377,18 @@ This variable is generally set from `tcl-proc-regexp', `tcl-typeword-list', and `tcl-keyword-list' by the function `tcl-set-font-lock-keywords'.") +(defvar tcl-font-lock-syntactic-keywords + ;; Mark the few `#' that are not comment-markers. + '(("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) + "Syntactic keywords for `tcl-mode'.") + ;; FIXME need some way to recognize variables because array refs look ;; like 2 sexps. (defvar tcl-type-alist - '( + '(("proc" nil tcl-expr tcl-commands) + ("method" nil tcl-expr tcl-commands) + ("destructor" tcl-commands) + ("constructor" tcl-commands) ("expr" tcl-expr) ("catch" tcl-commands) ("if" tcl-expr "then" tcl-commands) @@ -570,8 +405,7 @@ This variable is generally set from `tcl-proc-regexp', ;; either a command or an expr, and there is no real way to look ;; forward. ("loop" nil tcl-expr tcl-expr tcl-commands) - ("loop" nil tcl-expr tcl-commands) - ) + ("loop" nil tcl-expr tcl-commands)) "Alist that controls indentation. \(Actually, this really only controls what happens on continuation lines). Each entry looks like `(KEYWORD TYPE ...)'. @@ -591,120 +425,20 @@ argument is ignored (for indentation purposes). The second argument is a Tcl expression, and the last argument is Tcl commands.") (defvar tcl-explain-indentation nil - "If not `nil', debugging message will be printed during indentation.") + "If non-nil, debugging message will be printed during indentation.") -;; -;; Work around differences between various versions of Emacs. -;; - -;; We use this because Lemacs 19.9 has what we need. -(defconst tcl-pps-has-arg-6 - (or tcl-using-emacs-19 - (and tcl-using-lemacs-19 - (condition-case nil - (progn - (parse-partial-sexp (point) (point) nil nil nil t) - t) - (error nil)))) - "t if using an emacs which supports sixth (\"commentstop\") argument -to parse-partial-sexp.") - -;; Its pretty bogus to have to do this, but there is no easier way to -;; say "match not syntax-1 and not syntax-2". Too bad you can't put -;; \s in [...]. This sickness is used in Emacs 19 to match a defun -;; starter. (It is used for this in v18 as well). -;;(defconst tcl-omit-ws-regexp -;; (concat "^\\(\\s" -;; (mapconcat 'char-to-string "w_.()\"\\$'/" "\\|\\s") -;; "\\)\\S(*") -;; "Regular expression that matches everything except space, comment -;;starter, and comment ender syntax codes.") - -;; FIXME? Instead of using the hairy regexp above, we just use a -;; simple one. -;;(defconst tcl-omit-ws-regexp "^[^] \t\n#}]\\S(*" -;; "Regular expression used in locating function definitions.") - -;; Here's another stab. I think this one actually works. Now the -;; problem seems to be that there is a bug in Emacs 19.22 where -;; end-of-defun doesn't really use the brace matching the one that -;; trails defun-prompt-regexp. -(defconst tcl-omit-ws-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+") - -(defun tcl-internal-beginning-of-defun (&optional arg) - "Move backward to next beginning-of-defun. -With argument, do this that many times. -Returns t unless search stops due to end of buffer." - (interactive "p") - (if (or (null arg) (= arg 0)) - (setq arg 1)) - (let (success) - (while (progn - (setq arg (1- arg)) - (and (>= arg 0) - (setq success - (re-search-backward tcl-omit-ws-regexp nil 'move 1)))) - (while (and (looking-at "[]#}]") - (setq success - (re-search-backward tcl-omit-ws-regexp nil 'move 1))))) - (beginning-of-line) - (not (null success)))) - -(defun tcl-internal-end-of-defun (&optional arg) - "Move forward to next end of defun. -An end of a defun is found by moving forward from the beginning of one." - (interactive "p") - (if (or (null arg) (= arg 0)) (setq arg 1)) - (let ((start (point))) - ;; Was forward-char. I think this works a little better. - (forward-line) - (tcl-beginning-of-defun) - (while (> arg 0) - (while (and (re-search-forward tcl-omit-ws-regexp nil 'move 1) - (progn (beginning-of-line) t) - (looking-at "[]#}]") - (progn (forward-line) t))) - (let ((next-line (save-excursion - (forward-line) - (point)))) - (while (< (point) next-line) - (forward-sexp))) - (forward-line) - (if (> (point) start) (setq arg (1- arg)))))) - -;; In Emacs 19, we can use begining-of-defun as long as we set up a -;; certain regexp. In Emacs 18, we need our own function. -(fset 'tcl-beginning-of-defun - (if tcl-using-emacs-19 - 'beginning-of-defun - 'tcl-internal-beginning-of-defun)) - -;; Ditto end-of-defun. -(fset 'tcl-end-of-defun - (if tcl-using-emacs-19 - 'end-of-defun - 'tcl-internal-end-of-defun)) - -;; Internal mark-defun that is used for losing Emacsen. -(defun tcl-internal-mark-defun () - "Put mark at end of Tcl function, point at beginning." - (interactive) - (push-mark (point)) - (tcl-end-of-defun) - (if tcl-using-emacs-19 - (push-mark (point) nil t) - (push-mark (point))) - (tcl-beginning-of-defun) - (backward-paragraph)) - -;; In GNU Emacs 19.23 and later, mark-defun works as advertised. I -;; don't know about Lucid Emacs, so for now it and Emacs 18 just lose. -(fset 'tcl-mark-defun - (if tcl-using-emacs-19.23 - 'mark-defun - 'tcl-internal-mark-defun)) +;; Here's another stab. I think this one actually works. +;; We have to be careful that the open-brace following this regexp +;; is indeed the one corresponding to the function's body so +;; that end-of-defun works correctly. Tricky cases are: +;; proc foo { {arg1 def} arg2 } { +;; as well as +;; proc foo { \n {arg1 def} \n arg2 } { +;; The current setting handles the first case properly but not the second. +;; It also fails if `proc' is not in column-0 (e.g. it's in a namespace). +(defconst tcl-omit-ws-regexp "^[^] \t\n#}].+[ \t]+") @@ -714,9 +448,8 @@ An end of a defun is found by moving forward from the beginning of one." (defun tcl-set-proc-regexp () "Set `tcl-proc-regexp' from variable `tcl-proc-list'." - (setq tcl-proc-regexp (concat "^\\(" - (mapconcat 'identity tcl-proc-list "\\|") - "\\)[ \t]+"))) + (setq tcl-proc-regexp + (concat "^\\s-*" (regexp-opt tcl-proc-list t) "[ \t]+"))) (defun tcl-set-font-lock-keywords () "Set `tcl-font-lock-keywords'. @@ -728,21 +461,19 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'." 2 'font-lock-function-name-face) ;; Names of type-defining things. - (list (concat "\\(\\s-\\|^\\)\\(" - ;; FIXME Use 'regexp-quote? - (mapconcat 'identity tcl-typeword-list "\\|") - "\\)\\(\\s-\\|$\\)") + (list (concat "\\(\\s-\\|^\\)" + (regexp-opt tcl-typeword-list t) + "\\(\\s-\\|$\\)") 2 'font-lock-type-face) ;; Keywords. Only recognized if surrounded by whitespace. ;; FIXME consider using "not word or symbol", not ;; "whitespace". - (cons (concat "\\(\\s-\\|^\\)\\(" - ;; FIXME Use regexp-quote? - (mapconcat 'identity tcl-keyword-list "\\|") - "\\)\\(\\s-\\|$\\)") - 2) - ))) + (cons (concat "\\(\\s-\\|^\\)" + ;; FIXME Use regexp-quote? + (regexp-opt tcl-keyword-list t) + "\\(\\s-\\|$\\)") + 2)))) (if tcl-proc-regexp () @@ -752,13 +483,19 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'." () (tcl-set-font-lock-keywords)) + +(defvar tcl-imenu-generic-expression + `((nil ,(concat tcl-proc-regexp "\\([-A-Za-z0-9_:+*]+\\)") 2)) + "Imenu generic expression for `tcl-mode'. See `imenu-generic-expression'.") + ;; ;; The mode itself. ;; -(defun tcl-mode () +;;;###autoload +(define-derived-mode tcl-mode nil "Tcl" "Major mode for editing Tcl code. Expression and list commands understand all Tcl brackets. Tab indents for Tcl code. @@ -766,94 +503,76 @@ Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. Variables controlling indentation style: - tcl-indent-level + `tcl-indent-level' Indentation of Tcl statements within surrounding block. - tcl-continued-indent-level + `tcl-continued-indent-level' Indentation of continuation line relative to first line of command. Variables controlling user interaction with mode (see variable documentation for details): - tcl-tab-always-indent + `tcl-tab-always-indent' Controls action of TAB key. - tcl-auto-newline + `tcl-auto-newline' Non-nil means automatically newline before and after braces, brackets, and semicolons inserted in Tcl code. - tcl-electric-hash-style - Controls action of `#' key. - tcl-use-hairy-comment-detector - If t, use more complicated, but slower, comment detector. - This variable is only used in GNU Emacs 19. - -Turning on Tcl mode calls the value of the variable `tcl-mode-hook' -with no args, if that value is non-nil. Read the documentation for + `tcl-use-smart-word-finder' + If not nil, use a smarter, Tcl-specific way to find the current + word when looking up help on a Tcl command. + +Turning on Tcl mode runs `tcl-mode-hook'. Read the documentation for `tcl-mode-hook' to see what kinds of interesting hook functions already exist. Commands: \\{tcl-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map tcl-mode-map) - (setq major-mode 'tcl-mode) - (setq mode-name "Tcl") - (setq local-abbrev-table tcl-mode-abbrev-table) - (set-syntax-table tcl-mode-syntax-table) - - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) + (unless (and (boundp 'filladapt-mode) filladapt-mode) + (set (make-local-variable 'paragraph-ignore-fill-prefix) t)) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'tcl-indent-line) + (set (make-local-variable 'indent-line-function) 'tcl-indent-line) + (set (make-local-variable 'comment-indent-function) 'tcl-comment-indent) ;; Tcl doesn't require a final newline. ;; (make-local-variable 'require-final-newline) ;; (setq require-final-newline t) - (make-local-variable 'comment-start) - (setq comment-start "# ") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "#+ *") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'comment-end) - (setq comment-end "") - - (make-local-variable 'font-lock-keywords) - (setq font-lock-keywords tcl-font-lock-keywords) - - ;; The following only really makes sense under GNU Emacs 19. - (setq imenu-create-index-function 'tcl-imenu-create-index-function) - (make-local-variable 'parse-sexp-ignore-comments) - - (if tcl-using-emacs-19 - (progn - ;; This can only be set to t in Emacs 19 and Lucid Emacs. - ;; Emacs 18 and Epoch lose. - (setq parse-sexp-ignore-comments t) - ;; Lucid Emacs has defun-prompt-regexp, but I don't believe - ;; that it works for end-of-defun -- only for - ;; beginning-of-defun. - (make-local-variable 'defun-prompt-regexp) - (setq defun-prompt-regexp tcl-omit-ws-regexp) - ;; The following doesn't work in Lucid Emacs 19.6, but maybe - ;; it will appear in later versions. - (make-local-variable 'add-log-current-defun-function) - (setq add-log-current-defun-function 'add-log-tcl-defun)) - (setq parse-sexp-ignore-comments nil)) - - ;; Put Tcl menu into menubar for Lucid Emacs. This happens - ;; automatically for GNU Emacs. - (if (and tcl-using-lemacs-19 - current-menubar - (not (assoc "Tcl" current-menubar))) - (progn - (set-buffer-menubar (copy-sequence current-menubar)) - (add-menu nil "Tcl" tcl-lucid-menu))) - - (run-hooks 'tcl-mode-hook)) + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-start-skip) + "\\(\\(^\\|[;{[]\\)\\s-*\\)#+ *") + (set (make-local-variable 'comment-end) "") + + (set (make-local-variable 'outline-regexp) ".") + (set (make-local-variable 'outline-level) 'tcl-outline-level) + + (set (make-local-variable 'font-lock-defaults) + '(tcl-font-lock-keywords nil nil nil beginning-of-defun + (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords) + (parse-sexp-lookup-properties . t))) + + (set (make-local-variable 'imenu-generic-expression) + tcl-imenu-generic-expression) + + ;; Settings for new dabbrev code. + (set (make-local-variable 'dabbrev-case-fold-search) nil) + (set (make-local-variable 'dabbrev-case-replace) nil) + (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "[$!]") + (set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|\\s_") + + ;; This can only be set to t in Emacs 19 and XEmacs. + ;; Emacs 18 and Epoch lose. + (set (make-local-variable 'parse-sexp-ignore-comments) t) + ;; XEmacs has defun-prompt-regexp, but I don't believe + ;; that it works for end-of-defun -- only for + ;; beginning-of-defun. + (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp) + ;; The following doesn't work in Lucid Emacs 19.6, but maybe + ;; it will appear in later versions. + (set (make-local-variable 'add-log-current-defun-function) + 'tcl-add-log-defun) + + (easy-menu-add tcl-mode-menu) + ;; Append Tcl menu to popup menu for XEmacs. + (if (boundp 'mode-popup-menu) + (setq mode-popup-menu + (cons (concat mode-name " Mode Commands") tcl-mode-menu)))) @@ -900,10 +619,10 @@ Commands: (defun tcl-indent-command (&optional arg) "Indent current line as Tcl code, or in some cases insert a tab character. -If tcl-tab-always-indent is t (the default), always indent current line. -If tcl-tab-always-indent is nil and point is not in the indentation +If `tcl-tab-always-indent' is t (the default), always indent current line. +If `tcl-tab-always-indent' is nil and point is not in the indentation area at the beginning of the line, a TAB is inserted. -Other values of tcl-tab-always-indent cause the first possible action +Other values of `tcl-tab-always-indent' cause the first possible action from the following list to take place: 1. Move from beginning of line to correct indentation. @@ -918,7 +637,7 @@ from the following list to take place: ;; Indent if in indentation area, otherwise insert TAB. (if (<= (current-column) (current-indentation)) (tcl-indent-line) - (self-insert-command arg))) + (insert-tab arg))) ((eq tcl-tab-always-indent t) ;; Always indent. (tcl-indent-line)) @@ -930,17 +649,13 @@ from the following list to take place: (point))) (comment-p (tcl-in-comment))) (cond - ((= ipoint (save-excursion - (beginning-of-line) - (point))) + ((= ipoint (line-beginning-position)) (beginning-of-line) (tcl-indent-line) ;; If indenting didn't leave us in column 0, go to the ;; indentation. Otherwise leave point at end of line. This ;; is a hack. - (if (= (point) (save-excursion - (beginning-of-line) - (point))) + (if (= (point) (line-beginning-position)) (end-of-line) (back-to-indentation))) ((and comment-p (looking-at "[ \t]*$")) @@ -960,7 +675,7 @@ from the following list to take place: (tcl-indent-line)) ((not comment-p) (tcl-indent-line) - (tcl-indent-for-comment)) + (comment-indent)) (t ;; Go to start of comment. We don't leave point where it is ;; because we want to skip comment-start-skip. @@ -970,7 +685,7 @@ from the following list to take place: (defun tcl-indent-line () "Indent current line as Tcl code. Return the amount the indentation changed by." - (let ((indent (calculate-tcl-indent nil)) + (let ((indent (tcl-calculate-indent nil)) beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) @@ -1000,7 +715,7 @@ Return the amount the indentation changed by." (defun tcl-figure-type () "Determine type of sexp at point. -This is either 'tcl-expr, 'tcl-commands, or nil. Puts point at start +This is either `tcl-expr', `tcl-commands', or nil. Puts point at start of sexp that indicates types. See documentation for variable `tcl-type-alist' for more information." @@ -1017,7 +732,7 @@ See documentation for variable `tcl-type-alist' for more information." (if (looking-at "[a-zA-Z_]+") (let ((list tcl-type-alist) entry) - (setq word-stack (cons (current-word) word-stack)) + (setq word-stack (cons (tcl-word-no-props) word-stack)) (while (and list (not result)) (setq entry (car list)) (setq list (cdr list)) @@ -1042,7 +757,7 @@ See documentation for variable `tcl-type-alist' for more information." (message "Indentation type %s" result)) result)) -(defun calculate-tcl-indent (&optional parse-start) +(defun tcl-calculate-indent (&optional parse-start) "Return appropriate indentation for current line as Tcl code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment." @@ -1050,7 +765,7 @@ Returns nil if line starts inside a string, t if in a comment." (beginning-of-line) (let* ((indent-point (point)) (case-fold-search nil) - (continued-line + (continued-line (save-excursion (if (bobp) nil @@ -1064,7 +779,7 @@ Returns nil if line starts inside a string, t if in a comment." found-next-line) (if parse-start (goto-char parse-start) - (tcl-beginning-of-defun)) + (beginning-of-defun)) (while (< (point) indent-point) (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) @@ -1144,14 +859,14 @@ Returns nil if line starts inside a string, t if in a comment." -(defun indent-tcl-exp () +(defun tcl-indent-exp () "Indent each line of the Tcl grouping following point." (interactive) (let ((indent-stack (list nil)) (contain-stack (list (point))) (case-fold-search nil) outer-loop-done inner-loop-done state ostate - this-indent last-sexp continued-line + this-indent continued-line (next-depth 0) last-depth) (save-excursion @@ -1171,9 +886,6 @@ Returns nil if line starts inside a string, t if in a comment." (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state)) (setq next-depth (car state)) - (if (and (car (cdr (cdr state))) - (>= (car (cdr (cdr state))) 0)) - (setq last-sexp (car (cdr (cdr state))))) (if (or (nth 4 ostate)) (tcl-indent-line)) (if (or (nth 3 state)) @@ -1190,21 +902,19 @@ Returns nil if line starts inside a string, t if in a comment." (setq indent-stack (cdr indent-stack) contain-stack (cdr contain-stack) last-depth (1- last-depth))) - (if (/= last-depth next-depth) - (setq last-sexp nil)) ;; Add levels for any parens that were started in this line. (while (< last-depth next-depth) (setq indent-stack (cons nil indent-stack) contain-stack (cons nil contain-stack) last-depth (1+ last-depth))) (if (null (car contain-stack)) - (setcar contain-stack + (setcar contain-stack (or (car (cdr state)) (save-excursion (forward-sexp -1) (point))))) (forward-line 1) - (setq continued-line + (setq continued-line (save-excursion (backward-char) (= (preceding-char) ?\\))) @@ -1217,7 +927,7 @@ Returns nil if line starts inside a string, t if in a comment." (setq this-indent (car indent-stack)) ;; Just started a new nesting level. ;; Compute the standard indent for this level. - (let ((val (calculate-tcl-indent + (let ((val (tcl-calculate-indent (if (car indent-stack) (- (car indent-stack)))))) (setcar indent-stack @@ -1230,14 +940,14 @@ Returns nil if line starts inside a string, t if in a comment." (setq this-indent (- this-indent 1)))) ;; Put chosen indentation into effect. (or (null this-indent) - (= (current-column) - (if continued-line + (= (current-column) + (if continued-line (+ this-indent tcl-indent-level) this-indent)) (progn (delete-region (point) (progn (beginning-of-line) (point))) - (indent-to - (if continued-line + (indent-to + (if continued-line (+ this-indent tcl-indent-level) this-indent))))))))) ) @@ -1248,32 +958,20 @@ Returns nil if line starts inside a string, t if in a comment." ;; Interfaces to other packages. ;; -(defun tcl-imenu-create-index-function () - "Generate alist of indices for imenu." - (let ((re (concat tcl-proc-regexp "\\([^ \t\n{]+\\)")) - alist) - (imenu-progress-message 0) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (imenu-progress-message nil) - ;; Position on start of proc name, not beginning of line. - (setq alist (cons - (cons (buffer-substring (match-beginning 2) (match-end 2)) - (match-beginning 2)) - alist))) - (imenu-progress-message 100) - (nreverse alist))) - ;; FIXME Definition of function is very ad-hoc. Should use -;; tcl-beginning-of-defun. Also has incestuous knowledge about the +;; beginning-of-defun. Also has incestuous knowledge about the ;; format of tcl-proc-regexp. -(defun add-log-tcl-defun () +(defun tcl-add-log-defun () "Return name of Tcl function point is in, or nil." (save-excursion - (if (re-search-backward - (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t) - (buffer-substring (match-beginning 2) - (match-end 2))))) + (end-of-line) + (if (re-search-backward (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t) + (match-string 2)))) + +(defun tcl-outline-level () + (save-excursion + (skip-chars-forward " \t") + (current-column))) @@ -1290,8 +988,7 @@ Returns nil if line starts inside a string, t if in a comment." (defun tcl-filter (proc string) (let ((inhibit-quit t)) - (save-excursion - (set-buffer (process-buffer proc)) + (with-current-buffer (process-buffer proc) (goto-char (process-mark proc)) ;; Delete prompt if requested. (if (marker-buffer inferior-tcl-delete-prompt-marker) @@ -1301,8 +998,7 @@ Returns nil if line starts inside a string, t if in a comment." (comint-output-filter proc string)) (defun tcl-send-string (proc string) - (save-excursion - (set-buffer (process-buffer proc)) + (with-current-buffer (process-buffer proc) (goto-char (process-mark proc)) (beginning-of-line) (if (looking-at comint-prompt-regexp) @@ -1310,8 +1006,7 @@ Returns nil if line starts inside a string, t if in a comment." (comint-send-string proc string)) (defun tcl-send-region (proc start end) - (save-excursion - (set-buffer (process-buffer proc)) + (with-current-buffer (process-buffer proc) (goto-char (process-mark proc)) (beginning-of-line) (if (looking-at comint-prompt-regexp) @@ -1352,9 +1047,9 @@ Prefix argument means switch to the Tcl buffer afterwards." Prefix argument means switch to the Tcl buffer afterwards." (interactive "P") (save-excursion - (tcl-end-of-defun) + (end-of-defun) (let ((end (point))) - (tcl-beginning-of-defun) + (beginning-of-defun) (tcl-eval-region (point) end))) (if and-go (switch-to-tcl t))) @@ -1364,53 +1059,43 @@ Prefix argument means switch to the Tcl buffer afterwards." ;; Inferior Tcl mode itself. ;; -(defun inferior-tcl-mode () +(define-derived-mode inferior-tcl-mode comint-mode "Inferior Tcl" "Major mode for interacting with Tcl interpreter. -A Tcl process can be started with M-x inferior-tcl. +You can start a Tcl process with \\[inferior-tcl]. -Entry to this mode runs the hooks comint-mode-hook and -inferior-tcl-mode-hook, in that order. +Entry to this mode runs the normal hooks `comint-mode-hook' and +`inferior-tcl-mode-hook', in that order. You can send text to the inferior Tcl process from other buffers containing Tcl source. Variables controlling Inferior Tcl mode: - tcl-application + `tcl-application' Name of program to run. - tcl-command-switches + `tcl-command-switches' Command line arguments to `tcl-application'. - tcl-prompt-regexp + `tcl-prompt-regexp' Matches prompt. - inferior-tcl-source-command + `inferior-tcl-source-command' Command to use to read Tcl file in running application. - inferior-tcl-buffer + `inferior-tcl-buffer' The current inferior Tcl process buffer. See variable documentation for details on multiple-process support. The following commands are available: \\{inferior-tcl-mode-map}" - (interactive) - (comint-mode) - (setq comint-prompt-regexp (or tcl-prompt-regexp - (concat "^" - (regexp-quote tcl-application) - ">"))) - (setq major-mode 'inferior-tcl-mode) - (setq mode-name "Inferior Tcl") + (set (make-local-variable 'comint-prompt-regexp) + (or tcl-prompt-regexp + (concat "^" (regexp-quote tcl-application) ">"))) (setq mode-line-process '(": %s")) - (use-local-map inferior-tcl-mode-map) (setq local-abbrev-table tcl-mode-abbrev-table) (set-syntax-table tcl-mode-syntax-table) - (if tcl-using-emacs-19 - (progn - (make-local-variable 'defun-prompt-regexp) - (setq defun-prompt-regexp tcl-omit-ws-regexp))) - (make-local-variable 'inferior-tcl-delete-prompt-marker) - (setq inferior-tcl-delete-prompt-marker (make-marker)) - (set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter) - (run-hooks 'inferior-tcl-mode-hook)) + (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp) + (set (make-local-variable 'inferior-tcl-delete-prompt-marker) (make-marker)) + (set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter)) +;;;###autoload (defun inferior-tcl (cmd) "Run inferior Tcl process. Prefix arg means enter program name interactively. @@ -1419,18 +1104,15 @@ See documentation for function `inferior-tcl-mode' for more information." (list (if current-prefix-arg (read-string "Run Tcl: " tcl-application) tcl-application))) - (if (not (comint-check-proc "*inferior-tcl*")) - (progn - (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil - tcl-command-switches)) - (inferior-tcl-mode))) - (make-local-variable 'tcl-application) - (setq tcl-application cmd) + (unless (comint-check-proc "*inferior-tcl*") + (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil + tcl-command-switches)) + (inferior-tcl-mode)) + (set (make-local-variable 'tcl-application) cmd) (setq inferior-tcl-buffer "*inferior-tcl*") - (switch-to-buffer "*inferior-tcl*")) + (pop-to-buffer "*inferior-tcl*")) -(and (fboundp 'defalias) - (defalias 'run-tcl 'inferior-tcl)) +(defalias 'run-tcl 'inferior-tcl) @@ -1459,7 +1141,7 @@ first word following a semicolon, opening brace, or opening bracket." "Return t if point is just after the `#' beginning a real comment. Does not check to see if previous char is actually `#'. A real comment is either at the beginning of the buffer, -preceeded only by whitespace on the line, or has a preceeding +preceded only by whitespace on the line, or has a preceding semicolon, opening brace, or opening bracket on the same line." (save-excursion (backward-char) @@ -1470,7 +1152,9 @@ semicolon, opening brace, or opening bracket on the same line." Returns a list of the form `(FLAG . STATE)'. STATE can be used as input to future invocations. FLAG is nil if not in comment, t otherwise. If in comment, leaves point at beginning of comment. -Only works in Emacs 19. See also `tcl-simple-scan-for-comment', a + +This function does not work in Emacs 18. +See also `tcl-simple-scan-for-comment', a simpler version that is often right, and works in Emacs 18." (let ((bol (save-excursion (goto-char end) @@ -1479,8 +1163,7 @@ simpler version that is often right, and works in Emacs 18." real-comment last-cstart) (while (and (not last-cstart) (< (point) end)) - (setq real-comment nil) ;In case we've looped around and it is - ;set. + (setq real-comment nil) ;In case we've looped around and it is set. (setq state (parse-partial-sexp (point) end nil nil state t)) (if (nth 4 state) (progn @@ -1508,51 +1191,12 @@ simpler version that is often right, and works in Emacs 18." (goto-char last-cstart)) (cons real-comment state))) -(defun tcl-hairy-in-comment () - "Return t if point is in a comment, and leave point at beginning -of comment." +(defun tcl-in-comment () + "Return t if point is in a comment, and leave point at beginning of comment." (let ((save (point))) - (tcl-beginning-of-defun) + (beginning-of-defun) (car (tcl-hairy-scan-for-comment nil save nil)))) -(defun tcl-simple-in-comment () - "Return t if point is in comment, and leave point at beginning -of comment. This is faster that `tcl-hairy-in-comment', but is -correct less often." - (let ((save (point)) - comment) - (beginning-of-line) - (while (and (< (point) save) (not comment)) - (search-forward "#" save 'move) - (setq comment (tcl-real-comment-p))) - comment)) - -(defun tcl-in-comment () - "Return t if point is in comment, and leave point at beginning -of comment." - (if (and tcl-pps-has-arg-6 - tcl-use-hairy-comment-detector) - (tcl-hairy-in-comment) - (tcl-simple-in-comment))) - -(defun tcl-do-auto-fill () - "Auto-fill function for Tcl mode. Only auto-fills in a comment." - (let (in-comment - col) - (save-excursion - (setq in-comment (tcl-in-comment)) - (if in-comment - (setq col (1- (current-column))))) - (if in-comment - (progn - (do-auto-fill) - (save-excursion - (back-to-indentation) - (delete-region (point) (save-excursion - (beginning-of-line) - (point))) - (indent-to-column col)))))) - ;; @@ -1567,42 +1211,42 @@ to update the alist.") (defvar tcl-help-alist nil "Alist with command names as keys and filenames as values.") +(defun tcl-files-alist (dir &optional alist) + "Recursively add all pairs (FILE . PATH) under DIR to ALIST." + (dolist (file (directory-files dir t) alist) + (cond + ((not (file-directory-p file)) + (push (cons (file-name-nondirectory file) file) alist)) + ((member (file-name-nondirectory file) '("." ".."))) + (t (setq alist (tcl-files-alist file alist)))))) + (defun tcl-help-snarf-commands (dirlist) - "Build alist of commands and filenames." - (while dirlist - (let ((files (directory-files (car dirlist) t))) - (while files - (if (and (file-directory-p (car files)) - (not - (let ((fpart (file-name-nondirectory (car files)))) - (or (equal fpart ".") - (equal fpart ".."))))) - (let ((matches (directory-files (car files) t))) - (while matches - (or (file-directory-p (car matches)) - (setq tcl-help-alist - (cons - (cons (file-name-nondirectory (car matches)) - (car matches)) - tcl-help-alist))) - (setq matches (cdr matches))))) - (setq files (cdr files)))) - (setq dirlist (cdr dirlist)))) + "Return alist of commands and filenames." + (let ((alist nil)) + (dolist (dir dirlist alist) + (when (file-directory-p dir) + (setq alist (tcl-files-alist dir alist)))))) (defun tcl-reread-help-files () "Set up to re-read files, and then do it." (interactive) (message "Building Tcl help file index...") (setq tcl-help-saved-dirs tcl-help-directory-list) - (setq tcl-help-alist nil) - (tcl-help-snarf-commands tcl-help-directory-list) + (setq tcl-help-alist (tcl-help-snarf-commands tcl-help-directory-list)) (message "Building Tcl help file index...done")) +(defun tcl-word-no-props () + "Like `current-word', but strips properties." + (let ((word (current-word))) + (set-text-properties 0 (length word) nil word) + word)) + (defun tcl-current-word (flag) "Return current command word, or nil. If FLAG is nil, just uses `current-word'. Otherwise scans backward for most likely Tcl command word." - (if (and flag (eq major-mode 'tcl-mode)) + (if (and flag + (memq major-mode '(tcl-mode inferior-tcl-mode))) (condition-case nil (save-excursion ;; Look backward for first word actually in alist. @@ -1611,11 +1255,12 @@ Otherwise scans backward for most likely Tcl command word." (while (and (not (bobp)) (not (tcl-real-command-p))) (backward-sexp))) - (if (assoc (current-word) tcl-help-alist) - (current-word))) + (if (assoc (tcl-word-no-props) tcl-help-alist) + (tcl-word-no-props))) (error nil)) - (current-word))) + (tcl-word-no-props))) +;;;###autoload (defun tcl-help-on-word (command &optional arg) "Get help on Tcl command. Default is word at point. Prefix argument means invert sense of `tcl-use-smart-word-finder'." @@ -1632,7 +1277,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'." (if (or (null word) (string= word "")) "Help on Tcl command: " (format "Help on Tcl command (default %s): " word)) - tcl-help-alist nil t))) + tcl-help-alist nil t nil nil word))) current-prefix-arg)) (if (not (equal tcl-help-directory-list tcl-help-saved-dirs)) (tcl-reread-help-files)) @@ -1675,7 +1320,11 @@ Prefix argument means switch to the Tcl buffer afterwards." (list ;; car because comint-get-source returns a list holding the ;; filename. - (car (comint-get-source "Load Tcl file: " tcl-previous-dir/file + (car (comint-get-source "Load Tcl file: " + (or (and + (eq major-mode 'tcl-mode) + (buffer-file-name)) + tcl-previous-dir/file) '(tcl-mode) t)) current-prefix-arg)) (comint-check-source file) @@ -1685,8 +1334,6 @@ Prefix argument means switch to the Tcl buffer afterwards." (format inferior-tcl-source-command (tcl-quote file))) (if and-go (switch-to-tcl t))) -;; Maybe this should work just like tcl-load-file. But I think what -;; I've implemented will turn out to be more useful. (defun tcl-restart-with-file (file &optional and-go) "Restart inferior Tcl with file. If an inferior Tcl process exists, it is killed first. @@ -1724,24 +1371,13 @@ Prefix argument means switch to the Tcl buffer afterwards." tcl-application file tcl-command-switches) (if and-go (switch-to-tcl t))))))) -;; FIXME I imagine you can do this under Emacs 18. I just don't know -;; how. (defun tcl-auto-fill-mode (&optional arg) - "Like `auto-fill-mode', but controls filling of Tcl comments." + "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'." (interactive "P") - (and (not tcl-using-emacs-19) - (error "You must use Emacs 19 to get this feature.")) - ;; Following code taken from "auto-fill-mode" (simple.el). - (prog1 - (setq auto-fill-function - (if (if (null arg) - (not auto-fill-function) - (> (prefix-numeric-value arg) 0)) - 'tcl-do-auto-fill - nil)) - ;; Update mode line. FIXME I'd use force-mode-line-update, but I - ;; don't know if it exists in v18. - (set-buffer-modified-p (buffer-modified-p)))) + (auto-fill-mode arg) + (if auto-fill-function + (set (make-local-variable 'comment-auto-fill-only-comments) t) + (kill-local-variable 'comment-auto-fill-only-comments))) (defun tcl-electric-hash (&optional count) "Insert a `#' and quote if it does not start a real comment. @@ -1784,78 +1420,34 @@ styles." (interactive) (save-excursion (goto-char (point-min)) - (if (and tcl-pps-has-arg-6 tcl-use-hairy-comment-detector) - (let (state - result) - (while (< (point) (point-max)) - (setq result (tcl-hairy-scan-for-comment state (point-max) t)) - (if (car result) - (beginning-of-line 2) - (backward-char) - (if (eq ?# (following-char)) - (insert "\\")) - (forward-char)) - (setq state (cdr result)))) - (while (and (< (point) (point-max)) - (search-forward "#" nil 'move)) - (if (tcl-real-comment-p) + (let (state + result) + (while (< (point) (point-max)) + (setq result (tcl-hairy-scan-for-comment state (point-max) t)) + (if (car result) (beginning-of-line 2) - ;; There's really no good way for the simple converter to - ;; work. So we just quote # if it isn't already quoted. - ;; Bogus, but it works. (backward-char) - (if (not (eq ?\\ (preceding-char))) + (if (eq ?# (following-char)) (insert "\\")) - (forward-char)))))) - -(defun tcl-indent-for-comment () - "Indent this line's comment to comment column, or insert an empty comment. -Is smart about syntax of Tcl comments. -Parts of this were taken from indent-for-comment (simple.el)." - (interactive "*") - (end-of-line) - (or (tcl-in-comment) - (progn - ;; Not in a comment, so we have to insert one. Create an - ;; empty comment (since there isn't one on this line). If - ;; line is not blank, make sure we insert a ";" first. - (skip-chars-backward " \t") - (let ((eolpoint (point))) - (beginning-of-line) - (if (/= (point) eolpoint) - (progn - (goto-char eolpoint) - (insert - (if (tcl-real-command-p) "" ";") - "# ") - (backward-char)))))) - ;; Point is just after the "#" starting a comment. Move it as - ;; appropriate. - (let* ((indent (if comment-indent-hook - (funcall comment-indent-hook) - (funcall comment-indent-function))) - (begpos (progn - (backward-char) - (point)))) - (if (/= begpos indent) - (progn - (skip-chars-backward " \t" (save-excursion - (beginning-of-line) - (point))) - (delete-region (point) begpos) - (indent-to indent))) - (looking-at comment-start-skip) ; Always true. - (goto-char (match-end 0)) - ;; I don't like the effect of the next two. - ;;(skip-chars-backward " \t" (match-beginning 0)) - ;;(skip-chars-backward "^ \t" (match-beginning 0)) - )) + (forward-char)) + (setq state (cdr result)))))) + +(defun tcl-comment-indent () + "Return the desired indentation, but be careful to add a `;' if needed." + (save-excursion + ;; If line is not blank, make sure we insert a ";" first. + (skip-chars-backward " \t") + (unless (or (bolp) (tcl-real-command-p)) + (insert ";") + ;; Try and erase a non-significant char to keep charpos identical. + (if (memq (char-after) '(?\t ?\ )) (delete-char 1)))) + (funcall (default-value 'comment-indent-function))) ;; The following was inspired by the Tcl editing mode written by ;; Gregor Schmid . His version also ;; attempts to snarf the command line options from the command line, ;; but I didn't think that would really be that helpful (doesn't seem -;; like it owould be right enough. His version also looks for the +;; like it would be right enough. His version also looks for the ;; "#!/bin/csh ... exec" hack, but that seemed even less useful. ;; FIXME should make sure that the application mentioned actually ;; exists. @@ -1864,45 +1456,22 @@ Parts of this were taken from indent-for-comment (simple.el)." The first line is assumed to look like \"#!.../program ...\"." (save-excursion (goto-char (point-min)) - (if (looking-at "#![^ \t]*/\\([^ \t/]+\\)\\([ \t]\\|$\\)") - (progn - (make-local-variable 'tcl-application) - (setq tcl-application (buffer-substring (match-beginning 1) - (match-end 1))))))) - -;; This only exists to put on the menubar. I couldn't figure out any -;; other way to do it. FIXME should take "number of #-marks" -;; argument. -(defun tcl-uncomment-region (beg end) - "Uncomment region." - (interactive "r") - (comment-region beg end -1)) + (if (looking-at "#![^ \t]*/\\([^ \t\n/]+\\)\\([ \t]\\|$\\)") + (set (make-local-variable 'tcl-application) (match-string 1))))) ;; -;; Lucid menu support. +;; XEmacs menu support. ;; Taken from schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid), ;; who wrote a different Tcl mode. -;; We also have support for menus in FSF. We do this by -;; loading the Lucid menu emulation code. +;; We also have support for menus in Emacs. We do this by +;; loading the XEmacs menu emulation code. ;; (defun tcl-popup-menu (e) (interactive "@e") - (and tcl-using-emacs-19 - (not tcl-using-lemacs-19) - (if tcl-using-emacs-19.23 - (require 'lmenu) - ;; CAVEATS: - ;; * lmenu.el provides 'menubar, which is bogus. - ;; * lmenu.el causes menubars to be turned on everywhere. - ;; Doubly bogus! - ;; Both of these problems are fixed in Emacs 19.23. People - ;; using an Emacs before that just suffer. - (require 'menubar "lmenu"))) ;; This is annoying - ;; IMHO popup-menu should be autoloaded in FSF Emacs. Oh well. - (popup-menu tcl-lucid-menu)) + (popup-menu tcl-mode-menu)) @@ -1914,55 +1483,29 @@ The first line is assumed to look like \"#!.../program ...\"." ;; of expansion or splitting. Tcl quoting sure sucks. (defun tcl-quote (string) "Quote STRING according to Tcl rules." - (mapconcat (function (lambda (char) - (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ? ?\;)) - (concat "\\" (char-to-string char)) - (char-to-string char)))) + (mapconcat (lambda (char) + (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ? ?\;)) + (concat "\\" (char-to-string char)) + (char-to-string char))) string "")) - - ;; ;; Bug reporting. ;; - -(and (fboundp 'eval-when-compile) - (eval-when-compile - (require 'reporter))) - -(defun tcl-submit-bug-report () - "Submit via mail a bug report on Tcl mode." - (interactive) - (require 'reporter) - (and - (y-or-n-p "Do you really want to submit a bug report on Tcl mode? ") - (reporter-submit-bug-report - tcl-maintainer - (concat "Tcl mode " tcl-version) - '(tcl-indent-level - tcl-continued-indent-level - tcl-auto-newline - tcl-tab-always-indent - tcl-use-hairy-comment-detector - tcl-electric-has-style - tcl-help-directory-list - tcl-use-smart-word-finder - tcl-application - tcl-command-switches - tcl-prompt-regexp - inferior-tcl-source-command - tcl-using-emacs-19 - tcl-using-emacs-19.23 - tcl-using-lemacs-19 - tcl-proc-list - tcl-proc-regexp - tcl-typeword-list - tcl-keyword-list - tcl-font-lock-keywords - tcl-pps-has-arg-6)))) - +;; These are relics kept "just in case". +(defalias 'tcl-uncomment-region 'uncomment-region) +(defalias 'tcl-indent-for-comment 'comment-indent) +(defalias 'add-log-tcl-defun 'tcl-add-log-defun) +(defalias 'indent-tcl-exp 'tcl-indent-exp) +(defalias 'calculate-tcl-indent 'tcl-calculate-indent) +(defalias 'tcl-beginning-of-defun 'beginning-of-defun) +(defalias 'tcl-end-of-defun 'end-of-defun) +(defalias 'tcl-mark-defun 'mark-defun) +(defun tcl-mark () (mark t)) + (provide 'tcl) +;;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d ;;; tcl.el ends here