;;; 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
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;; BEFORE USE:
;;
;;
(defgroup tcl nil
- "Major mode for editing Tcl source in Emacs"
+ "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)
+ :type 'integer
+ :group 'tcl)
(defcustom tcl-continued-indent-level 4
"*Indentation of continuation line relative to first line of command."
- :type 'integer)
+ :type 'integer
+ :group 'tcl)
(defcustom tcl-auto-newline nil
"*Non-nil means automatically newline before and after braces you insert."
- :type 'boolean)
+ :type 'boolean
+ :group 'tcl)
(defcustom tcl-tab-always-indent tab-always-indent
"*Control effect of TAB key.
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)))
+ (const :tag "Maybe move or make or delete comment" 'tcl))
+ :group 'tcl)
(defcustom tcl-electric-hash-style nil ;; 'smart
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 nil."
- :type '(choice (const backslash) (const quote) (const smart) (const nil)))
+ :type '(choice (const backslash) (const quote) (const smart) (const nil))
+ :group 'tcl)
(defcustom tcl-help-directory-list nil
"*List of topmost directories containing TclX help files."
- :type '(repeat directory))
+ :type '(repeat directory)
+ :group 'tcl)
(defcustom tcl-use-smart-word-finder t
"*If not nil, use smart way to find current word, for Tcl help feature."
- :type 'boolean)
+ :type 'boolean
+ :group 'tcl)
(defcustom tcl-application "wish"
"*Name of Tcl program to run in inferior Tcl mode."
- :type 'string)
+ :type 'string
+ :group 'tcl)
(defcustom tcl-command-switches nil
"*List of switches to supply to the `tcl-application' program."
- :type '(repeat string))
+ :type '(repeat string)
+ :group 'tcl)
(defcustom tcl-prompt-regexp "^\\(% \\|\\)"
"*If not nil, a regexp that will match the prompt in the inferior process.
The default is \"^\\(% \\|\\)\", which will match the default primary
and secondary prompts for tclsh and wish."
- :type 'regexp)
+ :type 'regexp
+ :group 'tcl)
(defcustom inferior-tcl-source-command "source %s\n"
"*Format-string for building a Tcl command to load a file.
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."
- :type 'string)
+ :type 'string
+ :group 'tcl)
(defface tcl-escaped-newline '((t :inherit font-lock-string-face))
"Face used for (non-escaped) backslash at end of a line in Tcl mode."
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.
(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))
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*"))
(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))))
+ (if (memq (char-after) '(?\t ?\s)) (delete-char 1))))
(funcall (default-value 'comment-indent-function)))
;; The following was inspired by the Tcl editing mode written by
(defun tcl-quote (string)
"Quote STRING according to Tcl rules."
(mapconcat (lambda (char)
- (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ? ?\;))
+ (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ?\s ?\;))
(concat "\\" (char-to-string char))
(char-to-string char)))
string ""))