;;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
;; tcl-help.el -- Online help for Tcl.
;;
;; Author          : Tom Tromey <tromey@busco.lanl.gov>
;; Created On      : Mon Oct 11 17:02:35 1993
;; Last Modified By: Tom Tromey
;; Last Modified On: Thu Oct 14 19:07:33 1993
;; Update Count    : 5
;;
;; This program 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 1, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;; INSTALLATION
;;
;; Put this file somewhere in your load-path, and add the following to
;; your .emacs:
;;
;;       (autoload 'tcl-help-on-word "tcl-help" "Help on Tcl commands" t)
;;
;; Then bind tcl-help-on-word to a key in Tcl mode.  Here is what I do
;; in my .emacs:
;;
;;    (setq tcl-mode-hook '(attach-tcl-mode-hacks))
;;    (defun attach-tcl-mode-hacks ()
;;       (local-set-key "\C-hx" 'tcl-help-on-word)
;;       ...)
;;
;; Also, you will want to edit the defvar for tcl-help-directory
;; below.  It should point at the top-level directory containing the
;; tclX help files.
;;
;; FYI a *very* useful thing to do is nroff all the Tk man pages and
;; put them in a subdir of the help system.
;;
;; Please mail all comments and suggestions to me.
;;
;;
;; HISTORY 
;; 12-Oct-1993		Tom Tromey	
;;    Last Modified: Mon Oct 11 17:10:02 1993 #2 (Tom Tromey)
;;    Rewrote to use completion.
;; 11-Oct-1993		Tom Tromey	
;;    Changed how default is given.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar tcl-help-directory "/home/syzygy/scope/scripts/tclX/help"
  "Name of topmost directory containing tclX help files")

(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-on-word (command)
  "Get help on Tcl command.  Default is word at point."
  (interactive
   (list
    (progn
      (or tcl-help-alist
	  (tcl-help-snarf-commands tcl-help-directory))
      (completing-read (format "Help on Tcl command (default %s): "
			       (current-word))
		       tcl-help-alist nil t))))
  (if (string-equal command "")
      (setq command (current-word)))
  (let* ((help (get-buffer-create "*Tcl help*"))
	 (cell (assoc command tcl-help-alist))
	 (file (and cell (cdr cell))))
    (set-buffer help)
    (delete-region (point-min) (point-max))
    (if file
	(progn
	  (insert "*** " command "\n\n")
	  (insert-file-contents file))
      (insert "Tcl command " command " not in help\n"))
    (set-buffer-modified-p nil)
    (goto-char (point-min))
    (display-buffer help)))
