Fixed menu support.
[bpt/emacs.git] / lisp / progmodes / tcl.el
index 0246648..b86de14 100644 (file)
@@ -6,7 +6,7 @@
 ;; Author: Tom Tromey <tromey@busco.lanl.gov>
 ;;    Chris Lindblad <cjl@lcs.mit.edu>
 ;; Keywords: languages tcl modes
-;; Version: $Revision: 1.4 $
+;; Version: $Revision: 1.7 $
 
 ;; This file is part of GNU Emacs.
 
 ;;   (setq auto-mode-alist (append '(("\\.tcl$" . tcl-mode)) auto-mode-alist))
 ;;
 ;; If you plan to use the interface to the TclX help files, you must
-;; set the variable tcl-help-directory to point to the topmost
-;; directory containing the TclX help files.  Eg:
+;; set the variable tcl-help-directory-list to point to the topmost
+;; directories containing the TclX help files.  Eg:
 ;;
-;;   (setq tcl-help-directory "/usr/local/lib/tclx/help")
+;;   (setq tcl-help-directory-list '("/usr/local/lib/tclx/help"))
 ;;
 ;; Also you will want to add the following to your .emacs:
 ;;
@@ -51,7 +51,7 @@
 ;; LCD Archive Entry:
 ;; tcl|Tom Tromey|tromey@busco.lanl.gov|
 ;; Major mode for editing Tcl|
-;; $Date: 1994/04/07 00:23:36 $|$Revision: 1.4 $|~/modes/tcl.el.Z|
+;; $Date: 1994/05/03 01:23:42 $|$Revision: 1.7 $|~/modes/tcl.el.Z|
 
 ;; CUSTOMIZATION NOTES:
 ;; * tcl-proc-list can be used to customize a list of things that
 ;; according to context.
 
 ;; Change log:
+;; $Log: tcl.el,v $
+; Revision 1.7  1994/05/03  01:23:42  tromey
+; *** empty log message ***
+;
+; Revision 1.6  1994/04/23  16:23:36  tromey
+; Wrote tcl-indent-for-comment
+;
+;;
 ;; 18-Mar-1994         Tom Tromey      Fourth beta release.
 ;;    Added {un,}comment-region to menu.  Idea from
 ;;    Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
 ;; * Trailing \ will eat blank lines.  Should deal with this.
 ;;   (this would help catch some potential bugs).
 ;; * Inferior should display in half the screen, not the whole screen.
+;; * Indentation should deal with "switch".
+;; * Consider writing code to find help files automatically (for
+;;   common cases).
+;; * M-; sometimes fails (try on "if [blah] then {")
+;; * `#' shouldn't insert `\#' in string.
+;; * Add bug-reporting code.
 
 \f
 
@@ -227,8 +241,8 @@ 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.")
 
-(defvar tcl-help-directory nil
-  "*Name of topmost directory containing TclX help files")
+(defvar tcl-help-directory-list nil
+  "*List of topmost directories containing TclX help files")
 
 (defvar tcl-use-smart-word-finder t
   "*If not nil, use a better way of finding the current word when
@@ -279,33 +293,6 @@ quoted for Tcl.")
 
 (defvar tcl-mode-map ()
   "Keymap used in Tcl mode.")
-(if tcl-mode-map
-    ()
-  (setq tcl-mode-map (make-sparse-keymap))
-  (define-key tcl-mode-map "{" 'tcl-electric-char)
-  (define-key tcl-mode-map "}" 'tcl-electric-brace)
-  (define-key tcl-mode-map "[" 'tcl-electric-char)
-  (define-key tcl-mode-map "]" 'tcl-electric-char)
-  (define-key tcl-mode-map ";" 'tcl-electric-char)
-  (define-key tcl-mode-map "#" 'tcl-electric-hash)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-h" 'mark-tcl-function)
-  (define-key tcl-mode-map "\e\C-q" 'indent-tcl-exp)
-  (define-key tcl-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key tcl-mode-map "\t" 'tcl-indent-command)
-  (define-key tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
-  (and (fboundp 'comment-region)
-       (define-key tcl-mode-map "\C-c\C-c" 'comment-region))
-  (define-key tcl-mode-map "\C-c\C-d" 'tcl-help-on-word)
-  (define-key tcl-mode-map "\C-c\C-e" 'tcl-eval-defun)
-  (define-key tcl-mode-map "\C-c\C-l" 'tcl-load-file)
-  (define-key tcl-mode-map "\C-c\C-p" 'inferior-tcl)
-  (define-key tcl-mode-map "\C-c\C-r" 'tcl-eval-region)
-  (define-key tcl-mode-map "\C-c\C-z" 'switch-to-tcl))
 
 (defvar tcl-mode-syntax-table nil
   "Syntax table in use in Tcl-mode buffers.")
@@ -337,21 +324,6 @@ quoted for Tcl.")
 
 (defvar inferior-tcl-mode-map nil
   "Keymap used in Inferior Tcl mode.")
-(if inferior-tcl-mode-map
-    ()
-  ;; FIXME Use keymap inheritance here?  FIXME we override comint
-  ;; keybindings here.  Maybe someone has a better set?
-  (setq inferior-tcl-mode-map (copy-keymap comint-mode-map))
-  (define-key inferior-tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
-  (define-key inferior-tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
-  (define-key inferior-tcl-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key inferior-tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
-  (define-key inferior-tcl-mode-map "\C-c\C-d" 'tcl-help-on-word)
-  (define-key inferior-tcl-mode-map "\C-c\C-e" 'tcl-eval-defun)
-  (define-key inferior-tcl-mode-map "\C-c\C-l" 'tcl-load-file)
-  (define-key inferior-tcl-mode-map "\C-c\C-p" 'inferior-tcl)
-  (define-key inferior-tcl-mode-map "\C-c\C-r" 'tcl-eval-region)
-  (define-key inferior-tcl-mode-map "\C-c\C-z" 'switch-to-tcl))
 
 ;; Lucid Emacs menu.
 (defvar tcl-lucid-menu
@@ -369,7 +341,77 @@ quoted for Tcl.")
     ["Send file to Tcl process" tcl-load-file t]
     ["Restart Tcl process with file" tcl-restart-with-file t]
     "----"
-    ["Tcl help" tcl-help-on-word t]))
+    ["Tcl help" tcl-help-on-word t])
+  "Lucid Emacs menu for Tcl mode.")
+
+;; GNU Emacs does menus via keymaps.  Do it in a function in case we
+;; later decide to add it to inferior Tcl mode as well.
+(defun tcl-add-fsf-menu (map)
+  (define-key map [menu-bar] (make-sparse-keymap))
+  (require 'lmenu)
+  (define-key map [menu-bar tcl]
+    (cons "Tcl" (make-lucid-menu-keymap "Tcl" tcl-lucid-menu))))
+
+(defun tcl-fill-mode-map ()
+  (define-key tcl-mode-map "{" 'tcl-electric-char)
+  (define-key tcl-mode-map "}" 'tcl-electric-brace)
+  (define-key tcl-mode-map "[" 'tcl-electric-char)
+  (define-key tcl-mode-map "]" 'tcl-electric-char)
+  (define-key tcl-mode-map ";" 'tcl-electric-char)
+  (define-key tcl-mode-map "#" 'tcl-electric-hash)
+  ;; FIXME.
+  (define-key tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
+  ;; FIXME.
+  (define-key tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
+  ;; FIXME.
+  (define-key tcl-mode-map "\e\C-h" 'mark-tcl-function)
+  (define-key tcl-mode-map "\e\C-q" 'indent-tcl-exp)
+  (define-key tcl-mode-map "\177" 'backward-delete-char-untabify)
+  (define-key tcl-mode-map "\t" 'tcl-indent-command)
+  (define-key tcl-mode-map "\M-;" 'tcl-indent-for-comment)
+  (define-key tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
+  (and (fboundp 'comment-region)
+       (define-key tcl-mode-map "\C-c\C-c" 'comment-region))
+  (define-key tcl-mode-map "\C-c\C-d" 'tcl-help-on-word)
+  (define-key tcl-mode-map "\C-c\C-e" 'tcl-eval-defun)
+  (define-key tcl-mode-map "\C-c\C-l" 'tcl-load-file)
+  (define-key tcl-mode-map "\C-c\C-p" 'inferior-tcl)
+  (define-key tcl-mode-map "\C-c\C-r" 'tcl-eval-region)
+  (define-key tcl-mode-map "\C-c\C-z" 'switch-to-tcl)
+
+  ;; Make menus.
+  (if tcl-using-emacs-19
+      (if tcl-using-lemacs-19
+         ;; In Lucid, button 3 seems to be the standard for this.
+         (define-key tcl-mode-map 'button3 'tcl-popup-menu)
+       ;; In FSF 19, there is no standard, so I use shift-button2.
+       (tcl-add-fsf-menu tcl-mode-map)
+       (define-key tcl-mode-map [S-down-mouse-2] 'tcl-popup-menu))))
+
+(defun tcl-fill-inferior-map ()
+  (define-key inferior-tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
+  (define-key inferior-tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
+  (define-key inferior-tcl-mode-map "\177" 'backward-delete-char-untabify)
+  (define-key inferior-tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
+  (define-key inferior-tcl-mode-map "\C-c\C-d" 'tcl-help-on-word)
+  (define-key inferior-tcl-mode-map "\C-c\C-e" 'tcl-eval-defun)
+  (define-key inferior-tcl-mode-map "\C-c\C-l" 'tcl-load-file)
+  (define-key inferior-tcl-mode-map "\C-c\C-p" 'inferior-tcl)
+  (define-key inferior-tcl-mode-map "\C-c\C-r" 'tcl-eval-region)
+  (define-key inferior-tcl-mode-map "\C-c\C-z" 'switch-to-tcl))
+
+(if tcl-mode-map
+    ()
+  (setq tcl-mode-map (make-sparse-keymap))
+  (tcl-fill-mode-map))
+
+(if inferior-tcl-mode-map
+    ()
+  ;; FIXME Use keymap inheritance here?  FIXME we override comint
+  ;; keybindings here.  Maybe someone has a better set?
+  (setq inferior-tcl-mode-map (copy-keymap comint-mode-map))
+  (tcl-fill-inferior-map))
+
 
 (defvar inferior-tcl-buffer nil
   "*The current inferior-tcl process buffer.
@@ -418,8 +460,6 @@ Several functions exist which are useful to run from your
 `tcl-mode-hook' (see each function's documentation for more
 information):
 
-  tcl-install-menubar
-    Puts a \"Tcl\" menu on the menubar.  Doesn't work in Emacs 18.
   tcl-guess-application
     Guesses a default setting for `tcl-application' based on any
     \"#!\" line at the top of the file.
@@ -454,7 +494,7 @@ after changing this list.")
 
 (defvar tcl-typeword-list
   '("global" "upvar")
-  "List of Tcl keywords deonting \"type\".  Used only for highlighting.
+  "List of Tcl keywords denoting \"type\".  Used only for highlighting.
 Call `tcl-set-font-lock-keywords' after changing this list.")
 
 ;; Generally I've picked control operators to be keywords.
@@ -702,17 +742,20 @@ Commands:
   (setq mode-name "Tcl")
   (setq local-abbrev-table tcl-mode-abbrev-table)
   (set-syntax-table tcl-mode-syntax-table)
+
   (make-local-variable 'paragraph-start)
   (setq paragraph-start (concat "^$\\|" page-delimiter))
   (make-local-variable 'paragraph-separate)
   (setq paragraph-separate paragraph-start)
   (make-local-variable 'paragraph-ignore-fill-prefix)
   (setq paragraph-ignore-fill-prefix t)
+
   (make-local-variable 'indent-line-function)
   (setq indent-line-function 'tcl-indent-line)
   ;; Tcl doesn't require a final newline.
   ;; (make-local-variable 'require-final-newline)
   ;; (setq require-final-newline t)
+
   (make-local-variable 'comment-start)
   (setq comment-start "# ")
   (make-local-variable 'comment-start-skip)
@@ -721,10 +764,12 @@ Commands:
   (setq comment-column 40)
   (make-local-variable 'comment-end)
   (setq comment-end "")
+
   (make-local-variable 'font-lock-keywords)
   (setq font-lock-keywords tcl-font-lock-keywords)
   (setq imenu-create-index-function 'tcl-imenu-create-index-function)
   (make-local-variable 'parse-sexp-ignore-comments)
+
   (if tcl-using-emacs-19
       (progn
        ;; This can only be set to t in Emacs 19 and Lucid Emacs.
@@ -740,6 +785,16 @@ Commands:
        (make-local-variable 'add-log-current-defun-function)
        (setq add-log-current-defun-function 'add-log-tcl-defun))
     (setq parse-sexp-ignore-comments nil))
+
+  ;; Put Tcl menu into menubar for Lucid Emacs.  This happens
+  ;; automatically for GNU Emacs.
+  (if (and tcl-using-lemacs-19
+          current-menubar
+          (not (assoc "Tcl" current-menubar)))
+      (progn
+       (set-buffer-menubar (copy-sequence current-menubar))
+       (add-menu nil "Tcl" tcl-lucid-menu)))
+
   (run-hooks 'tcl-mode-hook))
 
 \f
@@ -802,7 +857,7 @@ from the following list to take place:
   (interactive "p")
   (cond
    ((not tcl-tab-always-indent)
-    ;; Indent if in identation area, otherwise insert TAB.
+    ;; Indent if in indentation area, otherwise insert TAB.
     (if (<= (current-column) (current-indentation))
        (tcl-indent-line)
       (self-insert-command arg)))
@@ -846,17 +901,8 @@ from the following list to take place:
        (goto-char eolpoint)
        (tcl-indent-line))
        ((not comment-p)
-       ;; Create an empty comment (since there isn't one on this
-       ;; line).  If line is not blank, make sure we insert a ";"
-       ;; first.
-       (beginning-of-line)
-       (if (/= (point) eolpoint)
-           (progn
-             (goto-char eolpoint)
-             (or (tcl-real-command-p)
-                 (insert ";"))))
        (tcl-indent-line)
-       (indent-for-comment))
+       (tcl-indent-for-comment))
        (t
        ;; Go to start of comment.  We don't leave point where it is
        ;; because we want to skip comment-start-skip.
@@ -1157,6 +1203,8 @@ Returns nil if line starts inside a string, t if in a comment."
 ;; Interfaces to other packages.
 ;;
 
+(autoload 'imenu-progress-message "imenu" "" nil 'macro)
+
 (defun tcl-imenu-create-index-function ()
   "Generate alist of indices for imenu."
   (let ((re (concat tcl-proc-regexp "\\([^ \t\n{]+\\)"))
@@ -1468,42 +1516,43 @@ of comment."
 ;; Help-related code.
 ;;
 
-(defvar tcl-help-saved-dir nil
-  "Saved help directory.  If `tcl-help-directory' changes, this allows
-tcl-help-on-word to update the alist")
+(defvar tcl-help-saved-dirs nil
+  "Saved help directories.
+If `tcl-help-directory-list' changes, this allows `tcl-help-on-word'
+to update the alist.")
 
 (defvar tcl-help-alist nil
   "Alist with command names as keys and filenames as values.")
 
-(defun tcl-help-snarf-commands (dir)
-  "Build alist of commands and filenames.  There is probably a much
-better implementation of this, but I'm too tired to think of it right
-now."
-  (let ((files (directory-files dir t)))
-    (while files
-      (if (and (file-directory-p (car files))
-              (not
-               (let ((fpart (file-name-nondirectory (car files))))
-                 (or (equal fpart ".")
-                     (equal fpart "..")))))
-         (let ((matches (directory-files (car files) t)))
-           (while matches
-             (or (file-directory-p (car matches))
-                 (setq tcl-help-alist
-                       (cons
-                        (cons (file-name-nondirectory (car matches))
-                              (car matches))
-                        tcl-help-alist)))
-             (setq matches (cdr matches)))))
-      (setq files (cdr files)))))
+(defun tcl-help-snarf-commands (dirlist)
+  "Build alist of commands and filenames."
+  (while dirlist
+    (let ((files (directory-files (car dirlist) t)))
+      (while files
+       (if (and (file-directory-p (car files))
+                (not
+                 (let ((fpart (file-name-nondirectory (car files))))
+                   (or (equal fpart ".")
+                       (equal fpart "..")))))
+           (let ((matches (directory-files (car files) t)))
+             (while matches
+               (or (file-directory-p (car matches))
+                   (setq tcl-help-alist
+                         (cons
+                          (cons (file-name-nondirectory (car matches))
+                                (car matches))
+                          tcl-help-alist)))
+               (setq matches (cdr matches)))))
+       (setq files (cdr files))))
+    (setq dirlist (cdr dirlist))))
 
 (defun tcl-reread-help-files ()
   "Set up to re-read files, and then do it."
   (interactive)
   (message "Building Tcl help file index...")
-  (setq tcl-help-saved-dir tcl-help-directory)
+  (setq tcl-help-saved-dirs tcl-help-directory-list)
   (setq tcl-help-alist nil)
-  (tcl-help-snarf-commands tcl-help-directory)
+  (tcl-help-snarf-commands tcl-help-directory-list)
   (message "Building Tcl help file index...done"))
 
 (defun tcl-current-word (flag)
@@ -1530,7 +1579,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'."
   (interactive
    (list
     (progn
-      (if (not (string= tcl-help-directory tcl-help-saved-dir))
+      (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
          (tcl-reread-help-files))
       (let ((word (tcl-current-word
                   (if current-prefix-arg
@@ -1542,7 +1591,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'."
           (format "Help on Tcl command (default %s): " word))
         tcl-help-alist nil t)))
     current-prefix-arg))
-  (if (not (string= tcl-help-directory tcl-help-saved-dir))
+  (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
       (tcl-reread-help-files))
   (if (string= command "")
       (setq command (tcl-current-word
@@ -1716,12 +1765,57 @@ styles."
              (insert "\\"))
          (forward-char))))))
 
+(defun tcl-indent-for-comment ()
+  "Indent this line's comment to comment column, or insert an empty comment.
+Is smart about syntax of Tcl comments.
+Parts of this were taken from indent-for-comment (simple.el)."
+  (interactive "*")
+  (end-of-line)
+  (or (tcl-in-comment)
+      (progn
+       ;; Not in a comment, so we have to insert one.  Create an
+       ;; empty comment (since there isn't one on this line).  If
+       ;; line is not blank, make sure we insert a ";" first.
+       (skip-chars-backward " \t")
+       (let ((eolpoint (point)))
+         (beginning-of-line)
+         (if (/= (point) eolpoint)
+             (progn
+               (goto-char eolpoint)
+               (or (tcl-real-command-p)
+                   (progn
+                     (insert ";# ")
+                     (backward-char))))))))
+  ;; Point is just after the "#" starting a comment.  Move it as
+  ;; appropriate.
+  (let* ((indent (if comment-indent-hook
+                    (funcall comment-indent-hook)
+                  (funcall comment-indent-function)))
+        (begpos (progn
+                  (backward-char)
+                  (point))))
+    (if (/= begpos indent)
+       (progn
+         (skip-chars-backward " \t" (save-excursion
+                                      (beginning-of-line)
+                                      (point)))
+         (delete-region (point) begpos)
+         (indent-to indent)))
+    (looking-at comment-start-skip)    ; Always true.
+    (goto-char (match-end 0))
+    ;; I don't like the effect of the next two.
+    ;;(skip-chars-backward " \t" (match-beginning 0))
+    ;;(skip-chars-backward "^ \t" (match-beginning 0))
+    ))
+
 ;; The following was inspired by the Tcl editing mode written by
 ;; Gregor Schmid <schmid@fb3-s7.math.TU-Berlin.DE>.  His version also
 ;; attempts to snarf the command line options from the command line,
 ;; but I didn't think that would really be that helpful (doesn't seem
 ;; like it owould be right enough.  His version also looks for the
 ;; "#!/bin/csh ... exec" hack, but that seemed even less useful.
+;; FIXME should make sure that the application mentioned actually
+;; exists.
 (defun tcl-guess-application ()
   "Attempt to guess Tcl application by looking at first line.
 The first line is assumed to look like \"#!.../program ...\"."
@@ -1747,37 +1841,12 @@ The first line is assumed to look like \"#!.../program ...\"."
 ;; Lucid menu support.
 ;; Taken from schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid),
 ;; who wrote a different Tcl mode.
-;; We also have simple support for menus in FSF.  We do this by
+;; We also have support for menus in FSF.  We do this by
 ;; loading the Lucid menu emulation code.
 ;;
 
-;; Put this into your tcl-mode-hook.
-(defun tcl-install-menubar ()
-  (and tcl-using-emacs-19
-       (not tcl-using-lemacs-19)
-       (if tcl-using-emacs-19.23
-          (require 'lmenu)
-        ;; CAVEATS:
-        ;; * lmenu.el provides 'menubar, which is bogus.
-        ;; * lmenu.el causes menubars to be turned on everywhere.
-        ;;   Doubly bogus!
-        ;; Both of these problems are fixed in Emacs 19.23.  People
-        ;; using an Emacs before that just suffer.
-        (require 'menubar "lmenu")))
-  (if (not (assoc "Tcl" current-menubar))
-      (progn
-       (set-buffer-menubar (copy-sequence current-menubar))
-       (add-menu nil "Tcl" (cdr tcl-lucid-menu))))
-  ;; You might want to do something like the below.  I have it
-  ;; commented out because it overrides existing bindings.
-  ;; For Lucid:
-  ;;   (define-key tcl-mode-map 'button3 'tcl-popup-menu)
-  ;; For FSF:
-  ;;   (define-key tcl-mode-map [down-mouse-3] 'tcl-popup-menu)
-  )
-
 (defun tcl-popup-menu (e)
-  (interactive "e")
+  (interactive "@e")
   (and tcl-using-emacs-19
        (not tcl-using-lemacs-19)
        (if tcl-using-emacs-19.23
@@ -1789,8 +1858,7 @@ The first line is assumed to look like \"#!.../program ...\"."
         ;; Both of these problems are fixed in Emacs 19.23.  People
         ;; using an Emacs before that just suffer.
         (require 'menubar "lmenu")))  ;; This is annoying
-  ;;(mouse-set-point e)
-  ;; IMHO popup-menu should be autoloaded.  Oh well.
+  ;; IMHO popup-menu should be autoloaded in FSF Emacs.  Oh well.
   (popup-menu tcl-lucid-menu))
 
 \f