;;; index snd.html

(defstruct tp name m mh o oh c ch l lh nh)

(defun snd-index (output)
  (let* ((index-size 2048)
	 (names (make-array index-size :initial-element nil))
	 (namesh (make-array index-size :initial-element nil))
	 (menu (make-array index-size :initial-element nil))
	 (other (make-array index-size :initial-element nil))
	 (lisp (make-array index-size :initial-element nil))
	 (cxcx (make-array index-size :initial-element nil))
	 (menuh (make-array index-size :initial-element nil))
	 (otherh (make-array index-size :initial-element nil))
	 (lisph (make-array index-size :initial-element nil))
	 (cxcxh(make-array index-size :initial-element nil))
	 (all-names (make-array (* 2 index-size) :initial-element nil))
	 (topic-ctr -1)
	 (name-ctr 0)
	 (topic -1))
    (with-open-file (sndf "snd.html")
      ;; read snd.html, grab all index data
      (let ((happy t))
	(loop while happy do
	  (let* ((urline (read-line sndf nil :EOF))
		 (line urline))
	    (setf happy (not (eq urline :EOF)))
	    (when happy
	      ;; search for <!-- I(...
	      (loop while line do
		(let ((pos (search "<a name=" line)))
		  (if pos
		      (let* ((epos (search ">" (subseq line pos)))
			     (name (subseq line (+ pos 9) (+ pos epos -1))))
			(if (find name all-names :test #'string=)
			    (print (format nil "multiple definitions of ~A?" name))
			  (progn
			    (setf (aref all-names name-ctr) name)
			    (incf name-ctr))))))
		(let ((pos (search "<!-- I(" line)))
		  (if pos
		      (let* ((epos (search "-->" line))
			     (nline (subseq line (+ pos 7) epos)))
			(setf line (subseq line (+ epos 3)))
			(let* ((paren (search "):" nline))
			       (curname (subseq nline 0 paren))
			       (tpos (position curname names :test #'(lambda (a b) (and a b (string-equal a b))))))
			  (if tpos 
			      (setf topic tpos)
			    (progn
			      (incf topic-ctr)
			      (setf topic topic-ctr)
			      (setf (aref names topic) curname)))
			  (setf nline (subseq nline (+ paren 2)))
			  (let ((type (elt nline 0)))
			    (setf paren (search ")" nline))
			    (let ((info (subseq nline 2 paren)))
			      (if (char= type #\M)
				  (progn
				    (if (aref menu topic) (warn "~A menu ~A overwrites ~A~%" (aref names topic) info (aref menu topic)))
				    (setf (aref menu topic) info))
				(if (char= type #\L)
				    (progn
				      (if (aref lisp topic) (warn "~A lisp ~A overwrites ~A~%" (aref names topic) info (aref lisp topic)))
				      (setf (aref lisp topic) info))
				  (if (char= type #\O)
				      (progn
					(if (aref other topic) (warn "~A other ~A overwrites ~A~%" (aref names topic) info (aref other topic)))
					(setf (aref other topic) info))
				    (if (char= type #\K)
					(progn
					  (if (aref cxcx topic) (warn "~A cxcx ~A overwrites ~A~%" (aref names topic) info (aref cxcx topic)))
					  (setf (aref cxcx topic) info))
				      (if (char= type #\A)
					  (progn
					    (if (aref namesh topic) (warn "~A namesh ~A overwrites ~A~%" (aref names topic) info (aref namesh topic)))
					    (setf (aref namesh topic) info))
					(error "unknown type: ~A in ~A from ~A" type nline urline)))))))
			    (setf nline (subseq nline (+ paren 1)))
			    (setf paren (search ")" nline))
			    (if paren
				(if (char= type #\M)
				    (progn
				      (setf (aref menuh topic) (subseq nline 1 paren)))
				  (if (char= type #\L)
				      (progn
					(setf (aref lisph topic) (subseq nline 1 paren)))
				    (if (char= type #\O)
					(progn
					  (setf (aref otherh topic) (subseq nline 1 paren)))
				      (if (char= type #\K)
					  (progn
					    (setf (aref cxcxh topic) (subseq nline 1 paren)))))))))))
		    (setf line nil)))))))))
    (let ((tparr (make-array (1+ topic-ctr) :element-type 'tp)))
      (loop for i from 0 to topic-ctr do
	(if (and (aref namesh i) (not (find (aref namesh i) all-names :test #'string=)))
	    (print (format nil "no definition of ~A (~A)?" (aref namesh i) (aref names i))))
	(if (and (aref menuh i) (not (find (aref menuh i) all-names :test #'string=)))
	    (print (format nil "no definition of ~A (~A)?" (aref menuh i) (aref menu i))))
	(if (and (aref otherh i) (not (find (aref otherh i) all-names :test #'string=)))
	    (print (format nil "no definition of ~A (~A)?" (aref otherh i) (aref other i))))
	(if (and (aref lisph i) (not (find (aref lisph i) all-names :test #'string=)))
	    (print (format nil "no definition of ~A (~A)?" (aref lisph i) (aref lisp i))))
	(if (and (aref cxcxh i) (not (find (aref cxcxh i) all-names :test #'string=)))
	    (print (format nil "no definition of ~A (~A)?" (aref cxcxh i) (aref cxcx i))))
	(setf (aref tparr i) (make-tp :name (aref names i) :nh (aref namesh i)
				      :m (aref menu i) :mh (aref menuh i)
				      :o (aref other i) :oh (aref otherh i)
				      :l (aref lisp i) :lh (aref lisph i)
				      :c (aref cxcx i) :ch (aref cxcxh i))))
      (setf tparr (sort tparr #'string-lessp :key #'tp-name))
      (with-open-file (ofil output :direction :output :if-exists :supersede :if-does-not-exist :create)
	(format ofil "<html><body>~%~%<table border>~%  ~
                                         <caption>Index</caption>~%  ~
                                         <!-- created ~A -->~%  ~
                                         <tr><th>Action<th>Menu<th>Keyboard<th>Lisp<th>Other~%"
		#+(and clm c-library-ok) (clm::c-strftime "%a %d-%b-%y %H:%M %Z") #-(and clm c-library-ok) "whenever")
	(loop for i from 0 to topic-ctr do
	  (let ((top (aref tparr i)))
	    (format ofil "  <tr><td>~A<td>~A<td>~A<td>~A<td>~A~%"
		    (if (tp-nh top)
			(format nil "<a href=\"#~A\">~A</a>" (tp-nh top) (tp-name top))
		      (tp-name top))
		    (let ((pos (and (tp-mh top) (search ":" (tp-m top)))))
		      (if pos
			  (format nil "<font size=\"2\">~A: <a href=\"#~A\">~A</a></font>" 
				  (subseq (tp-m top) 0 pos) (tp-mh top) (subseq (tp-m top) (+ pos 2)))
			(if (tp-mh top)
			    (format nil "<a href=\"#~A\"><font size=\"2\">~A</font></a>" (tp-mh top) (tp-m top))
			  (if (tp-m top) 
			      (format nil "<font size=\"2\">~A</font>" (tp-m top))
			    ""))))
		    (let* ((str (tp-c top))
			   (str1 (make-string (length str)))
			   (j 0))
		      (dotimes (i (length str))
			(if (or (not (string= "-" (elt str i)))
				(= i 0))
			    (progn
			      (setf (elt str1 j) (elt str i))
			      (incf j))))
		      (if (tp-ch top)
			  (format nil "<a href=\"#~A\"><font size=\"2\">~A</font></a>" (tp-ch top) (subseq str1 0 j))
			(if (tp-c top)
			    (format nil "<font size=\"2\">~A</font>" (subseq str1 0 j))
			  "")))
		    (if (tp-lh top)
			(format nil "<a href=\"#~A\"><font size=\"2\">~A</font></a>" (tp-lh top) (tp-l top))
		      (if (tp-l top)
			  (format nil "<font size=\"2\">~A</font>" (tp-l top))
			""))
		    (let* ((str (tp-o top))
			   (str1 (make-string (length str)))
			   (j 0))
		      (dotimes (i (length str))
			(if (or (not (string= "-" (elt str i)))
				(= i 0)
				(not (string= "C" (elt str (1- i)))))
			    (progn
			      (setf (elt str1 j) (elt str i))
			      (incf j))))
		      (if (tp-oh top)
			  (format nil "<a href=\"#~A\"><font size=\"2\">~A</font></a>" (tp-oh top) (subseq str1 0 j))
			(if (tp-o top)
			    (format nil "<font size=\"2\">~A</font>" (subseq str1 0 j))
			  ""))))))
	(format ofil "</table>~%~%</body></html>~%")))))
		    

