;fill-table.el
 ;; ver3.00
 ;; * TODO
 ;; 正式な CopyRight をつける
 ;; 英語化
 
 ;; 動作確認
 ;; Mule for Win32, Meadow1.15
 
 (setq fill-table-list 
       '(("|" "[ ]*|[ ]*" "|" ? ) ("[+]" "[-]*[+][-]*" "+" ?-) ))
 (setq fill-table-start-regexp 
       (concat "\\(" fill-prefix 
 	       (mapconcat 'car fill-table-list 
 			  (concat "\\)\\|\\(" fill-prefix)) "\\)"))
 (defun fill-table-beginning-of-line () ;100% match
   (move-to-left-margin) (re-search-forward fill-table-start-regexp nil t))
 
 (defun fill-table-looking-at (arg)
   (move-to-left-margin) (looking-at arg))
 
 (defun fill-table-bol-and-matchlist ()
   (fill-table-beginning-of-line)
   (let ((n (length fill-table-list)))
     (while (not (match-beginning n)) (setq n (- n 1)))
     (nth (- n 1) fill-table-list)))
 
 (defun fill-table-move-region (arg)
   (while (and (not (bobp)) (fill-table-looking-at fill-table-start-regexp))
     (forward-line arg))
   (if (< arg 0) 
       (forward-line) (forward-char -1)))
 
 (defun fill-table-re-search-forward (str arg)
   (re-search-forward str (save-excursion (end-of-line) (point)) t arg))
 
 (defun fill-current-column-table (arg)
   (interactive "p")
   (save-excursion
     (let* ((list (fill-table-bol-and-matchlist))
 	    (sep-reg (nth 1 list)) (sep-ins (nth 2 list)))
 	    (if (not (fill-table-re-search-forward sep-reg arg))
 		-1
 	      (re-search-backward sep-ins nil t)
 	      (current-column)))))
 
 (defun fill-table-set (arg col switch)
   (let* ((list (fill-table-bol-and-matchlist)) 
 	  (sep-reg (nth 1 list)) (sep-ins (nth 2 list)) (ins (nth 3 list))
 	  ins-num)
     (while (not (fill-table-re-search-forward sep-reg arg))
       (end-of-line) 
       (insert sep-ins) 
       (fill-table-beginning-of-line))
     (re-search-backward sep-ins nil t)
     (let* ((ins-num (- col (current-column))))
       (cond ((not (equal switch nil))
 	      (fill-table-beginning-of-line)
 	      (if (> arg 1)
 		  (fill-table-re-search-forward sep-reg (- arg 1)))))
       (insert-char ins ins-num))))
 
 (defun fill-table (arg)
   "Fill table.  Flush left when ARG is nill."
   (interactive)
   (let ((n (- (length fill-table-list) 1))
 	 col)
     (save-excursion
       (save-restriction
 	 (narrow-to-region (save-excursion (fill-table-move-region -1) (point))
 			   (save-excursion (fill-table-move-region 1) (point)))
 	 ;; normalize (n = length of fill-table)
 	 (while (>= n 0)
 	   (let* ((list (nth n fill-table-list))
 		  (sep-reg (nth 1 list)) (sep-ins (nth 2 list)))
 	     (goto-char (point-min))
 	     (while (re-search-forward sep-reg nil t)
 	       (replace-match sep-ins)))
 	   (setq n (- n 1)))
 	 ;; filling loop (n = number of column)
 	 (catch 'end-of-loop
 	   (setq n 1)
 	   (while (< n 100)
 	     ;; determine col
 	     (setq col -2)
 	     (goto-char (point-min))
 	     (while (not (eobp))
 	       (setq col (max col (fill-current-column-table n)))
 	       (forward-line 1))
 	     (if (<= col 0) (throw 'end-of-loop t))
 	     ;; set table with col
 	     (goto-char (point-min))
 	     (while (not (eobp))
 	       (fill-table-set n col arg)
 	       (forward-line 1))
 	     (setq n (+ n 1))))
 	 )
       (message "fill-table %d" (- n 1)))))
 
 (defadvice fill-paragraph (around fill-table-around first (arg) activate)
   "Fill paragaph or Fill table at point with the function `fill-table'
 and with the variable `fill-table-list'.  This function set the
 local variable `fill-table-start-regexp' with the variable
 `fill-prefix'.  See also Info node `(emacs)Fill Prefix'."
   (setq fill-table-start-regexp 
 	 (concat "\\(" fill-prefix 
 		 (mapconcat 'car fill-table-list 
 			  (concat "\\)\\|\\(" fill-prefix)) "\\)"))
   (if (save-excursion
 	 (fill-table-looking-at fill-table-start-regexp))
       (fill-table arg)
     ad-do-it))
 (ad-activate 'fill-paragraph)
 
 ;;EOF