add get-current-doc-state, doc-state-changed?, and doc-state?
This commit is contained in:
parent
469763ca37
commit
68b3371418
|
@ -1795,6 +1795,29 @@ collections, omitting documentation that is installed in the main
|
||||||
installation or in a user-specific location, respectively, if
|
installation or in a user-specific location, respectively, if
|
||||||
@racket[no-main?] or @racket[no-user?] is @racket[#t].}
|
@racket[no-main?] or @racket[no-user?] is @racket[#t].}
|
||||||
|
|
||||||
|
|
||||||
|
@defproc[(get-current-doc-state) doc-state?]{
|
||||||
|
Records the time stamps of files that are touched whenever the
|
||||||
|
documentation is changed.
|
||||||
|
|
||||||
|
@history[#:added "1.2"]
|
||||||
|
}
|
||||||
|
|
||||||
|
@defproc[(doc-state-changed? [doc-state doc-state?]) boolean?]{
|
||||||
|
Returns @racket[#t] when the time stamps of the files in
|
||||||
|
@racket[doc-state] changed (or new files appeared) and @racket[#f] otherwise.
|
||||||
|
|
||||||
|
If the result is @racket[#t], then the documentation in this installation of
|
||||||
|
Racket has changed and otherwise it hasn't.
|
||||||
|
|
||||||
|
@history[#:added "1.2"]
|
||||||
|
}
|
||||||
|
@defproc[(doc-state? [v any/c]) boolean?]{
|
||||||
|
A predicate to recognize the result of @racket[get-current-doc-state].
|
||||||
|
|
||||||
|
@history[#:added "1.2"]
|
||||||
|
}
|
||||||
|
|
||||||
@; ------------------------------------------------------------------------
|
@; ------------------------------------------------------------------------
|
||||||
|
|
||||||
@section[#:tag "materialize-user-docs"]{API for Materializing User-Specific Documentation}
|
@section[#:tag "materialize-user-docs"]{API for Materializing User-Specific Documentation}
|
||||||
|
|
|
@ -11,7 +11,7 @@
|
||||||
|
|
||||||
(define pkg-authors '(eli jay matthias mflatt robby ryanc samth))
|
(define pkg-authors '(eli jay matthias mflatt robby ryanc samth))
|
||||||
|
|
||||||
(define version "1.1")
|
(define version "1.2")
|
||||||
|
|
||||||
;; We need to be able to re-render this documentation even in
|
;; We need to be able to re-render this documentation even in
|
||||||
;; binary mode, since that's how we list new documentation:
|
;; binary mode, since that's how we list new documentation:
|
||||||
|
|
|
@ -4,6 +4,7 @@
|
||||||
racket/fasl
|
racket/fasl
|
||||||
racket/path
|
racket/path
|
||||||
racket/promise
|
racket/promise
|
||||||
|
racket/contract
|
||||||
setup/dirs
|
setup/dirs
|
||||||
setup/getinfo
|
setup/getinfo
|
||||||
"private/doc-path.rkt"
|
"private/doc-path.rkt"
|
||||||
|
@ -167,3 +168,38 @@
|
||||||
#:demand-source (make-key->source db-path no-user? no-main? quiet-fail?
|
#:demand-source (make-key->source db-path no-user? no-main? quiet-fail?
|
||||||
register-shutdown!))
|
register-shutdown!))
|
||||||
(load-xref (get-reader-thunks no-user? no-main? quiet-fail? (make-hash)))))
|
(load-xref (get-reader-thunks no-user? no-main? quiet-fail? (make-hash)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[get-current-doc-state (-> doc-state?)]
|
||||||
|
[doc-state-changed? (-> doc-state? boolean?)]
|
||||||
|
[doc-state? (-> any/c boolean?)]))
|
||||||
|
|
||||||
|
(define docindex.sqlite "docindex.sqlite")
|
||||||
|
|
||||||
|
(struct doc-state (table))
|
||||||
|
(define (get-current-doc-state)
|
||||||
|
(doc-state
|
||||||
|
(for/hash ([dir (in-list (get-doc-search-dirs))])
|
||||||
|
(define pth (build-path dir docindex.sqlite))
|
||||||
|
(values dir
|
||||||
|
(and (file-exists? pth)
|
||||||
|
(file-or-directory-modify-seconds pth))))))
|
||||||
|
(define (doc-state-changed? a-doc-state)
|
||||||
|
(define ht (doc-state-table a-doc-state))
|
||||||
|
(define dirs (get-doc-search-dirs))
|
||||||
|
(cond
|
||||||
|
[(same-as-sets? dirs (hash-keys ht))
|
||||||
|
(for/or ([dir (in-list dirs)])
|
||||||
|
(define old (hash-ref ht dir))
|
||||||
|
(define pth (build-path dir docindex.sqlite))
|
||||||
|
(define new (and (file-exists? pth)
|
||||||
|
(file-or-directory-modify-seconds pth)))
|
||||||
|
(not (equal? old new)))]
|
||||||
|
[else #t]))
|
||||||
|
|
||||||
|
(define (same-as-sets? l1 l2)
|
||||||
|
(and (andmap (λ (x1) (member x1 l2)) l1)
|
||||||
|
(andmap (λ (x2) (member x2 l1)) l2)))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user