1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
#lang racket/base
(require (for-syntax racket/base
syntax/parse))
(provide define-script)
;; Keep this file as light as possible as it is loaded in each script.
(begin-for-syntax
(define submodule-content '()))
(begin-for-syntax
(define (add-submod-content! stx)
(syntax-parse stx
[(_ body ...)
(when (null? submodule-content)
(syntax-local-lift-module-end-declaration
#'(generate-submodule)))
(set! submodule-content
(cons (syntax-local-introduce
#`(begin body ...))
submodule-content))])))
;; Does not work yet
(provide module-script-info+)
(define-syntax (module-script-info+ stx)
(add-submod-content! stx)
#'(void))
(provide script-help-string)
(define-syntax (script-help-string stx)
(syntax-parse stx
[(_ str:expr)
(add-submod-content!
#`(begin
(provide quickscript-module-help-string)
(define quickscript-module-help-string 'str)))
#'(void)]))
(define-syntax (define-script stx)
(syntax-parse stx
[(_ proc (~alt (~once (~seq #:label label-val))
(~optional (~seq #:menu-path (menu-path-val ...))
#:defaults ([(menu-path-val 1) null]))
(~optional (~seq #:help-string help-string-val)
#:defaults ([help-string-val #'""]))
(~optional (~seq #:shortcut shortcut-val)
#:defaults ([shortcut-val #'#f]))
(~optional (~seq #:shortcut-prefix shortcut-prefix-val)
#:defaults ([shortcut-prefix-val #'#f]))
(~optional (~and #:persistent
(~bind [persistent-val #'#t]))
#:defaults ([persistent-val #'#f]))
(~optional (~seq #:output-to
(~and output-to-val
(~or (~datum selection)
(~datum new-tab)
(~datum message-box)
(~datum clipboard)
#f)))
#:defaults ([output-to-val #'selection]))
(~optional (~seq #:os-types
(~and os-types-val
[(~alt (~optional (~datum unix))
(~optional (~datum macosx))
(~optional (~datum windows)))
...]))
#:defaults ([os-types-val #'(unix macosx windows)])))
...
rhs:expr)
(add-submod-content!
#`(begin
(provide proc)
(define proc (list
(cons 'label 'label-val)
(cons 'menu-path '(menu-path-val ...))
(cons 'help-string 'help-string-val)
(cons 'shortcut 'shortcut-val)
(cons 'shortcut-prefix 'shortcut-prefix-val)
(cons 'persistent? '#,(attribute persistent-val))
(cons 'output-to 'output-to-val)
(cons 'os-types 'os-types-val)))))
(syntax/loc stx
(begin (provide proc)
(define proc rhs)))]))
(define-syntax (generate-submodule stx)
#`(module script-info racket/base #,@submodule-content)
; for debugging:
#;#`(begin (require racket/pretty)
(pretty-print (list '#,submodule-content))))
;; The following examples should raise explicit syntax errors
#;(define-script my-script
#:label "My Script2"
#:menu-path ("a" "b")
#:help-string "hey"
#:shortcut 'f9
#:shortcut-prefixx '(ctl shift)
;#:persistent
(λ (str) "yeah2"))
|
