diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl index 5735d669f3..117f4f12a5 100644 --- a/pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -1795,6 +1795,29 @@ collections, omitting documentation that is installed in the main installation or in a user-specific location, respectively, if @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} diff --git a/pkgs/racket-index/info.rkt b/pkgs/racket-index/info.rkt index e7cc090b93..4efd85bbc7 100644 --- a/pkgs/racket-index/info.rkt +++ b/pkgs/racket-index/info.rkt @@ -11,7 +11,7 @@ (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 ;; binary mode, since that's how we list new documentation: diff --git a/pkgs/racket-index/setup/xref.rkt b/pkgs/racket-index/setup/xref.rkt index 4012d4a879..957b017cbf 100644 --- a/pkgs/racket-index/setup/xref.rkt +++ b/pkgs/racket-index/setup/xref.rkt @@ -4,6 +4,7 @@ racket/fasl racket/path racket/promise + racket/contract setup/dirs setup/getinfo "private/doc-path.rkt" @@ -167,3 +168,38 @@ #:demand-source (make-key->source db-path no-user? no-main? quiet-fail? register-shutdown!)) (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)))