Merge from mainline.

[gnu-emacs] / lisp / progmodes / tcl.el

diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index f0c4950616159a045f014ac80ce3421a6c97f171..eb254676469f4040a33522f37e8b6fb0aaaf4fea 100644 (file)
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1,7 +1,6 @@
 ;;; tcl.el --- Tcl code editing commands for Emacs
 
 ;;; tcl.el --- Tcl code editing commands for Emacs
 

-;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-;;           Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1998-2011  Free Software Foundation, Inc.

 
 ;; Maintainer: FSF
 ;; Author: Tom Tromey <tromey@redhat.com>
 
 ;; Maintainer: FSF
 ;; Author: Tom Tromey <tromey@redhat.com>


@@ -411,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'.")
 
 `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
   "Syntactic keywords for `tcl-mode'.")
 
 ;; FIXME need some way to recognize variables because array refs look


@@ -545,7 +545,7 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
 ;;
 
 ;;;###autoload
 ;;
 
 ;;;###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.
   "Major mode for editing Tcl code.
 Expression and list commands understand all Tcl brackets.
 Tab indents for Tcl code.


@@ -571,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
 
 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))
 
   (unless (and (boundp 'filladapt-mode) filladapt-mode)
     (set (make-local-variable 'paragraph-ignore-fill-prefix) t))
 


@@ -593,9 +590,9 @@ Commands:
   (set (make-local-variable 'outline-level) 'tcl-outline-level)
 
   (set (make-local-variable 'font-lock-defaults)
   (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 'imenu-generic-expression)
        tcl-imenu-generic-expression)


@@ -606,15 +603,11 @@ Commands:
   (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "[$!]")
   (set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|\\s_")
 
   (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)
   (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)
 
   (set (make-local-variable 'add-log-current-defun-function)
        'tcl-add-log-defun)
 


@@ -634,7 +627,7 @@ Commands:
   ;; Indent line first; this looks better if parens blink.
   (tcl-indent-line)
   (self-insert-command arg)
   ;; 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))))
       (progn
        (newline)
        (tcl-indent-line))))


@@ -658,7 +651,7 @@ Commands:
        ;; In auto-newline case, must insert a newline after each
        ;; brace.  So an explicit loop is needed.
        (while (> arg 0)
        ;; 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))))
          (tcl-indent-line)
          (newline)
          (setq arg (1- arg))))


@@ -1029,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)
 (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)
     (with-current-buffer (process-buffer proc)

-      (goto-char (process-mark proc))

       ;; Delete prompt if requested.
       ;; 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)
   (comint-output-filter proc string))
 
 (defun tcl-send-string (proc string)


@@ -1069,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'."
 (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
                                      (current-buffer)
                                    inferior-tcl-buffer))))
     (or proc


@@ -1202,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,
   "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)
   (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))
        real-comment
        last-cstart)
     (while (and (not last-cstart) (< (point) end))


@@ -1297,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
 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.
       (condition-case nil
          (save-excursion
            ;; Look backward for first word actually in alist.


@@ -1373,7 +1359,7 @@ Prefix argument means switch to the Tcl buffer afterwards."
     ;; filename.
     (car (comint-get-source "Load Tcl file: "
                            (or (and
     ;; 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))
                                 (buffer-file-name))
                                tcl-previous-dir/file)
                            '(tcl-mode) t))


@@ -1393,12 +1379,12 @@ Prefix argument means switch to the Tcl buffer afterwards."
    (list
     (car (comint-get-source "Restart with Tcl file: "
                            (or (and
    (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))
                                 (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))))
                  (current-buffer)
                inferior-tcl-buffer))
         (proc (and buf (get-process buf))))


@@ -1558,5 +1544,4 @@ The first line is assumed to look like \"#!.../program ...\"."
 
 (provide 'tcl)
 
 
 (provide 'tcl)
 

-;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d

 ;;; tcl.el ends here
 ;;; tcl.el ends here