forked from emacs-jupyter/jupyter
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathjupyter-org-client.el
1680 lines (1474 loc) · 69.1 KB
/
jupyter-org-client.el
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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; jupyter-org-client.el --- Org integration -*- lexical-binding: t -*-
;; Copyright (C) 2018-2020 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <[email protected]>
;; Created: 02 Jun 2018
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; A subclass of a Jupyter kernel client that integrates with `org-mode'
;; src-blocks.
;;; Code:
(eval-when-compile (require 'subr-x))
(require 'jupyter-repl)
(require 'ob)
(declare-function org-babel-python-table-or-string "ob-python" (results))
(declare-function org-babel-jupyter-initiate-session "ob-jupyter" (&optional session params))
(declare-function org-babel-jupyter-src-block-session "ob-jupyter" ())
(declare-function org-babel-jupyter-language-p "ob-jupyter" (lang))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-create "org-element" (type &optional props &rest children))
(declare-function org-element-type "org-element" (element))
(declare-function org-element-normalize-string "org-element" (s))
(declare-function org-element-at-point "org-element" ())
(declare-function org-drag-element-forward "org-element" ())
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-set-contents "org-element" (element &rest contents))
(declare-function org-element-latex-fragment-parser "org-element" ())
(declare-function org-element-latex-environment-parser "org-element" (limit affiliated))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-put-property "org-element" (element property value))
(declare-function orgtbl-to-orgtbl "org-table" (table params))
(declare-function org-table-align "org-table" ())
(declare-function org-in-src-block-p "org" (&optional inside))
(declare-function org-next-block "org" (arg &optional backward block-regexp))
(declare-function org-at-table-p "org" ())
(declare-function org-inside-LaTeX-fragment-p "org" ())
(declare-function org-toggle-latex-fragment "org" (&optional arg))
(defcustom jupyter-org-resource-directory "./.ob-jupyter/"
"Directory used to store automatically generated image files.
See `jupyter-org-image-file-name'."
:group 'ob-jupyter
:type 'string)
(defcustom jupyter-org-toggle-latex t
"Whether to automatically display latex fragments or not.
If a source block returns LaTeX fragments, LaTeX images will
automatically be shown if this is non-nil."
:group 'ob-jupyter
:type 'boolean)
(defcustom jupyter-org-pandoc-convertable
'("html" "markdown" "latex")
"Export blocks to convert to `org-mode' when ':pandoc t' header is set."
:group 'ob-jupyter
:type '(repeat string))
(defcustom jupyter-org-adjust-image-size t
"Try to best fit image output in the result block.
If non-nil, and `org-image-actual-width' is set to a list, the
image will not be stretched if its width is smaller than \(car
`org-image-actual-width'\). This is done by inserting an
#+ATTR_ORG keyword above the file path.
See also the docstring of `org-image-actual-width' for more details."
:group 'ob-jupyter
:type 'boolean)
(defconst jupyter-org-mime-types '(:text/org
;; Prioritize images over html
:image/svg+xml :image/jpeg :image/png
:text/html :text/markdown
:text/latex :text/plain)
"MIME types handled by Jupyter Org.")
(defclass jupyter-org-client (jupyter-repl-client)
())
(cl-defstruct (jupyter-org-request
(:include jupyter-request)
(:constructor nil)
(:constructor jupyter-org-request))
result-type
block-params
file
results
silent-p
id-cleared-p
inline-block-p
marker
async-p)
;;; `jupyter-kernel-client' interface
;;;; `jupyter-request' interface
(defvar org-babel-jupyter-current-src-block-params)
(cl-defmethod jupyter-generate-request ((_client jupyter-org-client) &rest slots)
"Return a `jupyter-org-request' for the current source code block."
(if (and org-babel-current-src-block-location
org-babel-jupyter-current-src-block-params
(provided-mode-derived-p
(buffer-local-value
;; Handle indirect buffers used by packages like polymode, see #171.
'major-mode (or (buffer-base-buffer) (current-buffer)))
'org-mode))
;; Only use a `jupyter-org-request' when executing code blocks, setting
;; the `major-mode' context isn't enough, consider when a client is
;; started due to sending a completion request.
(save-excursion
(goto-char org-babel-current-src-block-location)
(let* ((context (org-element-context))
(block-params org-babel-jupyter-current-src-block-params)
(result-params (alist-get :result-params block-params))
(req
(apply #'jupyter-org-request
(append
(list
:marker (copy-marker org-babel-current-src-block-location)
:inline-block-p (and (memq (org-element-type context)
'(inline-babel-call inline-src-block))
t)
:result-type (alist-get :result-type block-params)
:file (alist-get :file block-params)
:block-params block-params
:async-p (equal (alist-get :async block-params) "yes")
:silent-p (car (or (member "none" result-params)
(member "silent" result-params))))
slots))))
(put-text-property
org-babel-current-src-block-location
(1+ org-babel-current-src-block-location)
'jupyter-request req)
req))
(cl-call-next-method)))
(defun jupyter-org-request-at-point ()
"Return the `jupyter-org-request' associated with `point' or nil."
(when-let* ((context (org-element-context))
(babel-p (memq (org-element-type context)
'(src-block babel-call
inline-babel-call inline-src-block)))
(pos (jupyter-org-element-begin-after-affiliated context))
(req (get-text-property pos 'jupyter-request)))
(and (not (jupyter-request-idle-p req))
req)))
;;;; Stream
(cl-defmethod jupyter-handle-stream ((_client jupyter-org-client) (req jupyter-org-request) msg)
(jupyter-with-message-content msg (text)
(if (jupyter-org-request-inline-block-p req)
(jupyter-with-display-buffer "org-results" req
(insert (ansi-color-apply text))
(pop-to-buffer (current-buffer)))
(jupyter-org--add-result req text))))
;;;; Errors
(defvar jupyter-org-goto-error-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] #'jupyter-org-goto-error)
(define-key map (kbd "RET") #'jupyter-org-goto-error)
map)
"Keymap for jumping to an error in a source code block.")
(defun jupyter-org-goto-error ()
"Go to the error location specified by the jupyter-error-loc text property.
If `point' has a non-nil jupyter-error-loc property, jump to that
line in the previous source block. See
`jupyter-org-error-location'."
(interactive)
(when-let* ((loc (get-text-property (point) 'jupyter-error-loc)))
(pop-to-buffer (marker-buffer loc))
(goto-char loc)))
;;;;; `jupyter-org-error-location'
;; Inspiration from https://kitchingroup.cheme.cmu.edu/blog/2017/06/10/Adding-keymaps-to-src-blocks-via-org-font-lock-hook/
(defconst jupyter-org--goto-error-string "[goto error]")
(cl-defgeneric jupyter-org-error-location ()
"Return the line number corresponding to an error from a traceback.
This method is called with `point' at `point-min' in a buffer
containing the traceback of the last error that occurred due to
execution of a source block. It should return the line number
relative to the source block that caused the error or nil if a
line number could not be found."
(ignore))
(defun jupyter-org--goto-error-string (req)
(let* ((buffer (current-buffer))
(loc (org-with-point-at (jupyter-org-request-marker req)
(forward-line (or (with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(jupyter-org-error-location)))
0))
(point-marker))))
(propertize jupyter-org--goto-error-string
'jupyter-error-loc loc
'face 'link
'keymap jupyter-org-goto-error-map)))
(defun jupyter-org-add-error-keymap (limit)
"Add keymaps to text that contain a jupyter-error-loc property.
Search up to LIMIT from `point' for any text to add the keymap
to."
(save-restriction
(narrow-to-region (point) limit)
(let ((pos (point)) end)
(while (setq pos (next-single-property-change pos 'jupyter-error-loc))
(when (get-text-property pos 'jupyter-error-loc)
(setq end (next-single-property-change pos 'jupyter-error-loc))
(put-text-property pos end 'keymap jupyter-org-goto-error-map)
(setq pos end))))))
;;;;; Handler
(defvar org-font-lock-hook)
(cl-defmethod jupyter-handle-error ((_client jupyter-org-client) (req jupyter-org-request) msg)
(jupyter-with-message-content msg (traceback)
(setq traceback (org-element-normalize-string
(mapconcat #'identity traceback "\n")))
(pcase-let (((cl-struct jupyter-org-request
marker inline-block-p silent-p)
req))
(cond
((or inline-block-p silent-p)
;; Remove old inline results when an error happens since, if this was not
;; done, it would look like the code which caused the error produced the
;; old result.
(when inline-block-p
(org-with-point-at marker
(org-babel-remove-inline-result)))
(jupyter-with-display-buffer "traceback" 'reset
(jupyter-insert-ansi-coded-text traceback)
(goto-char (point-min))
(when silent-p
(insert (jupyter-org--goto-error-string req) "\n\n"))
(pop-to-buffer (current-buffer))))
(t
;; The keymap property in the string returned by
;; `jupyter-org--goto-error-string' gets removed by font-lock so ensure it
;; is re-added.
(unless (memq 'jupyter-org-add-error-keymap org-font-lock-hook)
(add-hook 'org-font-lock-hook 'jupyter-org-add-error-keymap nil t))
(jupyter-org--add-result
req (jupyter-org-comment
(with-temp-buffer
(insert traceback)
(jupyter-org--goto-error-string req))))
(jupyter-org--add-result req traceback))))))
;;;; Execute result
(cl-defmethod jupyter-handle-execute-result ((client jupyter-org-client) (req jupyter-org-request) msg)
(unless (eq (jupyter-org-request-result-type req) 'output)
(jupyter-with-message-content msg (data metadata)
(pcase-let (((cl-struct jupyter-org-request
inline-block-p async-p marker block-params)
req))
(cond
(inline-block-p
;; For inline results, only text/plain results are allowed at the moment.
;;
;; TODO: Handle all of the different macro types for inline results, see
;; `org-babel-insert-result'.
(setq data `(:text/plain ,(plist-get data :text/plain)))
(let ((result (let ((r (jupyter-org-result req data metadata)))
(if (stringp r) r
(or (org-element-property :value r) "")))))
(if async-p
(org-with-point-at marker
(org-babel-insert-result
result block-params nil nil (jupyter-kernel-language client)))
;; The results are returned in `org-babel-execute:jupyter' in the
;; synchronous case
(jupyter-org--add-result req result))))
(t
(jupyter-org--add-result req (jupyter-org-result req data metadata))))))))
;;;; Display data
(cl-defmethod jupyter-handle-display-data ((_client jupyter-org-client) (req jupyter-org-request) msg)
;; TODO: Add request objects as text properties of source code blocks to
;; implement display IDs. Or how can #+NAME be used as a display ID?
;;
;; Only the data of the execute-result message is inserted into the buffer
;; for inline code blocks.
(jupyter-with-message-content msg (data metadata)
(if (jupyter-org-request-inline-block-p req)
(jupyter-with-display-buffer "org-results" req
(jupyter-insert data metadata)
(pop-to-buffer (current-buffer))
(set-window-point (get-buffer-window (current-buffer)) (point-min)))
(jupyter-org--add-result req (jupyter-org-result req data metadata)))))
;;;; Execute reply
(cl-defmethod jupyter-handle-payload ((_source (eql set_next_input)) pl
&context (major-mode org-mode))
;; Assumes `point' is at a src-block element
(let ((src-block (org-element-at-point))
(result-p (org-babel-where-is-src-block-result)))
(save-excursion
(goto-char (jupyter-org-element-end-before-blanks src-block))
(forward-line -1)
;; Create an empty src-block after the current one but before any of the
;; current source block's results
(org-babel-demarcate-block)
(org-next-block 1)
(when result-p
(org-drag-element-forward))
(forward-line)
(insert (org-element-normalize-string (plist-get pl :text))))))
(cl-defmethod jupyter-handle-execute-reply ((_client jupyter-org-client) (req jupyter-org-request) msg)
(jupyter-with-message-content msg (status payload)
(when payload
(org-with-point-at (jupyter-org-request-marker req)
(jupyter-handle-payload payload)))
(if (equal status "ok")
(message "Code block evaluation complete.")
(message "An error occurred when evaluating code block."))
(when (jupyter-org-request-async-p req)
(jupyter-org--clear-request-id req)
(run-hooks 'org-babel-after-execute-hook))))
;;; Completion in code blocks
(defvar jupyter-org--src-block-cache nil
"A list of three elements (SESSION BEG END).
SESSION is the Jupyter session to use for completion requests for
a code block between BEG and END.
BEG and END are the bounds of the source block which made the
most recent completion request.")
(defsubst jupyter-org--src-block-beg ()
(nth 1 jupyter-org--src-block-cache))
(defsubst jupyter-org--src-block-end ()
(nth 2 jupyter-org--src-block-cache))
(defun jupyter-org--same-src-block-p ()
(when jupyter-org--src-block-cache
(cl-destructuring-bind (_ beg end)
jupyter-org--src-block-cache
(and
(marker-position beg)
(marker-position end)
(<= beg (point) end)))))
(defun jupyter-org--set-current-src-block ()
(unless (jupyter-org--same-src-block-p)
(let* ((el (org-element-at-point))
(lang (org-element-property :language el)))
(when (org-babel-jupyter-language-p lang)
(let* ((info (org-babel-get-src-block-info t el))
(params (nth 2 info))
(beg (save-excursion
(goto-char (org-element-property :post-affiliated el))
(line-beginning-position 2)))
(end (save-excursion
(goto-char (org-element-property :end el))
(skip-chars-backward "\r\n")
(line-beginning-position))))
(unless jupyter-org--src-block-cache
(setq jupyter-org--src-block-cache
(list nil (point-marker) (point-marker)))
;; Move the end marker when text is inserted
(set-marker-insertion-type (nth 2 jupyter-org--src-block-cache) t))
(setf (nth 0 jupyter-org--src-block-cache) params)
(cl-callf move-marker (nth 1 jupyter-org--src-block-cache) beg)
(cl-callf move-marker (nth 2 jupyter-org--src-block-cache) end))))))
(defmacro jupyter-org-when-in-src-block (&rest body)
"Evaluate BODY when inside a Jupyter source block.
Return the result of BODY when it is evaluated, otherwise nil is
returned."
(declare (debug (body)))
`(if (not (org-in-src-block-p 'inside))
;; Invalidate cache when going outside of a source block. This way if
;; the language of the block changes we don't end up using the cache
;; since it is only used for Jupyter blocks.
(when jupyter-org--src-block-cache
(set-marker (nth 1 jupyter-org--src-block-cache) nil)
(set-marker (nth 2 jupyter-org--src-block-cache) nil)
(setq jupyter-org--src-block-cache nil))
(jupyter-org--set-current-src-block)
(when (jupyter-org--same-src-block-p)
,@body)))
(defmacro jupyter-org-with-src-block-client (&rest body)
"Evaluate BODY with `jupyter-current-client' set to the session's client.
A client is initialized if necessary.
If `point' is not inside the code of a Jupyter source block, BODY
is not evaluated and nil is returned. Return the result of BODY
when it is evaluated.
In addition to evaluating BODY with an active Jupyter client set,
the `syntax-table' will be set to that of the REPL buffers."
(declare (debug (body)))
(let ((params (make-symbol "params"))
(syntax (make-symbol "syntax")))
`(jupyter-org-when-in-src-block
(let* ((,params (car jupyter-org--src-block-cache))
(jupyter-current-client
(buffer-local-value 'jupyter-current-client
(org-babel-jupyter-initiate-session
(alist-get :session ,params) ,params)))
(,syntax (jupyter-kernel-language-syntax-table
jupyter-current-client)))
(with-syntax-table ,syntax
,@body)))))
(cl-defmethod jupyter-code-context ((_type (eql inspect))
&context (major-mode org-mode))
(when (org-in-src-block-p 'inside)
(jupyter-line-context)))
(cl-defmethod jupyter-code-context ((_type (eql completion))
&context (major-mode org-mode))
;; Always called from within a valid code block. See
;; `jupyter-org-completion-at-point'.
(list (buffer-substring-no-properties
(jupyter-org--src-block-beg)
(jupyter-org--src-block-end))
(- (point) (jupyter-org--src-block-beg))))
(defun jupyter-org-completion-at-point ()
(jupyter-org-with-src-block-client
(jupyter-completion-at-point)))
;;; Inspection
(cl-defmethod jupyter-inspect (&context (major-mode org-mode)
&rest _ignore)
(jupyter-org-with-src-block-client
(cl-call-next-method)))
;;; Key bindings in code blocks
(defvar jupyter-org-interaction-mode-map (make-sparse-keymap))
(defun jupyter-org--key-def (key vect)
"Get KEY's definition, using VECT to lookup the keymap to search.
`jupyter-org-interaction-mode-map' contains keymaps bound to
single element vectors like [jupyter] or [python] which hold the
keybindings available for a particular language, [python], or for
any Jupyter code block, [jupyter]."
(let* ((map (lookup-key jupyter-org-interaction-mode-map vect))
(cmd (and (keymapp map) (lookup-key map key))))
(and (functionp cmd) cmd)))
(defun jupyter-org--define-key-filter (key &rest _)
"Return the definition for KEY when inside a Jupyter src-block or nil."
;; Fall back to regular `org-mode' keys when the current point is invisible,
;; e.g. folded subtrees.
(unless (org-invisible-p)
(jupyter-org-with-src-block-client
(let ((lang (jupyter-kernel-language jupyter-current-client)))
(or (jupyter-org--key-def key `[,lang])
(jupyter-org--key-def key [jupyter]))))))
(defun jupyter-org--call-with-src-block-client (def)
"Call DEF interactively with the current src-block's client."
(jupyter-org-with-src-block-client
(call-interactively def)))
(defvar jupyter-org--defining-key-p nil)
(defun jupyter-org-define-key (key def &optional lang)
"Bind KEY to DEF, but only when inside a Jupyter code block.
When `point' is inside a Jupyter code block, DEF is called using
the `jupyter-current-client' of the session associated with the
code block, see `jupyter-org-with-src-block-client'.
If LANG is non-nil, it is a language symbol such as python or
julia. Only bind KEY to DEF whenever the underlying kernel
language is LANG. If LANG is nil, then KEY is bound to DEF
regardless of kernel language. Note, the same key can be bound
for different kernel languages.
All of the keys are bound in `jupyter-org-interaction-mode-map'
and they only take effect when the variable
`jupyter-org-interaction-mode' is non-nil."
;; From http://endlessparentheses.com/define-context-aware-keys-in-emacs.html
;;
;; But the dynamic keybindings in code blocks is inspired by John Kitchin's
;; extensions to ob-ipython.
(setq lang `[,(or lang 'jupyter)])
(let ((map (or (lookup-key jupyter-org-interaction-mode-map lang)
(define-key jupyter-org-interaction-mode-map lang
(make-sparse-keymap)))))
(define-key map key
(let ((cmd (lambda ()
(interactive)
(jupyter-org--call-with-src-block-client def))))
(if (symbolp def)
(defalias (make-symbol (symbol-name def))
cmd (documentation def))
cmd))))
(let ((jupyter-org--defining-key-p t))
(unless (functionp (lookup-key jupyter-org-interaction-mode-map key))
(define-key jupyter-org-interaction-mode-map key
(list 'menu-item "" nil :filter
(lambda (&rest _)
(if jupyter-org--defining-key-p
;; Stub definition so that `lookup-key' returns a non-nil
;; value since the normal filter only returns a definition
;; when inside a source block. We only need to make the
;; definition for KEY once and not on every re-definition
;; of KEY for a particular language.
#'undefined
(jupyter-org--define-key-filter key))))))))
(jupyter-org-define-key (kbd "C-x C-e") #'jupyter-eval-line-or-region)
(jupyter-org-define-key (kbd "C-M-x") #'jupyter-eval-defun)
(jupyter-org-define-key (kbd "M-i") #'jupyter-inspect-at-point)
(jupyter-org-define-key (kbd "C-c C-r") #'jupyter-repl-restart-kernel)
(jupyter-org-define-key (kbd "C-c C-i") #'jupyter-repl-interrupt-kernel)
;;; Handling ANSI escapes in kernel output
;; NOTE: We cache the properties here since this is called during the font-lock
;; process (and maybe shouldn't be?) which means that it can be called many
;; times on the same region. We don't want to re-compute the faces on each
;; call.
(defun jupyter-org--ansi-color-apply-on-region (begin end)
"Handle ANSI escape codes between (BEGIN . END) and cache the results.
If (BEGIN . END) is not marked with a jupyter-ansi text property,
apply `jupyter-ansi-color-apply-on-region' on the region and mark
it with a non-nil jupyter-ansi property. Otherwise, prepend any
non-nil font-lock-face properties in the region to the face
property."
;; Don't add these changes to the undo list, gives a slight speed up.
(let ((buffer-undo-list t)
(inhibit-modification-hooks t)
next begin1 end1)
(while (/= begin end)
(setq next (next-single-property-change begin 'jupyter-ansi nil end))
(cond
((get-text-property begin 'jupyter-ansi)
(setq begin1 begin
end1 next
begin next)
(while (/= begin1 end1)
(setq next (next-single-property-change
begin1 'jupyter-face nil end1))
(when (get-text-property begin1 'jupyter-face)
(font-lock-prepend-text-property
begin1 next 'face (get-text-property begin1 'jupyter-face)))
(setq begin1 next)))
(t
(put-text-property begin next 'jupyter-ansi t)
(jupyter-ansi-color-apply-on-region begin next 'jupyter-face)
(setq begin next))))))
;; Adapted from `org-fontify-meta-lines-and-blocks-1'
(defun jupyter-org-font-lock-ansi-escapes (limit)
(let ((case-fold-search t))
(when (re-search-forward
"^[ \t]*\\(#\\+begin_example[ \t]*\\|: .*\\)$" limit t)
(let ((beg (match-beginning 1))
(beg1 (line-beginning-position 2))
end)
(cond
;; example block
((not (eq (char-after beg) ?:))
(when (re-search-forward
"^[ \t]*#\\+end_example\\>.*"
nil t) ;; on purpose, we look further than LIMIT
(setq end (min (point-max) (1- (match-beginning 0))))
(jupyter-org--ansi-color-apply-on-region beg1 end)))
;; fixed width
(t
(setq end (or (and (re-search-forward "^[ \t]*[^ \t:]" nil t)
(1- (match-beginning 0)))
(point-max)))
(jupyter-org--ansi-color-apply-on-region beg end)))))))
;;; `jupyter-org-interaction-mode'
(defvar org-font-lock-keywords)
(define-minor-mode jupyter-org-interaction-mode
"Minor mode for interacting with a Jupyter REPL from an `org-mode' buffer.
When this minor mode is enabled, some of the keybindings
available in `jupyter-repl-interaction-mode' are also available
when `point' is inside a Jupyter code block. Completion is also
enabled when `point' is inside a code block.
In addition, ANSI escape sequences in example blocks or
fixed-width elements are fontified.
By default this mode is enabled in every `org-mode' buffer.
key binding
--- -------
C-M-x `jupyter-eval-defun'
M-i `jupyter-inspect-at-point'
C-c TAB `jupyter-repl-interrupt-kernel'
C-c C-r `jupyter-repl-restart-kernel'
C-x C-e `jupyter-eval-line-or-region'"
:group 'ob-jupyter
:init-value nil
(cond
(jupyter-org-interaction-mode
(add-hook 'completion-at-point-functions 'jupyter-org-completion-at-point nil t)
(add-hook 'after-revert-hook 'jupyter-org-interaction-mode nil t)
(setq-local char-property-alias-alist
(copy-tree char-property-alias-alist))
(cl-callf append (alist-get 'invisible char-property-alias-alist)
'(jupyter-invisible))
(unless (cl-find-if
(lambda (x) (eq (car x) 'jupyter-org-font-lock-ansi-escapes))
org-font-lock-keywords)
(cl-callf append org-font-lock-keywords
'((jupyter-org-font-lock-ansi-escapes)))))
(t
(remove-hook 'completion-at-point-functions 'jupyter-org-completion-at-point t)
(remove-hook 'after-revert-hook 'jupyter-org-interaction-mode t)
(cl-callf2 delq 'jupyter-invisible
(alist-get 'invisible char-property-alias-alist))
(cl-callf2 cl-remove-if
(lambda (x) (eq (car x) 'jupyter-org-font-lock-ansi-escapes))
org-font-lock-keywords))))
(add-hook 'org-mode-hook 'jupyter-org-interaction-mode)
;;; Constructing org syntax trees
(defvar org-element-all-objects)
(defvar org-element-all-elements)
(defun jupyter-org-object-p (element)
"Return non-nil if ELEMENT's type is a member of `org-element-all-objects'."
(memq (org-element-type element) org-element-all-objects))
(defun jupyter-org-raw-string-p (str)
"Return non-nil if STR can be inserted as is during result insertion."
(and (stringp str) (get-text-property 0 'jupyter-org str)))
(defun jupyter-org-raw-string (str)
"Return STR, ensuring that it is flagged as already being `org' syntax.
Adds a non-nil jupyter-org text property on the first character
of STR. If a string returned by `jupyter-org-result' has a
non-nil jupyter-org property on the first character, it is
inserted without modification as the result of a code block."
(prog1 str
(put-text-property 0 1 'jupyter-org t str)))
(defun jupyter-org-table-string (str)
"Return STR, ensuring that it is flagged as containing an `org' table.
We need a way to distinguish a table string that is easily
removed from the code block vs a regular string that will need to
be wrapped in a drawer. Used in `jupyter-org-babel-result-p'."
(prog1 (jupyter-org-raw-string str)
(put-text-property 0 1 'org-table t str)))
(defun jupyter-org-comment (value)
"Return a comment `org-element' with VALUE."
(org-element-create 'comment (list :value value)))
(defun jupyter-org-export-block-or-pandoc (type value params)
"Return VALUE, either converted with pandoc or in an export block.
If PARAMS has non-nil value for key ':pandoc' and TYPE is in
`jupyter-org-pandoc-convertable', convert the result with pandoc.
Otherwise, wrap it in an export block."
(if (and (alist-get :pandoc params)
(member type jupyter-org-pandoc-convertable))
(list 'pandoc
(list :text "Converting..."
:type type
:value value))
(jupyter-org-export-block type value)))
(defun jupyter-org-export-block (type value)
"Return an export-block `org-element'.
The block will export TYPE and the contents of the block will be
VALUE."
(org-element-create 'export-block
(list :type type
:value (org-element-normalize-string value))))
(defun jupyter-org-file-link (path)
"Return a file link `org-element' that points to PATH."
(org-element-create 'link (list :type "file" :path path)))
(defun jupyter-org-image-link (path &optional width height)
"Return an `org-element' for an image at PATH.
If a WIDTH or HEIGHT are provided, then return a paragraph
element with an affiliated keyword ATTR_ORG. So that the image
link will be rendered like
#+ATTR_ORG :width 300 :height 300
[[file:<path>]]
Otherwise return a `jupyter-org-file-link' for PATH."
(if (or width height)
(let ((attrs (concat
(when width
(concat ":width " (number-to-string width)))
(when height
(concat (when width " ")
":height " (number-to-string height))))))
(org-element-create 'paragraph (list :attr_org (list attrs))
(jupyter-org-file-link path)
"\n"))
(jupyter-org-file-link path)))
(defun jupyter-org-src-block (language parameters value &optional switches)
"Return a src-block `org-element'.
LANGUAGE, PARAMETERS, VALUE, and SWITCHES all have the same
meaning as a src-block `org-element'."
(declare (indent 2))
(org-element-create 'src-block
(list :language language
:parameters parameters
:switches switches
:value value)))
(defun jupyter-org-example-block (value)
"Return an example-block `org-element' with VALUE."
(org-element-create 'example-block
(list :value (org-element-normalize-string value))))
;; From `org-babel-insert-result'
(defun jupyter-org-tabulablep (r)
"Return non-nil when R can be turned into an `org-mode' table."
(and (listp r)
(null (cdr (last r)))
(cl-every
(lambda (e) (or (atom e) (null (cdr (last e)))))
r)))
;; From `org-babel-insert-result'
(defun jupyter-org-table-to-orgtbl (table)
"Return TABLE formatted as an `org-mode' table string."
(with-temp-buffer
(insert (concat (orgtbl-to-orgtbl
(if (cl-every
(lambda (e)
(or (eq e 'hline) (listp e)))
table)
table
(list table))
nil)
"\n"))
(goto-char (point-min))
(when (org-at-table-p) (org-table-align))
(buffer-string)))
(defun jupyter-org-scalar (value)
"Return a scalar VALUE.
If VALUE is a string, return either a fixed-width `org-element'
or example-block depending on
`org-babel-min-lines-for-block-output'.
If VALUE is another `org-element' return it unchanged.
If VALUE is a list and can be represented as a table, return an
`org-mode' table as a string. To distinguish the table from a
regular string, it has a non-nil org-table text property on its
first character.
Otherwise, return VALUE formated as a fixed-width `org-element'."
(cond
((stringp value)
(if (cl-loop with i = 0 for c across value if (eq c ?\n) do (cl-incf i)
thereis (>= i org-babel-min-lines-for-block-output))
(jupyter-org-example-block value)
(org-element-create 'fixed-width (list :value value))))
((and (listp value)
(or (memq (car value) org-element-all-objects)
(memq (car value) org-element-all-elements)))
value)
((and (listp value)
(jupyter-org-tabulablep value))
(jupyter-org-table-string (jupyter-org-table-to-orgtbl value)))
(t
(org-element-create 'fixed-width (list :value (format "%S" value))))))
(defun jupyter-org-latex-fragment (value)
"Return a latex-fragment `org-element' consisting of VALUE."
(org-element-create 'latex-fragment (list :value value)))
(defun jupyter-org-latex-environment (value)
"Return a latex-fragment `org-element' consisting of VALUE."
(org-element-create 'latex-environment (list :value value)))
(defun jupyter-org-results-drawer (&rest results)
"Return a drawer `org-element' containing RESULTS.
RESULTS can be either strings or other `org-element's. Newlines
are added after every `org-element' object in RESULTS, such as
file links, so that each result appears on a single line in the
string representation of the drawer. The returned drawer has a
name of \"RESULTS\"."
(apply #'org-element-set-contents
(list 'drawer (list :drawer-name "RESULTS"))
(cl-loop
for res in results
if (jupyter-org-object-p res)
collect res into ret and collect "\n" into ret
else collect res into ret
finally return
(let ((last (last ret)))
;; Ensure the last element has a newline if it is already a string.
;; This is to avoid situations like
;;
;; :RESULTS:
;; foo:END:
(when (and (stringp (car last))
(not (zerop (length (car last)))))
(setcar last (org-element-normalize-string (car last))))
ret))))
;;; Inserting results
;;;; `jupyter-org-result'
(defun jupyter-org-image-file-name (data ext)
"Return a file name based on DATA and EXT.
`jupyter-org-resource-directory' is used as the directory name of
the file, the `sha1' hash of DATA is used as the base name, and
EXT is used as the extension."
(let ((dir (prog1 jupyter-org-resource-directory
(unless (file-directory-p jupyter-org-resource-directory)
(make-directory jupyter-org-resource-directory))))
(ext (if (= (aref ext 0) ?.) ext
(concat "." ext))))
(concat (file-name-as-directory dir) (sha1 data) ext)))
(defvar org-image-actual-width)
(defun jupyter-org--add-image-ext-maybe (file &optional ext)
"Return a file name for FILE with EXT.
If FILE is an image file with a specified extension, return FILE.
If FILE is an image file without a specified extension and EXT is
non-nil, return FILE with EXT as the extension. Otherwise, return
FILE."
(cond
((null file) file)
((image-type-from-file-name file) file)
((not (null ext)) (concat file "." ext))
(t file)))
(defun jupyter-org--image-result (mime content params &optional b64-encoded)
"Return an org-element suitable for inserting an image.
MIME is the image mimetype, CONTENT is a property list
(:data D :metadata M)
where D is the image data for MIME and M any metadata. D is
written to file and an org-element link to the file is returned.
PARAMS are the `jupyter-org-request-block-params', the ones
passed to `org-babel-execute:jupyter', of the source block that
returned D. If PARAMS contains a :file key, it's value is used
as the image file name. Otherwise a file name is created, see
`jupyter-org-image-file-name'. In the case that a file exists
with the same name being used, it is overwritten.
If B64-ENCODED is non-nil, the image data is assumed to be a
base64 encoded string and will be decoded before writing to file.
If METADATA contains a :width or :height key, then the returned
org-element will have an ATTR_ORG affiliated keyword containing
the width or height of the image. When there is no :width or
:height, an ATTR_ORG keyword containing the true size of the
image may still be added, see `jupyter-org-adjust-image-size'."
(let* ((file-ext (cl-case mime
(:image/png "png")
(:image/jpeg "jpg")
(:image/svg+xml "svg")))
(overwrite (not (null (alist-get :file params))))
(file (or (jupyter-org--add-image-ext-maybe (alist-get :file params) file-ext)
(jupyter-org-image-file-name
(plist-get content :data)
file-ext))))
(when (or overwrite (not (file-exists-p file)))
(let ((buffer-file-coding-system
(if b64-encoded 'binary
buffer-file-coding-system))
(require-final-newline nil))
(with-temp-file file
(insert (plist-get content :data))
(when b64-encoded
(base64-decode-region (point-min) (point-max))))))
(cl-destructuring-bind (&key width height &allow-other-keys)
(plist-get content :metadata)
(when (and jupyter-org-adjust-image-size (null width)
(numberp (car-safe org-image-actual-width)))
(let ((image-width (car (image-size
(create-image (expand-file-name file))
'pixels))))
(when (< image-width (car org-image-actual-width))
(setq width image-width))))
(jupyter-org-image-link file width height))))
(cl-defgeneric jupyter-org-result (_mime _content _params)
"Return an `org-element' representing a result.
Either a string or an `org-element' is a valid return value of
this method. The former will be inserted as is, while the latter
will be inserted by calling `org-element-interpret-data' first.
The returned result should be a representation of a MIME type's
CONTENT. CONTENT is a property list like
'(:data DATA :metadata METADATA)
that contains the DATA/METADATA of the mime type. As an example,
if MIME is `:text/markdown', then DATA should be the markdown
string. The returned result in this case will be
(jupyter-org-export-block \"markdown\" DATA)"
(ignore))
(defun jupyter-org--find-mime-types (req-types)
"Return the keywords in `jupyter-org-mime-types' that match REQ-TYPES.
REQ-TYPES is a string such as \"plain\", \"plain html\", or
\"text/plain\". The string \"text\" is translated to the keyword
`:text/plain' and \"image\" to `:image/png'.
If a match is not found, return nil."
(when (stringp req-types)
;; Iterate the user-specified mimetypes looking for symbols that match a
;; symbol in `jupyter-org-mime-types'. Invalid mimetypes are ignored.
(cl-loop
with translations = `(("text" . :text/plain)
("image" . :image/png))
for req-type in (split-string req-types)
for match = (or (cdr (assoc req-type translations))
(let ((regexp (if (string-match "/" req-type)
req-type
(concat "/" req-type "$"))))
(cl-loop for mime-type in jupyter-org-mime-types
if (string-match regexp (symbol-name mime-type))
return mime-type)))
if match collect match)))
(cl-defmethod jupyter-org-result ((req jupyter-org-request) plist &optional metadata)
"For REQ, return a rendered form of a message PLIST.
PLIST and METADATA have the same meaning as in
`jupyter-normalize-data'.
Given the source block parameters of REQ, loop over the mime
types in `jupyter-org-mime-types' calling
(jupyter-org-result MIME CONTENT PARAMS)
for each one. Return the result of the call for the first
mime-type that has a non-nil result.
MIME is the current mime-type, CONTENT is a property list
(:data ... :metadata ...)
containing the data of the mime-type and PARAMS are the source
block parameters.
If the source block parameters have a value for the :display
header argument, like \"image/png html plain\", then loop over
those mime types instead."
(cl-assert plist json-plist)
(let* ((params (jupyter-org-request-block-params req))
(display (alist-get :display params))
(mime-types (or (jupyter-org--find-mime-types display)
jupyter-org-mime-types)))
;; Push :file back into PARAMS if it was present in
;; `org-babel-execute:jupyter'. That function removes it because