#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH

;(load "debug")
;(kdb t)
; do not rely on autoload, since we are rebuilding it
(load "octal")
(load "defvar")
(load "stack-dump")
(load "statparams")
(load "file-type")
(if (= *machine* 'amiga) (load "grep"))

(defvar klone-update:version 3)
(defun hash-function-default (s &aux
    (hash 0)
    (l (length s))
    (inc (if (< l 8) 1 (logshift l -3)))
    (i 0)
  )
  (while (< i l)
    (setq hash (+ (logshift hash 3) (logshift hash -28) (i s)))
    (incf i inc)
  )
  hash
)

;; Klone script to update the AUTOLOAD.DIR in the given dirs on the command
;; line, or in the current dir or in the path if given the argument all

(setq directories (list))
(setq args (subseq *arguments* 1 ))	; exclude command name
					; parse switches
(setq Verbose ())
(while (and (setq opt (getn args 0)) (= #\- (getn opt 0)))
  (if (= "-v"  opt)
    (setq Verbose t)

    (= "-path" opt)
    (setq directories *load-pathname*)

    (progn
      (? "\
USAGE: klone-update [options] directories
    directories are the directory where to update AUTOLOAD.DIR
    defaults to current directory.
    options can be:
        -v verbose
        -path all dirs in *load-pathname* are updated
")
      (exit 1)
    )
  )
  (delete args 0)
)

(if Verbose
  (setq out *standard-output*)
  (setq out (open (copy "") :type :string :direction :output))
)

(if
  args
  (setq directories (+ directories args))
  
  (if (not directories) (setq directories '(".")))
)

(setq old-dir directories)
(setq directories (list))
(dolist (dir old-dir)
  (if (seek directories dir) ()
    (put directories -1 dir)
))

(setq autoload-comment (regcomp "^[#]"))

(defun process-directories ()
  (dolist (dir directories)
    (process-directory dir)
))

(defun process-directory (dir &aux
    (*current-directory* ".")
  )
  (if (setq *current-directory* dir)
    (progn (print-format out "processing directory %0\n" dir)
      (process-current-directory))
    (print-format out "directory %0 ignored\n" dir)
  )
)

(defun process-subdirectory (subdir)
  (print-format out "    processing sub-directory %0\n" subdir)
  (process-current-directory (+ subdir "/"))
)

(defun process-current-directory (&optional (subdir "") &aux
    (files (list))
    (subdirs (list))
    (grep-output (copy ""))
    grep-fd
    ftype
    fd
    patterns
    entry
  )
  ;; fills patterns
  (if (file-type (+ subdir "AUTOLOAD.PAT"))
    (with (fd (open (+ subdir "AUTOLOAD.PAT"))
	line ())
      (setq patterns (list))
      (catch 'EOF (while (setq line (read-line fd))
	  (if (not (or (regexec autoload-comment line)
		(= "" line)
	    ))
	    (put patterns -1 (regcomp line))
    ))))
    (setq patterns (list (regcomp ".*[.]kl$")))
  )
  
  (dolist (entry (if (= "" subdir) (directory)
	(map List (lambda (s) (+ subdir s)) (directory subdir))
    ))
    (setq ftype (file-type entry))
    (if
      (and (= 'file ftype)		; regular file
	(catch 'OK
	  (map ()
	    (lambda (p) (if (regexec p entry) (throw 'OK t)))
	    patterns
	  )
	  ()
      ))
      (put files -1 entry)
      
      (= 'directory ftype)		; subdir
      (nconc grep-output (process-subdirectory entry))
  ))
  
  (nconc grep-output
    (process-files
      (if (> (length files) 1) files (+ files (list "/dev/null"))))
  )
  
  (if (= subdir "") (progn		; only create .DIR in top
      (if (/= 0 (wait (system "echo > AUTOLOAD.DIR")))
	(? "klone-update error: cannot update AUTOLOAD.DIR in "
	  *current-directory* "\n"
	)
	(progn
	  (system "chmod a+rwx AUTOLOAD.DIR")
	  (if Verbose (? grep-output))
	  (klone-update-dir (open grep-output :type :string))
    )))
    ;; else return the output
    grep-output
  )
  
)

(defun process-files (l &aux grep-pipe res)
  (print-format out "    Files: %0\n" l)
  (if (= *machine* 'amiga)
    (setq res (apply grep (+ '("^[;][;]AUTOLOAD: ") l)))
    (progn
      (system (+ (list "grep" "^[;][;]AUTOLOAD: ") l)
	:output 'grep-pipe
      )
      (setq res (coerce grep-pipe String))
  ))
  (if Verbose (progn (print-format out "    Results:\n%0" res)
      (flush out)
  ))
  res
)  
  
(defun klone-update-dir (in)
  (setq dir (open "AUTOLOAD.DIR" :direction :output :if-exists :supersede))
  
  (print-format *standard-error* "Updating AUTOLOAD.DIR in %0\n"
    *current-directory*
  )
  
  (if (not (boundp 'dir)) (progn
      (print-format () "Cannot open AUTOLOAD.DIR in %0\n"
	*current-directory*
      )
      (exit)
  ))
  
  (setq reline (regcomp "^([^:]*):[;][;]AUTOLOAD:[ \t]*([^ \t]+)(.*)$"))
  (setq blank-string "                                                      ")
  
  (setq entries (coerce (list) Hashtable))
  (setq slots (list))
  (setq slot-offsets (list))
  
  (catch 'EOF
    (while t
      (setq line (read-line in))
      (if Verbose (print-format out "  ==> %0\n" line))
      (if (not (regexec reline line))
	(print-format *standard-error* "Bad line: %0\n" line)
	(progn
	  (setq symbol (coerce (regsub reline "\\2") Atom))
	  (if (getn entries symbol)
	    (print-format *standard-error*
	      "symbol defined twice: %0 in %1 and %2\n"
	      symbol
	      (getn (getn entries symbol) 0)
	      (regsub reline "\\1")
	    )
	    (put entries symbol
	      (list (regsub reline "\\1")
		(regsub reline "\\3")
  )))))))
  
  (setq number-of-slots (length entries))
  
  (dohash (symbol line entries)
    (setq slot (mod (*:hash (String symbol)) number-of-slots))
    (setq l (getn slots slot))
    (if l
      (put l -1 
	(list symbol (getn line 0) (getn line 1))
      )
      (put slots slot
	(list (list symbol (getn line 0) (getn line 1)))
    ))
  )
  
  (setq number-of-digits 3)
  
  (setq size 128)
  (with (stream (coerce "" Stream))
    (with (*print-readably* t)
      (write (coerce hash-function-default List) stream)
    )
    (incf size (length (coerce stream String)))
  )
  
  (dotimes (n number-of-slots)
    (incf size 3)
    (setq slot (getn slots n))
    (if slot
      (map () (lambda (entry)
	  (incf size (+ 7
	      (length (getn entry 0))
	      (length (getn entry 1))
	      (length (getn entry 2))
	)))
	slot
    ))
  )
  
  (incf size (* number-of-slots (+ 1 number-of-digits)))
  (setq old-digits number-of-digits)
  (while (/= old-digits (setq number-of-digits (length (coerce size String))))
    (incf size (* number-of-slots (- number-of-digits old-digits)))
    (setq old-digits number-of-digits)
  )
  
					;header
  (write "#!/usr/local/bin/klone-update\n" dir)
  (write "AUTOLOAD\n" dir)
  (print-format dir "%0\n" klone-update:version)
  (setq file-size-offset (file-position dir))
  (write (subseq blank-string 0 number-of-digits) dir)
  (write "\n" dir)
  (with (*print-readably* t)
    (write (coerce hash-function-default List) dir)
  )
  (print-format dir "\n%0\n%1\n" number-of-slots number-of-digits)
  
					;slot indexes
  (setq start-of-slot-indexes (file-position dir))
  (setq s (subseq blank-string 0 number-of-digits))
  (dotimes (i number-of-slots)
    (write s dir)
    (write "\n" dir)
  )
  
  (setq start-of-slots (file-position dir))
  
  (dotimes (n number-of-slots)
    (setq slot (getn slots n))
    (put slot-offsets n (file-position dir))
    (if slot
      (map () (lambda (entry)
	  (print-format dir "(%0 \"%1\" %2)\n"
	    (getn entry 0)
	    (getn entry 1)
	    (getn entry 2)
	))
	slot
    ))
    (write "()\n" dir)
  )
  
  (file-position dir start-of-slot-indexes 0)
  (dotimes (n number-of-slots)
    (setq s (coerce (get slot-offsets n) String))
    (write (subseq blank-string 0 (- number-of-digits (length s))) dir)
    (write s dir)
    (write "\n" dir)
  )
  
  (file-position dir 0 2)
  (setq file-size (file-position dir))
  (file-position dir file-size-offset 0)
  (setq s (coerce file-size String))
  (write (subseq blank-string 0 (- number-of-digits (length s))) dir)
  (write s dir)
  
  (flush dir)
  (close dir)
)

(process-directories)

;;=============================================================================
;;################### SMARTDOC ################################################;;=============================================================================

;#!/usr/local/bin/klone

;(load "debug")
;(kdb t)
; do not rely on autoload, since we are rebuilding it
;(load "octal")
;(load "stack-dump")
;(load "statparams")
;(load "file-type")

;; Klone script to update the AUTODOC.DIR in the given dirs on the command
;; line, or in the current dir or in the path if given the argument all

; (setq args (subseq *arguments* 1 ))	; exclude command name
; 					; parse switches
; (setq Verbose ())
; (while (and (setq opt (getn args 0)) (= #\- (getn opt 0)))
;   (if (= "-v"  opt)
;     (setq Verbose t)
; 
;     (progn
;       (? "\
; USAGE: klone-update [options] directories
;     directories are the directory where to update AUTODOC.DIR
;     defaults to current directory, or all dirs in path if name is all
;     options can be:
;         -v verbose
; ")
;       (exit 1)
;     )
;   )
;   (delete args 0)
; )
; 

(setq autodoc-comment (regcomp "^[#]"))

(defun process-current-directory (&optional (subdir "") &aux
    (files (list))
    (subdirs (list))
    (grep-output (copy ""))
    grep-fd
    ftype
    fd
    patterns
    entry
  )
  ;; fills patterns
  (if (file-type (+ subdir "AUTODOC.PAT"))
    (with (fd (open (+ subdir "AUTODOC.PAT"))
	line ())
      (setq patterns (list))
      (catch 'EOF (while (setq line (read-line fd))
	  (if (not (or (regexec autodoc-comment line)
		(= "" line)
	    ))
	    (put patterns -1 (regcomp line))
    ))))
    (setq patterns (list (regcomp ".*[.]kl$")))
  )
  
  (dolist (entry (if (= "" subdir) (directory)
	(map List (lambda (s) (+ subdir s)) (directory subdir))
    ))
    (setq ftype (file-type entry))
    (if
      (and (= 'file ftype)		; regular file
	(catch 'OK
	  (map ()
	    (lambda (p) (if (regexec p entry) (throw 'OK t)))
	    patterns
	  )
	  ()
      ))
      (put files -1 entry)
      
      (= 'directory ftype)		; subdir
      (nconc grep-output (process-subdirectory entry))
  ))
  
  (nconc grep-output
    (process-files
      (if (> (length files) 1) files (+ files (list "/dev/null"))))
  )
  
  (if (= subdir "") (progn		; only create .DIR in top
      (if (/= 0 (wait (system "echo > AUTODOC.DIR")))
	(? "klone-update error: cannot update AUTODOC.DIR in "
	  *current-directory* "\n"
	)
	(progn
	  (system "chmod a+rwx AUTODOC.DIR")
	  ;; (if Verbose (? grep-output))
	  (klone-update-dir (open grep-output :type :string))
    )))
    ;; else return the output
    grep-output
  )
  
)

(defun process-files (l &aux grep-pipe res)
  (print-format out "    Files: %0\n" l)
  (if (= *machine* 'amiga)
    (setq res (apply grep (+ '("^[;][;]AUTOLOAD: ") l)))
    (progn
      (system (+ (list "grep" "^[;][;]AUTODOC: ") l)
	:output 'grep-pipe
      )
      (setq res (coerce grep-pipe String))
  ))
  ;;  (if Verbose (progn (print-format out "    Results:\n%0" res)
  ;;      (flush out)
  ;;  ))
  res
)  

(defun strip-string (s &aux re
  )
  (if (regexec {regcomp "^[\"].*[\"]$"} s)
    (non-nil-or (trap-error 'ALL (read (open s :type :string)))
      s
    )
    (regexec (setq re {regcomp "^[\"](.*[^\"])$"}) s)
    (regsub re 1)
    (regexec (setq re {regcomp "^([^\"].*)[\"]$"}) s)
    (regsub re 1)
    s
  )
)

(defun klone-update-dir (in &aux
    the-reline
  )
  (setq dir (open "AUTODOC.DIR" :direction :output :if-exists :supersede))
  
  (print-format *standard-error* "Updating AUTODOC.DIR in %0\n"
    *current-directory*
  )
  
  (if (not (boundp 'dir)) (progn
      (print-format () "Cannot open AUTODOC.DIR in %0\n"
	*current-directory*
      )
      (exit)
  ))
  
  (setq reline (regcomp
      "^([^:]*):[;][;]AUTODOC:[ \t]*[\"]?([^ \t\"]+)[\"]?[ \t]*(.*)$"))
  (setq reline-quoted (regcomp
      "^([^:]*):[;][;]AUTODOC:[ \t]*[\"]([^\"]+)[\"][ \t]*(.*)$"))
  (setq blank-string "                                                      ")
  
  (setq entries (coerce (list) Hashtable))
  (setq slots (list))
  (setq slot-offsets (list))
  
  (catch 'EOF
    (while t
      (setq line (read-line in))
      (if Verbose (print-format out "  ==> %0\n" line))
      (if 
	(not (regexec reline line))
	(print-format *standard-error* "Bad line: %0\n" line)

	(progn
	  (if (regexec reline-quoted line)
	    (setq the-reline reline-quoted)
	    (setq the-reline reline)
	  )
	  (setq symbol (regsub the-reline "\\2"))
	  
	  (if 
	    (getn entries symbol)
	    (put (getn entries symbol) -1
	      (list (strip-string (regsub the-reline "\\1"))
		(strip-string (regsub the-reline "\\3"))
	      )
	    )
	    (put entries symbol
	      (list (list (strip-string (regsub the-reline "\\1"))
		 (strip-string  (regsub the-reline "\\3")))
	      )
	  ))
  ))))
  
  (setq number-of-slots (length entries))
  
  (dohash (symbol lines entries)
    (setq slot (mod (*:hash (String symbol)) number-of-slots))
    (setq l (getn slots slot))
    (if (not l)
      (put slots slot (setq l (list)))
    )
    (dolist (line lines)
      (put l -1 
	(list symbol (getn line 0) (getn line 1))
    ))
  )
  
  (setq number-of-digits 3)
  
  (setq size 128)
  (with (stream (coerce "" Stream))
    (with (*print-readably* t)
      (write (coerce hash-function-default List) stream)
    )
    (incf size (length (coerce stream String)))
  )
  
  (dotimes (n number-of-slots)
    (incf size 3)
    (setq slot (getn slots n))
    (if slot
      (map () (lambda (entry)
	  (incf size (+ 7
	      (length (getn entry 0))
	      (length (getn entry 1))
	      (length (getn entry 2))
	)))
	slot
    ))
  )
  
  (incf size (* number-of-slots (+ 1 number-of-digits)))
  (setq old-digits number-of-digits)
  (while (/= old-digits (setq number-of-digits (length (coerce size String))))
    (incf size (* number-of-slots (- number-of-digits old-digits)))
    (setq old-digits number-of-digits)
  )
  
					;header
  (write "#!/usr/local/bin/klone-update\n" dir)
  (write "AUTODOC\n" dir)
  (print-format dir "%0\n" klone-update:version)
  (setq file-size-offset (file-position dir))
  (write (subseq blank-string 0 number-of-digits) dir)
  (write "\n" dir)
  (with (*print-readably* t)
    (write (coerce hash-function-default List) dir)
  )
  (print-format dir "\n%0\n%1\n" number-of-slots number-of-digits)
  
					;slot indexes
  (setq start-of-slot-indexes (file-position dir))
  (setq s (subseq blank-string 0 number-of-digits))
  (dotimes (i number-of-slots)
    (write s dir)
    (write "\n" dir)
  )
  
  (setq start-of-slots (file-position dir))
  
  (dotimes (n number-of-slots)
    (setq slot (getn slots n))
    (put slot-offsets n (file-position dir))
    (if slot
      (map () (lambda (entry)
	  (print-format dir "(%r0 %r1 %r2)\n"
	    (getn entry 0)
	    (getn entry 1)
	    (getn entry 2)
	))
	slot
    ))
    (write "()\n" dir)
  )
  
  (file-position dir start-of-slot-indexes 0)
  (dotimes (n number-of-slots)
    (setq s (coerce (get slot-offsets n) String))
    (write (subseq blank-string 0 (- number-of-digits (length s))) dir)
    (write s dir)
    (write "\n" dir)
  )
  
  (file-position dir 0 2)
  (setq file-size (file-position dir))
  (file-position dir file-size-offset 0)
  (setq s (coerce file-size String))
  (write (subseq blank-string 0 (- number-of-digits (length s))) dir)
  (write s dir)
  
  (flush dir)
  (close dir)
)

(process-directories)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***