;;
;; Copyright 1998 Jun Obama <george@yk.rim.or.jp>
;;   Modified from html-region.el by TAMURA Kent <tkent@din.or.jp>
;;
;; INSTALL:
;;  1.Put this file to a directory in load-path.
;;  2.Add following line to your ~/.emacs:
;;	(require 'html-table-region)
;;
;;------------
;;
;;  Setting for html-helper-mode:
;;     add following line to your ~/.emacs:
;;
;;(add-hook 'html-helper-mode-hook
;;	  '(lambda () 
;;	     (progn
;;	       (require 'html-table-region)
;;	       (define-key html-helper-mode-map "\C-ct" 'html-table-region)
;;	       (define-key html-helper-mode-map "\C-cT" 'html-untable-region))) t)
;;------------
;;
;;  Setting for XEmacs 20.4 sgml-mode
;;     add following line to your ~/.emacs:
;;
;;(add-hook 'sgml-mode-hook
;;	  '(lambda () 
;;	     (progn
;;	       (require 'html-table-region)
;;	       (define-key sgml-mode-map "\C-ct" 'html-table-region)
;;	       (define-key sgml-mode-map "\C-cT" 'html-untable-region))) t)
;;
;;
(provide 'html-table-region)
;
; Default value of split regex
;
(defvar html-table-region-split-regexp "[ \t]+")
;
; history of split regex
;
(defvar html-table-region-spilt-regex-history nil)
;
; Default value of split column in plain text
;
(defvar html-untable-region-split-separator "\t")
;
; Regex of to delete html code
; for html table format into plain text table format
;
(defvar html-untable-region-table-start "<table[^<>].*>")
(defvar html-untable-region-table-end "</table>")
(defvar html-untable-region-column-item-start "<th>\\|<td>")
(defvar html-untable-region-column-item-end "</th>\\|</td>\\|<th>\\|<td>\\|<tr>\\|</tr>")
(defvar html-untable-region-row-item-start "<tr>")
(defvar html-untable-region-row-item-end "</tr>\\|</table>\\|<tr>")
(defvar html-untable-region-row-item-next "<tr>\\|</table>")
;
;
;
;
; html-table-region with calling perl script version  
;  (old version)
;
;(defun html-table-region-old ()
;  "region 内のテキストをhtml tableに変換する。"
;  (interactive)
;  (let ((head-pointp (< (point) (mark))))
;    (or head-pointp (exchange-point-and-mark))
;    (shell-command-on-region (point) (mark) "space-table-to-html-table.pl" t)
;    (exchange-point-and-mark)
;    (and head-pointp (exchange-point-and-mark))))
;
; html-table-region-interactive
;
(defun html-table-region-interactive (prompt default-input)
  (list (read-string prompt default-input)))
;
; convert region text string into html table format
;
(defun html-table-region (regexp)
  "Convert text table within region into html table format."
  (interactive (html-table-region-interactive "Column split regexp: " html-table-region-split-regexp))
  (let ((head-pointp (< (point) (mark))))
    (or head-pointp (exchange-point-and-mark))
    (save-excursion
;      (setq regexp (read-from-minibuffer "Column split regexp: " html-table-region-split-regexp nil nil 'html-table-region-split-regex-history))
;     (html-encode-region)
      (while (< (point) (mark))
	(let (bolp eolp pp tl lista listb)
	  (setq pp (point))
	  (setq bolp (save-excursion (beginning-of-line)
				     (point)))
	  (setq eolp (save-excursion (end-of-line)
				     (point)))
	  (setq tl (buffer-substring bolp eolp))
	  (delete-region bolp eolp)
	  (setq lista (html-table-region-split-string-to-list tl regexp))
	  (setq listb (html-table-region-list-to-table-row-list lista))
	  (while (not (eq nil listb))
	    (insert (car listb))
	    (setq listb (cdr listb)))
	  (forward-line))))
    (insert "<table border>\n")
    (exchange-point-and-mark)
    (insert "</table>")
    (and head-pointp (exchange-point-and-mark))))
;
; split one line string into list with regexp
;
(defun html-table-region-split-string-to-list (tl &optional regexp)
  (let (pp eosp cp retl)
    (cond ((eq regexp nil)
	   (setq regexp html-table-region-split-regexp)))
    (string-match "^" tl)
    (setq pp (match-beginning 0))
    (string-match "$" tl)
    (setq eosp (match-end 0))
    (while (string-match regexp tl pp)
      (setq retl (append retl (list (substring tl pp (match-beginning 0)))))
      (setq pp (match-end 0)))
    (cond ((= pp eosp) ())
	  (t (setq retl (append retl (list (substring tl pp eosp))))))
    retl))
;
; convert list into one row html format list
;
(defun html-table-region-list-to-table-row-list(tl)
  "Convert list into one row html format list."
  (let (ret)
    (setq ret (append ret (list "<tr>")))
    (while (not (eq nil tl))
      (setq ret (append ret (list "<td>") (car tl) (list "</td>")))
      (setq tl (cdr tl)))
    (setq ret (append ret (list "</tr>")))
    ret))
;
; encode plain text to html text
;
(defun html-encode-region ()		; < > &
  "Encode plain text character <, >, & within region into html &lt; &gt; &amp; ."
  (interactive)
  (let (end-point (head-pointp (< (point) (mark))))
    (or head-pointp (exchange-point-and-mark))
    (save-excursion
      (while (re-search-forward "[<>&]" (mark) t)
	(let (tl)
	  (setq tl (buffer-substring (match-beginning 0) (match-end 0)))
	  (cond ((string= tl "<") (replace-match "&lt;"))
		((string= tl ">") (replace-match "&gt;"))
		((string= tl "&") (replace-match "&amp;"))))))))
;
; decode html text into plain text
;
(defun html-decode-region ()		; < > &
  "Decode html special character &lt; &gt; &amp; within region into < > & ."
  (interactive)
  (let (end-point (head-pointp (< (point) (mark))))
    (or head-pointp (exchange-point-and-mark))
    (save-excursion
      (while (re-search-forward "&lt;\\|&gt;\\|&amp;" (mark) t)
	(let (tl)
	  (setq tl (buffer-substring (match-beginning 0) (match-end 0)))
	  (cond ((string= tl "&lt;") (replace-match "<"))
		((string= tl "&gt;") (replace-match ">"))
		((string= tl "&amp;") (replace-match "&"))))))))
;
;  html-untable-region
;
(defun html-untable-region (separator)
  "Convert html table within region into plain text. 
  In the converted after plain text, tab is used for default column separator and new-line is used for row separator."
  (interactive (html-table-region-interactive "Column split separator: " html-untable-region-split-separator))
  (let (borowp eorowp borp eorp tl listrow
	     (head-pointp (< (point) (mark))))
    (or head-pointp (exchange-point-and-mark))
    (save-excursion
;      (setq separator (read-string "Column split separator: " html-untable-region-split-separator))
      (while (re-search-forward html-untable-region-row-item-start (mark) t)
	(setq borowp (match-beginning 0))
	(setq borp (match-end 0))
	; get this row string into tl
	(save-excursion
	  (setq tl nil)
	  (cond ((re-search-forward html-untable-region-row-item-end (mark) t)
		 (setq eorp (match-beginning 0))
		 (setq eorowp (match-end 0)))
		(t
		 (setq eorp (mark))
		 (setq eorowp (mark))))
	  (setq tl (buffer-substring borp eorp)))
	; delete this row
	(save-excursion
	  (cond ((re-search-forward html-untable-region-row-item-next (mark) t)
		 (delete-region borowp (match-beginning 0)))
		(t
		 (delete-region borowp (mark)))))
	; split and insert this row data
	(cond ((not (eq tl nil))
	       (setq listrow (split-html-table-column-string-data-into-list tl))
	       (goto-char borowp)
	       (while (not (eq listrow nil))
		 (insert (car listrow))
		 (setq listrow (cdr listrow))
		 (if (not (eq listrow nil)) (insert separator)))
	       (insert "\n")))))
    (save-excursion
      (if (re-search-forward html-untable-region-table-start (mark) t)
	  (delete-region (match-beginning 0) (match-end 0))))
    (save-excursion
      (if (re-search-forward html-untable-region-table-end (mark) t)
	  (delete-region (match-beginning 0) (match-end 0))))))

;
; split html table column string data into list
; exam: "<td>A</td><td>B</td><td>C</td>" into ("A" "B" "C")
;
(defun split-html-table-column-string-data-into-list (tl)
  "Split html table column string data into list."
  (let (pp eosp colsp colep retl)
    (string-match "^" tl)
    (setq pp (match-beginning 0))
    (string-match "$" tl)
    (setq eosp (match-end 0))
    (while (string-match html-untable-region-column-item-start tl pp)
      (setq colsp (match-end 0))
      (setq pp (match-end 0))
      (cond ((string-match html-untable-region-column-item-end tl pp)
	     (setq colep (match-beginning 0))
	     (setq retl (append retl (list (substring tl colsp colep)))))
	    (t
	     (setq retl (append retl (list (substring tl colsp eosp)))))))
    retl))
;
; end of file
;