]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/tcl.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / progmodes / tcl.el
index 2669369645fe55b3a682a2e554b07a1c0edeacc7..f0c4950616159a045f014ac80ce3421a6c97f171 100644 (file)
@@ -1,6 +1,6 @@
 ;;; tcl.el --- Tcl code editing commands for Emacs
 
-;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
 ;;           Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -21,9 +21,7 @@
 ;; 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;; BEFORE USE:
 ;;
 
 (defgroup tcl nil
   "Major mode for editing Tcl source in Emacs."
+  :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
   :group 'languages)
 
 (defcustom tcl-indent-level 4
   "*Indentation of Tcl statements with respect to containing block."
   :type 'integer
   :group 'tcl)
+(put 'tcl-indent-level 'safe-local-variable 'integerp)
 
 (defcustom tcl-continued-indent-level 4
   "*Indentation of continuation line relative to first line of command."
   :type 'integer
   :group 'tcl)
+(put 'tcl-continued-indent-level 'safe-local-variable 'integerp)
 
 (defcustom tcl-auto-newline nil
   "*Non-nil means automatically newline before and after braces you insert."
@@ -681,16 +682,9 @@ from the following list to take place:
   5. Create an empty comment.
   6. Move backward to start of comment, indenting if necessary."
   (interactive "p")
-  (cond
-   ((not tcl-tab-always-indent)
-    ;; Indent if in indentation area, otherwise insert TAB.
-    (if (<= (current-column) (current-indentation))
-       (tcl-indent-line)
-      (insert-tab arg)))
-   ((eq tcl-tab-always-indent t)
-    ;; Always indent.
-    (tcl-indent-line))
-   (t
+  (if (memq tcl-tab-always-indent '(nil t))
+      (let ((tab-always-indent tcl-tab-always-indent))
+        (call-interactively 'indent-for-tab-command))
     ;; "Perl-mode" style TAB command.
     (let* ((ipoint (point))
           (eolpoint (progn
@@ -729,7 +723,7 @@ from the following list to take place:
        ;; Go to start of comment.  We don't leave point where it is
        ;; because we want to skip comment-start-skip.
        (tcl-indent-line)
-       (indent-for-comment)))))))
+       (indent-for-comment))))))
 
 (defun tcl-indent-line ()
   "Indent current line as Tcl code.
@@ -738,29 +732,28 @@ Return the amount the indentation changed by."
        beg shift-amt
        (case-fold-search nil)
        (pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-          (setq indent (current-indentation)))
-         (t
-          (skip-chars-forward " \t")
-          (if (listp indent) (setq indent (car indent)))
-          (cond ((= (following-char) ?})
-                 (setq indent (- indent tcl-indent-level)))
-                ((= (following-char) ?\])
-                 (setq indent (- indent 1))))))
-    (skip-chars-forward " \t")
-    (setq shift-amt (- indent (current-column)))
-    (if (zerop shift-amt)
-       (if (> (- (point-max) pos) (point))
-           (goto-char (- (point-max) pos)))
-      (delete-region beg (point))
-      (indent-to indent)
-      ;; If initial point was within line's indentation,
-      ;; position after the indentation.  Else stay at same point in text.
-      (if (> (- (point-max) pos) (point))
-         (goto-char (- (point-max) pos))))
-    shift-amt))
+    (if (null indent)
+        'noindent
+      (beginning-of-line)
+      (setq beg (point))
+      (skip-chars-forward " \t")
+      (if (listp indent) (setq indent (car indent)))
+      (cond ((= (following-char) ?})
+             (setq indent (- indent tcl-indent-level)))
+            ((= (following-char) ?\])
+             (setq indent (- indent 1))))
+      (skip-chars-forward " \t")
+      (setq shift-amt (- indent (current-column)))
+      (if (zerop shift-amt)
+          (if (> (- (point-max) pos) (point))
+              (goto-char (- (point-max) pos)))
+        (delete-region beg (point))
+        (indent-to indent)
+        ;; If initial point was within line's indentation,
+        ;; position after the indentation.  Else stay at same point in text.
+        (if (> (- (point-max) pos) (point))
+            (goto-char (- (point-max) pos))))
+      shift-amt)))
 
 (defun tcl-figure-type ()
   "Determine type of sexp at point.
@@ -1049,7 +1042,7 @@ Returns nil if line starts inside a string, t if in a comment."
 (defun tcl-send-string (proc string)
   (with-current-buffer (process-buffer proc)
     (goto-char (process-mark proc))
-    (beginning-of-line)
+    (forward-line 0)             ;Not (beginning-of-line) because of fields.
     (if (looking-at comint-prompt-regexp)
        (set-marker inferior-tcl-delete-prompt-marker (point))))
   (comint-send-string proc string))
@@ -1057,7 +1050,7 @@ Returns nil if line starts inside a string, t if in a comment."
 (defun tcl-send-region (proc start end)
   (with-current-buffer (process-buffer proc)
     (goto-char (process-mark proc))
-    (beginning-of-line)
+    (forward-line 0)             ;Not (beginning-of-line) because of fields.
     (if (looking-at comint-prompt-regexp)
        (set-marker inferior-tcl-delete-prompt-marker (point))))
   (comint-send-region proc start end))
@@ -1087,7 +1080,11 @@ See variable `inferior-tcl-buffer'."
 Prefix argument means switch to the Tcl buffer afterwards."
   (interactive "r\nP")
   (let ((proc (inferior-tcl-proc)))
-    (tcl-send-region proc start end)
+    (tcl-send-region
+     proc
+     ;; Strip leading and trailing whitespace.
+     (save-excursion (goto-char start) (skip-chars-forward " \t\n") (point))
+     (save-excursion (goto-char end) (skip-chars-backward " \t\n") (point)))
     (tcl-send-string proc "\n")
     (if and-go (switch-to-tcl t))))
 
@@ -1156,7 +1153,12 @@ See documentation for function `inferior-tcl-mode' for more information."
   (unless (comint-check-proc "*inferior-tcl*")
     (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil
                       tcl-command-switches))
-    (inferior-tcl-mode))
+    (inferior-tcl-mode)
+    ;; Make tclsh display a prompt on ms-windows (or under Unix, when a tty
+    ;; wasn't used).  Doesn't affect wish, unfortunately.
+    (unless (process-tty-name (inferior-tcl-proc))
+      (tcl-send-string (inferior-tcl-proc)
+                       "set ::tcl_interactive 1; concat\n")))
   (set (make-local-variable 'tcl-application) cmd)
   (setq inferior-tcl-buffer "*inferior-tcl*")
   (pop-to-buffer "*inferior-tcl*"))