X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9ad79cb4276d2dd2cad8f34d9c2f2128461bac7a..4f124fb5287c38e0f8e507a2b8a5edd4d0cfb42c:/lisp/progmodes/tcl.el diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 2166af583d..6965dea9fc 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1,12 +1,11 @@ ;;; tcl.el --- Tcl code editing commands for Emacs -;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1994,98,1999,2000,01,02,2003,2004 Free Software Foundation, Inc. -;; Maintainer: Tom Tromey +;; Maintainer: FSF ;; Author: Tom Tromey ;; Chris Lindblad ;; Keywords: languages tcl modes -;; Version: $Revision: 1.66 $ ;; This file is part of GNU Emacs. @@ -60,15 +59,16 @@ ;; Jesper Pedersen ;; dfarmer@evolving.com (Doug Farmer) ;; "Chris Alfeld" -;; Ben Wing +;; Ben Wing ;; 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: @@ -121,20 +121,17 @@ (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." - :group 'tcl :type 'integer) (defcustom tcl-auto-newline nil "*Non-nil means automatically newline before and after braces you insert." - :group 'tcl :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 @@ -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." - :group '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 -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." - :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." - :group 'tcl :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." - :group 'tcl :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." - :group 'tcl :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." - :group 'tcl :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'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'. @@ -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 - "If not `nil', debugging message will be printed during indentation.") + "If non-nil, debugging message will be printed during indentation.") -;; 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]+") @@ -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 Use regexp-quote? + ;; FIXME Use regexp-quote? (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)) + +(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'.") + ;; @@ -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-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. -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}" - (set (make-local-variable 'paragraph-start) "$\\| ") - (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) @@ -559,11 +535,11 @@ Commands: ;; (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 '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) @@ -571,9 +547,9 @@ Commands: (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) @@ -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) - (continued-line + (continued-line (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 - this-indent last-sexp continued-line + this-indent continued-line (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)) - (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)) @@ -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))) - (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)) - (setcar contain-stack + (setcar contain-stack (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) ?\\))) @@ -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) - (= (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))) - (indent-to - (if continued-line + (indent-to + (if continued-line (+ 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. ;; -(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. @@ -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. -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. @@ -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))) - (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*") - (switch-to-buffer "*inferior-tcl*")) + (pop-to-buffer "*inferior-tcl*")) (defalias 'run-tcl 'inferior-tcl) @@ -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)))) -(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 (and (looking-at "^[ \t]*#[ \t]*[^ \t\n]") - (not (bobp))) - (forward-line -1)) - (setq p-start (point))) - - ;; Search forwards. - (save-excursion - (while (looking-at "^[ \t]*#[ \t]*[^ \t\n]") - (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))))))) - ;; @@ -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) - "Like `auto-fill-mode', but controls filling of Tcl comments." + "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'." (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. @@ -1618,4 +1507,5 @@ The first line is assumed to look like \"#!.../program ...\"." (provide 'tcl) +;;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d ;;; tcl.el ends here