X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b14d552b33dcf0a2b85d91e7b385a07585a141b4..58635e4de85621d4f16befe15b1df44a637bd078:/lisp/progmodes/tcl.el diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index f9fd7beffd..eb25467646 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1,7 +1,6 @@ ;;; tcl.el --- Tcl code editing commands for Emacs -;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 -;; Free Software Foundation, Inc. +;; Copyright (C) 1994, 1998-2011 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Author: Tom Tromey @@ -10,10 +9,10 @@ ;; 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 3, 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 +20,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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;; BEFORE USE: ;; @@ -413,9 +410,10 @@ 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 "."))) +(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 @@ -547,7 +545,7 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'." ;; ;;;###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. @@ -573,10 +571,7 @@ documentation for details): 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)) @@ -595,9 +590,9 @@ Commands: (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) @@ -608,15 +603,11 @@ Commands: (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) @@ -636,7 +627,7 @@ Commands: ;; 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)))) @@ -660,7 +651,7 @@ Commands: ;; 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)))) @@ -1031,14 +1022,12 @@ Returns nil if line starts inside a string, t if in a comment." (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) @@ -1071,7 +1060,7 @@ With argument, positions cursor at end of buffer." (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 @@ -1204,15 +1193,10 @@ semicolon, opening brace, or opening bracket on the same line." "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)) @@ -1299,7 +1283,7 @@ to update the alist.") 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. @@ -1375,7 +1359,7 @@ Prefix argument means switch to the Tcl buffer afterwards." ;; 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)) @@ -1395,12 +1379,12 @@ Prefix argument means switch to the Tcl buffer afterwards." (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)))) @@ -1560,5 +1544,4 @@ The first line is assumed to look like \"#!.../program ...\"." (provide 'tcl) -;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d ;;; tcl.el ends here