;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*-

(in-package 'user)

(defvar *mailing-list-readtable*
	(let ((rdtbl (copy-readtable)))
	  (dolist (char '(#\# #\:))
	    (set-syntax-from-char char #\a rdtbl))
	  rdtbl))

(defvar *output-file-max-length* 900)

(defun read-master-list (pathname)
  (let ((entries ())
	(eof (list nil))
	(*readtable* *mailing-list-readtable*)
	(delimiters (list #\; #\Space #\Tab #\Return)))
    (with-open-file (str pathname :direction :input)
      (do ((char (read-char str nil eof) (read-char str nil eof)))
	  ((eq char eof))
	(if (member char delimiters)
	    (read-line str nil)
	    (progn
	      (unread-char char str)
	      (let* ((line (read-line str nil))
		     (delimiter-pos (length line)))
		(mapc #'(lambda (delimiter)
			  (when (find delimiter line)
			    (setq delimiter-pos
				  (min delimiter-pos
				       (position delimiter line)))))
		      delimiters)
		(setq entry (subseq line 0 delimiter-pos)))
		(unless (eq (length entry) 0) (push entry entries)))))
      (reverse entries))))

(defun convert-list (master to-directory nfiles)
  (setq master (pathname master)
	to-directory (pathname to-directory))
  (let ((entries (read-master-list master))
	(total-length 0)
	(pathnames ()))
    (dolist (e entries)
      (incf total-length (length e))
      (incf total-length 2))
    (format t
	    "~&There are ~D entries. Going to make ~D output files."
	    (length entries)
	    nfiles)
    (dotimes (i nfiles)
      (let ((path (make-pathname
		    :host (pathname-host to-directory)
		    :directory (pathname-directory to-directory)
		    :name (format nil "~A-~A" (pathname-name master) i)
		    :type "text")))
	(unless (probe-file path)
	  (format t "~&NOTE: ~A did not exist previously." path))
	(push path pathnames)))
    (setq pathnames (reverse pathnames))
    (write-sub-files entries pathnames)))

(defun write-sub-files (entries pathnames)
  (loop (when (or (null entries)
		  (null pathnames))
	  (cond (pathnames
		 (dolist (p pathnames)
		   (with-open-file (str p :direction :output) (terpri str))))
		(entries
		 (error "Too many entries for the number of files!.")))
	  (return t))
	(setq entries (write-sub-file entries (pop pathnames)))))

(defun write-sub-file (entries pathname)
  (with-open-file (str pathname :direction :output)
    (let* ((file-length 0)
	   (entry (car entries))			;Bootstrap
	   (entry-length (length entry)))	;the loop.
      (loop (when (or (null entries)
		      (> (+ file-length entry-length 2)
			 *output-file-max-length*))
	      (format t
		      "~&Wrote ~D characters into ~A"
		      file-length (truename str))
	      (return entries))
	    (unless (= file-length 0) (format str ",~%"))
	    (format str "~A" entry)
	    (incf file-length (+ entry-length 2))
	    (pop entries)
	    (setq entry (car entries)
		  entry-length (length entry))))))

(defun update-cl ()
  (convert-list "/pooh/kiuchi/cl-list/commonloops.text"
		"/pooh/kiuchi/cl-list/"
		10))