(compilation-start): Move let-binding of

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

diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index cf43669a2cf8c7c90865556f594b701ed3cfbea0..6965dea9fc107d0e2b6d28105f9fd9a02b2df200 100644 (file)
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1,12 +1,11 @@
 ;;; tcl.el --- Tcl code editing commands for Emacs
 
 ;;; tcl.el --- Tcl code editing commands for Emacs
 

-;; Copyright (C) 1994, 1998, 1999, 2000, 2001  Free Software Foundation, Inc.
+;; Copyright (C) 1994,98,1999,2000,01,02,2003,2004  Free Software Foundation, Inc.

 
 

-;; Maintainer: Tom Tromey <tromey@busco.lanl.gov>
-;; Author: Tom Tromey <tromey@busco.lanl.gov>
+;; Maintainer: FSF
+;; Author: Tom Tromey <tromey@redhat.com>

 ;;    Chris Lindblad <cjl@lcs.mit.edu>
 ;; Keywords: languages tcl modes
 ;;    Chris Lindblad <cjl@lcs.mit.edu>
 ;; Keywords: languages tcl modes

-;; Version: $Revision: 1.64 $

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -60,15 +59,16 @@
 ;; Jesper Pedersen <blackie@imada.ou.dk>
 ;; dfarmer@evolving.com (Doug Farmer)
 ;; "Chris Alfeld" <calfeld@math.utah.edu>
 ;; Jesper Pedersen <blackie@imada.ou.dk>
 ;; dfarmer@evolving.com (Doug Farmer)
 ;; "Chris Alfeld" <calfeld@math.utah.edu>

-;; Ben Wing <wing@666.com>
+;; Ben Wing <ben@xemacs.org>

 
 ;; KNOWN BUGS:
 
 ;; KNOWN BUGS:

-;; * In Tcl "#" is not always a comment character.  This can confuse
-;;   tcl.el in certain circumstances.  For now the only workaround is
-;;   to enclose offending hash characters in quotes or precede it with
-;;   a backslash.  Note that using braces won't work -- quotes change
-;;   the syntax class of characters between them, while braces do not.
-;;   The electric-# mode helps alleviate this problem somewhat.
+;; * In Tcl "#" is not always a comment character.  This can confuse tcl.el
+;;   in certain circumstances.  For now the only workaround is to use
+;;   font-lock which will mark the # chars accordingly or enclose offending
+;;   hash characters in quotes or precede them with a backslash.  Note that
+;;   using braces won't work -- quotes change the syntax class of characters
+;;   between them, while braces do not.  If you don't use font-lock, the
+;;   electric-# mode helps alleviate this problem somewhat.

 ;; * indent-tcl-exp is untested.
 
 ;; TODO:
 ;; * indent-tcl-exp is untested.
 
 ;; TODO:


@@ -76,7 +76,7 @@
 ;;   middle of a defun, or between defuns.  should notice if point is
 ;;   on first line of defun (or maybe even in comments before defun).
 ;; * Allow continuation lines to be indented under the first argument
 ;;   middle of a defun, or between defuns.  should notice if point is
 ;;   on first line of defun (or maybe even in comments before defun).
 ;; * Allow continuation lines to be indented under the first argument

-;;   of the preceeding line, like this:
+;;   of the preceding line, like this:

 ;;      [list something \
 ;;            something-else]
 ;; * There is a request that indentation work like this:
 ;;      [list something \
 ;;            something-else]
 ;; * There is a request that indentation work like this:


