;;; tcl.el --- Tcl code editing commands for Emacs
-;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Author: Tom Tromey <tromey@redhat.com>
;; 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
;; 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."
`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 ".")))
+(defconst tcl-syntax-propertize-function
+ (syntax-propertize-rules
+ ;; 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
;;
;;;###autoload
-(define-derived-mode tcl-mode nil "Tcl"
+(define-derived-mode tcl-mode prog-mode "Tcl"
"Major mode for editing Tcl code.
Expression and list commands understand all Tcl brackets.
Tab indents for Tcl code.
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}"
+already exist."
(unless (and (boundp 'filladapt-mode) filladapt-mode)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t))
(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)))
+ '(tcl-font-lock-keywords nil nil nil beginning-of-defun))
+ (set (make-local-variable 'syntax-propertize-function)
+ tcl-syntax-propertize-function)
(set (make-local-variable 'imenu-generic-expression)
tcl-imenu-generic-expression)
(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)
;; Indent line first; this looks better if parens blink.
(tcl-indent-line)
(self-insert-command arg)
- (if (and tcl-auto-newline (= last-command-char ?\;))
+ (if (and tcl-auto-newline (= last-command-event ?\;))
(progn
(newline)
(tcl-indent-line))))
;; In auto-newline case, must insert a newline after each
;; brace. So an explicit loop is needed.
(while (> arg 0)
- (insert last-command-char)
+ (insert last-command-event)
(tcl-indent-line)
(newline)
(setq arg (1- arg))))
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
;; 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.
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.
(defvar inferior-tcl-delete-prompt-marker nil)
(defun tcl-filter (proc string)
- (let ((inhibit-quit t))
+ (let ((inhibit-quit t)) ;FIXME: Isn't that redundant?
(with-current-buffer (process-buffer proc)
- (goto-char (process-mark proc))
;; Delete prompt if requested.
- (if (marker-buffer inferior-tcl-delete-prompt-marker)
- (progn
- (delete-region (point) inferior-tcl-delete-prompt-marker)
- (set-marker inferior-tcl-delete-prompt-marker nil)))))
+ (when (marker-buffer inferior-tcl-delete-prompt-marker)
+ (delete-region (process-mark proc) inferior-tcl-delete-prompt-marker)
+ (set-marker inferior-tcl-delete-prompt-marker nil))))
(comint-output-filter proc string))
(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))
(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))
(defun inferior-tcl-proc ()
"Return current inferior Tcl process.
See variable `inferior-tcl-buffer'."
- (let ((proc (get-buffer-process (if (eq major-mode 'inferior-tcl-mode)
+ (let ((proc (get-buffer-process (if (derived-mode-p 'inferior-tcl-mode)
(current-buffer)
inferior-tcl-buffer))))
(or proc
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))))
(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*"))
"Determine if point is in a comment.
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.
-
-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."
+t otherwise. If in comment, leaves point at beginning of comment."
(let ((bol (save-excursion
(goto-char end)
- (beginning-of-line)
- (point)))
+ (line-beginning-position)))
real-comment
last-cstart)
(while (and (not last-cstart) (< (point) end))
If FLAG is nil, just uses `current-word'.
Otherwise scans backward for most likely Tcl command word."
(if (and flag
- (memq major-mode '(tcl-mode inferior-tcl-mode)))
+ (derived-mode-p 'tcl-mode 'inferior-tcl-mode))
(condition-case nil
(save-excursion
;; Look backward for first word actually in alist.
;; filename.
(car (comint-get-source "Load Tcl file: "
(or (and
- (eq major-mode 'tcl-mode)
+ (derived-mode-p 'tcl-mode)
(buffer-file-name))
tcl-previous-dir/file)
'(tcl-mode) t))
(list
(car (comint-get-source "Restart with Tcl file: "
(or (and
- (eq major-mode 'tcl-mode)
+ (derived-mode-p 'tcl-mode)
(buffer-file-name))
tcl-previous-dir/file)
'(tcl-mode) t))
current-prefix-arg))
- (let* ((buf (if (eq major-mode 'inferior-tcl-mode)
+ (let* ((buf (if (derived-mode-p 'inferior-tcl-mode)
(current-buffer)
inferior-tcl-buffer))
(proc (and buf (get-process buf))))
(provide 'tcl)
-;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d
;;; tcl.el ends here