;; w3-detabulate.el: straighten out tables into a linear format suitable
;; for reading with Emacspeak

;; The technique I used to do this was inspired by the technique of
;; turning NOTE elements into tables; the parse tree is preprocessed
;; and then displayed.

(require 'cl)

;; If you load the library then the feature is on.
(defvar w3-detabulate t)

(defvar w3-detabulate-last-node nil)

(defun w3-detabulate (node)
  (let ((node-attrs (cadr node))
	(node-contents (nth 2 node))
	newnode
	(newnode-element 'div)
	(newnode-attrs '((class . "table")))
	(newnode-contents '())
	current-thing)
    (while (setq current-thing (car node-contents))
      (if (listp current-thing)
	  (case (car current-thing)
	    (tbody
	     (setq current-thing (w3-detabulate-process-section
				  current-thing)))
	    (thead
	     (setq current-thing (w3-detabulate-process-section
				  current-thing)))
	    (tfoot
	     (setq current-thing (w3-detabulate-process-section
				  current-thing)))))
      (setq newnode-contents (append newnode-contents (list current-thing)))
      (setq node-contents (cdr node-contents)))
    (setq newnode (list newnode-element newnode-attrs newnode-contents))
    (setq w3-detabulate-last-node newnode)))

(defun w3-detabulate-process-section (node)
  (let ((node-attrs (cadr node))
	(node-element (car node))
	(node-contents (nth 2 node))
	newnode
	(newnode-element 'div)
	(newnode-contents '())
	current-thing)
    (setq newnode-attrs (list (cons 'class
				    (case node-element
				      (thead "thead")
				      (tfoot "tfoot")
				      (otherwise "tbody")))))
    (while (setq current-thing (car node-contents))
      (if (listp current-thing)
	  (case (car current-thing)
	    (tr
	     (setq current-thing (w3-detabulate-process-row
				  current-thing)))))
      (setq newnode-contents (append newnode-contents (list current-thing)))
      (setq node-contents (cdr node-contents)))
    (setq newnode (list newnode-element newnode-attrs newnode-contents))
    newnode))

(defun w3-detabulate-process-row (node)
  (let ((node-attrs (cadr node))
	(node-contents (nth 2 node))
	newnode
	(newnode-element 'div)
	(newnode-attrs '((class . "tr")))
	(newnode-contents '())
	current-thing)
    (while (setq current-thing (car node-contents))
      (if (listp current-thing)
	  (case (car current-thing)
	    (td
	     (setq current-thing (w3-detabulate-process-cell
				  current-thing)))
	    (th
	     (setq current-thing (w3-detabulate-process-cell
				  current-thing)))))
      (setq newnode-contents (append newnode-contents (list current-thing)))
      (setq node-contents (cdr node-contents)))
    (setq newnode (list newnode-element newnode-attrs newnode-contents))
    newnode))

(defun w3-detabulate-process-cell (node)
  (let ((node-attrs (cadr node))
	(node-element (car node))
	(node-contents (nth 3 node))
	(newnode-element 'div)
	(newnode-attrs (list (cons 'class
				   (case node-element
				     (th "th")
				     (otherwise "td")))))
	(newnode (list newnode-element newnode-attrs node-contents)))
    newnode))