;; Tags facility for Emacs.
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;
;; This file "browse.el" is expressly for the purpose of browsing C++ source
;; code within GNUVO. It replaces the original tags.el.
;; Experimental.
;;
(defvar tag-table-files nil
  "List of file names covered by current tag table.
nil means it has not been computed yet; do (tag-table-files) to compute it.")

(defvar last-tag nil
  "Tag found by the last command.")

(defvar last-caller nil
  "Tag found by the last caller-related command.")

(defvar last-class nil
  "Tag found by the last class-related command.")
(defvar last-subclass nil
  "Tag found by the last subclassr-related command.")
(defvar last-instance nil
  "Tag found by the last instance-related command.")

(defun visit-tags-table (file)
  "Tell tags commands to use tag table file FILE.
FILE should be the name of a file created with the `etags' program.
A directory name is ok too; it means file TAGS in that directory."
  (interactive (list (read-file-name "Visit tags table: (default TAGS) "
				     default-directory
				     (concat default-directory "TAGS")
				     t)))
  (setq file (expand-file-name file))
  (if (file-directory-p file)
      (setq file (concat file "TAGS")))
  (setq tag-table-files nil
	tags-file-name file))

(defun visit-tags-table-buffer ()
  "Select the buffer containing the current tag table.
This is a file whose name is in the variable tags-file-name."
  (or tags-file-name
      (call-interactively 'visit-tags-table))
  (set-buffer (or (get-file-buffer tags-file-name)
		  (progn
		    (setq tag-table-files nil)
		    (find-file-noselect tags-file-name))))
  (or (verify-visited-file-modtime (get-file-buffer tags-file-name))
      (cond ((yes-or-no-p "Tags file has changed, read new contents? ")
	     (revert-buffer t t)
	     (setq tag-table-files nil))))
  (or (eq (char-after 1) ?\^L)
      (setq tags-file-name nil) ;; when not a valid tags table 
      (error "File %s not a valid tag table" tags-file-name)))

(defun file-of-tag ()
  "Return the file name of the file whose tags point is within.
Assumes the tag table is the current buffer.
File name returned is relative to tag table file's directory."
  (let ((opoint (point))
	prev size)
    (save-excursion
     (goto-char (point-min))
     (while (< (point) opoint)
       (forward-line 1)
       (end-of-line)
       (skip-chars-backward "^,\n")
       (setq prev (point))
       (setq size (read (current-buffer)))
       (goto-char prev)
       (forward-line 1)
       (forward-char size))
     (goto-char (1- prev))
     (buffer-substring (point)
		       (progn (beginning-of-line) (point))))))

(defun tag-table-files ()
  "Return a list of files in the current tag table.
File names returned are absolute."
  (save-excursion
   (visit-tags-table-buffer)
   (or tag-table-files
       (let (files)
	(goto-char (point-min))
	(while (not (eobp))
	  (forward-line 1)
	  (end-of-line)
	  (skip-chars-backward "^,\n")
	  (setq prev (point))
	  (setq size (read (current-buffer)))
	  (goto-char prev)
	  (setq files (cons (expand-file-name
			     (buffer-substring (1- (point))
					       (save-excursion
						 (beginning-of-line)
						 (point)))
			     (file-name-directory tags-file-name))
			    files))
	  (forward-line 1)
	  (forward-char size))
	(setq tag-table-files (nreverse files))))))

(defun find-tag-tag (tagname &optional interactive)
  (if interactive (setq tagname (read-string interactive)))
  (if (equal tagname "")
      (setq tagname (save-excursion
	              (modify-syntax-entry ?: "w") ; because ::x is a tag in c++
         	      (buffer-substring
		        (progn (backward-sexp 1) (point))
			(progn (forward-sexp 1) (point))))))
  (if interactive (list tagname) tagname))


(defun find-tag (tagname &optional next other-window stype)
  "Find tag (in current tag table) whose name contains TAGNAME.
 Selects the buffer that the tag is contained in
and puts point at its definition.
 If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
 If second arg NEXT is non-nil (interactively, with prefix arg),
searches for the next tag in the tag table
that matches the tagname used in the previous find-tag.

See documentation of variable tags-file-name."
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find tag: ")))
  (setq tagname (find-tag-tag tagname))
  (let (buffer file linebeg startpos testchar)
    (save-excursion
     (visit-tags-table-buffer)
      (if stype
          (setq testchar stype)
          (setq testchar ","))
     (if (not next)
	 (goto-char (point-min))
       (setq tagname last-tag))
     (setq last-tag tagname)
     (while (progn
             (re-search-forward (concat "^" tagname "\177"))
             (not
		(if stype
		   (save-excursion 
			(end-of-line) 
			(search-backward ",")
			(goto-char (1- (point)))
                        (looking-at testchar))
		   (save-excursion 
			(end-of-line) 
			(goto-char (1- (point)))
                        (looking-at testchar)))))) 
    (beginning-of-line)))
    (open-tag-callerline nil)
  (setq tags-loop-form '(find-tag nil t stype))
  ;; Return t in case used as the tags-loop-form.
  t)

 (defun find-tag-other-window (tagname &optional next)
  "Find tag (in current tag table) whose name contains TAGNAME.
 Selects the buffer that the tag is contained in in another window
and puts point at its definition.
 If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
 If second arg NEXT is non-nil (interactively, with prefix arg),
searches for the next tag in the tag table
that matches the tagname used in the previous find-tag.
See documentation of variable tags-file-name."
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find tag other window: ")))
  (find-tag tagname next t nil)) ; t is for other window parm (deleted)

(defvar next-file-list nil
  "List of files for next-file to process.")

(defun next-file (&optional initialize)
  "Select next file among files in current tag table.
Non-nil argument (prefix arg, if interactive)
initializes to the beginning of the list of files in the tag table."
  (interactive "P")
  (if initialize
      (setq next-file-list (tag-table-files)))
  (or next-file-list
      (error "All files processed."))
  (find-file (car next-file-list))
  (setq next-file-list (cdr next-file-list)))

(defvar tags-loop-form nil
  "Form for tags-loop-continue to eval to process one file.
If it returns nil, it is through with one file; move on to next.")

(defun tags-loop-continue (&optional first-time)
  "Continue last \\[tags-search] or \\[tags-query-replace] command.
Used noninteractively with non-nil argument
to begin such a command.  See variable tags-loop-form."
  (interactive)
  (if first-time
      (progn (next-file t)
	     (goto-char (point-min))))
  (while (not (eval tags-loop-form))
    (next-file)
    (message "Scanning file %s..." buffer-file-name)
    (goto-char (point-min))))

(defun tags-search (regexp)
  "Search through all files listed in tag table for match for REGEXP.
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue].

See documentation of variable tags-file-name."
  (interactive "sTags search (regexp): ")
  (if (and (equal regexp "")
	   (eq (car tags-loop-form) 're-search-forward))
      (tags-loop-continue nil)
    (setq tags-loop-form
	  (list 're-search-forward regexp nil t))
    (tags-loop-continue t)))

(defun tags-query-replace (from to)
  "Query-replace-regexp FROM with TO through all files listed in tag table.
If you exit (C-G or ESC), you can resume the query-replace
with the command \\[tags-loop-continue].

See documentation of variable tags-file-name."
  (interactive "sTags query replace (regexp): \nsTags query replace %s by: ")
  (setq tags-loop-form
	(list 'and (list 'save-excursion
			 (list 're-search-forward from nil t))
	      (list 'not (list 'perform-replace from to t t nil))))
  (tags-loop-continue t))

(defun list-tags (string)
  "Display list of tags in file FILE.
FILE should not contain a directory spec
unless it has one in the tag table."
  (interactive "sList tags (in file): ")
  (with-output-to-temp-buffer "*Tags List*"
    (princ "Tags in file ")
    (princ string)
    (terpri)
    (save-excursion
     (visit-tags-table-buffer)
     (goto-char 1)
     (search-forward (concat "\f\n" string ","))
     (forward-line 1)
     (while (not (looking-at "\f"))
       (princ (buffer-substring (point)
				(progn (skip-chars-forward "^\177")
				       (point))))
       (terpri)
       (forward-line 1)))))

(defun tags-apropos (string)
  "Display list of all tags in tag table REGEXP matches."
  (interactive "sTag apropos (regexp): ")
  (with-output-to-temp-buffer "*Tags List*"
    (princ "Tags matching regexp ")
    (prin1 string)
    (terpri)
    (save-excursion
     (visit-tags-table-buffer)
     (goto-char 1)
     (while (re-search-forward string nil t)
       (beginning-of-line)
       (if (save-excursion (end-of-line) (goto-char (1- (point)))
                           (looking-at ","))
           (progn
               (princ (buffer-substring (point)
				(progn (skip-chars-forward "^\177")
				       (point))))
               (terpri)))
               (forward-line 1)))))

(defun match-tag-and-caller (tagname callername)
 (let (tempstring 
       (found-tag t)
       (found-match nil))
    (visit-tags-table-buffer)
    (goto-char (point-min))
    (setq tagname (concat "^" (regexp-quote tagname) "\177"))
    (while (and found-tag (not found-match))
        (if (setq found-tag (re-search-forward tagname nil t))
         (setq found-match
            (progn
                (end-of-line)
                (search-backward ",")
                (setq tempstring
                      (buffer-substring (1+ (point))
                              (progn (end-of-line) (point))))
                (end-of-line)
                (search-backward ",")
                (goto-char (1- (point)))
                (and
                    (looking-at "f") 
                    (string-equal tempstring callername)))))
        (end-of-line))
    (beginning-of-line)
    (or found-match
        (progn (setq last-caller nil)
               (error "No tag and caller match") nil))))

(defun match-tag-not-caller (tagname callername)
 (let (tempstring 
       (found-tag t)
       (found-match nil))
    (visit-tags-table-buffer)
    (setq tagname (concat "^" (regexp-quote tagname) "\177"))
    (while (and found-tag (not found-match))
        (if (setq found-tag (re-search-forward tagname nil t))
         (setq found-match
            (progn
                (end-of-line)
                (search-backward ",")
                (setq tempstring
                      (buffer-substring (1+ (point))
                              (progn (end-of-line) (point))))
		(end-of-line)
		(search-backward ",")
		(goto-char (1- (point)))
		(and (looking-at "f")
                     (not (equal tempstring ""))
                     (not (string-equal tempstring callername))))))
        (end-of-line))
    (beginning-of-line)
    (or found-match
        (setq tempstring (progn (setq last-caller nil)
                                (error "No next caller for tag") nil)))
    ; Return the name of the new caller
    tempstring))
;XXX
(defun open-tag-callerline (other-window)
 (let (file
       startpos
       linebeg)
   (save-excursion
    (visit-tags-table-buffer)
    (search-forward "\177")
    (setq file (expand-file-name (file-of-tag)
				  (file-name-directory tags-file-name)))
    (setq linebeg
	   (buffer-substring (1- (point))
			     (save-excursion (beginning-of-line) (point))))
    (search-forward ",")
    (setq startpos (string-to-int
	   (buffer-substring (point) 
                             (save-excursion (search-forward ",") 
                                             (1- (point)))))))
    (if other-window
	    (find-file-other-window file)
      (find-file file)) 
    (widen)
    (push-mark)
    (let ((offset 80)
	  found
	  (pat (regexp-quote linebeg)))
      (or startpos (setq startpos (point-min)))
      (setq startpos (+ startpos offset))
      (while (and (not found)
		  (progn
		   (goto-char (- startpos offset))
		   (not (bobp))))
	(setq found
	      (re-search-forward pat (+ startpos offset) t))
	(setq offset (+ 80 offset)))
      (or found
	  (re-search-forward pat)))))
  
(defun find-tag-at-caller (tagname callername &optional other-window)
 (interactive (append (find-tag-tag nil "Find tag: ")
              (find-tag-tag nil "Find tag at caller: ")))
    (if  (match-tag-and-caller tagname callername)
         (open-tagC-callerline other-window))
    (setq last-tag tagname)
    (setq last-instance nil)
    (setq last-subclass nil)
    (setq search-last-string tagname)
    (setq last-caller callername))

(defun find-last-tag-at-caller (callername &optional other-window)
 (interactive (find-tag-tag nil "Find tag at caller: "))
 (let ((tagname last-tag))
    (if  (match-tag-and-caller tagname callername)
         (open-tag-callerline other-window))
    (setq last-caller callername)
    (setq last-tag tagname)
    (setq last-instance nil)
    (setq last-subclass nil)
    (setq search-last-string tagname)))

(defun find-tag-next-caller ()
 (interactive)
 (if last-caller
    (progn
        (visit-tags-table-buffer) 
        (forward-line 1)
        (if (setq last-caller (match-tag-not-caller last-tag last-caller))
            (open-tag-callerline nil)))
    (progn
        (visit-tags-table-buffer)
        (goto-char (point-min))
        (setq last-instance nil)
        (setq last-subclass nil)
        (if (setq last-caller (match-tag-not-caller last-tag nil))
            (open-tag-callerline nil)))))
 


(defun find-tag-callerlist (tagname)
  " Make a buffer with the names of all the callers for tag"
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find callers for tag: ")))
  (setq tagname (find-tag-tag tagname))
  (setq last-tag tagname)
  (setq last-caller nil)
  (setq last-instance nil)
  (setq last-subclass nil)
  (with-output-to-temp-buffer "*Tags Caller List*"
    (princ "Callers for tag ")
    (prin1 tagname)
    (terpri)
    (setq tagname (concat "^" (regexp-quote tagname) "\177"))
    (let ((callername nil))
        (save-excursion
         (visit-tags-table-buffer)
         (goto-char 1)
         (while (re-search-forward tagname nil t)
           (end-of-line)
           (search-backward ",")
           (setq callername (buffer-substring (1+ (point))
                                (progn (end-of-line) (point))))
	   (end-of-line)
	   (search-backward ",")
	   (goto-char (1- (point)))
           (if (and (looking-at "f") (not (equal callername "")))
               (progn
                   (princ callername)
                   (terpri)))
           (beginning-of-line)
           (forward-line 1))))))


(defun find-class (tagname &optional next)
  "Find tag (in current tag table) whose name contains TAGNAME.
 Must also match field containing c for class.
 Selects the buffer that the tag is contained in and puts point 
at its definition.
 If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
See documentation of variable tags-file-name."
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find class: ")))
  (setq last-tag last-class)
  (find-tag tagname next nil "c")
  (if tagname 
      (setq last-class tagname))
  (setq last-tag nil)
  (setq last-instance nil)
  (setq search-last-string last-class)
  (setq last-subclass nil))

(defun find-instance (tagname &optional next)
  "Find tag (in current tag table) whose name contains TAGNAME.
 Must also match field containing i for instance.
 Selects the buffer that the tag is contained in and puts point 
at its definition.
 If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
See documentation of variable tags-file-name."
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find instance: ")))
  (setq last-tag last-instance)
  (find-tag tagname next nil "i")
    (setq last-tag nil)
    (if tagname
        (setq last-instance tagname))
    (setq last-subclass nil)
    (setq search-last-string last-instance)
    (setq last-caller nil))


(defun find-class-other-window (tagname)
  "Find tag (in current tag table) whose name contains TAGNAME.
 Must also match field containing c for class.
 Selects the buffer that the tag is contained in and puts point 
 at its definition in another window.
 If TAGNAME is a null string, the expression in the buffer
 around or before point is used as the tag name.
 See documentation of variable tags-file-name."
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find class other window: ")))
  (find-tag tagname nil t "c") ; t is deleted parm other-window
  (setq last-class tagname)
  (setq last-tag nil)
  (setq last-instance nil)
  (setq search-last-string tagname)
  (setq last-subclass nil))

(defun find-inst-other-window (tagname)
  "Find tag (in current tag table) whose name contains TAGNAME.
 Must also match field containing i for instance.
 Selects the buffer that the tag is contained in and puts point 
 at its definition in another window.
 If TAGNAME is a null string, the expression in the buffer
 around or before point is used as the tag name.
 See documentation of variable tags-file-name."
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find instance other window: ")))
  (find-tag tagname nil t "i"); t is deleted parm other-window
    (setq last-tag nil)
    (setq last-instance tagname)
    (setq last-subclass nil)
    (setq search-last-string tagname)
    (setq last-caller nil))

(defun match-class-and-instance (classname instance stype errstring)
 (let (tempstring 
       (found-tag t)
       (found-match nil))
    (visit-tags-table-buffer)
    (goto-char (point-min))
    (setq instance (concat "^" (regexp-quote instance) "\177"))
    (while (and found-tag (not found-match))
        (if (setq found-tag (re-search-forward instance nil t))
         (setq found-match
            (progn
                (end-of-line)
                (search-backward ",")
                (setq tempstring
                      (buffer-substring (1+ (point))
                              (progn (end-of-line) (point))))
		(end-of-line)
		(search-backward ",")
		(goto-char (1- (point)))
		(and (looking-at stype)
                (string-equal tempstring classname)))))
        (end-of-line))
    (beginning-of-line)
    (or found-match
        (progn (setq last-subclass nil) 
               (setq last-instance nil)
               (error errstring) nil))))

(defun match-class-not-instance (tagname instance stype errstring)
 (let (tempstring 
       (found-tag t)
       (found-match nil))
    (visit-tags-table-buffer)
    (setq tagname (concat "," (regexp-quote tagname) ))
    (while (and found-tag (not found-match))
        (if (setq found-tag (re-search-forward tagname nil t))
         (setq found-match
            (progn
                (beginning-of-line)
                (search-forward "\177")
                (setq tempstring
                      (buffer-substring (1- (point))
                              (progn (beginning-of-line) (point))))
		(end-of-line)
		(search-backward ",")
		(goto-char (1- (point)))
		(and (not (equal tempstring ""))
		     (looking-at stype)    ))))
        (end-of-line))    ; for next regexp search starting place
    (beginning-of-line)
    (or found-match
        (setq tempstring (progn (setq last-subclass nil) 
                                (setq last-instance nil)
                                (error errstring) nil)))
    ; Return the name of the new caller
    tempstring))


(defun find-class-subclasslist (tagname)
  " Make a buffer with the names of all the subclasses for tagname"
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find subclasses of class: ")))
  (setq tagname (find-tag-tag tagname))
  (setq last-class tagname)
  (setq last-tag nil)
  (setq last-instance nil)
  (setq last-subclass nil)
  (with-output-to-temp-buffer "*Tags Subclass List*"
    (princ "Subclasses of class ")
    (prin1 tagname)
    (terpri)
    (setq tagname (concat "," (regexp-quote tagname) ))
    (let ((siname nil))
        (save-excursion
         (visit-tags-table-buffer)
         (goto-char 1)
         (while (re-search-forward tagname nil t)
           (beginning-of-line)
           (search-forward "\177")
           (setq siname (buffer-substring (1- (point))
                                (progn (beginning-of-line) (point))))
	   (end-of-line)
	   (search-backward ",")
	   (goto-char (1- (point)))
           (if (looking-at "c")
               (progn
                   (princ siname)
                   (terpri)))
           (beginning-of-line)
           (forward-line 1))))))

(defun find-class-instlist (tagname )
  " Make a buffer with the names of all the instances for tag"
  (interactive (if current-prefix-arg
		   '(nil t)
		   (find-tag-tag nil "Find instances of class: ")))
  (setq tagname (find-tag-tag tagname))
  (setq last-class tagname)
  (setq last-instance nil)
  (setq last-subclass nil)
  (setq last-tag nil)
  (with-output-to-temp-buffer "*Tags Instance List*"
    (princ "Instances of class ")
    (prin1 tagname)
    (terpri)
    (setq tagname (concat "," (regexp-quote tagname) ))
    (let ((siname nil))
        (save-excursion
         (visit-tags-table-buffer)
         (goto-char 1)
         (while (re-search-forward tagname nil t)
           (beginning-of-line)
           (search-forward "\177")
           (setq siname (buffer-substring (1- (point))
                                (progn (beginning-of-line) (point))))
	   (end-of-line)
	   (search-backward ",")
	   (goto-char (1- (point)))
           (if (looking-at "i")
               (progn
                   (princ siname)
                   (terpri)))
           (beginning-of-line)
           (forward-line 1))))))

(defun find-class-next-instance ()
 (interactive)
 (if (not last-class) (error "Must do find-class-instlist first"))
 (if last-instance
        (progn
            (visit-tags-table-buffer)
            (forward-line 1)
            (if (setq last-instance (match-class-not-instance
			last-class last-instance  "i" "No more instances"))
                (open-tag-callerline nil)))
    (progn
        (visit-tags-table-buffer)
        (goto-char (point-min))
        (if (setq last-instance 
		(match-class-not-instance last-class nil "i" "No instances"))
            (open-tag-callerline nil)))))


(defun find-class-next-subclass ()
 (interactive)
 (if (not last-class) (error "Must do find-class-subclasslist first"))
 (if last-subclass
        (progn
            (visit-tags-table-buffer)
            (forward-line 1)
            (if (setq last-subclass (match-class-not-instance
			last-class last-subclass  "c" "No more subclasses"))
                (open-tag-callerline nil)))
    (progn
        (visit-tags-table-buffer)
        (goto-char (point-min))
        (if (setq last-subclass 
		(match-class-not-instance last-class nil "c" "No subclasses"))
            (open-tag-callerline nil)))))

(defun is-member (item list)
  "[cl] MEMBER ITEM LIST => Is ITEM in LIST?  Uses eql on the cars of LIST."
  (let ((ptr list)
        (done nil)
        (result '()))
    (while (not (or done (atom ptr)))
      (cond ((equal item (car ptr))
             (setq done t)
             (setq result ptr)))
      (setq ptr (cdr ptr)))
    result))

(defun is-top-level (classname)
 " In order to be top level, the class name must not appear in any entry
 which defines it as a subclass of another class"
 (save-excursion
    (goto-char (point-min))
    (if (re-search-forward (concat "^" classname "\177") nil t)
       (if (progn (end-of-line) (looking-at ","))
    	  	t
		nil)
	t)))

(defun find-class-hierarchy ()
  " Make a buffer with the names of all the callers for tag"
  (interactive)
  (let (classname (parentlist nil))
  (with-output-to-temp-buffer "*Class Hierarchy*"
    (princ "Class Hierarchy")
        (save-excursion
         (visit-tags-table-buffer)
         (goto-char 1)
	 ; Find all parent classes and make sure top level.
         (while (re-search-forward ",c," nil t)
           (if (and (not (is-member (setq classname
			(buffer-substring (point) (progn
			(end-of-line) (point)))) parentlist))
		    (not (equal classname ""))
		    (is-top-level classname))
		(setq parentlist (append parentlist (list classname))))
	   (beginning-of-line)
	   (forward-line 1))
	 (goto-char (point-min)) ; get the parents with no subclasses too
	 (while (re-search-forward ",c,$" nil t)
           (beginning-of-line)
           (search-forward "\177")
           (setq classname (buffer-substring (1- (point))
                                (progn (beginning-of-line) (point))))
	   (if (and (not (equal classname ""))
	   	    (not (is-member classname parentlist)))
		(setq parentlist (append parentlist (list classname))))
	   (beginning-of-line)
	   (forward-line 1))
		
	  ; Find and print all subclasses of these top level parent classes.
         (while (not (null parentlist))
           (terpri)
	   (setq classname (car parentlist))
	   (setq parentlist (cdr parentlist))
           (princ classname)
           (print-subclasses classname "   "))))))

(defun print-subclasses (classname offset)
 (let (subclass)
   (save-excursion
      (goto-char (point-min))
      (while (re-search-forward (concat ",c," classname) nil t)
	(terpri)
	(beginning-of-line)
	(setq subclass (buffer-substring (point)
		(progn (search-forward "\177") (1- (point)))))
        (princ offset)
	(princ subclass)
	(print-subclasses subclass (concat offset "   "))
        (beginning-of-line)
        (forward-line 1)))))

; Set up some key bindings for these commands.

(global-set-key "\^xT" 'find-tag-at-caller)
(global-set-key "\^xN" 'find-tag-next-caller)
(global-set-key "\^xL" 'find-tag-callerlist)
(global-set-key "\^xC" 'find-class)
(global-set-key "\^x4\^xC" 'find-class-other-window)
(global-set-key "\^x4\^xI" 'find-instance-other-window)
(global-set-key "\^xI" 'find-instance)
(global-set-key "\^xJ" 'find-class-instlist)
(global-set-key "\^xK" 'find-class-subclasslist)
(global-set-key "\^xM" 'find-class-next-instance)
(global-set-key "\^xS" 'find-class-next-subclass)

