scribble/manual: add history

Also, show supplying package in providing-package hover at
definition sites.

original commit: 3f30400a59329a547aa47e80a1e0b592b9e8a73b

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

@@ -1,7 +1,8 @@
 #lang scribble/doc
 @(require scribble/manual "utils.rkt"
           (for-syntax racket/base)
-          (for-label scribble/manual-struct))
+          (for-label scribble/manual-struct
+                     version/utils))
 
 @(define lit-ellipses (racket ...))
 @(define lit-ellipses+ (racket ...+))
@@ -630,7 +631,9 @@ is determined automatically, but a set of providing packages can be
 specified explicitly with @racket[#:packages]. Each @racket[pkg-expr]
 result is passed on to a function like @racket[tt] for
 typesetting. Provide an empty sequence after @racket[#:packages] to
-suppress any package name in the output.
+suppress any package name in the output. Each @racket[pkg-expr]
+expression is are duplicated for a  @racket[declare-exporting] form,
+unless @racket[#:no-declare] is specified.
 
 Each @racket[option] form can appear at most once, and @racket[#:lang]
 and @racket[#:reader] are mutually exclusive.
@@ -639,8 +642,10 @@ The @tech{decode}d @racket[pre-flow]s introduce the module, but need
 not include all of the module content.}
 
 
-@defform/subs[(declare-exporting module-path ... maybe-sources)
+@defform/subs[(declare-exporting module-path ... maybe-pkgs maybe-sources)
-              ([maybe-sources code:blank
+              ([maybe-pkgs code:blank
+                           (code:line #:packages (pkg-expr ...))]
+               [maybe-sources code:blank
                               (code:line #:use-sources (module-path ...))])]{
 
 Associates the @racket[module-path]s to all bindings defined within the
@@ -711,10 +716,17 @@ identifiers that are documented within the section, but the
 @racket[module-path]s in @racket[#:use-sources] provide a binding context
 for connecting (via hyperlinks) definitions and uses of identifiers.
 
+Supply @racket[#:packages] to specify the package that provides the
+declared modules, which is otherwise inferred automatically from the
+first @racket[module-path]. The package names are used, for example,
+by @racket[history].
+
 The @racket[declare-exporting] form should be used no more than once
 per section, since the declaration applies to the entire section,
 although overriding @racket[declare-exporting] forms can appear in
-sub-sections.}
+sub-sections.
+
+@history[#:changed "1.1" @elem{Added @racket[#:packages] clause.}]}
 
 @defform*[[(defmodulelang one-or-multi maybe-sources option ... pre-flow ...)
            (defmodulelang one-or-multi #:module-path module-path
@@ -1820,6 +1832,29 @@ Returns @racket[#t] if @racket[v] is a bibliography entry created by
 @racket[bib-entry], @racket[#f] otherwise.}
 
 
+@; ------------------------------------------------------------------------
+@section{Version History}
+
+@defform[(history clause ...)
+         #:grammar ([clause (code:line #:added version-expr)
+                            (code:line #:changed version-expr content-expr)])
+         #:contracts ([version-expr valid-version?]
+                      [content-expr content?])]{
+
+Generates a @tech{block} for version-history notes. The version
+refers to a package as determined by a @racket[defmodule] or
+@racket[declare-exporting] declaration within an enclosing section.
+
+Normally, @racket[history] should be used at the end of a
+@racket[defform], @racket[defproc], @|etc|, entry, although it may
+also appear in a section that introduces a module (that has been added
+to a package). In the case of a @racket[changed] entry, the content
+produced by @racket[content-expr] should normally start with a capital
+letter and end with a period, but it can be a sentence fragment such
+as ``Added a @racket[#:changed] form.''
+
+@history[#:added "1.1"]}
+
 @; ------------------------------------------------------------------------
 @section{Miscellaneous}
 

pkgs/scribble-pkgs/scribble-lib/info.rkt

@@ -18,3 +18,5 @@
 (define pkg-desc "implementation (no documentation) part of \"scribble\"")
 
 (define pkg-authors '(mflatt eli))
+
+(define version "1.1")

pkgs/scribble-pkgs/scribble-lib/scribble/manual.rkt

@@ -13,7 +13,8 @@
          "private/manual-vars.rkt"
          "private/manual-bind.rkt"
          "private/manual-utils.rkt"
-         "private/manual-defaults.rkt")
+         "private/manual-defaults.rkt"
+         "private/manual-history.rkt")
 
 (provide unsyntax
          make-binding-redirect-elements
@@ -29,7 +30,8 @@
                        "private/manual-bib.rkt"
                        "private/manual-form.rkt"
                        "private/manual-class.rkt"
-                       "private/manual-unit.rkt")
+                       "private/manual-unit.rkt"
+                       "private/manual-history.rkt")
          (except-out (all-from-out "private/manual-vars.rkt")
                      *deftogether)
          (except-out (all-from-out "private/manual-proc.rkt")

pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-bind.rkt

@@ -1,5 +1,7 @@
 #lang scheme/base
-(require "../struct.rkt"
+(require racket/string
+         racket/format
+         "../struct.rkt"
          "../scheme.rkt"
          "../search.rkt"
          "../basic.rkt"
@@ -71,10 +73,13 @@
             (intern-hover-style
              (string-append
               "Provided from: "
-              (let loop ([from from])
+              (string-join (map ~s from) ", ")
-                (if (null? (cdr from))
+              (let ([from-pkgs (resolve-get/tentative p ri '(exporting-packages #f))])
-                    (format "~s" (car from))
+                (if (and from-pkgs (pair? from-pkgs))
-                    (format "~s, ~a" (car from) (loop (cdr from)))))))
+                    (string-append
+                     " | Package: "
+                     (string-join (map ~a from-pkgs) ", "))
+                    ""))))
             e)
            e)))
    (lambda () e)

pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-ex.rkt

@@ -5,6 +5,6 @@
 (provide (struct-out exporting-libraries)
          current-signature)
 
-(define-struct (exporting-libraries element) (libs source-libs))
+(define-struct (exporting-libraries element) (libs source-libs pkgs))
 
 (define current-signature (make-parameter #f))

pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-history.rkt

@@ -0,0 +1,59 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     syntax/parse)
+         version/utils
+         scribble/base
+         scribble/core
+         "manual-sprop.rkt"
+         "manual-ex.rkt"
+         "manual-style.rkt")
+
+(provide history)
+
+(struct history-entry (what vers vers-stx expl))
+
+(begin-for-syntax
+ (define-splicing-syntax-class clause
+   #:attributes (e)
+   [pattern (~seq #:added vers)
+            #:attr e #'(history-entry "Added" vers (quote-syntax vers) '("."))]
+   [pattern (~seq #:changed vers content)
+            #:attr e #'(history-entry "Changed" vers (quote-syntax vers)
+                                      (list ": " content))]))
+
+(define-syntax (history stx)
+  (syntax-parse stx
+    [(_ c:clause ...)
+     #'(make-history (list c.e ...))]))
+
+(define (make-history es)
+  (for ([e (in-list es)])
+    (define vers (history-entry-vers e))
+    (unless (valid-version? vers)
+      (raise-syntax-error 'history
+                          (format "not a valid version: ~e"
+                                  vers)
+                          (history-entry-vers-stx e))))
+  (delayed-block
+   (lambda (renderer p ri)
+     (define pkg
+       (let ([from (resolve-get/tentative p ri '(exporting-packages #f))])
+         (and from
+              (pair? from)
+              (car from))))
+     (para
+      #:style (style "SHistory" (list scheme-properties))
+      (for/list ([e (in-list (sort es (lambda (a b) (version<? b a))
+                                   #:key history-entry-vers))]
+                 [i (in-naturals)])
+        (define vers (history-entry-vers e))
+        (list (if (zero? i)
+                  ""
+                  " ")
+              (history-entry-what e)
+              " in version "
+              vers
+              (if (and pkg (zero? i))
+                  (list " of package " (tt pkg))
+                  null)
+              (history-entry-expl e)))))))

pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-mod.rkt

@@ -73,9 +73,15 @@
        (with-syntax ([(decl-exp ...)
                       (if (attribute no-declare)
                           #'()
-                          (if (attribute modpath)
+                          (with-syntax ([(mod ...)
-                              #'((declare-exporting modpath ... #:use-sources (pname ...)))
+                                         (if (attribute modpath)
-                              #'((declare-exporting name2 ... #:use-sources (pname ...)))))]
+                                             #'(modpath ...)
+                                             #'(name2 ...))]
+                                        [(pkg-decl ...)
+                                         (if (attribute pkg)
+                                             #'(#:packages (pkg ...))
+                                             #'())])
+                            #'((declare-exporting mod ... pkg-decl ... #:use-sources (pname ...)))))]
                      [kind (cond
                             [(attribute language) #'#t]
                             [(attribute readr) #''reader]
@@ -180,23 +186,26 @@
 
 ;; ----------------------------------------
 
+(define (compute-packages module-path)
+  (let* ([path (with-handlers ([exn:missing-module? (lambda (exn) #f)])
+                 (and module-path
+                      (resolved-module-path-name
+                       (module-path-index-resolve (module-path-index-join module-path #f)))))]
+         [pkg (and path
+                   (path? path)
+                   (or (path->pkg path)
+                       (let ([c (path->main-collects-relative path)])
+                         (and c
+                              "base"))))])
+    (if pkg
+        (list pkg)
+        null)))
+
 (define (*defmodule names modpaths module-path packages link-target? lang content req)
   (let ([modpaths (or modpaths names)])
     (define pkg-spec
-      (let ([pkgs
+      (let ([pkgs (or packages
-             (or packages
+                      (compute-packages module-path))])
-                 (let* ([path (with-handlers ([exn:missing-module? (lambda (exn) #f)])
-                                (and module-path
-                                     (resolved-module-path-name
-                                      (module-path-index-resolve (module-path-index-join module-path #f)))))]
-                        [pkg (and path 
-                                  (or (path->pkg path)
-                                      (let ([c (path->main-collects-relative path)])
-                                        (and c
-                                             "base"))))])
-                   (if pkg
-                       (list pkg)
-                       null)))])
         (and pkgs
              (pair? pkgs)
              (make-flow
@@ -281,23 +290,36 @@
                         the-module-path-index-desc)))
 
 (define-syntax (declare-exporting stx)
-  (syntax-case stx ()
+  (syntax-parse stx
-    [(_ lib ... #:use-sources (plib ...))
+    [(_ lib:expr ... 
-     (let ([libs (syntax->list #'(lib ... plib ...))])
+        (~optional (~seq #:packages (pkg ...)))
-       (for ([l libs])
+        (~optional (~seq #:use-sources (plib ...))))
-         (unless (module-path? (syntax->datum l))
+     (with-syntax ([(plib ...) (if (attribute plib)
-           (raise-syntax-error #f "not a module path" stx l)))
+                                   #'(plib ...)
-       (when (null? libs)
+                                   #'())]
-         (raise-syntax-error #f "need at least one module path" stx))
+                   [packages (if (attribute pkg)
-       #'(*declare-exporting '(lib ...) '(plib ...)))]
+                                 #'(list pkg ...)
-    [(_ lib ...) #'(*declare-exporting '(lib ...) '())]))
+                                 #'#f)])
+       (let ([libs (syntax->list #'(lib ... plib ...))])
+         (for ([l libs])
+           (unless (module-path? (syntax->datum l))
+             (raise-syntax-error #f "not a module path" stx l)))
+         (when (null? libs)
+           (raise-syntax-error #f "need at least one module path" stx))
+         #'(*declare-exporting '(lib ...) '(plib ...) packages)))]))
 
-(define (*declare-exporting libs source-libs)
+(define (*declare-exporting libs source-libs in-pkgs)
+  (define pkgs (or in-pkgs
+                   (if (null? libs)
+                       null
+                       (compute-packages (car libs)))))
   (make-splice
    (list
     (make-part-collect-decl
      (make-collect-element
       #f null
-      (lambda (ri) (collect-put! ri '(exporting-libraries #f) libs))))
+      (lambda (ri)
+        (collect-put! ri '(exporting-libraries #f) libs)
+        (collect-put! ri '(exporting-packages #f) pkgs))))
     (make-part-collect-decl
-     (make-exporting-libraries #f null (and (pair? libs) libs) source-libs)))))
+     (make-exporting-libraries #f null (and (pair? libs) libs) source-libs pkgs)))))

pkgs/scribble-pkgs/scribble-lib/scribble/racket.css

@@ -243,3 +243,10 @@
    top: 0px;
    z-index: 1;
 }
+
+/* ---------------------------------------- */
+/* History */
+
+.SHistory {
+  font-size: 82%;
+}