;;; begincopyright
;;;  Copyright (c) 1993 Xerox Corporation. All rights reserved.
;;;  Use and copying of this software and preparation of derivative works based
;;;  upon this software are permitted. Any distribution of this software or
;;;  derivative works must comply with all applicable United States export
;;;  control laws. This software is made available AS IS, and Xerox Corporation
;;;  makes no warranty about the software, its performance or its conformity to
;;;  any specification. Any person obtaining a copy of this software is requested
;;;  to send their name and post office or electronic mail address to:
;;;    PCR Coordinator
;;;    Xerox PARC
;;;    3333 Coyote Hill Rd.
;;;    Palo Alto, CA 94304
;;;    or pcrcoordinator@parc.xerox.com
;;;  endcopyright */
;;; ----------------------------------------------------------------
;;; Assume the current buffer holds a file in tioga format,
;;; convert into a plain ascii format that shows all the tioga structure

(require 'tioga)

;;; Other converters should ignore the root node (level 0).

(defvar tioga-dump-node-count)
(defvar tioga-dump-max-level)

;;; ---------------- Tioga walk handlers

(defun tioga-start-node-dump (format-name level)
  (cond ((= level 0)
	 (setq tioga-dump-node-count 1)
	 (setq tioga-dump-max-level 0))
	(t
	 (setq tioga-dump-max-level (max level tioga-dump-max-level))
	 (setq tioga-dump-node-count (+ tioga-dump-node-count 1))))
  (if (= (length format-name) 0)
      (setq format-name "<none>"))
  (tioga-dump-outs (concat "[START " level " as " format-name "]\n")))

(defun tioga-handle-prop-dump (prop-name str)
  (tioga-dump-outs (concat "[PROP " prop-name " of " str "]\n")))

(defun tioga-add-looks-dump (looks start len)
  ;; LOOKS is a 32 bit integer represented as a string
  ;; MSB is high bit of the character at index 0.
  (tioga-dump-outs (concat "[LOOKS "
			   (tioga-format-looks looks)
			   " at "
			   start
			   " for "
			   len
			   "]\n")))

(defun tioga-insert-text-dump (text commentp level)
  (tioga-dump-outs (format "[%s %d]\n"
			   (if commentp "COMMENT" "TEXT")
			   level))
  (tioga-dump-outs text)
  (tioga-dump-outs "[ENDINSERT]\n"))

(defun tioga-end-node-dump (level)
  (tioga-dump-outs (concat "[END " level "]\n")))

;;; ---------------- Main 

(defvar tioga-dump-output-buffer nil)

(defun tioga-dump-convert-buffer ()
  (interactive)
  (if (buffer-modified-p)
      (error "won't Tioga-convert a modified buffer"))
  (barf-if-buffer-read-only)
  (setq tioga-dump-output-buffer (generate-new-buffer (buffer-name)))
  (let ((success nil))
    (unwind-protect
	(progn
	  (tioga-walk-buffer  (function tioga-start-node-dump)
			      (function tioga-handle-prop-dump)
			      (function tioga-add-looks-dump)
			      (function tioga-insert-text-dump)
			      (function tioga-end-node-dump))
	  (tioga-dump-outs 
	   (format  "[MAX-LEVEL %d]\n[NODE-COUNT %d]\n[LOOKS-USED %s]\n[FORMATS-USED %s]\n"
		    tioga-dump-max-level
		    tioga-dump-node-count
		    (cdr (sort (mapcar '(lambda (a)
					  (tioga-format-looks (car a)))
				       tioga-looks-table)
			       (function string<)))
		    (cdr (sort (mapcar 'car tioga-format-table) 'string<))))
	  (erase-buffer)
	  (insert-buffer tioga-dump-output-buffer)
	  (setq success t))
      (cond (success
	     (kill-buffer tioga-dump-output-buffer))
	    (t
	     (switch-to-buffer-other-window tioga-dump-output-buffer)
	     (setq tioga-dump-output-buffer nil))))))

;;; ---------------- Utilities

(defun tioga-dump-outs (str)
  (save-excursion
    (set-buffer tioga-dump-output-buffer)
    (insert str)))