Index: code-docs/dust.scrbl ================================================================== --- code-docs/dust.scrbl +++ code-docs/dust.scrbl @@ -58,15 +58,28 @@ These are project-wide pagetrees: @racket[articles-pagetree] contains a pagenode for every Pollen document contained in @racket[articles-folder], and @racket[series-pagetree] contains a pagenode for every Pollen document in @racket[series-folder]. The pagenodes themselves point to the rendered @tt{.html} targets of the source documents. -@defproc[(here-output-path) path?] +@deftogether[(@defproc[(here-output-path) path?] + @defproc[(here-source-path) path?])]{ + +Returns the path to the current output or source file, relative to @racket[current-project-root]. If +no metas are available, returns @racket[(string->path ".")]. + +For the output path, this is similar to the @tt{here} variable that Pollen provides, except it is +available outside templates. As to the source path, Pollen provides it via the @racket['here-path] +key in the current metas, but it is a full absolute path, rather then relative to +@racket[current-project-root]. + +} + +@defproc[(checked-in?) boolean?]{ + +Returns @racket[#t] if the current article is checked into the Fossil repo, @racket[#f] otherwise. -Returns the path to the current output file, relative to @racket[current-project-root]. If no metas -are available, returns @racket[(string->path ".")]. This is like what you can get from the @tt{here} -variable that Pollen provides, except it is available outside templates. +} @defproc[(here-id [suffix (or/c (listof string?) string? #f) #f]) string?] Returns the 8-character prefix of the SHA1 hash of the current document’s output path. If no metas are available, the hash of @racket[(string->path ".")] is used. If @racket[_suffix] evaluates to Index: dust.rkt ================================================================== --- dust.rkt +++ dust.rkt @@ -10,24 +10,28 @@ net/uri-codec file/sha1 gregor txexpr racket/list + racket/match + racket/port racket/system racket/string) ;; Provides common helper functions used throughout the project (provide maybe-meta ; Select from (current-metas) or default value ("") if not available maybe-attr ; Return an attribute’s value or a default ("") if not available here-output-path + here-source-path here-id listing-context series-metas-noun ; Retrieve noun-singular from current 'series meta, or "" series-metas-title ; Retrieve title of series in current 'series meta, or "" metas-series-pagenode invalidate-series + checked-in? make-tag-predicate tx-strs ymd->english ymd->dateformat default-authorname @@ -55,20 +59,25 @@ (define (maybe-meta m [missing ""]) (cond [(current-metas) (or (select-from-metas m (current-metas)) missing)] [else missing])) +;; Return the current source path, relative to (current-project-root) +(define (here-source-path) + (match (current-metas) + [(? hash? m) + (define-values (_ rel-path-parts) + (drop-common-prefix (explode-path (current-project-root)) + (explode-path (string->path (hash-ref m 'here-path))))) + (apply build-path rel-path-parts)] + [_ (string->path ".")])) + ;; Return the current output path, relative to (current-project-root) ;; Similar to the variable 'here' which is only accessible in Pollen templates, ;; except this is an actual path, not a string. (define (here-output-path) - (cond [(current-metas) - (define-values (_ rel-path-parts) - (drop-common-prefix (explode-path (current-project-root)) - (explode-path (string->path (select-from-metas 'here-path (current-metas)))))) - (->output-path (apply build-path rel-path-parts))] - [else (string->path ".")])) + (->output-path (here-source-path))) (define listing-context (make-parameter "")) ;; Checks current-metas for a 'series meta and returns the pagenode of that series, ;; or '|| if no series is specified. @@ -117,10 +126,20 @@ (format "~a.poly.pm" series-name))) (when (file-exists? series-file) (case (system-type 'os) [(windows) (system (format "type nul >> ~a" series-file))] [else (system (format "touch ~a" series-file))])))) + +;; Determine if the current article has been checked into Fossil repo +(define (checked-in?) + (cond [(current-metas) + (define articles-path (build-path (current-project-root) articles-folder)) + (define checked-in + (with-output-to-string + (lambda () (system (format "/usr/local/bin/fossil ls ~a" articles-path))))) + (string-contains? checked-in (path->string (here-source-path)))] + [else #f])) ;; ~~~ Project-wide Pagetrees ~~~ (define (include-in-pagetree folder extension) (define (matching-file? f) Index: snippets-html.rkt ================================================================== --- snippets-html.rkt +++ snippets-html.rkt @@ -3,10 +3,11 @@ ; SPDX-License-Identifier: BlueOak-1.0.0 ; This file is licensed under the Blue Oak Model License 1.0.0. ;; Provides functions for displaying content in HTML templates. (require pollen/template + pollen/core pollen/decode pollen/private/version racket/string racket/function racket/list @@ -44,24 +45,36 @@

The Local Yarn

}) +(define (html$-repo-links) + (define here (path->string (here-source-path))) + (cond + [(checked-in?) + ◊string-append{}] + [else (format "" here) ])) + (define (html$-article-open pagenode title? title-tx published) (cond [title? ◊string-append{
◊(->html `(h1 [[class "entry-title"]] ,@(get-elements title-tx)))

+ ◊(html$-repo-links)
}] [else ◊string-append{

+ ◊(html$-repo-links)
}])) (define (html$-article-close footertext) (cond [(non-empty-string? footertext) ◊string-append{
@@ -70,31 +83,31 @@ [else "
"])) (define (html$-article-listing-short pagenode pubdate title) ◊string-append{
- -

◊|title|

+ +

◊|title|

}) (define (html$-article-excerpt pagenode excerpt-tx) ◊string-append{ - ◊(->html excerpt-tx #:splice? #t) -

Read more…

-}) + ◊(->html excerpt-tx #:splice? #t) +

Read more…

+ }) (define (html$-page-footer) ◊string-append{ -