diff --git a/collects/scribble/base.rkt b/collects/scribble/base.rkt index 9d8af190..c77425dd 100644 --- a/collects/scribble/base.rkt +++ b/collects/scribble/base.rkt @@ -5,13 +5,15 @@ "manual-struct.rkt" "decode-struct.rkt" "html-properties.rkt" + "tag.rkt" scheme/list scheme/class racket/contract/base racket/contract/combinator - setup/main-collects (for-syntax scheme/base)) +(provide (all-from-out "tag.rkt")) + ;; ---------------------------------------- (define-syntax-rule (title-like-contract) @@ -158,96 +160,6 @@ ;; ---------------------------------------- -; XXX unknown contracts -(provide intern-taglet - module-path-index->taglet - doc-prefix) -(provide/contract - [module-path-prefix->string (module-path? . -> . string?)]) - -(require syntax/modcollapse - ;; Needed to normalize planet version numbers: - (only-in planet/resolver get-planet-module-path/pkg) - (only-in planet/private/data pkg-maj pkg-min)) - -(define interned (make-weak-hash)) - -(define (intern-taglet v) - (let ([v (if (list? v) - (map intern-taglet v) - (datum-intern-literal v))]) - (if (or (string? v) - (bytes? v) - (list? v)) - (let ([b (hash-ref interned v #f)]) - (if b - (or (weak-box-value b) - ;; just in case the value is GCed before we extract it: - (intern-taglet v)) - (begin - (hash-set! interned v (make-weak-box v)) - v))) - v))) - -(define (do-module-path-index->taglet mod) - ;; Derive the name from the module path: - (let ([p (collapse-module-path-index - mod - (lambda () (build-path (current-directory) "dummy")))]) - (if (path? p) - ;; If we got a path back anyway, then it's best to use the resolved - ;; name; if the current directory has changed since we - ;; the path-index was resolved, then p might not be right. Also, - ;; the resolved path might be a symbol instead of a path. - (let ([rp (resolved-module-path-name - (module-path-index-resolve mod))]) - (if (path? rp) - (intern-taglet - (path->main-collects-relative rp)) - rp)) - (let ([p (if (and (pair? p) - (eq? (car p) 'planet)) - ;; Normalize planet verion number based on current - ;; linking: - (let-values ([(path pkg) - (get-planet-module-path/pkg p #f #f)]) - (list* 'planet - (cadr p) - (list (car (caddr p)) - (cadr (caddr p)) - (pkg-maj pkg) - (pkg-min pkg)) - (cdddr p))) - ;; Otherwise the path is fully normalized: - p)]) - (intern-taglet p))))) - -(define collapsed (make-weak-hasheq)) -(define (module-path-index->taglet mod) - (or (hash-ref collapsed mod #f) - (let ([v (do-module-path-index->taglet mod)]) - (hash-set! collapsed mod v) - v))) - -(define (module-path-prefix->string p) - (datum-intern-literal - (format "~a" (module-path-index->taglet (module-path-index-join p #f))))) - -(define doc-prefix - (case-lambda - [(doc s) - (if doc - (if (list? s) - (cons (module-path-prefix->string doc) s) - (list (module-path-prefix->string doc) s)) - s)] - [(doc prefix s) - (doc-prefix doc (if prefix - (append prefix (list s)) - s))])) - -;; ---------------------------------------- - (define (item? x) (an-item? x)) (define recur-items/c @@ -525,7 +437,7 @@ (make-link-element (if u? #f "plainlink") (decode-content body) `(elem ,t))) (define (secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f]) - (make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc prefix s)))) + (make-link-element (if u? #f "plainlink") null (make-section-tag s #:doc doc #:tag-prefixes prefix))) (define (Secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f]) (let ([le (secref s #:underline? u? #:doc doc #:tag-prefixes prefix)]) (make-link-element diff --git a/collects/scribble/tag.rkt b/collects/scribble/tag.rkt new file mode 100644 index 00000000..3525d936 --- /dev/null +++ b/collects/scribble/tag.rkt @@ -0,0 +1,109 @@ +#lang racket/base +(require racket/contract/base + syntax/modcollapse + setup/main-collects + scribble/core + ;; Needed to normalize planet version numbers: + (only-in planet/resolver get-planet-module-path/pkg) + (only-in planet/private/data pkg-maj pkg-min)) + +(provide + (contract-out + [make-section-tag ((string?) + (#:doc (or/c #f module-path?) + #:tag-prefixes (or/c #f (listof string?))) + . ->* . + tag?)] + [taglet? (any/c . -> . boolean?)] + [module-path-prefix->string (module-path? . -> . string?)] + [module-path-index->taglet (module-path-index? . -> . taglet?)] + [intern-taglet (any/c . -> . any/c)] + [doc-prefix (case-> + ((or/c #f module-path?) taglet? . -> . taglet?) + ((or/c #f module-path?) (or/c #f (listof string?)) taglet? . -> . taglet?))])) + +(define (make-section-tag s #:doc [doc #f] #:tag-prefixes [prefix #f]) + `(part ,(doc-prefix doc prefix s))) + +(define (taglet? v) + (and (not (generated-tag? v)) + (tag? (list 'something v)))) + +(define interned (make-weak-hash)) + +(define (intern-taglet v) + (let ([v (if (list? v) + (map intern-taglet v) + (datum-intern-literal v))]) + (if (or (string? v) + (bytes? v) + (list? v)) + (let ([b (hash-ref interned v #f)]) + (if b + (or (weak-box-value b) + ;; just in case the value is GCed before we extract it: + (intern-taglet v)) + (begin + (hash-set! interned v (make-weak-box v)) + v))) + v))) + +(define (do-module-path-index->taglet mod) + ;; Derive the name from the module path: + (let ([p (collapse-module-path-index + mod + (lambda () (build-path (current-directory) "dummy")))]) + (if (path? p) + ;; If we got a path back anyway, then it's best to use the resolved + ;; name; if the current directory has changed since we + ;; the path-index was resolved, then p might not be right. Also, + ;; the resolved path might be a symbol instead of a path. + (let ([rp (resolved-module-path-name + (module-path-index-resolve mod))]) + (if (path? rp) + (intern-taglet + (path->main-collects-relative rp)) + rp)) + (let ([p (if (and (pair? p) + (eq? (car p) 'planet)) + ;; Normalize planet verion number based on current + ;; linking: + (let-values ([(path pkg) + (get-planet-module-path/pkg p #f #f)]) + (list* 'planet + (cadr p) + (list (car (caddr p)) + (cadr (caddr p)) + (pkg-maj pkg) + (pkg-min pkg)) + (cdddr p))) + ;; Otherwise the path is fully normalized: + p)]) + (intern-taglet p))))) + +(define collapsed (make-weak-hasheq)) +(define (module-path-index->taglet mod) + (or (hash-ref collapsed mod #f) + (let ([v (do-module-path-index->taglet mod)]) + (hash-set! collapsed mod v) + v))) + +(define (module-path-prefix->string p) + (datum-intern-literal + (format "~a" (module-path-index->taglet (module-path-index-join p #f))))) + +(define doc-prefix + (case-lambda + [(doc s) + (if doc + (if (list? s) + (cons (module-path-prefix->string doc) s) + (list (module-path-prefix->string doc) s)) + s)] + [(doc prefix s) + (doc-prefix doc (if prefix + (append prefix (if (list? s) + s + (list s))) + s))])) + diff --git a/collects/scribblings/scribble/base.scrbl b/collects/scribblings/scribble/base.scrbl index e21c4b75..73aa19e4 100644 --- a/collects/scribblings/scribble/base.scrbl +++ b/collects/scribblings/scribble/base.scrbl @@ -6,8 +6,8 @@ @(define-syntax def-section-like (syntax-rules () [(_ id result/c x ...) - (defproc (id [#:tag tag (or/c false/c string? (listof string?)) #f] - [#:tag-prefix tag-prefix (or/c false/c string? module-path?) #f] + (defproc (id [#:tag tag (or/c #f string? (listof string?)) #f] + [#:tag-prefix tag-prefix (or/c #f string? module-path?) #f] [#:style style (or/c style? #f string? symbol? (listof symbol?)) #f] [pre-content pre-content?] (... ...+)) result/c @@ -60,11 +60,11 @@ have @racketmodname[scribble/manual]). @section{Document Structure} -@defproc[(title [#:tag tag (or/c false/c string? (listof string?)) #f] - [#:tag-prefix tag-prefix (or/c false/c string? module-path?) #f] +@defproc[(title [#:tag tag (or/c #f string? (listof string?)) #f] + [#:tag-prefix tag-prefix (or/c #f string? module-path?) #f] [#:style style (or/c style? #f string? symbol? (listof symbol?)) #f] - [#:version vers (or/c string? false/c) #f] - [#:date date (or/c string? false/c) #f] + [#:version vers (or/c string? #f) #f] + [#:date date (or/c string? #f) #f] [pre-content pre-content?] ...+) title-decl?]{ @@ -470,8 +470,8 @@ Generates a literal hyperlinked URL.} @defproc[(secref [tag string?] - [#:doc module-path (or/c module-path? false/c) #f] - [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f] + [#:doc module-path (or/c module-path? #f) #f] + [#:tag-prefixes prefixes (or/c (listof string?) #f) #f] [#:underline? underline? any/c #t]) element?]{ @@ -508,8 +508,8 @@ title after the section number. Customize the output (see @defproc[(Secref [tag string?] - [#:doc module-path (or/c module-path? false/c) #f] - [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f] + [#:doc module-path (or/c module-path? #f) #f] + [#:tag-prefixes prefixes (or/c (listof string?) #f) #f] [#:underline? underline? any/c #t]) element?]{ @@ -518,8 +518,8 @@ with a word (e.g., ``section''), then the word is capitalized.} @defproc[(seclink [tag string?] - [#:doc module-path (or/c module-path? false/c) #f] - [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f] + [#:doc module-path (or/c module-path? #f) #f] + [#:tag-prefixes prefixes (or/c (listof string?) #f) #f] [#:underline? underline? any/c #t] [pre-content pre-content?] ...) element?]{ @@ -549,11 +549,6 @@ The tag @racket[t] refers to the content form of The @tech{decode}d @racket[pre-content] is hyperlinked to @racket[t], which is normally defined using @racket[elemtag].} -@defproc[(module-path-prefix->string [mod-path module-path?]) string?]{ - -Converts a module path to a string by resolving it to a path, and -using @racket[path->main-collects-relative].} - @; ------------------------------------------------------------------------ @section[#:tag "base-indexing"]{Indexing} @@ -601,7 +596,7 @@ section by @racket[decode]. The @racket[word]s serve as both the keys and as the rendered forms of the keys within the index.} -@defproc[(index-section [#:tag tag (or/c false/c string?) "doc-index"]) +@defproc[(index-section [#:tag tag (or/c #f string?) "doc-index"]) part?]{ Produces a part that shows the index the enclosing document. The @@ -634,3 +629,11 @@ also the @racket['quiet] style of @racket[part] (i.e., in a @racket[part] structure, not supplied as the @racket[style] argument to @racket[local-table-of-contents]), which normally suppresses sub-part entries in a table of contents.} + +@; ------------------------------------------------------------------------ + +@section{Tags} + +The exports of @racketmodname[scribble/tag] are all re-exported by +@racketmodname[scribble/base]. + diff --git a/collects/scribblings/scribble/core.scrbl b/collects/scribblings/scribble/core.scrbl index 29b2e727..78560974 100644 --- a/collects/scribblings/scribble/core.scrbl +++ b/collects/scribblings/scribble/core.scrbl @@ -259,6 +259,9 @@ full tag, where the symbol part is supplied automatically. For example, @racket[section] and @racket[secref] both accept a string ``tag'', where @racket['part] is implicit. +The @racketmodname[scribble/tag] library provides functions for constructing +@tech{tags}. + @; ------------------------------------------------------------------------ @section[#:tag "style"]{Styles} diff --git a/collects/scribblings/scribble/internals.scrbl b/collects/scribblings/scribble/internals.scrbl index 05b52b04..7cf095bc 100644 --- a/collects/scribblings/scribble/internals.scrbl +++ b/collects/scribblings/scribble/internals.scrbl @@ -13,5 +13,6 @@ @include-section["doclang.scrbl"] @include-section["docreader.scrbl"] @include-section["xref.scrbl"] +@include-section["tag.scrbl"] @include-section["config.scrbl"] @include-section["racket.scrbl"] diff --git a/collects/scribblings/scribble/tag.scrbl b/collects/scribblings/scribble/tag.scrbl new file mode 100644 index 00000000..c0d200a1 --- /dev/null +++ b/collects/scribblings/scribble/tag.scrbl @@ -0,0 +1,86 @@ +#lang scribble/doc +@(require scribble/manual "utils.rkt" + (for-label setup/main-collects)) + +@title[#:tag "tag"]{Tag Utilities} + +@declare-exporting[scribble/tag scribble/base] + +@defmodule*/no-declare[(scribble/tag)]{The @racketmodname[scribble/tag] +library provides utilities for constructing cross-reference +@tech{tags}. The library is re-exported by +@racketmodname[scribble/base].} + +@; ------------------------------------------------------------------------ + +@defproc[(make-section-tag [name string?] + [#:doc doc-mod-path (or/c module-path? #f) #f] + [#:tag-prefixes tag-prefixes (or/c #f (listof string?)) #f]) + tag?]{ + +Forms a @tech{tag} that refers to a section whose ``tag'' (as provided +by the @racket[#:tag] argument to @racket[section], for example) is +@racket[name]. If @racket[doc-mod-path] is provided, the @tech{tag} +references a section in the document implemented by +@racket[doc-mod-path] from outside the document. Additional tag +prefixes (for intermediate sections, typically) can be provided as +@racket[tag-prefixes].} + + +@defproc[(taglet? [v any/c]) boolean?]{ + +Returns @racket[#t] if @racket[v] is a @tech{taglet}, @racket[#f] +otherwise. + +A @deftech{taglet} is a value that can be combined with a symbol via +@racket[list] to form a @tech{tag}, but that is not a +@racket[generated-tag]. A @tech{taglet} is therefore useful as a piece +of a @tech{tag}, and specifically as a piece of a tag that can gain a +prefix (e.g., to refer to a section of a document from outside the +document).} + + +@defproc*[([(doc-prefix [mod-path (or/c #f module-path?)] + [taglet taglet?]) + taglet?] + [(doc-prefix [mod-path (or/c #f module-path?)] + [extra-prefixes (or/c #f (listof taglet?))] + [taglet taglet?]) + taglet?])]{ + +Converts part of a cross-reference @tech{tag} that would work within a +document implemented by @racket[mod-path] to one that works from +outside the document, assuming that @racket[mod-path] is not +@racket[#f]. That is, @racket[mod-path] is converted to a +@tech{taglet} and added as prefix to an existing @racket[taglet]. + +If @racket[extra-prefixes] is provided, then its content is added as a +extra prefix elements before the prefix for @racket[mod-path] is +added. A @racket[#f] value for @racket[extra-prefixes] is equivalent +to @racket['()]. + +If @racket[mod-path] is @racket[#f], then @racket[taglet] is returned +without a prefix (except adding @racket[extra-prefixes], if provided).} + + +@defproc[(module-path-prefix->string [mod-path module-path?]) string?]{ + +Converts a module path to a string by resolving it to a path, and +using @racket[path->main-collects-relative].} + +@defproc[(module-path-index->taglet [mpi module-path-index?]) taglet?]{ + +Converts a module path index to a @tech{taglet}---a normalized +encoding of the path as an S-expression---that is interned via +@racket[intern-taglet]. + +The string form of the @tech{taglet} is used as prefix in a @tech{tag} +to form cross-references into the document that is implemented by the +module referenced by @racket[mpi].} + +@defproc[(intern-taglet [v any/c]) any/c]{ + +Returns a value that is @racket[equal?] to @racket[v], where multiple +calls to @racket[intern-taglet] for @racket[equal?] @racket[v]s +produce the same (i.e., @racket[eq?]) value.} +