add a scribble/blueboxes library to get the content of the

blueboxes in unstyled form

(moved from DrRacket here)

original commit: 24ecd045637a60114d51c9e33bf0035b1a9c046c

pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/blueboxes.scrbl

@@ -0,0 +1,39 @@
+#lang scribble/doc
+@(require scribble/manual "utils.rkt"
+          (for-label scribble/core
+                     scribble/blueboxes
+                     racket/contract))
+
+@title[#:tag "blueboxes"]{Blue Boxes Utilities}
+
+@defmodule[scribble/blueboxes]{
+  The @racketmodname[scribble/blueboxes] provides access
+  to the content of the ``blue boxes'' that describe
+  some module's export (but without any styling).}
+
+@defproc[(fetch-blueboxes-strs [tag tag?]
+                               [#:blueboxes-cache blueboxes-cache
+                                                  blueboxes-cache?
+                                                  (make-blueboxes-cache)])
+         (or/c #f (non-empty-listof string?))]{
+  Returns a list of strings that show the content of the blue box
+  (without any styling information) for the documentation referenced
+  by @racket[tag].
+  
+  The first string in the list describes the export (e.g. @racket["procedure"]
+  when @racket[defproc] is used, or @racket["syntax"] when @racket[defform]
+  was used to document the export).
+}
+
+@defproc[(make-blueboxes-cache [populate? boolean?]) blueboxes-cache?]{
+  Constructs a new (mutable) blueboxes cache. 
+  
+  If @racket[populate?] is @racket[#f], the cache is initially
+  unpopulated, in which case it is filled in the first time the cache
+  is passed to @racket[fetch-bluebxoes-strs]. Otherwise, the cache is
+  initially populated.
+}
+
+@defproc[(blueboxes-cache? [v any/c]) boolean?]{
+  Determines if @racket[v] is a blueboxes cache.                                                
+}

pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/internals.scrbl

@@ -14,5 +14,6 @@
 @include-section["docreader.scrbl"]
 @include-section["xref.scrbl"]
 @include-section["tag.scrbl"]
+@include-section["blueboxes.scrbl"]
 @include-section["config.scrbl"]
 

pkgs/scribble-pkgs/scribble-lib/scribble/blueboxes.rkt

@@ -0,0 +1,80 @@
+#lang racket/base
+(require setup/dirs 
+         racket/serialize
+         racket/contract
+         scribble/core)
+
+(provide
+ (contract-out
+  [fetch-blueboxes-strs (->* (tag?) (#:blueboxes-cache blueboxes-cache?) 
+                             (or/c #f (non-empty-listof string?)))]
+  [make-blueboxes-cache (-> boolean? blueboxes-cache?)]
+  [blueboxes-cache? (-> any/c boolean?)]))
+
+(struct blueboxes-cache (info) #:mutable)
+(define (make-blueboxes-cache populate?)
+  (blueboxes-cache (and populate? (build-blueboxes-cache))))
+
+(define (fetch-blueboxes-strs tag #:blueboxes-cache [cache (make-blueboxes-cache #f)])
+  (define plain-strs (fetch-strs-for-single-tag tag cache))
+  (cond
+    [(and plain-strs
+          (pair? tag)
+          (eq? (car tag) 'def))
+     (define constructor-strs 
+       (fetch-strs-for-single-tag (cons 'construtor (cdr tag)) cache))
+     (if constructor-strs
+         (append plain-strs 
+                 '("") 
+                 ;; cdr drops the "white label" line (constructor, presumably)
+                 (cdr constructor-strs))
+         plain-strs)]
+    [else
+     plain-strs]))
+
+(define (fetch-strs-for-single-tag tag cache)
+  (unless (blueboxes-cache-info cache)
+    (set-blueboxes-cache-info! cache (build-blueboxes-cache)))
+  (for/or ([ent (in-list (blueboxes-cache-info cache))])
+    (define offset+lens (hash-ref (list-ref ent 2) tag #f))
+    (cond
+      [offset+lens
+       (apply
+        append
+        (for/list ([offset+len (in-list offset+lens)])
+          (define fn (list-ref ent 0))
+          (define offset (list-ref ent 1))
+          (call-with-input-file fn
+            (λ (port)
+              (port-count-lines! port)
+              (file-position port (+ (car offset+len) offset))
+              (for/list ([i (in-range (cdr offset+len))])
+                (read-line port))))))]
+      [else #f])))
+
+;; build-blueboxes-cache : (listof (list file-path int hash[tag -o> (cons int int)]))
+(define (build-blueboxes-cache)
+  (filter
+   values
+   (for*/list ([doc-search-dir (in-list (get-doc-search-dirs))]
+               [doc-dir-name (in-list (if (directory-exists? doc-search-dir)
+                                          (directory-list doc-search-dir)
+                                          '()))])
+     (define x (build-path doc-search-dir doc-dir-name "blueboxes.rktd"))
+     (and (file-exists? x)
+          (call-with-input-file x
+            (λ (port)
+              (port-count-lines! port)
+              (define first-line (read-line port))
+              (define pos (file-position port))
+              (define desed 
+                (with-handlers ([exn:fail? (λ (x) 
+                                             (log-warning "Failed to deserialize ~a: ~a"
+                                                          x
+                                                          (exn-message x))
+                                             #f)])
+                  (deserialize (read port))))
+              (and desed
+                   (list x
+                         (+ (string->number first-line) pos)
+                         desed))))))))