;; smartdoc.kl
;; the autodocing code using directories
 
(setq *package* "smartdoc")

;;AUTODOC: AUTODOC.DIR "format of the smartdocer directory cache"
"\
The smart autodocumenter \"smartdoc\" looks for files \"AUTODOC.DIR\" in the
directories in *load-pathname*, and looks for the symbol to find the file
to be doced. The format of this file is:

#!<any-path>/klone-update-d NL		;auto-recreating script
AUTODOC				;magic number
<version-number> NL			;version number is 3
<file-size-in-bytes> NL			;used as checksum
<hash-function> NL			;present (a line), but ignored in v3
<number-of-slots> NL			;modulo for hash
<number-of-digits-of-slot-indexes> NL	;
<newline-separated-list-of-slot-indexes> NL ; the list of byte offsets in file
					;begining just after header
<slots>

slots is a nil-terminated list of slots-descriptions, one per line.
slot-descriptions:
(symbol \"file-name-relative-to-this-dir\" usage-string required-symbol...)
where required-symbol can be a symbol that must be defined or an expression
that must evaluate to t, if present.
usage-string is a string describing briefly the command, to be used by the 
apropos command.
"
;;AUTOLOAD: help
(defunq help (smartdoc:name &aux
    files-to-load
    smartdoc:print-done
    out
    (result (list))
    res
  )
  (if (and (typep smartdoc:name String)
      (setq files-to-load (smartdocer:find-file (coerce smartdoc:name String)))
    ) (with (line ())
      
      (setq smartdoc:pattern (regcomp
	  (+ "^;;AUTODOC:[ ]*[\"]?" (quote-string-for-regexp smartdoc:name)
	    "[\"]?[ ]+(.*)$")))
      (dohash (filename N files-to-load)
	(with (fd (open filename :error ()))
	  (if fd
	    (catch 'EOF
	      (while (> N 0)
		(setq line (read-line fd))
		(if (regexec smartdoc:pattern line) (progn
		    (setq out (coerce "" Stream))
		    (smartdoc:print fd out)
		    (setq res (coerce out String))
		    (if (and (/= "" res) (not (seek result res)))
		      (progn
			(if smartdoc:print-done ()
			  (progn (setq smartdoc:print-done t)
			    (smartdoc:print-separator)
			))
			(? res)
			(smartdoc:print-separator)
			(put result -1 res)
		    ))
		    (setq N (- N 1))
		))
	    ))
	    (print-format *standard-error*
	      "ERROR: smartdoc cannot open %0 for %1\n" filename smartdoc:name)
))))))

;;AUTOLOAD: smartdoc:help
;;AUTODOC: smartdoc:help "returns help texts for function"
;;(smartdoc:help name)
;;returns a list of strings, each one being a documentation for the object name
;;there can be more than one due to the polymorphism of some objects, e.g.
;;(length (smartdoc:help get)) = 5 because get has many meanings
;;skips first lines as long as they begin with ;;AUTO

(defun smartdoc:help (smartdoc:name &aux
    files-to-load
    (result (list))
    res
    out
    smartdoc:print-done
  )
  (if (and (typep smartdoc:name String)
      (setq files-to-load (smartdocer:find-file (coerce smartdoc:name String)))
    ) (with (line ())
      
      (setq smartdoc:pattern (regcomp
	  (+ "^;;AUTODOC:[ ]*[\"]?" (quote-string-for-regexp smartdoc:name)
	    "[\"]?[ ]+(.*)$")))
      (dohash (filename N files-to-load)
	(with (fd (open filename))
	  (if fd
	    (catch 'EOF
	      (while (> N 0)
		(setq line (read-line fd))
		(if (regexec smartdoc:pattern line) (progn
		    (setq out (coerce "" Stream))
		    (smartdoc:print fd out)
		    (setq res (coerce out String))
		    (if (and (/= "" res) (not (seek result res)))
		      (put result -1 res)
		    )
		    (setq N (- N 1))
		))
	    ))
	    (print-format *standard-error*
	      "ERROR: smartdoc cannot open %0 for %1\n" filename smartdoc:name)
  )))))
  result
)

;; returns a p-list (file-name, number-of-occurences)
(defun smartdocer:find-file (name &aux
    (smartdocer:list (list))
  )
  (dolist (path *load-pathname*)
    (smartdocer:parse-dir path name))
  smartdocer:list
)

(defun smartdocer:parse-dir (path name &aux
    (dir-name (+ (if (= "" path) "." path) "/AUTODOC.DIR"))
    dir
    line
    version
    file-size
    number-of-slots
    number-of-digits
    file-offset
  )
  (catch 'EOF
    (if (setq dir-file (with (*load-pathname* '(".") *load-extensions ())
	    (find-file dir-name)))
      (progn
	(setq dir (open dir-file))
	(setq line (read-line dir))
	(setq line (read-line dir))
	(if (/= "AUTODOC" line)
	  (error 'smartdocer:Error:InvalidDir dir-name)
	)
	(setq version-number (read dir))
	(setq file-size (read dir))
	(if 
	  (= version-number 3) ;v3: ignore hash definition
	  (read dir)		
	  (= version-number 2)		;v2: no such line
	  ()
	  (= version-number 1)		;v1: use file hash-function
	  (setq hash (apply (read dir) (list name)))
	)

	(setq number-of-slots (read dir))
	(if (= 0 number-of-slots)
	  (throw 'EOF ())
	)
	(setq number-of-digits (read dir))
	(file-position dir 
	  (*
	    (mod (*:hash (String name)) number-of-slots)
	    (+ number-of-digits 1)
	  )
	  1
	)
	(setq file-offset (read dir))
	(file-position dir file-offset 0)
	
					;look at all slot entries
	(while (setq line (read dir))
	  (if (and
	      (= name (getn line 0))
	      (or (not (getn line 3))
		(if (typep (getn line 3) Symbol)
		  (boundp (getn line 3))
		  (eval (getn line 3))
	      ))
	    )
	    (put smartdocer:list (+ path "/" (getn line 1))
	      (+ 1 (get smartdocer:list (+ path "/" (getn line 1)) 0))
	    )
	))
    ))
  )
  ()
)

(setq smartdocer:Error:InvalidDir "Bad smartdocer directory: %0")

;;AUTOLOAD: apropos
(defunq apropos (apropos:expr &key from quote case &aux
    dir-name
    dir
    line
    version
    file-size
    number-of-slots
    number-of-digits
    file-offset
    dir-file
    (descs (list))
    desc
    pattern
    (re-text (regcomp ".*[.]txt$"))
  )
  (if (not (typep apropos:expr String))
    (if (not (typep (setq apropos:expr (eval apropos:expr)) String))
      (error "Usage: apropos string")
  ))
  (setq apropos:expr (String apropos:expr))
  (if quote (setq apropos:expr (quote-string-for-regexp apropos:expr)))
  (if (not case) (setq apropos:expr (re-nocase apropos:expr)))
  
  (setq pattern (regcomp apropos:expr))
  (dolist (path *load-pathname*)
    (setq dir-name (+ (if (= "" path) "." path) "/AUTODOC.DIR"))
    (catch 'EOF
      (if (setq dir-file (with (*load-pathname* '(".") *load-extensions ())
	    (find-file dir-name)))
	(progn
	  (setq dir (open dir-file))
	  (setq line (read-line dir))
	  (setq line (read-line dir))
	  (if (/= "AUTODOC" line)
	    (error 'smartdocer:Error:InvalidDir dir-name)
	  )
	  (setq version-number (read dir))
	  (setq file-size (read dir))
	  (if 
	    (= version-number 3) ;v3: ignore hash def
	    (read dir)		
	    (= version-number 2)		;v2: no such line
	    ()
	    (= version-number 1)		;v1: use file hash-function
	    (setq hash (apply (read dir) (list name)))
	  )
	  (setq number-of-slots (read dir))
	  (setq number-of-digits (read dir))
	  (file-position dir 
	    (* number-of-slots (+ number-of-digits 1))
	    1
	  )
					;look at all slot entries
	  (while t
	    (setq line (read dir))
	    (when (and
		(or
		  (regexec pattern (get line 0 "")) ;func name
		  (regexec pattern (get line 2 "")) ;one-line description
		)
		(or (not (getn line 3))	;see if there is a condition
		  (if (typep (getn line 3) Symbol)
		    (boundp (getn line 3))
		    (eval (getn line 3))
		))
	      )
	      (if (not (seek descs
		    (setq desc (+ (coerce (get line 0 "") String)
			" - " (get line 2 "") "\n"
		    ))
		))
		(if (and from
		    (or
		      (and (seek #("doc" doc :doc] from)
			  (not (regexec re-text (get line 1 "")))
			)
			(and (seek #("code" code :code) from)
			  (regexec re-text (get line 1 ""))
		  ))))
		  ()
		  (put descs -1 desc)
  ))))))))
  (dolist (desc descs)
    (? desc)
  )
  (length descs)
)

(defun smartdoc:print-separator ()
  (dotimes (i 79)
    (? "*")
  )
  (? "\n")
)

(defun smartdoc:print (fd out &aux
    line
    (re-com (regcomp "^;+ ?(.*)$"))     ;text as comments
    (re-quote (regcomp "^[ \t]*[\"]"))	;text as a Klone string
    (re-raw (regcomp "^[ \t]*[\x1e]"))	;text as a Klone raw string
    (re-dashes (regcomp "^--------"))	;ascii doc format, includes usage
    (quote-num 0)
    (blank (regcomp "^[ \t]*$"))
    (re-auto (regcomp "^;;AUTO"))
    (closing-string-line (regcomp "([^\\]|^)[\"][ \t]*$"))
    (closing-raw-string-line (regcomp "[\x1e]"))
    lines
  )
  (setq line (read-line fd))
  (while (or (regexec re-auto line) (regexec blank line))
    (setq line (read-line fd))
  )
  (if
    (regexec re-com line) (progn
      (smartdoc:print-usage out)
      (while (regexec re-com line)
	(write-line (regsub re-com "\\1") out)
	(setq line (read-line fd))
    ))
    
    (regexec re-quote line) (progn
      (smartdoc:print-usage out)
      (setq lines (+ line "\n"))
      (while (not (regexec closing-string-line (setq line (read-line fd))))
	(setq lines (+ lines line "\n"))
      )
      (setq lines (+ lines line "\n"))
      (write-line (read (open lines :type :string)) out)
    )
    
    (regexec re-raw line) (progn
      (smartdoc:print-usage out)
      (setq lines (+ line "\n"))
      (while (not (regexec closing-raw-string-line (setq line (read-line fd))))
	(setq lines (+ lines line "\n"))
      )
      (setq lines (+ lines line "\n"))
      (write-line (read (open lines :type :string)) out)
    )
    
    (regexec re-dashes line)
    (progn
      (setq line (read-line fd))
      (while (not (regexec re-dashes line))
	(write-line line out)
	(setq line (read-line fd))
    ))
    
    (print-format *standard-error*
      "ERROR: smartdoc Unknown ;;AUTODOC: syntax in file %0 for name %1:\n    %r2\n"
      filename smartdoc:name line
    )
  )
)

(defun smartdoc:print-usage (out &aux
    (desc (regsub smartdoc:pattern 1))
  )
  (if (regexec {regcomp "^[\"]"} desc)
    (setq desc (read (open desc  :type :string)))
  )
  (print-format out "%0 - %1\n\n" smartdoc:name desc)
)
