Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Automated Resyntax fixes #466

Open
wants to merge 12 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion scribble-lib/scribble/base/lang.rkt
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
#lang racket/base
(require scribble/doclang scribble/base)
(require scribble/base
scribble/doclang)
(provide (all-from-out scribble/doclang
scribble/base))
(module configure-runtime racket/base (require scribble/base/lang/configure-runtime))
21 changes: 6 additions & 15 deletions scribble-lib/scribble/private/define-popup.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -13,21 +13,12 @@
[found-open?
(cond
[(char=? char #\})
(regexp-replace
#rx"^[\n ]*"
(regexp-replace
#rx"[\n ]*$"
(apply string (reverse chars))
"")
"")]
[else
(loop (+ pos 1) #t (cons char chars))])]
[else
(cond
[(char=? char #\{)
(loop (+ pos 1) #t '())]
[else
(loop (+ pos 1) #f '())])])]
(regexp-replace #rx"^[\n ]*"
(regexp-replace #rx"[\n ]*$" (apply string (reverse chars)) "")
"")]
[else (loop (+ pos 1) #t (cons char chars))])]
[(char=? char #\{) (loop (+ pos 1) #t '())]
[else (loop (+ pos 1) #f '())])]
[else #f])))

(define define-popup
Expand Down
6 changes: 3 additions & 3 deletions scribble-lib/scriblib/figure.rkt
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
#lang racket/base
(require racket/contract/base
scribble/manual
scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
scribble/manual
scribble/private/lang-parameters
setup/main-collects
"private/counter.rkt"
scribble/private/lang-parameters)
"private/counter.rkt")

(provide figure
figure*
Expand Down
43 changes: 16 additions & 27 deletions scribble-lib/scriblib/footnote.rkt
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
#lang racket/base

(require scribble/core
(require racket/promise
scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
racket/promise
setup/main-collects
"private/counter.rkt")

Expand Down Expand Up @@ -44,27 +44,19 @@
(define (footnote-part . text) (do-footnote-part footnotes id))))

(define (do-footnote footnotes id text)
(let ([tag (generated-tag)]
[content (decode-content text)])
(make-traverse-element
(lambda (get set)
(set id (cons (cons
(make-element footnote-target-style
(make-element
'superscript
(counter-target footnotes tag #f)))
(define tag (generated-tag))
(define content (decode-content text))
(make-traverse-element
(lambda (get set)
(set id
(cons (cons (make-element footnote-target-style
(make-element 'superscript (counter-target footnotes tag #f)))
content)
(get id null)))
(make-element footnote-style
(list
(make-element
footnote-ref-style
(make-element
'superscript
(counter-ref footnotes tag #f)))
(make-element
footnote-content-style
content)))))))
(get id null)))
(make-element footnote-style
(list (make-element footnote-ref-style
(make-element 'superscript (counter-ref footnotes tag #f)))
(make-element footnote-content-style content))))))

(define (do-footnote-part footnotes id)
(make-part
Expand All @@ -78,9 +70,6 @@
(lambda (get set)
(make-compound-paragraph
footnote-block-style
(map (lambda (content)
(make-paragraph
footnote-block-content-style
content))
(reverse (get id null)))))))
(for/list ([content (in-list (reverse (get id null)))])
(make-paragraph footnote-block-content-style content))))))
null))
231 changes: 114 additions & 117 deletions scribble-lib/scriblib/gui-eval.rkt
Original file line number Diff line number Diff line change
@@ -1,39 +1,37 @@
#lang racket/base

(require scribble/eval
scribble/core
scribble/scheme
(require (for-syntax racket/base)
racket/class
racket/file
racket/runtime-path
racket/sandbox
racket/serialize
"private/gui-eval-exn.rkt"
racket/system
racket/sandbox
(for-syntax racket/base))
scribble/core
scribble/eval
scribble/scheme
"private/gui-eval-exn.rkt")

(define-syntax define-mr
(syntax-rules ()
[(_ mr orig)
(begin
(provide mr)
(define-syntax (mr stx)
(syntax-case stx ()
[(_ #:eval+opts the-eval get-predicate? get-render get-get-width get-get-height x (... ...))
#'(let ([the-eval-x the-eval])
(parameterize ([scribble-eval-handler (gui-eval-handler the-eval-x
get-predicate?
get-render
get-get-width
get-get-height)])
(orig #:eval the-eval-x x (... ...))))]
[(_ x (... ...))
#'(parameterize ([scribble-eval-handler (gui-eval-handler gui-eval
(λ () (gui-eval 'pict?))
(λ () (gui-eval 'draw-pict))
(λ () (gui-eval 'pict-width))
(λ () (gui-eval 'pict-height)))])
(orig #:eval gui-eval x (... ...)))])))]))
(define-syntax-rule (define-mr mr orig)
(begin
(provide mr)
(define-syntax (mr stx)
(syntax-case stx ()
[(_ #:eval+opts the-eval get-predicate? get-render get-get-width get-get-height x (... ...))
#'(let ([the-eval-x the-eval])
(parameterize ([scribble-eval-handler (gui-eval-handler the-eval-x
get-predicate?
get-render
get-get-width
get-get-height)])
(orig #:eval the-eval-x x (... ...))))]
[(_ x (... ...))
#'(parameterize ([scribble-eval-handler (gui-eval-handler gui-eval
(λ () (gui-eval 'pict?))
(λ () (gui-eval 'draw-pict))
(λ () (gui-eval 'pict-width))
(λ () (gui-eval 'pict-height)))])
(orig #:eval gui-eval x (... ...)))]))))

(define gui-eval (make-base-eval #:pretty-print? #f))

Expand Down Expand Up @@ -68,61 +66,61 @@
"exprs.dat"))

(define gui-eval-handler
(if mred?
(let ([eh (scribble-eval-handler)]
[log-file (open-output-file exprs-dat-file #:exists 'truncate/replace)])
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
(lambda (ev catching-exns? expr)
(write (serialize (if (syntax? expr) (syntax->datum expr) expr)) log-file)
(newline log-file)
(flush-output log-file)
(let ([result
(with-handlers ([exn:fail?
(lambda (exn)
(make-gui-exn (exn-message exn)))])
;; put the call to fixup-picts in the handlers
;; so that errors in the user-supplied predicates &
;; conversion functions show up in the rendered output
(fixup-picts (get-predicate?) (get-render) (get-get-width) (get-get-height)
(eh ev catching-exns? expr)))])
(write (serialize result) log-file)
(newline log-file)
(flush-output log-file)
(if (gui-exn? result)
(raise (make-exn:fail
(gui-exn-message result)
(current-continuation-marks)))
result)))))
(let ([log-file (with-handlers ([exn:fail:filesystem?
(lambda (exn)
(open-input-string ""))])
(open-input-file exprs-dat-file))])
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
(lambda (ev catching-exns? expr)
(with-handlers ([exn:fail? (lambda (exn)
(if catching-exns?
(raise exn)
(void)))])
(let ([v (read log-file)])
(if (eof-object? v)
(error "expression not in log file")
(let ([v (deserialize v)])
(if (equal? v (if (syntax? expr)
(syntax->datum expr)
expr))
(let ([v (read log-file)])
(if (eof-object? v)
(error "expression result missing in log file")
(let ([v (deserialize v)])
(if (gui-exn? v)
(raise (make-exn:fail
(gui-exn-message v)
(current-continuation-marks)))
v))))
(error 'mreval
"expression does not match log file: ~e versus: ~e"
expr
v)))))))))))
(cond
[mred?
(define eh (scribble-eval-handler))
(define log-file (open-output-file exprs-dat-file #:exists 'truncate/replace))
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
(lambda (ev catching-exns? expr)
(write (serialize (if (syntax? expr)
(syntax->datum expr)
expr))
log-file)
(newline log-file)
(flush-output log-file)
(define result
(with-handlers ([exn:fail? (lambda (exn) (make-gui-exn (exn-message exn)))])
;; put the call to fixup-picts in the handlers
;; so that errors in the user-supplied predicates &
;; conversion functions show up in the rendered output
(fixup-picts (get-predicate?)
(get-render)
(get-get-width)
(get-get-height)
(eh ev catching-exns? expr))))
(write (serialize result) log-file)
(newline log-file)
(flush-output log-file)
(if (gui-exn? result)
(raise (make-exn:fail (gui-exn-message result) (current-continuation-marks)))
result)))]
[else
(define log-file
(with-handlers ([exn:fail:filesystem? (lambda (exn) (open-input-string ""))])
(open-input-file exprs-dat-file)))
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
(lambda (ev catching-exns? expr)
(with-handlers ([exn:fail? (lambda (exn)
(when catching-exns?
(raise exn))
(void))])
(define v (read log-file))
(if (eof-object? v)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Shouldn't this be converted to cond to allow further refactoring? Or does it hit the limit? @jackfirth

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The let expression in the if body isn't refactorable, since it has a [v (deserialize v)] clause.

(error "expression not in log file")
(let ([v (deserialize v)])
(if (equal? v
(if (syntax? expr)
(syntax->datum expr)
expr))
(let ([v (read log-file)])
(if (eof-object? v)
(error "expression result missing in log file")
(let ([v (deserialize v)])
(if (gui-exn? v)
(raise (make-exn:fail (gui-exn-message v)
(current-continuation-marks)))
v))))
(error 'mreval "expression does not match log file: ~e versus: ~e" expr v)))))))]))

(define image-counter 0)

Expand All @@ -133,41 +131,40 @@
(let loop ([v v])
(cond
[(predicate? v)
(let ([fn (build-string-path img-dir
(format "img~a.png" image-counter))])
(set! image-counter (add1 image-counter))
(let ([dc (let ([pss (make-object (gui-eval 'ps-setup%))])
(send pss set-mode 'file)
(send pss set-file (path-replace-suffix fn #".pdf"))
(parameterize ([(gui-eval 'current-ps-setup) pss])
(let ([xb (box 0)]
[yb (box 0)])
(send pss get-scaling xb yb)
(new (gui-eval 'pdf-dc%)
[interactive #f]
[width (* (unbox xb) (get-width v))]
[height (* (unbox yb) (get-height v))]))))])
(send dc start-doc "Image")
(send dc start-page)
(render v dc 0 0)
(send dc end-page)
(send dc end-doc))
(let* ([bm (make-object (gui-eval 'bitmap%)
(define fn (build-string-path img-dir (format "img~a.png" image-counter)))
(set! image-counter (add1 image-counter))
(let ([dc (let ([pss (make-object (gui-eval 'ps-setup%))])
(send pss set-mode 'file)
(send pss set-file (path-replace-suffix fn #".pdf"))
(parameterize ([(gui-eval 'current-ps-setup) pss])
(let ([xb (box 0)]
[yb (box 0)])
(send pss get-scaling xb yb)
(new (gui-eval 'pdf-dc%)
[interactive #f]
[width (* (unbox xb) (get-width v))]
[height (* (unbox yb) (get-height v))]))))])
(send dc start-doc "Image")
(send dc start-page)
(render v dc 0 0)
(send dc end-page)
(send dc end-doc))
(define bm
(make-object (gui-eval 'bitmap%)
(inexact->exact (ceiling (get-width v)))
(inexact->exact (ceiling (get-height v))))]
[dc (make-object (gui-eval 'bitmap-dc%) bm)])
(send dc set-smoothing 'aligned)
(send dc clear)
(render v dc 0 0)
(send bm save-file fn 'png)
(make-image-element
#f
(list "[image]")
;; Be sure to use a string rather than a path, because
;; it gets recorded in "exprs.dat".
(path->string (path-replace-suffix fn #""))
'(".pdf" ".png")
1.0)))]
(inexact->exact (ceiling (get-height v)))))
(define dc (make-object (gui-eval 'bitmap-dc%) bm))
(send dc set-smoothing 'aligned)
(send dc clear)
(render v dc 0 0)
(send bm save-file fn 'png)
(make-image-element #f
(list "[image]")
;; Be sure to use a string rather than a path, because
;; it gets recorded in "exprs.dat".
(path->string (path-replace-suffix fn #""))
'(".pdf" ".png")
1.0)]
[(pair? v) (cons (loop (car v))
(loop (cdr v)))]
[(serializable? v) v]
Expand Down
4 changes: 2 additions & 2 deletions scribble-lib/scriblib/render-cond.rkt
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
#lang racket/base
(require scribble/core
(for-syntax racket/base))
(require (for-syntax racket/base)
scribble/core)

(provide cond-element
cond-block)
Expand Down
Loading
Loading