;;; 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 of Mesa code in Tioga format;
;;; convert it into plain ASCII.

(require 'tioga)

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

(defun tmesa-start-node (format-name level)
  (if (memq (intern format-name) '(head unit))
      (terpri tmesa-output-buffer)))

(defun tmesa-handle-prop (prop-name str)
  ;; Do nothing.
  )

(defun tmesa-add-looks (looks start len)
  ;; Do nothing.
  )

(defun tmesa-insert-text (text commentp level)
  (if (/= level 0)
      (save-excursion
	(set-buffer tmesa-output-buffer)
	(let ((start (point))
	      (indent (make-string (* (1- level) 3) ?\ )))
	  (insert text)
	  (goto-char start)
	  (cond (commentp
		 (let ((fill-prefix (concat indent "-- ")))
		   (while (not (eobp))
		     (setq start (point))
		     (cond ((looking-at "[\n\r]")
			    (forward-char 1))
			   (t
			    (insert indent)
			    (cond ((looking-at "--")
				   (forward-char 2)
				   (if (or (eobp)
					   (/= (char-after (point)) ?\ ))
				       (insert " ")))
				  (t
				   (insert "-- ")))
			    (re-search-forward "[\n\r]" nil 0))
			   (save-restriction
			     (narrow-to-region start (point))
			     (fill-region (point-min) (point-max))
			     (goto-char (point-max)))))))
		(t
		 (insert indent)
		 (while (and (re-search-forward "[\n\r]" nil 0)
			     (not (eobp)))
		   (insert indent)
		   (insert "      "))))))))

(defun tmesa-end-node (level)
  ;; Do nothing.
  )

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

(defvar tmesa-output-buffer nil)

(defun tmesa-convert-buffer ()
  (interactive)
  (if (buffer-modified-p)
      (error "I refuse to Tioga-Convert a modified buffer..."))
  (barf-if-buffer-read-only)
  (setq tmesa-output-buffer (generate-new-buffer (buffer-name)))
  (unwind-protect
      (progn
	(tioga-walk-buffer 'tmesa-start-node
			   'tmesa-handle-prop
			   'tmesa-add-looks
			   'tmesa-insert-text
			   'tmesa-end-node)
	(save-excursion
	  (set-buffer tmesa-output-buffer)
	  (subst-char-in-region (point-min) (point-max) ?\r ?\n))
	(erase-buffer)
	(insert-buffer tmesa-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 tmesa-output-buffer)
    (setq tmesa-output-buffer nil)))