@@ -121,20 +121,17 @@
 
 (defcustom tcl-indent-level 4
   "*Indentation of Tcl statements with respect to containing block."
 
 (defcustom tcl-indent-level 4
   "*Indentation of Tcl statements with respect to containing block."

-  :group 'tcl

   :type 'integer)
 
 (defcustom tcl-continued-indent-level 4
   "*Indentation of continuation line relative to first line of command."
   :type 'integer)
 
 (defcustom tcl-continued-indent-level 4
   "*Indentation of continuation line relative to first line of command."

-  :group 'tcl

   :type 'integer)
 
 (defcustom tcl-auto-newline nil
   "*Non-nil means automatically newline before and after braces you insert."
   :type 'integer)
 
 (defcustom tcl-auto-newline nil
   "*Non-nil means automatically newline before and after braces you insert."

-  :group 'tcl

   :type 'boolean)
 
   :type 'boolean)
 

-(defcustom tcl-tab-always-indent t
+(defcustom tcl-tab-always-indent tab-always-indent

   "*Control effect of TAB key.
 If t (the default), always indent current line.
 If nil and point is not in the indentation area at the beginning of
   "*Control effect of TAB key.
 If t (the default), always indent current line.
 If nil and point is not in the indentation area at the beginning of


@@ -148,41 +145,35 @@ to take place:
   4. Move forward to end of line, indenting if necessary.
   5. Create an empty comment.
   6. Move backward to start of comment, indenting if necessary."
   4. Move forward to end of line, indenting if necessary.
   5. Create an empty comment.
   6. Move backward to start of comment, indenting if necessary."

-  :group 'tcl

   :type '(choice (const :tag "Always" t)
                 (const :tag "Beginning only" nil)
                 (const :tag "Maybe move or make or delete comment" 'tcl)))
 
 
   :type '(choice (const :tag "Always" t)
                 (const :tag "Beginning only" nil)
                 (const :tag "Maybe move or make or delete comment" 'tcl)))
 
 

-(defcustom tcl-electric-hash-style 'smart
+(defcustom tcl-electric-hash-style nil ;; 'smart

   "*Style of electric hash insertion to use.
 Possible values are `backslash', meaning that `\\' quoting should be
 done; `quote', meaning that `\"' quoting should be done; `smart',
 meaning that the choice between `backslash' and `quote' should be
 made depending on the number of hashes inserted; or nil, meaning that
 no quoting should be done.  Any other value for this variable is
   "*Style of electric hash insertion to use.
 Possible values are `backslash', meaning that `\\' quoting should be
 done; `quote', meaning that `\"' quoting should be done; `smart',
 meaning that the choice between `backslash' and `quote' should be
 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 `smart'."
-  :group 'tcl
+taken to mean `smart'.  The default is nil."

   :type '(choice (const backslash) (const quote) (const smart) (const nil)))
 
 (defcustom tcl-help-directory-list nil
   "*List of topmost directories containing TclX help files."
   :type '(choice (const backslash) (const quote) (const smart) (const nil)))
 
 (defcustom tcl-help-directory-list nil
   "*List of topmost directories containing TclX help files."

-  :group 'tcl

   :type '(repeat directory))
 
 (defcustom tcl-use-smart-word-finder t
   "*If not nil, use smart way to find current word, for Tcl help feature."
   :type '(repeat directory))
 
 (defcustom tcl-use-smart-word-finder t
   "*If not nil, use smart way to find current word, for Tcl help feature."

-  :group 'tcl

   :type 'boolean)
 
 (defcustom tcl-application "wish"
   "*Name of Tcl program to run in inferior Tcl mode."
   :type 'boolean)
 
 (defcustom tcl-application "wish"
   "*Name of Tcl program to run in inferior Tcl mode."

-  :group 'tcl

   :type 'string)
 
 (defcustom tcl-command-switches nil
   "*List of switches to supply to the `tcl-application' program."
   :type 'string)
 
 (defcustom tcl-command-switches nil
   "*List of switches to supply to the `tcl-application' program."

-  :group 'tcl

   :type '(repeat string))
 
 (defcustom tcl-prompt-regexp "^\\(% \\|\\)"
   :type '(repeat string))
 
 (defcustom tcl-prompt-regexp "^\\(% \\|\\)"


@@ -191,7 +182,6 @@ If nil, the prompt is the name of the application with \">\" appended.
 
 The default is \"^\\(% \\|\\)\", which will match the default primary
 and secondary prompts for tclsh and wish."
 
 The default is \"^\\(% \\|\\)\", which will match the default primary
 and secondary prompts for tclsh and wish."

-  :group 'tcl

   :type 'regexp)
 
 (defcustom inferior-tcl-source-command "source %s\n"
   :type 'regexp)
 
 (defcustom inferior-tcl-source-command "source %s\n"


@@ -200,7 +190,6 @@ This format string should use `%s' to substitute a file name
 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."
 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."

-  :group 'tcl

   :type 'string)
 
 ;;
   :type 'string)
 
 ;;


@@ -317,7 +306,7 @@ have three inferior Lisps running:
 If you do a \\[tcl-eval-defun] command on some Lisp source code, what
 process do you send it to?
 
 If you do a \\[tcl-eval-defun] command on some Lisp source code, what
 process do you send it to?
 

-- If you're in a process buffer (foo, bar, or *inferior-tcl*), 
+- If you're in a process buffer (foo, bar, or *inferior-tcl*),

   you send it to that process.
 - If you're in some other buffer (e.g., a source file), you
   send it to the process attached to buffer `inferior-tcl-buffer'.
   you send it to that process.
 - If you're in some other buffer (e.g., a source file), you
   send it to the process attached to buffer `inferior-tcl-buffer'.


@@ -436,32 +425,20 @@ argument is ignored (for indentation purposes).  The second argument
 is a Tcl expression, and the last argument is Tcl commands.")
 
 (defvar tcl-explain-indentation nil
 is a Tcl expression, and the last argument is Tcl commands.")
 
 (defvar tcl-explain-indentation nil

-  "If not `nil', debugging message will be printed during indentation.")
+  "If non-nil, debugging message will be printed during indentation.")

 
 \f
 
 
 \f
 

-;; Its pretty bogus to have to do this, but there is no easier way to
-;; say "match not syntax-1 and not syntax-2".  Too bad you can't put
-;; \s in [...].  This sickness is used in Emacs 19 to match a defun
-;; starter.  (It is used for this in v18 as well).
-;;(defconst tcl-omit-ws-regexp
-;;  (concat "^\\(\\s"
-;;       (mapconcat 'char-to-string "w_.()\"\\$'/" "\\|\\s")
-;;       "\\)\\S(*")
-;;  "Regular expression that matches everything except space, comment
-;;starter, and comment ender syntax codes.")
-
-;; FIXME?  Instead of using the hairy regexp above, we just use a
-;; simple one.
-;;(defconst tcl-omit-ws-regexp "^[^] \t\n#}]\\S(*"
-;;  "Regular expression used in locating function definitions.")
-
-;; Here's another stab.  I think this one actually works.  Now the
-;; problem seems to be that there is a bug in Emacs 19.22 where
-;; end-of-defun doesn't really use the brace matching the one that
-;; trails defun-prompt-regexp.
-;; ?? Is there a bug now ??
-(defconst tcl-omit-ws-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+")
+;; Here's another stab.  I think this one actually works.
+;; We have to be careful that the open-brace following this regexp
+;; is indeed the one corresponding to the function's body so
+;; that end-of-defun works correctly.  Tricky cases are:
+;;    proc foo { {arg1 def} arg2 } {
+;; as well as
+;;    proc foo { \n {arg1 def} \n arg2 } {
+;; The current setting handles the first case properly but not the second.
+;; It also fails if `proc' is not in column-0 (e.g. it's in a namespace).
+(defconst tcl-omit-ws-regexp "^[^] \t\n#}].+[ \t]+")

 
 \f
 
 
 \f
 


@@ -493,7 +470,7 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
         ;; FIXME consider using "not word or symbol", not
         ;; "whitespace".
         (cons (concat "\\(\\s-\\|^\\)"
         ;; FIXME consider using "not word or symbol", not
         ;; "whitespace".
         (cons (concat "\\(\\s-\\|^\\)"

-                      ;; FIXME Use regexp-quote? 
+                      ;; FIXME Use regexp-quote?

                       (regexp-opt tcl-keyword-list t)
                       "\\(\\s-\\|$\\)")
               2))))
                       (regexp-opt tcl-keyword-list t)
                       "\\(\\s-\\|$\\)")
               2))))


@@ -506,6 +483,11 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
     ()
   (tcl-set-font-lock-keywords))
 
     ()
   (tcl-set-font-lock-keywords))
 

+
+(defvar tcl-imenu-generic-expression
+  `((nil ,(concat tcl-proc-regexp "\\([-A-Za-z0-9_:+*]+\\)") 2))
+  "Imenu generic expression for `tcl-mode'.  See `imenu-generic-expression'.")
+

 \f
 
 ;;
 \f
 
 ;;


@@ -533,24 +515,18 @@ documentation for details):
   `tcl-auto-newline'
     Non-nil means automatically newline before and after braces, brackets,
     and semicolons inserted in Tcl code.
   `tcl-auto-newline'
     Non-nil means automatically newline before and after braces, brackets,
     and semicolons inserted in Tcl code.

-  `tcl-electric-hash-style'
-    Controls action of `#' key.

   `tcl-use-smart-word-finder'
     If not nil, use a smarter, Tcl-specific way to find the current
     word when looking up help on a Tcl command.
 
   `tcl-use-smart-word-finder'
     If not nil, use a smarter, Tcl-specific way to find the current
     word when looking up help on a Tcl command.
 

-Turning on Tcl mode calls the value of the variable `tcl-mode-hook'
-with no args, if that value is non-nil.  Read the documentation for
+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}"
 `tcl-mode-hook' to see what kinds of interesting hook functions
 already exist.
 
 Commands:
 \\{tcl-mode-map}"

-  (set (make-local-variable 'paragraph-start) "$\\|\f")
-  (set (make-local-variable 'paragraph-separate) paragraph-start)
-
-  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
-  (set (make-local-variable 'fill-paragraph-function) 'tcl-do-fill-paragraph)
+  (unless (and (boundp 'filladapt-mode) filladapt-mode)
+    (set (make-local-variable 'paragraph-ignore-fill-prefix) t))

 
   (set (make-local-variable 'indent-line-function) 'tcl-indent-line)
   (set (make-local-variable 'comment-indent-function) 'tcl-comment-indent)
 
   (set (make-local-variable 'indent-line-function) 'tcl-indent-line)
   (set (make-local-variable 'comment-indent-function) 'tcl-comment-indent)


@@ -559,11 +535,11 @@ Commands:
   ;; (setq require-final-newline t)
 
   (set (make-local-variable 'comment-start) "# ")
   ;; (setq require-final-newline t)
 
   (set (make-local-variable 'comment-start) "# ")

-  (set (make-local-variable 'comment-start-skip) "#+ *")
-  (set (make-local-variable 'comment-column) 40) ;why?  -stef
+  (set (make-local-variable 'comment-start-skip)
+       "\\(\\(^\\|[;{[]\\)\\s-*\\)#+ *")

   (set (make-local-variable 'comment-end) "")
 
   (set (make-local-variable 'comment-end) "")
 

-  (set (make-local-variable 'outline-regexp) "[^\n\^M]")
+  (set (make-local-variable 'outline-regexp) ".")

   (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)


@@ -571,9 +547,9 @@ Commands:
         (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords)
         (parse-sexp-lookup-properties . t)))
 
         (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords)
         (parse-sexp-lookup-properties . t)))
 

-  (set (make-local-variable 'imenu-create-index-function)
-       'tcl-imenu-create-index-function)
-  
+  (set (make-local-variable 'imenu-generic-expression)
+       tcl-imenu-generic-expression)
+

   ;; Settings for new dabbrev code.
   (set (make-local-variable 'dabbrev-case-fold-search) nil)
   (set (make-local-variable 'dabbrev-case-replace) nil)
   ;; Settings for new dabbrev code.
   (set (make-local-variable 'dabbrev-case-fold-search) nil)
   (set (make-local-variable 'dabbrev-case-replace) nil)


@@ -789,7 +765,7 @@ Returns nil if line starts inside a string, t if in a comment."
     (beginning-of-line)
     (let* ((indent-point (point))
           (case-fold-search nil)
     (beginning-of-line)
     (let* ((indent-point (point))
           (case-fold-search nil)

-          (continued-line 
+          (continued-line

            (save-excursion
              (if (bobp)
                  nil
            (save-excursion
              (if (bobp)
                  nil


@@ -890,7 +866,7 @@ Returns nil if line starts inside a string, t if in a comment."
        (contain-stack (list (point)))
        (case-fold-search nil)
        outer-loop-done inner-loop-done state ostate
        (contain-stack (list (point)))
        (case-fold-search nil)
        outer-loop-done inner-loop-done state ostate

-       this-indent last-sexp continued-line
+       this-indent continued-line

        (next-depth 0)
        last-depth)
     (save-excursion
        (next-depth 0)
        last-depth)
     (save-excursion


@@ -910,9 +886,6 @@ Returns nil if line starts inside a string, t if in a comment."
          (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
                                          nil nil state))
          (setq next-depth (car state))
          (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
                                          nil nil state))
          (setq next-depth (car state))

-         (if (and (car (cdr (cdr state)))
-                  (>= (car (cdr (cdr state))) 0))
-             (setq last-sexp (car (cdr (cdr state)))))

          (if (or (nth 4 ostate))
              (tcl-indent-line))
          (if (or (nth 3 state))
          (if (or (nth 4 ostate))
              (tcl-indent-line))
          (if (or (nth 3 state))


@@ -929,21 +902,19 @@ Returns nil if line starts inside a string, t if in a comment."
            (setq indent-stack (cdr indent-stack)
                  contain-stack (cdr contain-stack)
                  last-depth (1- last-depth)))
            (setq indent-stack (cdr indent-stack)
                  contain-stack (cdr contain-stack)
                  last-depth (1- last-depth)))

-         (if (/= last-depth next-depth)
-             (setq last-sexp nil))

          ;; Add levels for any parens that were started in this line.
          (while (< last-depth next-depth)
            (setq indent-stack (cons nil indent-stack)
                  contain-stack (cons nil contain-stack)
                  last-depth (1+ last-depth)))
          (if (null (car contain-stack))
          ;; Add levels for any parens that were started in this line.
          (while (< last-depth next-depth)
            (setq indent-stack (cons nil indent-stack)
                  contain-stack (cons nil contain-stack)
                  last-depth (1+ last-depth)))
          (if (null (car contain-stack))

-             (setcar contain-stack 
+             (setcar contain-stack

                      (or (car (cdr state))
                          (save-excursion
                            (forward-sexp -1)
                            (point)))))
          (forward-line 1)
                      (or (car (cdr state))
                          (save-excursion
                            (forward-sexp -1)
                            (point)))))
          (forward-line 1)

-         (setq continued-line 
+         (setq continued-line

                (save-excursion
                  (backward-char)
                  (= (preceding-char) ?\\)))
                (save-excursion
                  (backward-char)
                  (= (preceding-char) ?\\)))


@@ -969,14 +940,14 @@ Returns nil if line starts inside a string, t if in a comment."
                   (setq this-indent (- this-indent 1))))
            ;; Put chosen indentation into effect.
            (or (null this-indent)
                   (setq this-indent (- this-indent 1))))
            ;; Put chosen indentation into effect.
            (or (null this-indent)

-               (= (current-column) 
-                  (if continued-line 
+               (= (current-column)
+                  (if continued-line

                       (+ this-indent tcl-indent-level)
                     this-indent))
                (progn
                  (delete-region (point) (progn (beginning-of-line) (point)))
                       (+ this-indent tcl-indent-level)
                     this-indent))
                (progn
                  (delete-region (point) (progn (beginning-of-line) (point)))

-                 (indent-to 
-                  (if continued-line 
+                 (indent-to
+                  (if continued-line

                       (+ this-indent tcl-indent-level)
                     this-indent)))))))))
   )
                       (+ this-indent tcl-indent-level)
                     this-indent)))))))))
   )


@@ -987,23 +958,6 @@ Returns nil if line starts inside a string, t if in a comment."
 ;; Interfaces to other packages.
 ;;
 
 ;; Interfaces to other packages.
 ;;
 

-(defun tcl-imenu-create-index-function ()
-  "Generate alist of indices for imenu."
-  (let ((re (concat tcl-proc-regexp "\\([^ \t\n{]+\\)"))
-       alist prev-pos)
-    (goto-char (point-min))
-    (imenu-progress-message prev-pos 0)
-    (save-match-data
-      (while (re-search-forward re nil t)
-       (imenu-progress-message prev-pos)
-       ;; Position on start of proc name, not beginning of line.
-       (setq alist (cons
-                    (cons (buffer-substring (match-beginning 2) (match-end 2))
-                          (match-beginning 2))
-                    alist))))
-    (imenu-progress-message prev-pos 100)
-    (nreverse alist)))
-

 ;; FIXME Definition of function is very ad-hoc.  Should use
 ;; beginning-of-defun.  Also has incestuous knowledge about the
 ;; format of tcl-proc-regexp.
 ;; FIXME Definition of function is very ad-hoc.  Should use
 ;; beginning-of-defun.  Also has incestuous knowledge about the
 ;; format of tcl-proc-regexp.


@@ -1108,7 +1062,7 @@ Prefix argument means switch to the Tcl buffer afterwards."
 (define-derived-mode inferior-tcl-mode comint-mode "Inferior Tcl"
   "Major mode for interacting with Tcl interpreter.
 
 (define-derived-mode inferior-tcl-mode comint-mode "Inferior Tcl"
   "Major mode for interacting with Tcl interpreter.
 

-A Tcl process can be started with M-x inferior-tcl.
+You can start a Tcl process with \\[inferior-tcl].

 
 Entry to this mode runs the normal hooks `comint-mode-hook' and
 `inferior-tcl-mode-hook', in that order.
 
 Entry to this mode runs the normal hooks `comint-mode-hook' and
 `inferior-tcl-mode-hook', in that order.


@@ -1150,15 +1104,13 @@ See documentation for function `inferior-tcl-mode' for more information."
    (list (if current-prefix-arg
             (read-string "Run Tcl: " tcl-application)
           tcl-application)))
    (list (if current-prefix-arg
             (read-string "Run Tcl: " tcl-application)
           tcl-application)))

-  (if (not (comint-check-proc "*inferior-tcl*"))
-      (progn
-       (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil
-                          tcl-command-switches))
-       (inferior-tcl-mode)))
-  (make-local-variable 'tcl-application)
-  (setq tcl-application cmd)
+  (unless (comint-check-proc "*inferior-tcl*")
+    (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil
+                      tcl-command-switches))
+    (inferior-tcl-mode))
+  (set (make-local-variable 'tcl-application) cmd)

   (setq inferior-tcl-buffer "*inferior-tcl*")
   (setq inferior-tcl-buffer "*inferior-tcl*")

-  (switch-to-buffer "*inferior-tcl*"))
+  (pop-to-buffer "*inferior-tcl*"))

 
 (defalias 'run-tcl 'inferior-tcl)
 
 
 (defalias 'run-tcl 'inferior-tcl)
 


@@ -1189,7 +1141,7 @@ first word following a semicolon, opening brace, or opening bracket."
   "Return t if point is just after the `#' beginning a real comment.
 Does not check to see if previous char is actually `#'.
 A real comment is either at the beginning of the buffer,
   "Return t if point is just after the `#' beginning a real comment.
 Does not check to see if previous char is actually `#'.
 A real comment is either at the beginning of the buffer,

-preceeded only by whitespace on the line, or has a preceeding
+preceded only by whitespace on the line, or has a preceding

 semicolon, opening brace, or opening bracket on the same line."
   (save-excursion
     (backward-char)
 semicolon, opening brace, or opening bracket on the same line."
   (save-excursion
     (backward-char)


@@ -1245,64 +1197,6 @@ simpler version that is often right, and works in Emacs 18."
     (beginning-of-defun)
     (car (tcl-hairy-scan-for-comment nil save nil))))
 
     (beginning-of-defun)
     (car (tcl-hairy-scan-for-comment nil save nil))))
 

-(defun tcl-do-fill-paragraph (ignore)
-  "fill-paragraph function for Tcl mode.  Only fills in a comment."
-  (let (in-comment col where)
-    (save-excursion
-      (end-of-line)
-      (setq in-comment (tcl-in-comment))
-      (if in-comment
-         (progn
-           (setq where (1+ (point)))
-           (setq col (1- (current-column))))))
-    (and in-comment
-        (save-excursion
-          (back-to-indentation)
-          (= col (current-column)))
-        ;; In a comment.  Set the fill prefix, and find the paragraph
-        ;; boundaries by searching for lines that look like
-        ;; comment-only lines.
-        (let ((fill-prefix (buffer-substring (progn
-                                               (beginning-of-line)
-                                               (point))
-                                             where))
-              p-start p-end)
-          ;; Search backwards.
-          (save-excursion
-            (while (looking-at "^[ \t]*#")
-              (forward-line -1))
-            (forward-line)
-            (setq p-start (point)))
-
-          ;; Search forwards.
-          (save-excursion
-            (while (looking-at "^[ \t]*#")
-              (forward-line))
-            (setq p-end (point)))
-
-          ;; Narrow and do the fill.
-          (save-restriction
-            (narrow-to-region p-start p-end)
-            (fill-paragraph ignore)))))
-  t)
-
-(defun tcl-do-auto-fill ()
-  "Auto-fill function for Tcl mode.  Only auto-fills in a comment."
-  (if (> (current-column) fill-column)
-      (let ((fill-prefix "# ")
-           in-comment col)
-       (save-excursion
-         (setq in-comment (tcl-in-comment))
-         (if in-comment
-             (setq col (1- (current-column)))))
-       (if in-comment
-           (progn
-             (do-auto-fill)
-             (save-excursion
-               (back-to-indentation)
-               (delete-region (point) (line-beginning-position))
-               (indent-to-column col)))))))
-

 \f
 
 ;;
 \f
 
 ;;


@@ -1478,17 +1372,12 @@ Prefix argument means switch to the Tcl buffer afterwards."
        (if and-go (switch-to-tcl t)))))))
 
 (defun tcl-auto-fill-mode (&optional arg)
        (if and-go (switch-to-tcl t)))))))
 
 (defun tcl-auto-fill-mode (&optional arg)

-  "Like `auto-fill-mode', but controls filling of Tcl comments."
+  "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'."

   (interactive "P")
   (interactive "P")

-  ;; Following code taken from "auto-fill-mode" (simple.el).
-  (prog1
-      (setq auto-fill-function
-           (if (if (null arg)
-                   (not auto-fill-function)
-                 (> (prefix-numeric-value arg) 0))
-               'tcl-do-auto-fill
-             nil))
-    (force-mode-line-update)))
+  (auto-fill-mode arg)
+  (if auto-fill-function
+      (set (make-local-variable 'comment-auto-fill-only-comments) t)
+    (kill-local-variable 'comment-auto-fill-only-comments)))

 
 (defun tcl-electric-hash (&optional count)
   "Insert a `#' and quote if it does not start a real comment.
 
 (defun tcl-electric-hash (&optional count)
   "Insert a `#' and quote if it does not start a real comment.


@@ -1618,4 +1507,5 @@ 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