;;; ----------------------------------------------------------------
;;; 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)))