",
133 | "header" -> ExportString[
134 | Append[
135 | header,
136 | {"date" -> DateString["ISODateTime"], "msg_type" -> replyType, "msg_id" -> StringInsert[StringReplace[CreateUUID[], "-" -> ""], "-", 9]}
137 | ],
138 | "JSON",
139 | "Compact" -> True
140 | ],
141 | "pheader" -> If[branchOff, "{}", ExportString[header, "JSON", "Compact" -> True]],
142 | "metadata" -> ExportString[
143 | {"text/html" -> {}},
144 | "JSON",
145 | "Compact" -> True
146 | ],
147 | "content" -> replyContent
148 | ];
149 |
150 | (* generate the signature of the reply message *)
151 | AssociateTo[
152 | result,
153 | "signature" ->
154 | hmac[
155 | keyString,
156 | StringJoin[
157 | result["header"],
158 | result["pheader"],
159 | result["metadata"],
160 | If[StringQ[result["content"]], result["content"], ByteArrayToString[result["content"]]]
161 | ]
162 | ]
163 | ];
164 |
165 | (* return the built reply message frame *)
166 | Return[result];
167 | ];
168 |
169 | (* end the private context for WolframLanguageForJupyter *)
170 | End[]; (* `Private` *)
171 |
172 | (************************************
173 | Get[] guard
174 | *************************************)
175 |
176 | ] (* WolframLanguageForJupyter`Private`$GotMessagingUtilities *)
177 |
--------------------------------------------------------------------------------
/WolframLanguageForJupyter/Resources/OutputHandlingUtilities.wl:
--------------------------------------------------------------------------------
1 | (************************************************
2 | OutputHandlingUtilities.wl
3 | *************************************************
4 | Description:
5 | Utilities for handling the result
6 | of Wolfram Language expressions
7 | so that, as outputs, they are
8 | reasonably displayed in Jupyter
9 | notebooks
10 | Symbols defined:
11 | textQ,
12 | toText,
13 | toOutTextHTML,
14 | toImageData,
15 | toOutImageHTML
16 | *************************************************)
17 |
18 | (************************************
19 | Get[] guard
20 | *************************************)
21 |
22 | If[
23 | !TrueQ[WolframLanguageForJupyter`Private`$GotOutputHandlingUtilities],
24 |
25 | WolframLanguageForJupyter`Private`$GotOutputHandlingUtilities = True;
26 |
27 | (************************************
28 | load required
29 | WolframLanguageForJupyter
30 | files
31 | *************************************)
32 |
33 | Get[FileNameJoin[{DirectoryName[$InputFileName], "Initialization.wl"}]]; (* $canUseFrontEnd, $outputSetToTeXForm,
34 | $outputSetToTraditionalForm,
35 | $trueFormatType, $truePageWidth,
36 | failedInBase64 *)
37 |
38 | (************************************
39 | private symbols
40 | *************************************)
41 |
42 | (* begin the private context for WolframLanguageForJupyter *)
43 | Begin["`Private`"];
44 |
45 | (************************************
46 | helper utility for converting
47 | an expression into a
48 | textual form
49 | *************************************)
50 |
51 | (* convert an expression into a textual form,
52 | using as much of the options already set for $Output as possible for ToString *)
53 | (* NOTE: toOutTextHTML used to call toStringUsingOutput *)
54 | toStringUsingOutput[expr_] :=
55 | ToString[
56 | expr,
57 | Sequence @@
58 | Cases[
59 | Options[$Output],
60 | Verbatim[Rule][opt_, val_] /;
61 | MemberQ[
62 | Keys[Options[ToString]],
63 | opt
64 | ]
65 | ]
66 | ];
67 |
68 | (************************************
69 | helper utility for determining
70 | if a result should be
71 | displayed as text or an image
72 | *************************************)
73 |
74 | (* check if a string contains any private use area characters *)
75 | containsPUAQ[str_] :=
76 | AnyTrue[
77 | ToCharacterCode[str, "Unicode"],
78 | (57344 <= #1 <= 63743 || 983040 <= #1 <= 1048575 || 1048576 <= #1 <= 1114111) &
79 | ];
80 |
81 | (************************************
82 | utility for determining if a
83 | result should be displayed
84 | as text or an image
85 | *************************************)
86 |
87 | (* determine if a result does not depend on any Wolfram Language frontend functionality,
88 | such that it should be displayed as text *)
89 | textQ[expr_] := Module[
90 | {
91 | (* the head of expr *)
92 | exprHead,
93 |
94 | (* pattern objects *)
95 | pObjects
96 | },
97 |
98 | (* if we cannot use the frontend, use text *)
99 | If[
100 | !$canUseFrontEnd,
101 | Return[True];
102 | ];
103 |
104 | (* save the head of the expression *)
105 | exprHead = Head[expr];
106 |
107 | (* if the expression is wrapped with InputForm or OutputForm,
108 | automatically format as text *)
109 | If[exprHead === InputForm || exprHead === OutputForm,
110 | Return[True]
111 | ];
112 |
113 | (* if the FormatType of $Output is set to TeXForm, or if the expression is wrapped with TeXForm,
114 | and the expression has an acceptable textual form, format as text *)
115 | If[($outputSetToTeXForm || exprHead == TeXForm) && !containsPUAQ[ToString[expr]],
116 | Return[True];
117 | ];
118 |
119 | (* if the FormatType of $Output is set to TraditionalForm,
120 | or if the expression is wrapped with TraditionalForm,
121 | do not use text *)
122 | If[$outputSetToTraditionalForm || exprHead === TraditionalForm,
123 | Return[False]
124 | ];
125 |
126 | (* breakdown expr into atomic objects organized by their Head *)
127 | pObjects =
128 | GroupBy[
129 | Complement[
130 | Quiet[Cases[
131 | expr,
132 | elem_ /; (Depth[Unevaluated[elem]] == 1) -> Hold[elem],
133 | {0, Infinity},
134 | Heads -> True
135 | ]],
136 | (* these symbols are fine *)
137 | {Hold[List], Hold[Association]}
138 | ],
139 | (
140 | Replace[
141 | #1,
142 | Hold[elem_] :> Head[Unevaluated[elem]]
143 | ]
144 | ) &
145 | ];
146 |
147 | (* if expr just contains atomic objects of the types listed above, return True *)
148 | If[
149 | ContainsOnly[Keys[pObjects], {Integer, Real}],
150 | Return[True];
151 | ];
152 |
153 | (* if expr just contains atomic objects of the types listed above, along with some symbols,
154 | return True only if the symbols have no attached rules *)
155 | If[
156 | ContainsOnly[Keys[pObjects], {Integer, Real, String, Symbol}],
157 | Return[
158 | AllTrue[
159 | Lookup[pObjects, String, {}],
160 | (!containsPUAQ[ReleaseHold[#1]]) &
161 | ] &&
162 | AllTrue[
163 | Lookup[pObjects, Symbol, {}],
164 | (
165 | Replace[
166 | #1,
167 | Hold[elem_] :> ToString[Definition[elem]]
168 | ] === "Null"
169 | ) &
170 | ]
171 | ];
172 | ];
173 |
174 | (* otherwise, no, the result should not be displayed as text *)
175 | Return[False];
176 | ];
177 |
178 | (************************************
179 | utilities for generating
180 | HTML for displaying
181 | results as text and images
182 | *************************************)
183 |
184 | (* generate the textual form of a result using a given page width *)
185 | (* NOTE: the OutputForm (which ToString uses) of any expressions wrapped with, say, InputForm should
186 | be identical to the string result of an InputForm-wrapped expression itself *)
187 | toText[result_, pageWidth_] :=
188 | ToString[
189 | (* make sure to apply $trueFormatType to the result if the result is not already headed by TeXForm *)
190 | If[
191 | Head[result] === TeXForm,
192 | result,
193 | $trueFormatType[result]
194 | ],
195 | (* also, use the given page width *)
196 | PageWidth -> pageWidth
197 | ];
198 | (* generate the textual form of a result using the current PageWidth setting for $Output *)
199 | toText[result_] := toText[result, $truePageWidth];
200 |
201 | (* generate HTML for the textual form of a result *)
202 | toOutTextHTML[result_] :=
203 | Module[
204 | {
205 | (* if the result should be marked as TeX *)
206 | isTeX
207 | },
208 | (* check if the result should be marked as TeX *)
209 | isTeX = ((Head[result] === TeXForm) || ($outputSetToTeXForm));
210 | Return[
211 | StringJoin[
212 |
213 | (* mark this result as preformatted only if it isn't TeX *)
214 | If[
215 | !isTeX,
216 | {
217 | (* preformatted *)
218 | ""
222 | },
223 | {}
224 | ],
225 |
226 | (* mark the text as TeX, if is TeX *)
227 | If[isTeX, "$$", ""],
228 |
229 | (* the textual form of the result *)
230 | ({"", ToString[#1], ";"} & /@
231 | ToCharacterCode[
232 | If[
233 | isTeX,
234 | (* if the result is TeX, do not allow line breaks *)
235 | toText[result, Infinity],
236 | (* otherwise, just call toText *)
237 | toText[result]
238 | ],
239 | "Unicode"
240 | ]),
241 |
242 | (* mark the text as TeX, if is TeX *)
243 | If[isTeX, "$$", ""],
244 |
245 | (* mark this result as preformatted only if it isn't TeX *)
246 | If[
247 | !isTeX,
248 | {
249 | (* end the element *)
250 | "
"
251 | },
252 | {}
253 | ]
254 | ]
255 | ];
256 | ];
257 |
258 | (* generate a byte array of image data for the rasterized form of a result *)
259 | toImageData[result_] :=
260 | Module[
261 | {
262 | (* the preprocessed form of a result *)
263 | preprocessedForm
264 | },
265 | (* preprocess the result *)
266 | If[
267 | Head[result] === Manipulate,
268 | preprocessedForm = result;
269 | ,
270 | preprocessedForm = Rasterize[result];
271 | ];
272 | (* if the preprocessing failed, return $Failed *)
273 | If[
274 | FailureQ[preprocessedForm],
275 | Return[$Failed];
276 | ];
277 | (* now return preprocessedForm as a byte array corresponding to the PNG format *)
278 | Return[
279 | ExportByteArray[
280 | preprocessedForm,
281 | "PNG"
282 | ]
283 | ];
284 | ];
285 |
286 | (* generate HTML for the rasterized form of a result *)
287 | toOutImageHTML[result_] :=
288 | Module[
289 | {
290 | (* the rasterization of result *)
291 | imageData,
292 | (* the rasterization of result in base 64 *)
293 | imageDataInBase64
294 | },
295 |
296 | (* rasterize the result *)
297 | imageData =
298 | toImageData[
299 | $trueFormatType[result]
300 | ];
301 | If[
302 | !FailureQ[imageData],
303 | (* if the rasterization did not fail, convert it to base 64 *)
304 | imageInBase64 = BaseEncode[imageData];
305 | ,
306 | (* if the rasterization did fail, try to rasterize result with Shallow *)
307 | imageData =
308 | toImageData[
309 | $trueFormatType[Shallow[result]]
310 | ];
311 | If[
312 | !FailureQ[imageData],
313 | (* if the rasterization did not fail, convert it to base 64 *)
314 | imageInBase64 = BaseEncode[imageData];
315 | ,
316 | (* if the rasterization did fail, try to rasterize $Failed *)
317 | imageData =
318 | toImageData[
319 | $trueFormatType[$Failed]
320 | ];
321 | If[
322 | !FailureQ[imageData],
323 | (* if the rasterization did not fail, convert it to base 64 *)
324 | imageInBase64 = BaseEncode[imageData];
325 | ,
326 | (* if the rasterization did fail, use a hard-coded base64 rasterization of $Failed *)
327 | imageInBase64 = failedInBase64;
328 | ];
329 | ];
330 | ];
331 |
332 | (* return HTML for the rasterized form of result *)
333 | Return[
334 | StringJoin[
335 | (* display a inlined PNG image encoded in base64 *)
336 | "
"
341 | ]
342 | ]
343 | ];
344 |
345 | (* end the private context for WolframLanguageForJupyter *)
346 | End[]; (* `Private` *)
347 |
348 | (************************************
349 | Get[] guard
350 | *************************************)
351 |
352 | ] (* WolframLanguageForJupyter`Private`$GotOutputHandlingUtilities *)
353 |
--------------------------------------------------------------------------------
/WolframLanguageForJupyter/Resources/RequestHandlers.wl:
--------------------------------------------------------------------------------
1 | (************************************************
2 | RequestHandlers.wl
3 | *************************************************
4 | Description:
5 | Handlers for message frames of the form
6 | "*_request" arriving from Jupyter
7 | Symbols defined:
8 | isCompleteRequestHandler,
9 | executeRequestHandler,
10 | completeRequestHandler
11 | *************************************************)
12 |
13 | (************************************
14 | Get[] guard
15 | *************************************)
16 |
17 | If[
18 | !TrueQ[WolframLanguageForJupyter`Private`$GotRequestHandlers],
19 |
20 | WolframLanguageForJupyter`Private`$GotRequestHandlers = True;
21 |
22 | (************************************
23 | load required
24 | WolframLanguageForJupyter
25 | files
26 | *************************************)
27 |
28 | Get[FileNameJoin[{DirectoryName[$InputFileName], "Initialization.wl"}]]; (* loopState *)
29 |
30 | Get[FileNameJoin[{DirectoryName[$InputFileName], "SocketUtilities.wl"}]]; (* sendFrame *)
31 | Get[FileNameJoin[{DirectoryName[$InputFileName], "MessagingUtilities.wl"}]]; (* createReplyFrame *)
32 |
33 | Get[FileNameJoin[{DirectoryName[$InputFileName], "EvaluationUtilities.wl"}]]; (* redirectPrint, redirectMessages, simulatedEvaluate *)
34 |
35 | Get[FileNameJoin[{DirectoryName[$InputFileName], "OutputHandlingUtilities.wl"}]]; (* textQ, toOutTextHTML, toOutImageHTML,
36 | toText, containsPUAQ *)
37 |
38 | Get[FileNameJoin[{DirectoryName[$InputFileName], "CompletionUtilities.wl"}]]; (* rewriteNamedCharacters *)
39 |
40 | (************************************
41 | private symbols
42 | *************************************)
43 |
44 | (* begin the private context for WolframLanguageForJupyter *)
45 | Begin["`Private`"];
46 |
47 | (************************************
48 | handler for is_complete_requests
49 | *************************************)
50 |
51 | (* handle is_complete_request message frames received on the shell socket *)
52 | isCompleteRequestHandler[] :=
53 | Module[
54 | {
55 | (* the length of the code string to check completeness for *)
56 | stringLength,
57 | (* the value returned by SyntaxLength[] on the code string to check completeness for *)
58 | syntaxLength
59 | },
60 |
61 | (* mark loopState["isCompleteRequestSent"] as True *)
62 | loopState["isCompleteRequestSent"] = True;
63 |
64 | (* set the appropriate reply type *)
65 | loopState["replyMsgType"] = "is_complete_reply";
66 |
67 | (* determine the length of the code string *)
68 | stringLength = StringLength[loopState["frameAssoc"]["content"]["code"]];
69 | (* determine the SyntaxLength[] value for the code string *)
70 | syntaxLength = SyntaxLength[loopState["frameAssoc"]["content"]["code"]];
71 |
72 | (* test the value of syntaxLength to determine the completeness of the code string,
73 | setting the content of the reply appropriately *)
74 | Which[
75 | (* if the above values could not be correctly determined,
76 | the completeness status of the code string is unknown *)
77 | !IntegerQ[stringLength] || !IntegerQ[syntaxLength],
78 | loopState["replyContent"] = "{\"status\":\"unknown\"}";,
79 | (* if the SyntaxLength[] value for a code string is greater than its actual length,
80 | the code string is incomplete *)
81 | syntaxLength > stringLength,
82 | loopState["replyContent"] = "{\"status\":\"incomplete\"}";,
83 | (* if the SyntaxLength[] value for a code string is less than its actual length,
84 | the code string contains a syntax error (or is "invalid") *)
85 | syntaxLength < stringLength,
86 | loopState["replyContent"] = "{\"status\":\"invalid\"}";,
87 | (* if the SyntaxLength[] value for a code string is equal to its actual length,
88 | the code string is complete and correct *)
89 | syntaxLength == stringLength,
90 | loopState["replyContent"] = "{\"status\":\"complete\"}";
91 | ];
92 | ];
93 |
94 | (************************************
95 | handler for execute_requests
96 | *************************************)
97 |
98 | (* handle execute_request message frames received on the shell socket *)
99 | executeRequestHandler[] :=
100 | Module[
101 | {
102 | (* message formatter function *)
103 | messageFormatter,
104 |
105 | (* content of the desired frame to send on the IO Publish socket *)
106 | ioPubReplyContent,
107 |
108 | (* the HTML form for any generated message *)
109 | errorMessage,
110 |
111 | (* the total result of the evaluation:
112 | an association containing
113 | the result of evaluation ("EvaluationResult"),
114 | indices of the output lines of the result ("EvaluationResultOutputLineIndices"),
115 | the total number of indices consumed by this evaluation ("ConsumedIndices"),
116 | generated messages ("GeneratedMessages")
117 | *)
118 | totalResult,
119 |
120 | (* flag for if there are any unreported error messages after execution of the input *)
121 | unreportedErrorMessages
122 | },
123 |
124 | (* if an is_complete_request has been sent, assume jupyter-console is running the kernel,
125 | redirect messages, and handle any "Quit", "Exit", "quit" or "exit" inputs *)
126 | If[
127 | loopState["isCompleteRequestSent"],
128 | loopState["redirectMessages"] = True;
129 | If[
130 | StringMatchQ[
131 | loopState["frameAssoc"]["content"]["code"],
132 | "Quit" | "Exit" | "quit" | "exit"
133 | ],
134 | loopState["replyMsgType"] = "execute_reply";
135 | (* NOTE: uses payloads *)
136 | loopState["replyContent"] = ExportString[Association["status" -> "ok", "execution_count" -> loopState["executionCount"], "user_expressions" -> {}, "payload" -> {Association["source" -> "ask_exit", "keepkernel" -> False]}], "JSON", "Compact" -> True];
137 | Return[];
138 | ];
139 | ];
140 |
141 | (* redirect Print so that it prints in the Jupyter notebook *)
142 | loopState["printFunction"] = (redirectPrint[loopState["frameAssoc"], #1] &);
143 |
144 | (* if loopState["redirectMessages"] is True,
145 | update Jupyter explicitly with any errors that occur DURING the execution of the input *)
146 | If[
147 | loopState["redirectMessages"],
148 | messageFormatter[messageName_, messageText_] :=
149 | redirectMessages[
150 | loopState["frameAssoc"],
151 | messageName,
152 | messageText,
153 | (* add a newline if loopState["isCompleteRequestSent"] *)
154 | loopState["isCompleteRequestSent"]
155 | ];
156 | SetAttributes[messageFormatter, HoldAll];
157 | Internal`$MessageFormatter = messageFormatter;
158 | ];
159 |
160 | (* evaluate the input, and store the total result in totalResult *)
161 | totalResult = simulatedEvaluate[loopState["frameAssoc"]["content"]["code"]];
162 |
163 | (* restore printFunction to False *)
164 | loopState["printFunction"] = False;
165 |
166 | (* unset messageFormatter and Internal`$MessageFormatter *)
167 | Unset[messageFormatter];
168 | Unset[Internal`$MessageFormatter];
169 |
170 | (* set the appropriate reply type *)
171 | loopState["replyMsgType"] = "execute_reply";
172 |
173 | (* set the content of the reply to information about WolframLanguageForJupyter's execution of the input *)
174 | loopState["replyContent"] =
175 | ExportString[
176 | Association[
177 | "status" -> "ok",
178 | "execution_count" -> loopState["executionCount"],
179 | "user_expressions" -> {},
180 | (* see https://jupyter-client.readthedocs.io/en/stable/messaging.html#payloads-deprecated *)
181 | (* if the "askExit" flag is True, add an "ask_exit" payload *)
182 | (* NOTE: uses payloads *)
183 | "payload" -> If[loopState["askExit"], {Association["source" -> "ask_exit", "keepkernel" -> False]}, {}]
184 | ],
185 | "JSON",
186 | "Compact" -> True
187 | ];
188 |
189 | (* check if there are any unreported error messages *)
190 | unreportedErrorMessages =
191 | (
192 | (* ... because messages are not being redirected *)
193 | (!loopState["redirectMessages"]) &&
194 | (* ... and because at least one message was generated *)
195 | (StringLength[totalResult["GeneratedMessages"]] > 0)
196 | );
197 |
198 | (* if there are no results, or if the "askExit" flag is True,
199 | do not send anything on the IO Publish socket and return *)
200 | If[
201 | (Length[totalResult["EvaluationResultOutputLineIndices"]] == 0) ||
202 | (loopState["askExit"]),
203 | (* set the "askExit" flag to False *)
204 | loopState["askExit"] = False;
205 | (* send any unreported error messages *)
206 | If[unreportedErrorMessages,
207 | redirectMessages[
208 | loopState["frameAssoc"],
209 | "",
210 | totalResult["GeneratedMessages"],
211 | (* do not add a newline *)
212 | False,
213 | (* drop message name *)
214 | True
215 | ];
216 | ];
217 | (* increment loopState["executionCount"] as needed *)
218 | loopState["executionCount"] += totalResult["ConsumedIndices"];
219 | Return[];
220 | ];
221 |
222 | (* generate an HTML form of the message text *)
223 | errorMessage =
224 | If[
225 | !unreportedErrorMessages,
226 | (* if there are no unreported error messages, there is no need to format them *)
227 | {},
228 | (* build the HTML form of the message text *)
229 | {
230 | (* preformatted *)
231 | "",
236 | (* the generated messages *)
237 | StringJoin[{"", ToString[#1], ";"} & /@ ToCharacterCode[totalResult["GeneratedMessages"], "UTF-8"]],
238 | (* end the element *)
239 | "
"
240 | }
241 | ];
242 |
243 | (* format output as purely text, image, or cloud interface *)
244 | If[
245 | (* check if the input was wrapped with Interact,
246 | which is used when the output should be displayed as an embedded cloud object *)
247 | TrueQ[totalResult["InteractStatus"]] &&
248 | (* check if we are logged into the Cloud *)
249 | $CloudConnected,
250 | (* prepare the content for a reply message frame to be sent on the IO Publish socket *)
251 | ioPubReplyContent =
252 | ExportString[
253 | Association[
254 | (* the first output index *)
255 | "execution_count" -> First[totalResult["EvaluationResultOutputLineIndices"]],
256 | (* HTML code to embed output uploaded to the Cloud in the Jupyter notebook *)
257 | "data" ->
258 | {
259 | "text/html" ->
260 | StringJoin[
261 | (* display any generated messages as inlined PNG images encoded in base64 *)
262 | "
",
267 | (* embed the cloud object *)
268 | EmbedCode[CloudDeploy[totalResult["EvaluationResult"]], "HTML"][[1]]["CodeSection"]["Content"],
269 | (* end the whole element *)
270 | "
"
271 | ],
272 | "text/plain" -> ""
273 | },
274 | (* no metadata *)
275 | "metadata" -> {"text/html" -> {}, "text/plain" -> {}}
276 | ],
277 | "JSON",
278 | "Compact" -> True
279 | ];
280 | ,
281 | (* if every output line can be formatted as text, use a function that converts the output to text *)
282 | (* otherwise, use a function that converts the output to an image *)
283 | (* TODO: allow for mixing text and image results *)
284 | If[AllTrue[totalResult["EvaluationResult"], textQ],
285 | toOut = toOutTextHTML,
286 | toOut = toOutImageHTML
287 | ];
288 | (* prepare the content for a reply message frame to be sent on the IO Publish socket *)
289 | ioPubReplyContent = ExportByteArray[
290 | Association[
291 | (* the first output index *)
292 | "execution_count" -> First[totalResult["EvaluationResultOutputLineIndices"]],
293 | (* the data representing the results and messages *)
294 | "data" ->
295 | {
296 | (* generate HTML for the results and messages *)
297 | "text/html" ->
298 | If[
299 | loopState["isCompleteRequestSent"],
300 | (* if an is_complete_request has been sent, assume jupyter-console is running the kernel,
301 | and do not generate HTML *)
302 | "",
303 | (* otherwise, output the results in a grid *)
304 | If[
305 | Length[totalResult["EvaluationResult"]] > 1,
306 | StringJoin[
307 | (* add grid style *)
308 | "
314 |
315 | ",
316 | (* display error message *)
317 | errorMessage,
318 | (* start the grid *)
319 | "
",
320 | (* display the output lines *)
321 | Table[
322 | {
323 | (* start the grid item *)
324 | "
",
325 | (* show the output line *)
326 | toOut[totalResult["EvaluationResult"][[outIndex]]],
327 | (* end the grid item *)
328 | "
"
329 | },
330 | {outIndex, 1, Length[totalResult["EvaluationResult"]]}
331 | ],
332 | (* end the element *)
333 | "
"
334 | ],
335 | StringJoin[
336 | (* start the element *)
337 | "",
338 | (* display error message *)
339 | errorMessage,
340 | (* if there are messages, but no results, do not display a result *)
341 | If[
342 | Length[totalResult["EvaluationResult"]] == 0,
343 | "",
344 | (* otherwise, display a result *)
345 | toOut[First[totalResult["EvaluationResult"]]]
346 | ],
347 | (* end the element *)
348 | "
"
349 | ]
350 | ]
351 | ],
352 | (* provide, as a backup, plain text for the results *)
353 | "text/plain" ->
354 | StringJoin[
355 | Table[
356 | {
357 | toText[totalResult["EvaluationResult"][[outIndex]]],
358 | (* -- also, suppress newline if this is the last result *)
359 | If[outIndex != Length[totalResult["EvaluationResult"]], "\n", ""]
360 | },
361 | {outIndex, 1, Length[totalResult["EvaluationResult"]]}
362 | ]
363 | ]
364 | },
365 | (* no metadata *)
366 | "metadata" -> {"text/html" -> {}, "text/plain" -> {}}
367 | ],
368 | "JSON",
369 | "Compact" -> True
370 | ];
371 | ];
372 |
373 | (* create frame from ioPubReplyContent *)
374 | loopState["ioPubReplyFrame"] =
375 | createReplyFrame[
376 | (* use the current source frame *)
377 | loopState["frameAssoc"],
378 | (* the reply message type *)
379 | "execute_result",
380 | (* the reply message content *)
381 | ioPubReplyContent,
382 | (* do not branch off *)
383 | False
384 | ];
385 |
386 | (* increment loopState["executionCount"] as needed *)
387 | loopState["executionCount"] += totalResult["ConsumedIndices"];
388 | ];
389 |
390 | (************************************
391 | handler for complete_requests
392 | *************************************)
393 |
394 | (* handle complete_request message frames received on the shell socket *)
395 | completeRequestHandler[] :=
396 | Module[
397 | {
398 | (* for storing the code string to offer completion suggestions on *)
399 | codeStr
400 | },
401 | (* get the code string to rewrite the named characters of, ending at the cursor *)
402 | codeStr =
403 | StringTake[
404 | loopState["frameAssoc"]["content"]["code"],
405 | {
406 | 1,
407 | loopState["frameAssoc"]["content"]["cursor_pos"]
408 | }
409 | ];
410 | (* set the appropriate reply type *)
411 | loopState["replyMsgType"] = "complete_reply";
412 | (* set the content of the reply to a list of rewrites for any named characters in the code string *)
413 | loopState["replyContent"] =
414 | ByteArrayToString[
415 | ExportByteArray[
416 | Association[
417 | "matches" ->
418 | DeleteDuplicates[
419 | Prepend[
420 | Select[
421 | rewriteNamedCharacters[codeStr],
422 | (!containsPUAQ[#1])&
423 | ],
424 | codeStr
425 | ]
426 | ],
427 | "cursor_start" -> 0,
428 | "cursor_end" -> StringLength[codeStr],
429 | "metadata" -> {},
430 | "status" -> "ok"
431 | ],
432 | "JSON",
433 | "Compact" -> True
434 | ]
435 | ];
436 | ];
437 |
438 | (* end the private context for WolframLanguageForJupyter *)
439 | End[]; (* `Private` *)
440 |
441 | (************************************
442 | Get[] guard
443 | *************************************)
444 |
445 | ] (* WolframLanguageForJupyter`Private`$GotRequestHandlers *)
446 |
--------------------------------------------------------------------------------
/WolframLanguageForJupyter/Resources/SocketUtilities.wl:
--------------------------------------------------------------------------------
1 | (************************************************
2 | SocketUtilities.wl
3 | *************************************************
4 | Description:
5 | Low-level utilities for writing to
6 | sockets
7 | Symbols defined:
8 | socketWriteFunction,
9 | sendFrame,
10 | hmac
11 | *************************************************)
12 |
13 | (************************************
14 | Get[] guard
15 | *************************************)
16 |
17 | If[
18 | !TrueQ[WolframLanguageForJupyter`Private`$GotSocketUtilities],
19 |
20 | WolframLanguageForJupyter`Private`$GotSocketUtilities = True;
21 |
22 | (************************************
23 | get required paclets
24 | *************************************)
25 |
26 | (* obtain ZMQ utilities *)
27 | Needs["ZeroMQLink`"]; (* socketWriteFunction, ZeroMQLink`Private`ZMQWriteInternal,
28 | ZeroMQLink`ZMQSocketWriteMessage *)
29 |
30 | (************************************
31 | private symbols
32 | *************************************)
33 |
34 | (* begin the private context for WolframLanguageForJupyter *)
35 | Begin["`Private`"];
36 |
37 | (************************************
38 | utility for writing a part
39 | of a message frame to a
40 | socket
41 | *************************************)
42 |
43 | (* write a part of a message frame to a socket *)
44 | (* adjust for differences in Wolfram Engine version *)
45 | If[TrueQ[$VersionNumber < 12.0],
46 | Options[socketWriteFunction] = {"Asynchronous"->False,"Multipart"->False};
47 | socketWriteFunction[sock_, data_List, opts:OptionsPattern[]] := ZeroMQLink`Private`ZMQWriteInternal[sock, data, opts];
48 | socketWriteFunction[sock_, data_ByteArray, rest___]:= socketWriteFunction[sock, Normal[data], rest]
49 | ,
50 | socketWriteFunction = ZeroMQLink`ZMQSocketWriteMessage
51 | ];
52 |
53 | (************************************
54 | utility for writing a message
55 | frame to a socket
56 | *************************************)
57 |
58 | (* write a message frame that matches Jupyter's messaging protocols to a socket *)
59 | sendFrame[socket_, frame_Association] := Module[{},
60 |
61 | (* see https://jupyter-client.readthedocs.io/en/stable/messaging.html for an explanation of the below *)
62 |
63 | socketWriteFunction[
64 | socket,
65 | frame["ident"],
66 | "Multipart" -> True
67 | ];
68 |
69 | socketWriteFunction[
70 | socket,
71 | StringToByteArray[#1],
72 | "Multipart" -> True
73 | ]& /@ Lookup[frame, {"idsmsg", "signature", "header", "pheader", "metadata"}];
74 |
75 | socketWriteFunction[
76 | socket,
77 | If[ByteArrayQ[frame["content"]], frame["content"], StringToByteArray[frame["content"]]],
78 | "Multipart" -> False
79 | ];
80 | ];
81 |
82 | (************************************
83 | utility for determining the
84 | HMAC signature of a
85 | message frame
86 | *************************************)
87 |
88 | (* determine the HMAC signature of a message frame *)
89 | hmac[key_String, message_String] :=
90 | Module[
91 | {
92 | method, blockSize, outputSize,
93 | baKey, baMessage,
94 | baKeyPrime,
95 | keyPrime,
96 | baOPadded, baIPadded
97 | },
98 |
99 | (* adapted from wikipedia article on HMAC's definition *)
100 |
101 | method = "SHA256";
102 | blockSize = 64;
103 | outputSize = 32;
104 |
105 | baKey = StringToByteArray[key];
106 | baMessage = StringToByteArray[message];
107 |
108 | If[Length[baKey] > blockSize,
109 | baKeyPrime = Hash[baKey, method, "ByteArray"];
110 | ];
111 |
112 | If[Length[baKey] < blockSize,
113 | baKeyPrime = Join[
114 | baKey,
115 | ByteArray[
116 | Table[0, {blockSize - Length[baKey]}]
117 | ]
118 | ];
119 | ];
120 |
121 | keyPrime = Normal[baKeyPrime];
122 |
123 | baOPadded = ByteArray[BitXor[#1, 92] & /@ Normal[keyPrime]];
124 | baIPadded = ByteArray[BitXor[#1, 54] & /@ Normal[keyPrime]];
125 |
126 | Hash[
127 | Join[
128 | baOPadded,
129 | Hash[
130 | Join[
131 | baIPadded,
132 | baMessage
133 | ],
134 | method,
135 | "ByteArray"
136 | ]
137 | ],
138 | method,
139 | "HexString"
140 | ]
141 | ];
142 |
143 | (* end the private context for WolframLanguageForJupyter *)
144 | End[]; (* `Private` *)
145 |
146 | (************************************
147 | Get[] guard
148 | *************************************)
149 |
150 | ] (* WolframLanguageForJupyter`Private`$GotSocketUtilities *)
151 |
--------------------------------------------------------------------------------
/WolframLanguageForJupyter/WolframLanguageForJupyter.m:
--------------------------------------------------------------------------------
1 | BeginPackage["WolframLanguageForJupyter`"];
2 |
3 | ConfigureJupyter::subcommand = "The first argument to ConfigureJupyter is the subcommand: either \"add\", \"remove\", or \"clear\".";
4 | ConfigureJupyter::argx = "ConfigureJupyter called with `1` arguments; 1 argument is expected.";
5 |
6 | ConfigureJupyter::notfound = "Jupyter installation on Environment[\"PATH\"] not found.";
7 | ConfigureJupyter::isdir = "Provided `1` binary path is a directory. Please provide the path to the `1` binary.";
8 | ConfigureJupyter::nobin = "Provided `1` binary path does not exist.";
9 |
10 | ConfigureJupyter::notadded = "An error has occurred. The desired Wolfram Engine is not in \"jupyter kernelspec list.\" See WolframLanguageForJupyter`.`Errors`.`$ConfigureError for the message that Jupyter returned when attempting to add the Wolfram Engine.";
11 | ConfigureJupyter::notremoved = "An error has occurred: Wolfram Engine(s) still in \"jupyter kernelspec list.\" See WolframLanguageForJupyter`.`Errors`.`$ConfigureError for the message that Jupyter returned when attempting to remove the Wolfram Engine.";
12 |
13 | ConfigureJupyter::addconflict = "An error has occurred. A Wolfram Engine with the same $VersionNumber of the target Wolfram Engine is in \"jupyter kernelspec list.\" Attempting to overwrite ...";
14 | (* ConfigureJupyter::removeconflict = "An error has occurred. The Wolfram Engine(s) to be removed is/are not in \"jupyter kernelspec list.\""; *)
15 |
16 | ConfigureJupyter::nolink = "An error has occurred: Communication with provided Wolfram Engine binary could not be established.";
17 |
18 | ConfigureJupyter::usage =
19 | "ConfigureJupyter[subcommand:\"add\"|\"remove\"|\"clear\"] evaluates the action associated with subcommand, relying on the current Wolfram Engine binary path and the first Jupyter installation on Environment[\"PATH\"] when relevant.
20 | ConfigureJupyter[subcommand:\"add\"|\"remove\"|\"clear\", opts] evaluates the action associated with subcommand, using specified paths for \"WolframEngineBinary\" and \"JupyterInstallation\" when given as options.";
21 |
22 | Begin["`Private`"];
23 |
24 | (*
25 | Dictionary:
26 | mathBin/mathBinSession = WolframKernel binary
27 | kernelspec = Kernel Specification; term used by Jupyter
28 | notProvidedQ = was a Wolfram Engine Binary explicitly specified?
29 | *)
30 |
31 | (* START: Helper symbols *)
32 |
33 | projectHome = DirectoryName[$InputFileName];
34 |
35 | (* establishes link with Wolfram Engine at mathBin and evaluates $Version/$VersionNumber *)
36 | (* returns string form *)
37 | getVersionFromKernel[mathBin_String] :=
38 | Module[{link, res},
39 | link =
40 | LinkLaunch[
41 | StringJoin[
42 | {
43 | "\"",
44 | mathBin,
45 | "\" -wstp"
46 | }
47 | ]
48 | ];
49 | If[FailureQ[link],
50 | Return[$Failed];
51 | ];
52 | (* bleed link *)
53 | While[LinkReadyQ[link, 0.5], LinkRead[link];];
54 | LinkWrite[link, Unevaluated[$VersionNumber]];
55 | res = StringTrim[ToString[LinkRead[link]], "ReturnPacket[" | "]"];
56 | LinkClose[link];
57 | If[!StringContainsQ[res, "[" | "]"],
58 | Return[res];,
59 | Return[$Failed];
60 | ];
61 | ];
62 |
63 | (* determine display name for Jupyter installation from Wolfram Engine $Version/$VersionNumber *)
64 | (* returns {Kernel ID, Display Name} *)
65 | getNames[mathBin_String, notProvidedQ_?BooleanQ] :=
66 | Module[{version, installDir, (* names, hashedKernelUUID *) versionStr},
67 | (* if Wolfram Engine binary not provided, just evaluate $Version in the current session *)
68 | (* otherwise, use MathLink to obtain $Version *)
69 | If[
70 | notProvidedQ,
71 | version = ToString[$VersionNumber];
72 | installDir = $InstallationDirectory;
73 | ,
74 | version = Quiet[getVersionFromKernel[mathBin]];
75 | If[
76 | FailureQ[version],
77 | Return[$Failed];
78 | ];
79 | installDir = mathBin;
80 | ];
81 |
82 | versionStr = StringTrim[version, "."];
83 | Return[
84 | {
85 | (* Kernel ID *)
86 | StringJoin["wolframlanguage", versionStr],
87 | (* Display Name *)
88 | StringJoin["Wolfram Language ", versionStr]
89 | }
90 | ];
91 | ];
92 |
93 | (* determine symbols related to finding Wolfram Engine and Jupyter installations *)
94 | (* mathBinSession: WolframKernel location for the current session *)
95 | (* fileExt: file extension for executables *)
96 | (* pathSeperator: delimiter for directories on PATH *)
97 | defineGlobalVars[] :=
98 | Switch[
99 | $OperatingSystem,
100 | "Windows",
101 | mathBinSession = FileNameJoin[{$InstallationDirectory, "wolfram.exe"}];
102 | fileExt = ".exe";
103 | pathSeperator = ";";,
104 | "MacOSX",
105 | mathBinSession = FileNameJoin[{$InstallationDirectory, "MacOS", "WolframKernel"}];
106 | fileExt = "";
107 | pathSeperator = ":";,
108 | "Unix",
109 | mathBinSession = FileNameJoin[{$InstallationDirectory, "Executables", "WolframKernel"}];
110 | fileExt = "";
111 | pathSeperator = ":";
112 | ];
113 |
114 | mathBinSession := (defineGlobalVars[]; mathBinSession);
115 | fileExt := (defineGlobalVars[]; fileExt);
116 | pathSeperator := (defineGlobalVars[]; pathSeperator);
117 |
118 | (* a list of directories in PATH *)
119 | splitPath :=
120 | StringSplit[
121 | (* restore PATH, if due to a bug, it becomes essentially empty; this is relevant to finding the Jupyter installation *)
122 | (* otherwise, just use PATH directly *)
123 | If[
124 | $OperatingSystem === "MacOSX" && FileType["~/.profile"] === File,
125 | StringTrim[
126 | RunProcess[
127 | $SystemShell,
128 | "StandardOutput",
129 | StringJoin[Import["~/.profile", "String"], "\necho $PATH"],
130 | ProcessEnvironment -> {}
131 | ],
132 | "\n"
133 | ]
134 | ,
135 | Environment["PATH"]
136 | ],
137 | pathSeperator];
138 |
139 |
140 | (* find Jupyter installation path *)
141 | (* returns above *)
142 | findJupyterPath[] :=
143 | SelectFirst[
144 | splitPath,
145 | (* check every directory in PATH to see if a Jupyter binary is a member *)
146 | (FileType[FileNameJoin[{#1, StringJoin["jupyter", fileExt]}]] === File)&
147 | ];
148 |
149 | (* get information about installed kernels in Jupyter *)
150 | (* returns kernel IDs in Jupyter *)
151 | getKernels[jupyterPath_String, processEnvironment_] :=
152 | Module[{json, kernelspecAssoc},
153 | (* obtain information about "jupyter kernelspec list" in JSON *)
154 | json = Quiet[ImportString[RunProcess[{jupyterPath, "kernelspec", "list", "--json"}, "StandardOutput", ProcessEnvironment -> processEnvironment], "JSON"]];
155 | (* transform that JSON information into an Association *)
156 | kernelspecAssoc =
157 | If[
158 | FailureQ[json],
159 | Association[],
160 | Replace[
161 | json,
162 | part_List /; AllTrue[part, Head[#1] === Rule &] -> Association @ part,
163 | {0, Infinity}
164 | ]
165 | ];
166 | Return[
167 | (* if the above process worked, just return the kernel IDs of all the kernelspecs *)
168 | (* otherwise, return an empty list *)
169 | If[
170 | KeyExistsQ[kernelspecAssoc, "kernelspecs"],
171 | Keys[kernelspecAssoc["kernelspecs"]],
172 | {}
173 | ]
174 | ];
175 | ];
176 |
177 |
178 | (* END: Helper symbols *)
179 |
180 | (* main install command *)
181 | (* specs: options \"WolframEngineBinary\" and \"JupyterInstallation\" in an Association, when provided *)
182 | (* removeQ: remove a Jupyter installation or not *)
183 | (* removeAllQ: clear all Jupyter installations or not *)
184 | (* removeQ first, removeAllQ second: "add" is False, False; "remove" is True, False, and "clear" is True, True *)
185 | (* returns action success status *)
186 | configureJupyter[specs_Association, removeQ_?BooleanQ, removeAllQ_?BooleanQ] :=
187 | Module[
188 | {
189 | retrievedNames, kernelID, displayName,
190 | notProvidedQ,
191 | jupyterPath, mathBin,
192 | fileType,
193 | processEnvironment,
194 | baseDir, tempDir,
195 | wlKernels, (* wlKernelsL(owerCase) *) wlKernelsL,
196 | commandArgs,
197 | exitInfo, kernelspecAssoc, kernelspecs
198 | },
199 |
200 | (* just check that the REPL script is there *)
201 | If[
202 | !(
203 | FileType[
204 | FileNameJoin[{projectHome, "Resources", "KernelForWolframLanguageForJupyter.wl"}]
205 | ] === File
206 | ),
207 | Return[$Failed];
208 | ];
209 |
210 | jupyterPath = specs["JupyterInstallation"];
211 | (* if no Jupyter installation path provided, determine it from PATH *)
212 | If[
213 | MissingQ[jupyterPath],
214 | jupyterPath = findJupyterPath[];
215 | (* if Jupyter not on PATH, message *)
216 | If[MissingQ[jupyterPath],
217 | Message[ConfigureJupyter::notfound, "Jupyter"];
218 | Return[$Failed];
219 | ];
220 | jupyterPath = FileNameJoin[{jupyterPath, StringJoin["jupyter", fileExt]}];
221 | ];
222 |
223 | mathBin =
224 | Lookup[
225 | specs,
226 | "WolframEngineBinary",
227 | (* if no "WolframEngineBinary" provided, use the session Wolfram Kernel location and set notProvidedQ to True *)
228 | (notProvidedQ = True; mathBinSession)
229 | ];
230 |
231 | (* check that the Jupyter installation path is a file, and message appropriately *)
232 | If[
233 | !((fileType = FileType[jupyterPath]) === File),
234 | Switch[
235 | fileType,
236 | Directory,
237 | Message[ConfigureJupyter::isdir, "Jupyter"];,
238 | None,
239 | Message[ConfigureJupyter::nobin, "Jupyter"];
240 | ];
241 | Return[$Failed];
242 | ];
243 |
244 | {kernelID, displayName} = {"", ""};
245 | (* if not clearing, check that the Wolfram Engine installation path is a file, and message appropriately *)
246 | If[
247 | !(removeQ && removeAllQ),
248 | If[
249 | (fileType = FileType[mathBin]) === File,
250 | (* get the "Kernel ID" and "Display Name" for the new Jupyter kernel *)
251 | retrievedNames = getNames[mathBin, TrueQ[notProvidedQ]];
252 | If[FailureQ[retrievedNames], Message[ConfigureJupyter::nolink]; Return[$Failed]];
253 | {kernelID, displayName} = retrievedNames;
254 | ,
255 | Switch[
256 | fileType,
257 | Directory,
258 | Message[ConfigureJupyter::isdir, "Wolfram Engine"];,
259 | None,
260 | Message[ConfigureJupyter::nobin, "Wolfram Engine"];
261 | ];
262 | Return[$Failed];
263 | ];
264 | ];
265 |
266 | (* as an association for 11.3 compatibility *)
267 | processEnvironment = Association[GetEnvironment[]];
268 | processEnvironment["PATH"] = StringJoin[Riffle[Append[splitPath, DirectoryName[jupyterPath]], pathSeperator]];
269 |
270 | (* list of kernels in Jupyter to perform an action on *)
271 | wlKernels = {kernelID};
272 | tempDir = "";
273 | (* if adding, ...*)
274 | (* otherwise, when removing or clearing, ...*)
275 | If[
276 | !removeQ,
277 |
278 | (* create staging directory for files needed to register a kernel with Jupyter *)
279 | tempDir = CreateDirectory[
280 | FileNameJoin[{
281 | projectHome,
282 | CreateUUID[],
283 | kernelID
284 | }], CreateIntermediateDirectories -> True
285 | ];
286 |
287 | (* export a JSON file to the staging directory that contains all the relevant information on how to run the kernel *)
288 | Export[
289 | FileNameJoin[{tempDir, "kernel.json"}],
290 | Association[
291 | "argv" -> {
292 | mathBin,
293 | (* TODO: automatically find the kernel script
294 | (only) if the Wolfram Engine being installed is the same as the one used to execute this command *)
295 | "-script",
296 | FileNameJoin[{projectHome, "Resources", "KernelForWolframLanguageForJupyter.wl"}],
297 | "{connection_file}"
298 | (* , "-noprompt" *)
299 | },
300 | "display_name" -> displayName,
301 | "language" -> "Wolfram Language"
302 | ]
303 | ];
304 |
305 | (* create a list of arguments that directs Jupyter to install from the staging directory *)
306 | commandArgs = {jupyterPath, "kernelspec", "install", "--user", tempDir};,
307 | (* create a list of arguments that directs Jupyter to remove ... *)
308 | commandArgs = {jupyterPath, "kernelspec", "remove", "-f",
309 | If[
310 | !removeAllQ,
311 | (* just the specified kernel *)
312 | kernelID,
313 | (* all Wolfram Language Jupyter kernels *)
314 | (* select from all kernel IDs in Jupyter those that match the form used by this install *)
315 | Sequence @@ (wlKernels = Select[getKernels[jupyterPath, processEnvironment], StringMatchQ[#1, (* ("WolframLanguage-" | "wl-") *) "WolframLanguage" ~~ ___, IgnoreCase -> True] &])
316 | ]
317 | }
318 | ];
319 | (* if no kernels to act on, quit *)
320 | If[Length[wlKernels] == 0, Return[];];
321 | wlKernelsL = ToLowerCase /@ wlKernels;
322 |
323 | (* for error detection, get a snapshot of kernels before the action is performed *)
324 | kernelspecs = getKernels[jupyterPath, processEnvironment];
325 | (* when adding, if there is a kernel with the same id already in Jupyter, it will be replaced; thus, message, but continue *)
326 | If[SubsetQ[kernelspecs, wlKernelsL] && !removeQ, Message[ConfigureJupyter::addconflict]];
327 |
328 | (* perform the action *)
329 | exitInfo = RunProcess[commandArgs, All, ProcessEnvironment -> processEnvironment];
330 | (* remove temporary directory if it was created *)
331 | If[StringLength[tempDir] > 0, DeleteDirectory[DirectoryName[tempDir], DeleteContents -> True]];
332 |
333 | (* get list of kernels after the action was performed *)
334 | kernelspecs = getKernels[jupyterPath, processEnvironment];
335 | (* message about success with respect to the action that was performed *)
336 | If[
337 | !Xor[removeQ, SubsetQ[kernelspecs, wlKernelsL]],
338 | WolframLanguageForJupyter`Errors`$ConfigureError = exitInfo["StandardError"];
339 | Print[WolframLanguageForJupyter`Errors`$ConfigureError];
340 | If[!removeQ, Message[ConfigureJupyter::notadded];, Message[ConfigureJupyter::notremoved];];
341 | Return[$Failed];
342 | ];
343 | ];
344 |
345 | (* convert options to an Association *)
346 | ConfigureJupyter[
347 | args___,
348 | opts:OptionsPattern[] /; Length[{opts}] > 0
349 | ] := ConfigureJupyter[args, Association[opts]];
350 |
351 | (* mold ConfigureJupyter arguments to what is expected by the main install function, configureJupyter ... *)
352 | ConfigureJupyter["Add", args___] := ConfigureJupyter["add", args];
353 | ConfigureJupyter["add"] := ConfigureJupyter["add", Association[]];
354 | ConfigureJupyter["add", assoc_Association] := configureJupyter[assoc, False, False];
355 |
356 | ConfigureJupyter["Remove", args___] := ConfigureJupyter["remove", args];
357 | ConfigureJupyter["remove"] := ConfigureJupyter["remove", Association[]];
358 | ConfigureJupyter["remove", assoc_Association] := configureJupyter[assoc, True, False];
359 |
360 | ConfigureJupyter["Clear", args___] := ConfigureJupyter["clear", args];
361 | ConfigureJupyter["clear"] := ConfigureJupyter["clear", Association[]];
362 | ConfigureJupyter["clear", assoc_Association] := configureJupyter[assoc, True, True];
363 |
364 | ConfigureJupyter[sc_String, ___] /; !StringMatchQ[sc, "add" | "remove" | "clear" | "Add" | "Remove" | "Clear"] := Message[ConfigureJupyter::subcommand];
365 | ConfigureJupyter[Except[_String], ___] := Message[ConfigureJupyter::subcommand];
366 | ConfigureJupyter[args___] := Message[ConfigureJupyter::argx, Length[{args}]];
367 |
368 | End[];
369 | EndPackage[];
370 |
--------------------------------------------------------------------------------
/configure-jupyter.wls:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env wolframscript
2 |
3 | Begin["WolframLanguageForJupyter`Private`"];
4 |
5 | notfound = "configure-jupyter.wls: Jupyter installation on Environment[\"PATH\"] not found.";
6 | isdir = "configure-jupyter.wls: Provided Jupyter binary path is a directory. Please provide the path to the Jupyter binary."
7 | nobin = "configure-jupyter.wls: Provided Jupyter binary path does not exist.";
8 | isdirMath = "configure-jupyter.wls: Provided Wolfram Engine binary path is a directory. Please provide the path to the Wolfram Engine binary."
9 | nobinMath = "configure-jupyter.wls: Provided Wolfram Engine binary path does not exist.";
10 | notadded = "configure-jupyter.wls: An error has occurred. The desired Wolfram Engine is not in \"jupyter kernelspec list.\"";
11 | notremoved = "configure-jupyter.wls: An error has occurred: Wolfram Engine(s) still in \"jupyter kernelspec list.\"";
12 | addconflict = "configure-jupyter.wls: An error has occurred. A Wolfram Engine with the same $VersionNumber of the target Wolfram Engine is in \"jupyter kernelspec list.\" Attempting to overwrite ...";
13 | (* removeconflict = "configure-jupyter.wls: An error has occurred. The Wolfram Engine(s) to be removed is/are not in \"jupyter kernelspec list.\""; *)
14 | removeconflict = "";
15 | nopaclet = "configure-jupyter.wls: WolframLanguageForJupyter paclet source not detected. Are you running the script in the root project directory?";
16 | nolink = "configure-jupyter.wls: Communication with provided Wolfram Engine binary could not be established.";
17 |
18 | (*
19 | Dictionary:
20 | mathBin/mathBinSession = WolframKernel binary
21 | kernelspec = Kernel Specification; term used by Jupyter
22 | notProvidedQ = was a Wolfram Engine Binary explicitly specified?
23 | *)
24 |
25 | (* START: Helper symbols *)
26 |
27 | projectHome = If[StringQ[$InputFileName] && $InputFileName != "", DirectoryName[$InputFileName], Directory[]];
28 |
29 | (* establishes link with Wolfram Engine at mathBin and evaluates $Version/$VersionNumber *)
30 | (* returns string form *)
31 | getVersionFromKernel[mathBin_String] :=
32 | Module[{link, res},
33 | link =
34 | LinkLaunch[
35 | StringJoin[
36 | {
37 | "\"",
38 | mathBin,
39 | "\" -wstp"
40 | }
41 | ]
42 | ];
43 | If[FailureQ[link],
44 | Return[$Failed];
45 | ];
46 | (* bleed link *)
47 | While[LinkReadyQ[link, 0.5], LinkRead[link];];
48 | LinkWrite[link, Unevaluated[$VersionNumber]];
49 | res = StringTrim[ToString[LinkRead[link]], "ReturnPacket[" | "]"];
50 | LinkClose[link];
51 | If[!StringContainsQ[res, "[" | "]"],
52 | Return[res];,
53 | Return[$Failed];
54 | ];
55 | ];
56 |
57 | (* determine display name for Jupyter installation from Wolfram Engine $Version/$VersionNumber *)
58 | (* returns {Kernel ID, Display Name} *)
59 | getNames[mathBin_String, notProvidedQ_?BooleanQ] :=
60 | Module[{version, installDir, (* names, hashedKernelUUID *) versionStr},
61 | (* if Wolfram Engine binary not provided, just evaluate $Version in the current session *)
62 | (* otherwise, use MathLink to obtain $Version *)
63 | If[
64 | notProvidedQ,
65 | version = ToString[$VersionNumber];
66 | installDir = $InstallationDirectory;
67 | ,
68 | version = Quiet[getVersionFromKernel[mathBin]];
69 | If[
70 | FailureQ[version],
71 | Return[$Failed];
72 | ];
73 | installDir = mathBin;
74 | ];
75 |
76 | (*
77 |
78 | hashedKernelUUID = StringJoin["wl-script-", Hash[installDir, "SHA", "HexString"]];
79 |
80 | names = StringCases[version, name___ ~~ " for " ~~ ("Mac" | "Microsoft" | "Windows" | "Linux") -> name];
81 | Return[
82 | If[Length[names] > 0,
83 | {
84 | ToLowerCase[StringJoin[
85 | "WolframLanguage-script-",
86 | StringReplace[First[names], Whitespace -> "-"]
87 | ]],
88 | StringJoin[
89 | "Wolfram Language (",
90 | Capitalize[
91 | First[names],
92 | "AllWords"
93 | ],
94 | ") | Script Install"
95 | ]
96 | }
97 | ,
98 | {hashedKernelUUID, "Wolfram Language | Script Install"}
99 | ]
100 | ];
101 |
102 | *)
103 |
104 | versionStr = StringTrim[version, "."];
105 | Return[
106 | {
107 | (* Kernel ID *)
108 | StringJoin["wolframlanguage", versionStr],
109 | (* Display Name *)
110 | StringJoin["Wolfram Language ", versionStr]
111 | }
112 | ];
113 | ];
114 |
115 | (* determine symbols related to finding Wolfram Engine and Jupyter installations *)
116 | (* mathBinSession: WolframKernel location for the current session *)
117 | (* fileExt: file extension for executables *)
118 | (* pathSeperator: delimiter for directories on PATH *)
119 | defineGlobalVars[] :=
120 | Switch[
121 | $OperatingSystem,
122 | "Windows",
123 | mathBinSession = FileNameJoin[{$InstallationDirectory, "wolfram.exe"}];
124 | fileExt = ".exe";
125 | pathSeperator = ";";,
126 | "MacOSX",
127 | mathBinSession = FileNameJoin[{$InstallationDirectory, "MacOS", "WolframKernel"}];
128 | fileExt = "";
129 | pathSeperator = ":";,
130 | "Unix",
131 | mathBinSession = FileNameJoin[{$InstallationDirectory, "Executables", "WolframKernel"}];
132 | fileExt = "";
133 | pathSeperator = ":";
134 | ];
135 |
136 | mathBinSession := (defineGlobalVars[]; mathBinSession);
137 | fileExt := (defineGlobalVars[]; fileExt);
138 | pathSeperator := (defineGlobalVars[]; pathSeperator);
139 |
140 | (* a list of directories in PATH *)
141 | splitPath := StringSplit[Environment["PATH"], pathSeperator];
142 |
143 | (* restore PATH, if due to a bug, it becomes essentially empty; this is relevant to finding the Jupyter installation *)
144 | (* returns above *)
145 | attemptPathRegeneration[] := If[
146 | $OperatingSystem === "MacOSX" && FileType["~/.profile"] === File,
147 | Print["install.wls: Warning: Regenerating PATH ..."];
148 | SetEnvironment[
149 | "PATH" -> StringTrim[
150 | RunProcess[
151 | $SystemShell,
152 | "StandardOutput",
153 | StringJoin[Import["~/.profile", "String"], "\necho $PATH"],
154 | ProcessEnvironment -> {}
155 | ],
156 | "\n"
157 | ]
158 | ];
159 | ];
160 |
161 | (* find Jupyter installation path *)
162 | (* returns kernel IDs in Jupyter *)
163 | findJupyterPath[] :=
164 | SelectFirst[
165 | splitPath,
166 | (* check every directory in PATH to see if a Jupyter binary is a member *)
167 | (FileType[FileNameJoin[{#1, StringJoin["jupyter", fileExt]}]] === File)&
168 | ];
169 |
170 | (* get information about installed kernels in Jupyter *)
171 | (* returns kernel IDs in Jupyter *)
172 | getKernels[jupyterPath_String, processEnvironment_] :=
173 | Module[{json, kernelspecAssoc},
174 | (* obtain information about "jupyter kernelspec list" in JSON *)
175 | json = Quiet[ImportString[RunProcess[{jupyterPath, "kernelspec", "list", "--json"}, "StandardOutput", ProcessEnvironment -> processEnvironment], "JSON"]];
176 | (* transform that JSON information into an Association *)
177 | kernelspecAssoc =
178 | If[
179 | FailureQ[json],
180 | Association[],
181 | Replace[
182 | json,
183 | part_List /; AllTrue[part, Head[#1] === Rule &] -> Association @ part,
184 | {0, Infinity}
185 | ]
186 | ];
187 | Return[
188 | (* if the above process worked, just return the kernel IDs of all the kernelspecs *)
189 | (* otherwise, return an empty list *)
190 | If[
191 | KeyExistsQ[kernelspecAssoc, "kernelspecs"],
192 | Keys[kernelspecAssoc["kernelspecs"]],
193 | {}
194 | ]
195 | ];
196 | ];
197 |
198 |
199 | (* END: Helper symbols *)
200 |
201 | (* main install command *)
202 | (* specs: options \"WolframEngineBinary\" and \"JupyterInstallation\" in an Association, when provided *)
203 | (* removeQ: remove a Jupyter installation or not *)
204 | (* removeAllQ: clear all Jupyter installations or not *)
205 | (* removeQ first, removeAllQ second: "add" is False, False; "remove" is True, False, and "clear" is True, True *)
206 | configureJupyter[specs_Association, removeQ_?BooleanQ, removeAllQ_?BooleanQ] :=
207 | Module[
208 | {
209 | kernelScript,
210 | retrievedNames, kernelID, displayName,
211 | notProvidedQ,
212 | jupyterPath, mathBin,
213 | fileType,
214 | processEnvironment,
215 | baseDir, tempDir,
216 | wlKernels, (* wlKernelsL(owerCase) *) wlKernelsL,
217 | commandArgs,
218 | exitInfo, kernelspecAssoc, kernelspecs,
219 | conflictMessage, failureMessage
220 | },
221 |
222 | kernelScript = FileNameJoin[{projectHome, "WolframLanguageForJupyter", "Resources", "KernelForWolframLanguageForJupyter.wl"}];
223 | (* just check that the REPL script is there *)
224 | If[
225 | !(FileType[kernelScript] === File),
226 | Print[nopaclet];
227 | Return[$Failed];
228 | ];
229 |
230 | jupyterPath = specs["JupyterInstallation"];
231 | (* if no Jupyter installation path provided, determine it from PATH *)
232 | If[
233 | MissingQ[jupyterPath],
234 | jupyterPath = findJupyterPath[];
235 | (* if Jupyter not on PATH, message *)
236 | If[MissingQ[jupyterPath],
237 | Print[notfound];
238 | Return[$Failed];
239 | ];
240 | jupyterPath = FileNameJoin[{jupyterPath, StringJoin["jupyter", fileExt]}];
241 | ];
242 |
243 | mathBin =
244 | Lookup[
245 | specs,
246 | "WolframEngineBinary",
247 | (* if no "WolframEngineBinary" provided, use the session Wolfram Kernel location and set notProvidedQ to True *)
248 | (notProvidedQ = True; mathBinSession)
249 | ];
250 |
251 | (* check that the Jupyter installation path is a file *)
252 | If[
253 | !((fileType = FileType[jupyterPath]) === File),
254 | Switch[
255 | fileType,
256 | Directory,
257 | Print[isdir];,
258 | None,
259 | Print[nobin];
260 | ];
261 | Return[$Failed];
262 | ];
263 |
264 | {kernelID, displayName} = {"", ""};
265 | (* if not clearing, check that the Wolfram Engine installation path is a file, and message appropriately *)
266 | If[
267 | !(removeQ && removeAllQ),
268 | If[
269 | (fileType = FileType[mathBin]) === File,
270 | (* get the "Kernel ID" and "Display Name" for the new Jupyter kernel *)
271 | retrievedNames = getNames[mathBin, TrueQ[notProvidedQ]];
272 | If[FailureQ[retrievedNames], Print[nolink]; Return[$Failed]];
273 | {kernelID, displayName} = retrievedNames;,
274 | Switch[
275 | fileType,
276 | Directory,
277 | Print[isdirMath];,
278 | None,
279 | Print[nobinMath];
280 | ];
281 | Return[$Failed];
282 | ];
283 | ];
284 |
285 | (* as an association for 11.3 compatibility *)
286 | processEnvironment = Association[GetEnvironment[]];
287 | processEnvironment["PATH"] = StringJoin[Environment["PATH"], pathSeperator, DirectoryName[jupyterPath]];
288 |
289 | (* list of kernels in Jupyter to perform an action on *)
290 | wlKernels = {kernelID};
291 | tempDir = "";
292 | (* if adding, ...*)
293 | (* otherwise, when removing or clearing, ...*)
294 | If[
295 | !removeQ,
296 | failureMessage = notadded;
297 | conflictMessage = addconflict;
298 |
299 | (* create staging directory for files needed to register a kernel with Jupyter *)
300 | tempDir = CreateDirectory[
301 | FileNameJoin[{
302 | projectHome,
303 | CreateUUID[],
304 | (* removing this would cause every evalution of addKernelToJupyter adds a new kernel with a different uuid *)
305 | kernelID
306 | }], CreateIntermediateDirectories -> True
307 | ];
308 |
309 | (* export a JSON file to the staging directory that contains all the relevant information on how to run the kernel *)
310 | Export[
311 | FileNameJoin[{tempDir, "kernel.json"}],
312 | Association[
313 | "argv" -> {mathBin, "-script", kernelScript, "{connection_file}", "ScriptInstall" (* , "-noprompt" *)},
314 | "display_name" -> displayName,
315 | "language" -> "Wolfram Language"
316 | ]
317 | ];
318 |
319 | (* create a list of arguments that directs Jupyter to install from the staging directory *)
320 | commandArgs = {jupyterPath, "kernelspec", "install", "--user", tempDir};,
321 | failureMessage = notremoved;
322 | conflictMessage = removeconflict;
323 | (* create a list of arguments that directs Jupyter to remove ... *)
324 | commandArgs = {jupyterPath, "kernelspec", "remove", "-f",
325 | If[
326 | !removeAllQ,
327 | (* just the specified kernel *)
328 | kernelID,
329 | (* all Wolfram Language Jupyter kernels *)
330 | (* select from all kernel IDs in Jupyter those that match the form used by this install *)
331 | Sequence @@ (wlKernels = Select[getKernels[jupyterPath, processEnvironment], StringMatchQ[#1, (* ("WolframLanguage-" | "wl-") *) "WolframLanguage" ~~ ___, IgnoreCase -> True] &])
332 | ]
333 | }
334 | ];
335 | (* if no kernels to act on, quit *)
336 | If[Length[wlKernels] == 0, Return[];];
337 | wlKernelsL = ToLowerCase /@ wlKernels;
338 |
339 | (* for error detection, get a snapshot of kernels before the action is performed *)
340 | kernelspecs = getKernels[jupyterPath, processEnvironment];
341 | (* when adding, if there is a kernel with the same id already in Jupyter, it will be replaced; thus, message, but continue *)
342 | If[Xor[removeQ, SubsetQ[kernelspecs, wlKernelsL]], Print[conflictMessage];];
343 |
344 | (* perform the action *)
345 | exitInfo = RunProcess[commandArgs, All, ProcessEnvironment -> processEnvironment];
346 | (* remove temporary directory if it was created *)
347 | If[StringLength[tempDir] > 0, DeleteDirectory[DirectoryName[tempDir], DeleteContents -> True]];
348 |
349 | (* get list of kernels after the action was performed *)
350 | kernelspecs = getKernels[jupyterPath, processEnvironment];
351 | (* message about success with respect to the action that was performed *)
352 | If[
353 | !Xor[removeQ, SubsetQ[kernelspecs, wlKernelsL]],
354 | Print[failureMessage];
355 | Print["configure-jupyter.wls: See below for the message that Jupyter returned when attempting to add the Wolfram Engine."];
356 | Print[StringTrim[exitInfo["StandardError"], Whitespace]];
357 | Return[$Failed];
358 | ];
359 | ];
360 |
361 | (* checking RunProcess ..., and messaging appropriately *)
362 | If[
363 | FailureQ[RunProcess[$SystemShell, All, ""]],
364 | (* maybe remove *)
365 | If[
366 | MemberQ[$CommandLine, "-script"],
367 | Print["configure-jupyter.wls: Please use -file instead of -script in WolframScript."];
368 | Quit[];
369 | ,
370 | Print["configure-jupyter.wls: An unknown error has occurred."];
371 | attemptPathRegeneration[];
372 | If[FailureQ[RunProcess[$SystemShell, All, ""]], Quit[]];
373 | ];
374 | ];
375 |
376 | defineGlobalVars[];
377 |
378 | (* maybe remove *)
379 | (* checking PATH ..., and messaging appropriately *)
380 | If[
381 | Length[splitPath] == 1,
382 | Print["configure-jupyter.wls: Warning: This script has encountered a very small PATH environment variable."];
383 | Print["configure-jupyter.wls: Warning: This can occur due to a possible WolframScript bug."];
384 | attemptPathRegeneration[];
385 | ];
386 |
387 |
388 | (* START: Building usage message *)
389 |
390 | templateJupyterPath = StringJoin["\"", FileNameJoin[{"path", "to", "Jupyter-binary"}], "\""];
391 | templateWLPath = StringJoin["\"", FileNameJoin[{"", "absolute", "path", "to", "Wolfram-Engine-binary--not-wolframscript"}], "\""];
392 |
393 | (* helpMessage = StringJoin[
394 | "configure-jupyter.wls add [", templateJupyterPath, "]\n",
395 | "configure-jupyter.wls adds a Wolfram Engine to a Jupyter binary on PATH, or optional provided Jupyter binary path\n",
396 | "configure-jupyter.wls add ", templateJupyterPath, " ", templateWLPath, "\n",
397 | "\tadds the provided absolute Wolfram Engine binary path to the provided Jupyter binary path\n",
398 | "configure-jupyter.wls remove [", templateJupyterPath ,"]\n",
399 | "\tremoves any Wolfram Engines found on a Jupyter binary on PATH, or optional provided Jupyter binary path"
400 | ]; *)
401 |
402 | helpMessage = StringJoin[
403 | "configure-jupyter.wls add [", templateWLPath, "]\n",
404 | "\tadds a Wolfram Engine, either attached to the current invocation, or at the provided absolute Wolfram Engine binary path, to a Jupyter binary on PATH\n",
405 | "configure-jupyter.wls add ", templateWLPath, " ", templateJupyterPath, "\n",
406 | "\tadds the provided absolute Wolfram Engine binary path to the provided Jupyter binary path\n",
407 | "configure-jupyter.wls remove [", templateWLPath ,"]\n",
408 | "\tremoves the Wolfram Engine, either attached to the current invocation, or at the provided absolute Wolfram Engine binary path, from a Jupyter binary on PATH\n",
409 | "configure-jupyter.wls remove ", templateWLPath, " ", templateJupyterPath, "\n",
410 | "\tremoves the provided absolute Wolfram Engine binary path from the provided Jupyter binary path\n",
411 | "configure-jupyter.wls clear [", templateJupyterPath ,"]\n",
412 | "\tremoves all Wolfram Engines found on a Jupyter binary on PATH, or optional provided Jupyter binary path\n",
413 | "configure-jupyter.wls build\n",
414 | "\tbuilds the WolframLanguageForJupyter paclet in the project directory"
415 | ];
416 |
417 | (* END: Building usage message *)
418 |
419 |
420 | (* based off of the script invocation, use configureJupyter or PackPaclet; or display help message *)
421 | If[
422 | Length[$ScriptCommandLine] < 2 ||
423 | Length[$ScriptCommandLine] > 4 ||
424 | $ScriptCommandLine[[2]] === "help",
425 | Print[helpMessage];
426 | ,
427 | Switch[
428 | $ScriptCommandLine[[2]],
429 | "add" | "Add",
430 | command = {False, False};,
431 | "remove" | "Remove",
432 | command = {True, False};,
433 | "clear" | "Clear",
434 | command = {True, True};,
435 | "build",
436 | PackPaclet["WolframLanguageForJupyter"];
437 | Quit[];
438 | ,
439 | _,
440 | Print[helpMessage];
441 | ];
442 |
443 | configureJupyter[
444 | Switch[
445 | Length[$ScriptCommandLine],
446 | 4,
447 | Association[
448 | "WolframEngineBinary" -> $ScriptCommandLine[[3]],
449 | "JupyterInstallation" -> $ScriptCommandLine[[4]]
450 | ],
451 | 3,
452 | If[command === {True, True},
453 | Association["JupyterInstallation" -> $ScriptCommandLine[[3]]],
454 | Association["WolframEngineBinary" -> $ScriptCommandLine[[3]]]
455 | ],
456 | 2,
457 | Association[]
458 | ],
459 | Sequence @@ command
460 | ];
461 | ];
462 |
463 | End[];
464 |
--------------------------------------------------------------------------------
/extras/custom.js:
--------------------------------------------------------------------------------
1 | /* (adapted) from https://stackoverflow.com/a/19961519 by Erik Aigner */
2 | HTMLTextAreaElement.prototype.insertAtCaret = function (text) {
3 | text = text || '';
4 | if(document.selection) {
5 | // IE
6 | this.focus();
7 | var sel = document.selection.createRange();
8 | sel.text = text;
9 | }
10 | else if(this.selectionStart || this.selectionStart === 0) {
11 | // Others
12 | var startPos = this.selectionStart;
13 | var endPos = this.selectionEnd;
14 | this.value = this.value.substring(0, startPos) + text + this.value.substring(endPos, this.value.length);
15 | this.selectionStart = startPos + text.length;
16 | this.selectionEnd = startPos + text.length;
17 | }
18 | else {
19 | this.value += text;
20 | }
21 | };
22 |
23 | /* (adapted) from https://stackoverflow.com/a/51114347 by bambam */
24 | function redirectEsc(event) {
25 | if(event.which == 27)
26 | {
27 | event.target.insertAtCaret(
28 | /* the vertical ellipsis character */
29 | String.fromCharCode(8942)
30 | );
31 | event.stopImmediatePropagation();
32 | }
33 | }
34 |
35 | /* (adapted) from https://stackoverflow.com/a/51114347 by bambam */
36 | var observer = new MutationObserver(function(mutations) {
37 |
38 | Array.from(
39 | document.querySelectorAll('.input_area')
40 | ).forEach(
41 | textarea =>
42 | {
43 | textarea.removeEventListener('keydown', redirectEsc);
44 | textarea.addEventListener('keydown', redirectEsc);
45 | }
46 | );
47 |
48 | });
49 |
50 | observer.observe(document, {childList:true, subtree:true});
--------------------------------------------------------------------------------
/images/in-out-01.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/WolframResearch/WolframLanguageForJupyter/9a26ac78743cc47084c9c99ff75c5aee2657a409/images/in-out-01.png
--------------------------------------------------------------------------------
/images/in-out-02.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/WolframResearch/WolframLanguageForJupyter/9a26ac78743cc47084c9c99ff75c5aee2657a409/images/in-out-02.png
--------------------------------------------------------------------------------
/images/in-out-03.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/WolframResearch/WolframLanguageForJupyter/9a26ac78743cc47084c9c99ff75c5aee2657a409/images/in-out-03.png
--------------------------------------------------------------------------------
/images/menu-01.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/WolframResearch/WolframLanguageForJupyter/9a26ac78743cc47084c9c99ff75c5aee2657a409/images/menu-01.png
--------------------------------------------------------------------------------