Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
116 lines (96 sloc) 3.87 KB
(in-package :cl-mongo)
;; This uses documentation-template to generate reasonably useful
;; documentation. Some of the edi weitz specific stuff is replaced.
(defvar *REPO-ROOT* nil "root of the repository; used for documentation generation")
(defun string-replace*(sep new str)
(let ((l ()))
(do ((pos (search sep str :test #'string=)
(search sep str :test #'string=)))
((or (null pos) (eql 0 pos)))
(push (subseq str 0 pos) l)
(push new l)
(setf str (subseq str (+ pos (length sep) ))))
(nreverse (cons str l))))
(defun string-replace(sep new str)
(let ((L (string-replace* sep new str)))
(reduce (lambda (s1 s2) (concatenate 'string s1 s2)) L :initial-value "")))
(defun slurp-stream(stream)
(let ((seq (make-string (file-length stream))))
(read-sequence seq stream)
(defun write-file(path str)
(with-open-file (stream path :direction :output
:if-exists :supersede :if-does-not-exist :create)
(write-sequence str stream))
(format t "error [~A] on writing to ~A" c path))))
(defun load-file(path)
(with-open-file (stream path :direction :input)
(slurp-stream stream))
(format t "error [~A] on reading from ~A" c path))))
(defun customize (str)
(labels ((customize* (lst str)
(if (null lst)
(customize* (cdr lst)
(string-replace (car (car lst)) (cadr (car lst)) str)))))
(let* ((lst ()))
(push (list "BSD-style" "MIT-style") lst)
(push (list "" "") lst)
(push (list "" "") lst)
(customize* lst str))))
(defun segment* (str accum)
(let* ((start-token "<!--")
(end-token "-->")
(start-comment (search start-token str))
(end-comment (search end-token str) )
(piece (subseq str 0 start-comment)))
(if end-comment
(segment* (subseq str (+ (length end-token) end-comment)) (cons piece accum))
(nreverse (cons str accum)))))
(defun rebuild* (l accum)
(if l
(rebuild* (cdr l) (concatenate 'string accum (car l)))
(defun select-body (str)
(let* ((body-start-token "<body")
(body-end-token "</body>")
(start-body (search body-start-token str))
(end-body (search body-end-token str))
(piece (subseq str start-body (+ (length body-start-token) 2 end-body))))
(defun strip-comments (str)
(rebuild* (segment* str () ) ""))
(defun gendoc (target)
(documentation-template:create-template :cl-mongo :subtitle "api reference"
:target target
:maybe-skip-methods-p t)
(write-file target (customize (load-file target)))))
(defun generate-readme (&key (path *REPO-ROOT*) )
" This function generates a file with the latest api description.
The :path keyword specifies the location. It expects a sub-directory <path>/doc.
Api documentation is generated on the fly, by extracting comments from the classes,
generics and fuctions exported in the packages file.
The resulting file is <path>/doc/index.html. <path>/ is generated by
appending the api documentation to <path>/doc/
:path or *REPO-ROOT* are typically set to the root of the repository.
(let* ((index-path (format nil "~A~A" (make-pathname :directory path) "/doc/index.html"))
(readme-path (format nil "~A~A" (make-pathname :directory path) "/doc/"))
(target (format nil "~A~A" (make-pathname :directory path) "")))
(gendoc index-path)
(write-file target (concatenate 'string (load-file readme-path)
(select-body (strip-comments (load-file index-path)))))))
(format t "error [~A] on writing the readme to ~A. Is *REPO-ROOT* [~A] set ok ?" c path *REPO-ROOT*))))
Jump to Line
Something went wrong with that request. Please try again.