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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
#lang at-exp racket/base
(require racket/contract
racket/dict
racket/format
racket/file
racket/path
racket/runtime-path
compiler/compilation-path
compiler/cm
"exn-gobbler.rkt")
(provide (all-defined-out))
(module+ test
(require rackunit))
(define version-bytes (string->bytes/utf-8 (version)))
(define vm-bytes (string->bytes/utf-8 (symbol->string (system-type 'vm))))
(define-logger quickscript)
;; TODO: What if (find-system-path 'pref-dir) does not exist?
(define quickscript-dir
(or (getenv "PLTQUICKSCRIPTDIR")
(build-path (find-system-path 'pref-dir) "quickscript")))
(define library-file
(build-path quickscript-dir "library.rktd"))
(define user-script-dir
(build-path quickscript-dir "user-scripts"))
(define (path-free? p-str)
(not (path-only p-str)))
(define (path-string->string p-str)
(if (string? p-str)
p-str
(path->string p-str)))
(define (script-file? f)
(equal? (path-get-extension f) #".rkt"))
(define (path-string=? dir1 dir2)
(string=? (path-string->string dir1)
(path-string->string dir2)))
(module+ test
(check-true (path-free? "a.rkt"))
(check-false (path-free? "b/a.rkt"))
(check-false (path-free? "b/a"))
(when (eq? (system-path-convention-type) 'unix)
(check-true
(path-string=? "a/b/c.rkt"
(build-path "a" "b/c.rkt")))))
(define-syntax-rule (time-info str body ...)
(let ([ms (current-milliseconds)])
(log-quickscript-info (string-append "Begin: " str "..."))
(begin0
(begin body ...)
(log-quickscript-info
(string-append "End : " str ". Took " (number->string (- (current-milliseconds) ms)) "ms")))))
(define props-default
`((name . #f)
(filepath . #f)
(label . #f) ; Should be mandatory
(menu-path . ())
(shortcut . #f)
(shortcut-prefix . #f) ; should be (get-default-shortcut-prefix), but this depends on gui/base
(help-string . "My amazing script")
(output-to . selection) ; outputs the result in a new tab
(persistent? . #f)
(os-types . (unix macosx windows)) ; list of supported os types
))
(define this-os-type (system-type 'os))
;; proc-name : string?
;; label : string?
;; TODO: extend this with a given property-dict
(define (make-simple-script-string proc-name label
#:script-help-string [script-help-string #f])
;; See the manual in the Scripts|Manage Scripts|Help menu for more information.
@string-append{
#lang racket/base
(require quickscript)
@(if script-help-string (string-append "\n(script-help-string " (~s script-help-string) ")\n") "")
;; Returns a replacement string for the selected string `selection`
;; ("" if no text is selected), or `#f` to leave the selection as is.
(define-script @proc-name
#:label "@label"
(λ (selection)
#f))
})
;; script-filename : path-string?
(define (make-submod-path script-filename)
(list 'submod
(list 'file (path-string->string script-filename))
'script-info))
;; script-filename : path-string?
;; Returns #f or a string.
;; Important: see note for get-property-dicts
(define (get-script-help-string script-filename)
(dynamic-require (make-submod-path script-filename)
'quickscript-module-help-string
(λ () #f)))
(define (property-dict? v)
(and (dict? v)
(dict-has-key? v 'label)))
;; Returns a list of dictionaries of the properties of the scripts in script-filename,
;; augmented with the scripts' function and the script filepath.
;; IMPORTANT: Loads the file in the current namespace, so a new namespace should probably
;; be created with (make-base-empty-namespace).
;; script-filename : path-string?
(define (get-property-dicts script-filepath)
; Ensure the script is compiled for the correct version of Racket
(compile-user-script script-filepath)
(define the-submod (make-submod-path script-filepath))
(dynamic-require the-submod #f)
(define-values (vars syntaxes) (module->exports the-submod))
(define funs (map car (dict-ref vars 0)))
(define property-dicts
(filter values
(for/list ([fun (in-list funs)])
(define maybe-props (dynamic-require the-submod fun))
(and (property-dict? maybe-props)
(list*
(cons 'name fun)
(cons 'filepath script-filepath)
maybe-props)))))
property-dicts)
(define (prop-dict-ref props key)
(dict-ref props key (dict-ref props-default key)))
(module+ test
(require racket/file)
(define dir (find-system-path 'temp-dir))
(define filename "tmp-script.rkt")
(define filepath (build-path dir filename))
(define proc-sym 'my-first-script)
(define proc-name (symbol->string proc-sym))
(define label "My First Script")
(define help-str "The help-string of the script.")
(display-to-file (make-simple-script-string proc-name label
#:script-help-string help-str)
filepath
#:exists 'replace)
; Note: because the script requires `quickscript/script`,
; quickscript must be installed as package/collection for the following to work.
(define-values (prop-dicts help-str2)
(parameterize ([current-namespace (make-base-empty-namespace)])
(values (get-property-dicts filepath)
(get-script-help-string filepath))))
(check = (length prop-dicts) 1)
(define props (car prop-dicts))
(check string=?
(dict-ref props 'label)
label)
(check eq?
(prop-dict-ref props 'name)
proc-sym)
(check string=?
help-str2
help-str))
;===================;
;=== Compilation ===;
;===================;
(define/contract (compile-user-script file)
(-> path-string? any)
;; Simple wrapper for now, but may be specialized for efficiency later.
(void)
#;(compile-user-scripts (list file)))
(define/contract (compile-user-scripts files
#:exn-gobbler [gb (make-exn-gobbler "Compiling scripts")])
(->* [(listof path-string?)]
[#:exn-gobbler exn-gobbler?]
exn-gobbler?)
; Synchronous version:
(parameterize ([current-namespace (make-base-empty-namespace)])
(define cmc (make-caching-managed-compile-zo))
(for ([f (in-list files)])
(with-handlers* ([exn:fail? (λ (e) (gobble gb e (path->string f)))])
(time-info (format "Compiling ~a" (path->string f))
(cmc f)))))
(log-quickscript-info (exn-gobbler->string gb))
gb)
(define (zo-file src-file)
(get-compilation-bytecode-file src-file #:modes '("compiled")))
|
