;;; begincopyright
;;;  Copyright (c) 1988 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 of scheme code in tioga format,
;;; convert it into plain ASCII.

(require 'tioga)

(defvar tscheme-indent-stack)

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

(defun tscheme-start-node (format-name level)
  (if (< level 2)
      (setq tscheme-indent-stack (cons 0 tscheme-indent-stack))
    (let ((parent-indent (car tscheme-indent-stack)))
      (setq tscheme-indent-stack
	    (cons (+ parent-indent
		     (if (string-match "^scheme\\([0-9]+\\)$" format-name)
			 (string-to-int (substring format-name 6))
		       3))
		  tscheme-indent-stack)))))

(defun tscheme-handle-prop (prop-name str)
  (if (and (string= prop-name "postfix")
	   (string-match "\\([-0-9]+\\) sp bigger leftIndent" str))
      (let ((old-indent (car tscheme-indent-stack))
	    (increment (string-to-int (substring str 0 (match-end 1)))))
	(setq tscheme-indent-stack
	      (cons (+ old-indent increment)
		    (cdr tscheme-indent-stack))))))

(defun tscheme-add-looks (looks start len)
  ;; LOOKS is a 32 bit integer represented as a string
  ;; MSB is high bit of the character at index 0.

  ;; For Scheme, ignore it.
  )

(defun tscheme-insert-text (text commentp level)
  (if (> level 0)
      (let* ((indent (car tscheme-indent-stack))
	     (space (make-string indent ?\ )))
	(tscheme-outs space)
	(if (and commentp (/= (aref text 0) ?\;))
	    (tscheme-outs ";; "))
	(tscheme-outs text))))

(defun tscheme-end-node (level)
  (setq tscheme-indent-stack (cdr tscheme-indent-stack)))

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

(defvar tscheme-output-buffer nil)

(defun tscheme-convert-buffer ()
  (interactive)
  (if (buffer-modified-p)
      (error "I refuse to Tioga-Convert a modified buffer..."))
  (barf-if-buffer-read-only)
  (setq tscheme-output-buffer (generate-new-buffer (buffer-name)))
  (let ((tscheme-indent-stack '()))
    (unwind-protect
	(progn
	  (tioga-walk-buffer 'tscheme-start-node
			     'tscheme-handle-prop
			     'tscheme-add-looks
			     'tscheme-insert-text
			     'tscheme-end-node)
	  (save-excursion
	    (set-buffer tscheme-output-buffer)
	    (subst-char-in-region (point-min) (point-max) ?\r ?\n))
	  (erase-buffer)
	  (insert-buffer tscheme-output-buffer)
	  (goto-char (point-min))
	  (while (search-forward "\323" nil t) ; Fix up copyright symbol...
	    (replace-match "(C)" t))
	  (goto-char (point-min)))
      (kill-buffer tscheme-output-buffer)
      (setq tscheme-output-buffer nil))))

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

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