From 8b80ceda39b42c7c315b475ce8792e25624955e1 Mon Sep 17 00:00:00 2001 From: Daniel Weschke Date: Sun, 5 May 2024 20:36:39 +0200 Subject: [PATCH] change python config, add jupyter and ein --- lisp/anaphora/anaphora-pkg.el | 12 + lisp/anaphora/anaphora.el | 474 + lisp/code-cells/code-cells-pkg.el | 14 + lisp/code-cells/code-cells.el | 442 + lisp/deferred/deferred-pkg.el | 14 + lisp/deferred/deferred.el | 971 + lisp/ein/ein-cell.el | 1109 ++ lisp/ein/ein-classes.el | 331 + lisp/ein/ein-completer.el | 34 + lisp/ein/ein-contents-api.el | 353 + lisp/ein/ein-core.el | 174 + lisp/ein/ein-dev.el | 230 + lisp/ein/ein-events.el | 63 + lisp/ein/ein-file.el | 63 + lisp/ein/ein-gat.el | 729 + lisp/ein/ein-ipdb.el | 126 + lisp/ein/ein-ipynb-mode.el | 81 + lisp/ein/ein-jupyter.el | 435 + lisp/ein/ein-kernel.el | 612 + lisp/ein/ein-kernelinfo.el | 56 + lisp/ein/ein-kill-ring.el | 55 + lisp/ein/ein-log.el | 116 + lisp/ein/ein-markdown-mode.el | 8082 ++++++++ lisp/ein/ein-node.el | 65 + lisp/ein/ein-notebook.el | 1011 + lisp/ein/ein-notebooklist.el | 826 + lisp/ein/ein-notification.el | 180 + lisp/ein/ein-output-area.el | 187 + lisp/ein/ein-pager.el | 98 + lisp/ein/ein-pkg.el | 15 + lisp/ein/ein-process.el | 215 + lisp/ein/ein-python-send.el | 160 + lisp/ein/ein-pytools.el | 56 + lisp/ein/ein-query.el | 223 + lisp/ein/ein-scratchsheet.el | 50 + lisp/ein/ein-shared-output.el | 230 + lisp/ein/ein-traceback.el | 193 + lisp/ein/ein-utils.el | 721 + lisp/ein/ein-websocket.el | 119 + lisp/ein/ein-worksheet.el | 1161 ++ lisp/ein/ein.el | 52 + lisp/ein/ob-ein.el | 458 + lisp/ein/poly-ein.el | 496 + lisp/jupyter/Makefile | 50 + lisp/jupyter/js/Makefile | 28 + lisp/jupyter/js/emacs-jupyter.js | 342 + lisp/jupyter/js/index.js | 12 + lisp/jupyter/js/manager.js | 82 + lisp/jupyter/js/package.json | 33 + lisp/jupyter/js/webpack.config.js | 29 + lisp/jupyter/jupyter-R.el | 63 + lisp/jupyter/jupyter-base.el | 793 + lisp/jupyter/jupyter-c++.el | 45 + lisp/jupyter/jupyter-channel-ioloop.el | 187 + lisp/jupyter/jupyter-channel.el | 73 + lisp/jupyter/jupyter-client.el | 1812 ++ lisp/jupyter/jupyter-env.el | 192 + lisp/jupyter/jupyter-ioloop.el | 502 + lisp/jupyter/jupyter-javascript.el | 54 + lisp/jupyter/jupyter-julia.el | 245 + lisp/jupyter/jupyter-kernel-process.el | 416 + lisp/jupyter/jupyter-kernel.el | 130 + lisp/jupyter/jupyter-kernelspec.el | 273 + lisp/jupyter/jupyter-messages.el | 678 + lisp/jupyter/jupyter-mime.el | 671 + lisp/jupyter/jupyter-monads.el | 494 + lisp/jupyter/jupyter-org-client.el | 1899 ++ lisp/jupyter/jupyter-org-extensions.el | 686 + lisp/jupyter/jupyter-pkg.el | 17 + lisp/jupyter/jupyter-python.el | 110 + lisp/jupyter/jupyter-repl.el | 2179 +++ lisp/jupyter/jupyter-rest-api.el | 1103 ++ lisp/jupyter/jupyter-server-kernel.el | 375 + lisp/jupyter/jupyter-server.el | 574 + lisp/jupyter/jupyter-tramp.el | 881 + lisp/jupyter/jupyter-widget-client.el | 287 + lisp/jupyter/jupyter-zmq-channel-ioloop.el | 82 + lisp/jupyter/jupyter-zmq-channel.el | 252 + lisp/jupyter/jupyter.el | 44 + lisp/jupyter/ob-jupyter.el | 836 + lisp/jupyter/widget.html | 33 + lisp/ox-ipynb.el | 1108 ++ lisp/request/request-pkg.el | 12 + lisp/request/request.el | 1234 ++ .../Untitled-checkpoint.ipynb | 6 + lisp/zmq/Makefile | 93 + lisp/zmq/emacs-zmq.so | Bin 0 -> 230672 bytes lisp/zmq/src/.deps/emacs_zmq_la-constants.Plo | 148 + lisp/zmq/src/.deps/emacs_zmq_la-context.Plo | 149 + lisp/zmq/src/.deps/emacs_zmq_la-core.Plo | 150 + lisp/zmq/src/.deps/emacs_zmq_la-emacs-zmq.Plo | 157 + lisp/zmq/src/.deps/emacs_zmq_la-msg.Plo | 149 + lisp/zmq/src/.deps/emacs_zmq_la-poll.Plo | 149 + lisp/zmq/src/.deps/emacs_zmq_la-socket.Plo | 151 + lisp/zmq/src/.deps/emacs_zmq_la-util.Plo | 149 + lisp/zmq/src/.libs/emacs-zmq.la | 1 + lisp/zmq/src/.libs/emacs-zmq.lai | 41 + lisp/zmq/src/.libs/emacs-zmq.so | Bin 0 -> 230672 bytes lisp/zmq/src/.libs/emacs_zmq_la-constants.o | Bin 0 -> 61856 bytes lisp/zmq/src/.libs/emacs_zmq_la-context.o | Bin 0 -> 13768 bytes lisp/zmq/src/.libs/emacs_zmq_la-core.o | Bin 0 -> 36816 bytes lisp/zmq/src/.libs/emacs_zmq_la-emacs-zmq.o | Bin 0 -> 49912 bytes lisp/zmq/src/.libs/emacs_zmq_la-msg.o | Bin 0 -> 34320 bytes lisp/zmq/src/.libs/emacs_zmq_la-poll.o | Bin 0 -> 39632 bytes lisp/zmq/src/.libs/emacs_zmq_la-socket.o | Bin 0 -> 46560 bytes lisp/zmq/src/.libs/emacs_zmq_la-util.o | Bin 0 -> 23152 bytes lisp/zmq/src/Makefile | 1057 + lisp/zmq/src/Makefile.am | 19 + lisp/zmq/src/Makefile.in | 1057 + lisp/zmq/src/aclocal.m4 | 1559 ++ lisp/zmq/src/ar-lib | 271 + lisp/zmq/src/autom4te.cache/output.0 | 15927 +++++++++++++++ lisp/zmq/src/autom4te.cache/output.1 | 15927 +++++++++++++++ lisp/zmq/src/autom4te.cache/output.2 | 15927 +++++++++++++++ lisp/zmq/src/autom4te.cache/output.3 | 15928 ++++++++++++++++ lisp/zmq/src/autom4te.cache/requests | 626 + lisp/zmq/src/autom4te.cache/traces.0 | 2992 +++ lisp/zmq/src/autom4te.cache/traces.1 | 595 + lisp/zmq/src/autom4te.cache/traces.2 | 2992 +++ lisp/zmq/src/autom4te.cache/traces.3 | 595 + lisp/zmq/src/compile | 348 + lisp/zmq/src/config.guess | 1748 ++ lisp/zmq/src/config.log | 684 + lisp/zmq/src/config.status | 1854 ++ lisp/zmq/src/config.sub | 1884 ++ lisp/zmq/src/configure | 15928 ++++++++++++++++ lisp/zmq/src/configure.ac | 85 + lisp/zmq/src/constants.c | 207 + lisp/zmq/src/context.c | 63 + lisp/zmq/src/context.h | 13 + lisp/zmq/src/core.c | 309 + lisp/zmq/src/core.h | 297 + lisp/zmq/src/depcomp | 791 + lisp/zmq/src/emacs-module.h | 204 + lisp/zmq/src/emacs-zmq.c | 322 + lisp/zmq/src/emacs-zmq.h | 34 + lisp/zmq/src/emacs-zmq.la | 41 + lisp/zmq/src/emacs_zmq_la-constants.lo | 12 + lisp/zmq/src/emacs_zmq_la-context.lo | 12 + lisp/zmq/src/emacs_zmq_la-core.lo | 12 + lisp/zmq/src/emacs_zmq_la-emacs-zmq.lo | 12 + lisp/zmq/src/emacs_zmq_la-msg.lo | 12 + lisp/zmq/src/emacs_zmq_la-poll.lo | 12 + lisp/zmq/src/emacs_zmq_la-socket.lo | 12 + lisp/zmq/src/emacs_zmq_la-util.lo | 12 + lisp/zmq/src/install-sh | 541 + lisp/zmq/src/libtool | 11943 ++++++++++++ lisp/zmq/src/ltmain.sh | 11437 +++++++++++ lisp/zmq/src/m4/libtool.m4 | 8399 ++++++++ lisp/zmq/src/m4/ltoptions.m4 | 437 + lisp/zmq/src/m4/ltsugar.m4 | 124 + lisp/zmq/src/m4/ltversion.m4 | 24 + lisp/zmq/src/m4/lt~obsolete.m4 | 99 + lisp/zmq/src/missing | 215 + lisp/zmq/src/msg.c | 249 + lisp/zmq/src/msg.h | 23 + lisp/zmq/src/poll.c | 392 + lisp/zmq/src/poll.h | 15 + lisp/zmq/src/socket.c | 468 + lisp/zmq/src/socket.h | 23 + lisp/zmq/src/util.c | 178 + lisp/zmq/src/util.h | 18 + lisp/zmq/zmq-pkg.el | 15 + lisp/zmq/zmq.el | 663 + settings/dot-settings.el | 8 +- settings/org-settings.el | 2 + settings/python-settings.el | 141 +- settings/syntax-checking-settings.el | 28 +- 168 files changed, 177127 insertions(+), 46 deletions(-) create mode 100644 lisp/anaphora/anaphora-pkg.el create mode 100644 lisp/anaphora/anaphora.el create mode 100644 lisp/code-cells/code-cells-pkg.el create mode 100644 lisp/code-cells/code-cells.el create mode 100644 lisp/deferred/deferred-pkg.el create mode 100644 lisp/deferred/deferred.el create mode 100644 lisp/ein/ein-cell.el create mode 100644 lisp/ein/ein-classes.el create mode 100644 lisp/ein/ein-completer.el create mode 100644 lisp/ein/ein-contents-api.el create mode 100644 lisp/ein/ein-core.el create mode 100644 lisp/ein/ein-dev.el create mode 100644 lisp/ein/ein-events.el create mode 100644 lisp/ein/ein-file.el create mode 100644 lisp/ein/ein-gat.el create mode 100644 lisp/ein/ein-ipdb.el create mode 100644 lisp/ein/ein-ipynb-mode.el create mode 100644 lisp/ein/ein-jupyter.el create mode 100644 lisp/ein/ein-kernel.el create mode 100644 lisp/ein/ein-kernelinfo.el create mode 100644 lisp/ein/ein-kill-ring.el create mode 100644 lisp/ein/ein-log.el create mode 100644 lisp/ein/ein-markdown-mode.el create mode 100644 lisp/ein/ein-node.el create mode 100644 lisp/ein/ein-notebook.el create mode 100644 lisp/ein/ein-notebooklist.el create mode 100644 lisp/ein/ein-notification.el create mode 100644 lisp/ein/ein-output-area.el create mode 100644 lisp/ein/ein-pager.el create mode 100644 lisp/ein/ein-pkg.el create mode 100644 lisp/ein/ein-process.el create mode 100644 lisp/ein/ein-python-send.el create mode 100644 lisp/ein/ein-pytools.el create mode 100644 lisp/ein/ein-query.el create mode 100644 lisp/ein/ein-scratchsheet.el create mode 100644 lisp/ein/ein-shared-output.el create mode 100644 lisp/ein/ein-traceback.el create mode 100644 lisp/ein/ein-utils.el create mode 100644 lisp/ein/ein-websocket.el create mode 100644 lisp/ein/ein-worksheet.el create mode 100644 lisp/ein/ein.el create mode 100644 lisp/ein/ob-ein.el create mode 100644 lisp/ein/poly-ein.el create mode 100644 lisp/jupyter/Makefile create mode 100644 lisp/jupyter/js/Makefile create mode 100644 lisp/jupyter/js/emacs-jupyter.js create mode 100644 lisp/jupyter/js/index.js create mode 100644 lisp/jupyter/js/manager.js create mode 100644 lisp/jupyter/js/package.json create mode 100644 lisp/jupyter/js/webpack.config.js create mode 100644 lisp/jupyter/jupyter-R.el create mode 100644 lisp/jupyter/jupyter-base.el create mode 100644 lisp/jupyter/jupyter-c++.el create mode 100644 lisp/jupyter/jupyter-channel-ioloop.el create mode 100644 lisp/jupyter/jupyter-channel.el create mode 100644 lisp/jupyter/jupyter-client.el create mode 100644 lisp/jupyter/jupyter-env.el create mode 100644 lisp/jupyter/jupyter-ioloop.el create mode 100644 lisp/jupyter/jupyter-javascript.el create mode 100644 lisp/jupyter/jupyter-julia.el create mode 100644 lisp/jupyter/jupyter-kernel-process.el create mode 100644 lisp/jupyter/jupyter-kernel.el create mode 100644 lisp/jupyter/jupyter-kernelspec.el create mode 100644 lisp/jupyter/jupyter-messages.el create mode 100644 lisp/jupyter/jupyter-mime.el create mode 100644 lisp/jupyter/jupyter-monads.el create mode 100644 lisp/jupyter/jupyter-org-client.el create mode 100644 lisp/jupyter/jupyter-org-extensions.el create mode 100644 lisp/jupyter/jupyter-pkg.el create mode 100644 lisp/jupyter/jupyter-python.el create mode 100644 lisp/jupyter/jupyter-repl.el create mode 100644 lisp/jupyter/jupyter-rest-api.el create mode 100644 lisp/jupyter/jupyter-server-kernel.el create mode 100644 lisp/jupyter/jupyter-server.el create mode 100644 lisp/jupyter/jupyter-tramp.el create mode 100644 lisp/jupyter/jupyter-widget-client.el create mode 100644 lisp/jupyter/jupyter-zmq-channel-ioloop.el create mode 100644 lisp/jupyter/jupyter-zmq-channel.el create mode 100644 lisp/jupyter/jupyter.el create mode 100644 lisp/jupyter/ob-jupyter.el create mode 100644 lisp/jupyter/widget.html create mode 100644 lisp/ox-ipynb.el create mode 100644 lisp/request/request-pkg.el create mode 100644 lisp/request/request.el create mode 100644 lisp/zmq/.ipynb_checkpoints/Untitled-checkpoint.ipynb create mode 100644 lisp/zmq/Makefile create mode 100755 lisp/zmq/emacs-zmq.so create mode 100644 lisp/zmq/src/.deps/emacs_zmq_la-constants.Plo create mode 100644 lisp/zmq/src/.deps/emacs_zmq_la-context.Plo create mode 100644 lisp/zmq/src/.deps/emacs_zmq_la-core.Plo create mode 100644 lisp/zmq/src/.deps/emacs_zmq_la-emacs-zmq.Plo create mode 100644 lisp/zmq/src/.deps/emacs_zmq_la-msg.Plo create mode 100644 lisp/zmq/src/.deps/emacs_zmq_la-poll.Plo create mode 100644 lisp/zmq/src/.deps/emacs_zmq_la-socket.Plo create mode 100644 lisp/zmq/src/.deps/emacs_zmq_la-util.Plo create mode 120000 lisp/zmq/src/.libs/emacs-zmq.la create mode 100644 lisp/zmq/src/.libs/emacs-zmq.lai create mode 100755 lisp/zmq/src/.libs/emacs-zmq.so create mode 100644 lisp/zmq/src/.libs/emacs_zmq_la-constants.o create mode 100644 lisp/zmq/src/.libs/emacs_zmq_la-context.o create mode 100644 lisp/zmq/src/.libs/emacs_zmq_la-core.o create mode 100644 lisp/zmq/src/.libs/emacs_zmq_la-emacs-zmq.o create mode 100644 lisp/zmq/src/.libs/emacs_zmq_la-msg.o create mode 100644 lisp/zmq/src/.libs/emacs_zmq_la-poll.o create mode 100644 lisp/zmq/src/.libs/emacs_zmq_la-socket.o create mode 100644 lisp/zmq/src/.libs/emacs_zmq_la-util.o create mode 100644 lisp/zmq/src/Makefile create mode 100644 lisp/zmq/src/Makefile.am create mode 100644 lisp/zmq/src/Makefile.in create mode 100644 lisp/zmq/src/aclocal.m4 create mode 100755 lisp/zmq/src/ar-lib create mode 100644 lisp/zmq/src/autom4te.cache/output.0 create mode 100644 lisp/zmq/src/autom4te.cache/output.1 create mode 100644 lisp/zmq/src/autom4te.cache/output.2 create mode 100644 lisp/zmq/src/autom4te.cache/output.3 create mode 100644 lisp/zmq/src/autom4te.cache/requests create mode 100644 lisp/zmq/src/autom4te.cache/traces.0 create mode 100644 lisp/zmq/src/autom4te.cache/traces.1 create mode 100644 lisp/zmq/src/autom4te.cache/traces.2 create mode 100644 lisp/zmq/src/autom4te.cache/traces.3 create mode 100755 lisp/zmq/src/compile create mode 100755 lisp/zmq/src/config.guess create mode 100644 lisp/zmq/src/config.log create mode 100755 lisp/zmq/src/config.status create mode 100755 lisp/zmq/src/config.sub create mode 100755 lisp/zmq/src/configure create mode 100644 lisp/zmq/src/configure.ac create mode 100644 lisp/zmq/src/constants.c create mode 100644 lisp/zmq/src/context.c create mode 100644 lisp/zmq/src/context.h create mode 100644 lisp/zmq/src/core.c create mode 100644 lisp/zmq/src/core.h create mode 100755 lisp/zmq/src/depcomp create mode 100644 lisp/zmq/src/emacs-module.h create mode 100644 lisp/zmq/src/emacs-zmq.c create mode 100644 lisp/zmq/src/emacs-zmq.h create mode 100644 lisp/zmq/src/emacs-zmq.la create mode 100644 lisp/zmq/src/emacs_zmq_la-constants.lo create mode 100644 lisp/zmq/src/emacs_zmq_la-context.lo create mode 100644 lisp/zmq/src/emacs_zmq_la-core.lo create mode 100644 lisp/zmq/src/emacs_zmq_la-emacs-zmq.lo create mode 100644 lisp/zmq/src/emacs_zmq_la-msg.lo create mode 100644 lisp/zmq/src/emacs_zmq_la-poll.lo create mode 100644 lisp/zmq/src/emacs_zmq_la-socket.lo create mode 100644 lisp/zmq/src/emacs_zmq_la-util.lo create mode 100755 lisp/zmq/src/install-sh create mode 100755 lisp/zmq/src/libtool create mode 100644 lisp/zmq/src/ltmain.sh create mode 100644 lisp/zmq/src/m4/libtool.m4 create mode 100644 lisp/zmq/src/m4/ltoptions.m4 create mode 100644 lisp/zmq/src/m4/ltsugar.m4 create mode 100644 lisp/zmq/src/m4/ltversion.m4 create mode 100644 lisp/zmq/src/m4/lt~obsolete.m4 create mode 100755 lisp/zmq/src/missing create mode 100644 lisp/zmq/src/msg.c create mode 100644 lisp/zmq/src/msg.h create mode 100644 lisp/zmq/src/poll.c create mode 100644 lisp/zmq/src/poll.h create mode 100644 lisp/zmq/src/socket.c create mode 100644 lisp/zmq/src/socket.h create mode 100644 lisp/zmq/src/util.c create mode 100644 lisp/zmq/src/util.h create mode 100644 lisp/zmq/zmq-pkg.el create mode 100644 lisp/zmq/zmq.el diff --git a/lisp/anaphora/anaphora-pkg.el b/lisp/anaphora/anaphora-pkg.el new file mode 100644 index 00000000..31216239 --- /dev/null +++ b/lisp/anaphora/anaphora-pkg.el @@ -0,0 +1,12 @@ +(define-package "anaphora" "20240120.1744" "anaphoric macros providing implicit temp variables" 'nil :commit "a755afa7db7f3fa515f8dd2c0518113be0b027f6" :authors + '(("Roland Walker" . "walker@pobox.com")) + :maintainers + '(("Roland Walker" . "walker@pobox.com")) + :maintainer + '("Roland Walker" . "walker@pobox.com") + :keywords + '("extensions") + :url "http://github.com/rolandwalker/anaphora") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/lisp/anaphora/anaphora.el b/lisp/anaphora/anaphora.el new file mode 100644 index 00000000..e9b53551 --- /dev/null +++ b/lisp/anaphora/anaphora.el @@ -0,0 +1,474 @@ +;;; anaphora.el --- anaphoric macros providing implicit temp variables -*- lexical-binding: t -*- +;; +;; This code is in the public domain. +;; +;; Author: Roland Walker +;; Homepage: http://github.com/rolandwalker/anaphora +;; URL: http://raw.githubusercontent.com/rolandwalker/anaphora/master/anaphora.el +;; Version: 1.0.4 +;; Last-Updated: 18 Jun 2018 +;; EmacsWiki: Anaphora +;; Keywords: extensions +;; +;;; Commentary: +;; +;; Quickstart +;; +;; (require 'anaphora) +;; +;; (awhen (big-long-calculation) +;; (foo it) ; `it' is provided as +;; (bar it)) ; a temporary variable +;; +;; ;; anonymous function to compute factorial using `self' +;; (alambda (x) (if (= x 0) 1 (* x (self (1- x))))) +;; +;; ;; to fontify `it' and `self' +;; (with-eval-after-load "lisp-mode" +;; (anaphora-install-font-lock-keywords)) +;; +;; Explanation +;; +;; Anaphoric expressions implicitly create one or more temporary +;; variables which can be referred to during the expression. This +;; technique can improve clarity in certain cases. It also enables +;; recursion for anonymous functions. +;; +;; To use anaphora, place the anaphora.el library somewhere +;; Emacs can find it, and add the following to your ~/.emacs file: +;; +;; (require 'anaphora) +;; +;; The following macros are made available +;; +;; `aand' +;; `ablock' +;; `acase' +;; `acond' +;; `aecase' +;; `aetypecase' +;; `apcase' +;; `aif' +;; `alambda' +;; `alet' +;; `aprog1' +;; `aprog2' +;; `atypecase' +;; `awhen' +;; `awhile' +;; `a+' +;; `a-' +;; `a*' +;; `a/' +;; +;; See Also +;; +;; M-x customize-group RET anaphora RET +;; http://en.wikipedia.org/wiki/On_Lisp +;; http://en.wikipedia.org/wiki/Anaphoric_macro +;; +;; Notes +;; +;; Partially based on examples from the book "On Lisp", by Paul +;; Graham. +;; +;; Compatibility and Requirements +;; +;; GNU Emacs version 26.1 : yes +;; GNU Emacs version 25.x : yes +;; GNU Emacs version 24.x : yes +;; GNU Emacs version 23.x : yes +;; GNU Emacs version 22.x : yes +;; GNU Emacs version 21.x and lower : unknown +;; +;; Bugs +;; +;; TODO +;; +;; better face for it and self +;; +;;; License +;; +;; All code contributed by the author to this library is placed in the +;; public domain. It is the author's belief that the portions adapted +;; from examples in "On Lisp" are in the public domain. +;; +;; Regardless of the copyright status of individual functions, all +;; code herein is free software, and is provided without any express +;; or implied warranties. +;; +;;; Code: +;; + +;;; requirements + +;; for declare, labels, do, block, case, ecase, typecase, etypecase +(require 'cl-lib) + +;;; customizable variables + +;;;###autoload +(defgroup anaphora nil + "Anaphoric macros providing implicit temp variables" + :version "1.0.4" + :link '(emacs-commentary-link :tag "Commentary" "anaphora") + :link '(url-link :tag "GitHub" "http://github.com/rolandwalker/anaphora") + :link '(url-link :tag "EmacsWiki" "http://emacswiki.org/emacs/Anaphora") + :prefix "anaphora-" + :group 'extensions) + +;;;###autoload +(defcustom anaphora-use-long-names-only nil + "Use only long names such as `anaphoric-if' instead of traditional `aif'." + :type 'boolean + :group 'anaphora) + +;;; font-lock + +(defun anaphora-install-font-lock-keywords nil + "Fontify keywords `it' and `self'." + (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\<" (regexp-opt '("it" "self") 'paren) "\\>") + 1 font-lock-variable-name-face)) 'append)) + +;;; aliases + +;;;###autoload +(progn + (defun anaphora--install-traditional-aliases (&optional arg) + "Install traditional short aliases for anaphoric macros. + +With negative numeric ARG, remove traditional aliases." + (let ((syms '( + (if . t) + (prog1 . t) + (prog2 . t) + (when . when) + (while . t) + (and . t) + (cond . cond) + (lambda . lambda) + (block . block) + (case . case) + (ecase . ecase) + (typecase . typecase) + (etypecase . etypecase) + (pcase . pcase) + (let . let) + (+ . t) + (- . t) + (* . t) + (/ . t) + ))) + (cond + ((and (numberp arg) + (< arg 0)) + (dolist (cell syms) + (when (ignore-errors + (eq (symbol-function (intern-soft (format "a%s" (car cell)))) + (intern-soft (format "anaphoric-%s" (car cell))))) + (fmakunbound (intern (format "a%s" (car cell))))))) + (t + (dolist (cell syms) + (let* ((builtin (car cell)) + (traditional (intern (format "a%s" builtin))) + (long (intern (format "anaphoric-%s" builtin)))) + (defalias traditional long) + (put traditional 'lisp-indent-function + (get builtin 'lisp-indent-function)) + (put traditional 'edebug-form-spec (cdr cell))))))))) + +;;;###autoload +(unless anaphora-use-long-names-only + (anaphora--install-traditional-aliases)) + +;;; macros + +;;;###autoload +(defmacro anaphoric-if (cond then &rest else) + "Like `if', but the result of evaluating COND is bound to `it'. + +The variable `it' is available within THEN and ELSE. + +COND, THEN, and ELSE are otherwise as documented for `if'." + (declare (debug t) + (indent 2)) + `(let ((it ,cond)) + (if it ,then ,@else))) + +;;;###autoload +(defmacro anaphoric-prog1 (first &rest body) + "Like `prog1', but the result of evaluating FIRST is bound to `it'. + +The variable `it' is available within BODY. + +FIRST and BODY are otherwise as documented for `prog1'." + (declare (debug t) + (indent 1)) + `(let ((it ,first)) + (progn ,@body) + it)) + +;;;###autoload +(defmacro anaphoric-prog2 (form1 form2 &rest body) + "Like `prog2', but the result of evaluating FORM2 is bound to `it'. + +The variable `it' is available within BODY. + +FORM1, FORM2, and BODY are otherwise as documented for `prog2'." + (declare (debug t) + (indent 2)) + `(progn + ,form1 + (let ((it ,form2)) + (progn ,@body) + it))) + +;;;###autoload +(defmacro anaphoric-when (cond &rest body) + "Like `when', but the result of evaluating COND is bound to `it'. + +The variable `it' is available within BODY. + +COND and BODY are otherwise as documented for `when'." + (declare (debug when) + (indent 1)) + `(anaphoric-if ,cond + (progn ,@body))) + +;;;###autoload +(defmacro anaphoric-while (test &rest body) + "Like `while', but the result of evaluating TEST is bound to `it'. + +The variable `it' is available within BODY. + +TEST and BODY are otherwise as documented for `while'." + (declare (debug t) + (indent 1)) + `(do ((it ,test ,test)) + ((not it)) + ,@body)) + +;;;###autoload +(defmacro anaphoric-and (&rest conditions) + "Like `and', but the result of the previous condition is bound to `it'. + +The variable `it' is available within all CONDITIONS after the +initial one. + +CONDITIONS are otherwise as documented for `and'. + +Note that some implementations of this macro bind only the first +condition to `it', rather than each successive condition." + (declare (debug t)) + (cond + ((null conditions) + t) + ((null (cdr conditions)) + (car conditions)) + (t + `(anaphoric-if ,(car conditions) (anaphoric-and ,@(cdr conditions)))))) + +;;;###autoload +(defmacro anaphoric-cond (&rest clauses) + "Like `cond', but the result of each condition is bound to `it'. + +The variable `it' is available within the remainder of each of CLAUSES. + +CLAUSES are otherwise as documented for `cond'." + (declare (debug cond)) + (if (null clauses) + nil + (let ((cl1 (car clauses)) + (sym (gensym))) + `(let ((,sym ,(car cl1))) + (if ,sym + (if (null ',(cdr cl1)) + ,sym + (let ((it ,sym)) ,@(cdr cl1))) + (anaphoric-cond ,@(cdr clauses))))))) + +;;;###autoload +(defmacro anaphoric-lambda (args &rest body) + "Like `lambda', but the function may refer to itself as `self'. + +ARGS and BODY are otherwise as documented for `lambda'." + (declare (debug lambda) + (indent defun)) + `(cl-labels ((self ,args ,@body)) + #'self)) + +;;;###autoload +(defmacro anaphoric-block (name &rest body) + "Like `block', but the result of the previous expression is bound to `it'. + +The variable `it' is available within all expressions of BODY +except the initial one. + +NAME and BODY are otherwise as documented for `block'." + (declare (debug block) + (indent 1)) + `(cl-block ,name + ,(funcall (anaphoric-lambda (body) + (cl-case (length body) + (0 nil) + (1 (car body)) + (t `(let ((it ,(car body))) + ,(self (cdr body)))))) + body))) + +;;;###autoload +(defmacro anaphoric-case (expr &rest clauses) + "Like `case', but the result of evaluating EXPR is bound to `it'. + +The variable `it' is available within CLAUSES. + +EXPR and CLAUSES are otherwise as documented for `case'." + (declare (debug case) + (indent 1)) + `(let ((it ,expr)) + (cl-case it ,@clauses))) + +;;;###autoload +(defmacro anaphoric-ecase (expr &rest clauses) + "Like `ecase', but the result of evaluating EXPR is bound to `it'. + +The variable `it' is available within CLAUSES. + +EXPR and CLAUSES are otherwise as documented for `ecase'." + (declare (debug ecase) + (indent 1)) + `(let ((it ,expr)) + (cl-ecase it ,@clauses))) + +;;;###autoload +(defmacro anaphoric-typecase (expr &rest clauses) + "Like `typecase', but the result of evaluating EXPR is bound to `it'. + +The variable `it' is available within CLAUSES. + +EXPR and CLAUSES are otherwise as documented for `typecase'." + (declare (debug typecase) + (indent 1)) + `(let ((it ,expr)) + (cl-typecase it ,@clauses))) + +;;;###autoload +(defmacro anaphoric-etypecase (expr &rest clauses) + "Like `etypecase', but result of evaluating EXPR is bound to `it'. + +The variable `it' is available within CLAUSES. + +EXPR and CLAUSES are otherwise as documented for `etypecase'." + (declare (debug etypecase) + (indent 1)) + `(let ((it ,expr)) + (cl-etypecase it ,@clauses))) + +;;;###autoload +(defmacro anaphoric-pcase (expr &rest clauses) + "Like `pcase', but the result of evaluating EXPR is bound to `it'. + +The variable `it' is available within CLAUSES. + +EXPR and CLAUSES are otherwise as documented for `pcase'." + (declare (debug pcase) + (indent 1)) + `(let ((it ,expr)) + (pcase it ,@clauses))) + +;;;###autoload +(defmacro anaphoric-let (form &rest body) + "Like `let', but the result of evaluating FORM is bound to `it'. + +FORM and BODY are otherwise as documented for `let'." + (declare (debug let) + (indent 1)) + `(let ((it ,form)) + (progn ,@body))) + +;;;###autoload +(defmacro anaphoric-+ (&rest numbers-or-markers) + "Like `+', but the result of evaluating the previous expression is bound to `it'. + +The variable `it' is available within all expressions after the +initial one. + +NUMBERS-OR-MARKERS are otherwise as documented for `+'." + (declare (debug t)) + (cond + ((null numbers-or-markers) + 0) + (t + `(let ((it ,(car numbers-or-markers))) + (+ it (anaphoric-+ ,@(cdr numbers-or-markers))))))) + +;;;###autoload +(defmacro anaphoric-- (&optional number-or-marker &rest numbers-or-markers) + "Like `-', but the result of evaluating the previous expression is bound to `it'. + +The variable `it' is available within all expressions after the +initial one. + +NUMBER-OR-MARKER and NUMBERS-OR-MARKERS are otherwise as +documented for `-'." + (declare (debug t)) + (cond + ((null number-or-marker) + 0) + ((null numbers-or-markers) + `(- ,number-or-marker)) + (t + `(let ((it ,(car numbers-or-markers))) + (- ,number-or-marker (+ it (anaphoric-+ ,@(cdr numbers-or-markers)))))))) + +;;;###autoload +(defmacro anaphoric-* (&rest numbers-or-markers) + "Like `*', but the result of evaluating the previous expression is bound to `it'. + +The variable `it' is available within all expressions after the +initial one. + +NUMBERS-OR-MARKERS are otherwise as documented for `*'." + (declare (debug t)) + (cond + ((null numbers-or-markers) + 1) + (t + `(let ((it ,(car numbers-or-markers))) + (* it (anaphoric-* ,@(cdr numbers-or-markers))))))) + +;;;###autoload +(defmacro anaphoric-/ (dividend divisor &rest divisors) + "Like `/', but the result of evaluating the previous divisor is bound to `it'. + +The variable `it' is available within all expressions after the +first divisor. + +DIVIDEND, DIVISOR, and DIVISORS are otherwise as documented for `/'." + (declare (debug t)) + (cond + ((null divisors) + `(/ ,dividend ,divisor)) + (t + `(let ((it ,divisor)) + (/ ,dividend (* it (anaphoric-* ,@divisors))))))) + +(provide 'anaphora) + +;; +;; Emacs +;; +;; Local Variables: +;; indent-tabs-mode: nil +;; mangle-whitespace: t +;; require-final-newline: t +;; coding: utf-8 +;; byte-compile-warnings: (not cl-functions redefine) +;; End: +;; +;; LocalWords: Anaphora EXPR awhen COND ARGS alambda ecase typecase +;; LocalWords: etypecase aprog aand acond ablock acase aecase alet +;; LocalWords: atypecase aetypecase apcase +;; + +;;; anaphora.el ends here diff --git a/lisp/code-cells/code-cells-pkg.el b/lisp/code-cells/code-cells-pkg.el new file mode 100644 index 00000000..79657cbe --- /dev/null +++ b/lisp/code-cells/code-cells-pkg.el @@ -0,0 +1,14 @@ +(define-package "code-cells" "20231119.2138" "Lightweight notebooks with support for ipynb files" + '((emacs "27.1")) + :commit "44546ca256f3da29e3ac884e3d699c8455acbd6e" :authors + '(("Augusto Stoffel" . "arstoffel@gmail.com")) + :maintainers + '(("Augusto Stoffel" . "arstoffel@gmail.com")) + :maintainer + '("Augusto Stoffel" . "arstoffel@gmail.com") + :keywords + '("convenience" "outlines") + :url "https://github.com/astoff/code-cells.el") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/lisp/code-cells/code-cells.el b/lisp/code-cells/code-cells.el new file mode 100644 index 00000000..e38d321e --- /dev/null +++ b/lisp/code-cells/code-cells.el @@ -0,0 +1,442 @@ +;;; code-cells.el --- Lightweight notebooks with support for ipynb files -*- lexical-binding: t; -*- + +;; Copyright (C) 2022, 2023 Free Software Foundation, Inc. + +;; Author: Augusto Stoffel +;; Keywords: convenience, outlines +;; URL: https://github.com/astoff/code-cells.el +;; Package-Requires: ((emacs "27.1")) +;; Version: 0.4 + +;; 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 of the License, 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 this program. If not, see . + +;;; Commentary: + +;; With this package, you can efficiently navigate, edit and execute +;; code split into cells according to certain magic comments. It also +;; allows you to open ipynb notebook files directly in Emacs. They +;; will be automatically converted to a script for editing, and +;; converted back to notebook format when saving. An external tool, +;; Jupytext by default, is required for this. +;; +;; A minor mode, `code-cells-mode', provides the following features: +;; +;; - Fontification of cell boundaries. +;; +;; - Keybindings for the cell navigation and evaluation commands, +;; under the `C-c %' prefix. +;; +;; - Outline mode integration: cell headers have outline level +;; determined by the number of percent signs or asterisks; within a +;; cell, outline headings are as determined by the major mode, but +;; they are demoted by an amount corresponding to the level of the +;; containing cell. This provides code folding and hierarchical +;; navigation, among other things, when `outline-minor-mode' is +;; active. +;; +;; This minor mode is automatically activated when opening an ipynb +;; file, but you can also activate it in any other buffer, either +;; manually or through a hook. + +;;; Code: + +(require 'outline) +(require 'pulse) +(eval-when-compile + (require 'cl-lib) + (require 'let-alist) + (require 'rx)) + +(defgroup code-cells nil + "Utilities for code split into cells." + :group 'convenience + :prefix "code-cells-") + +;;; Cell navigation + +(defcustom code-cells-boundary-regexp + (rx line-start + (+ (syntax comment-start)) + (or (seq (* (syntax whitespace)) "%" (group-n 1 (+ "%"))) + (group-n 1 (+ "*")) + (seq " In[" (* (any space digit)) "]:"))) + "Regular expression specifying cell boundaries. +It should match at the beginning of a line. The length of the +first capture determines the outline level." + :type 'regexp + :safe #'stringp) + +;;;###autoload +(defun code-cells-forward-cell (&optional arg) + "Move to the next cell boundary, or end of buffer. +With ARG, repeat this that many times. If ARG is negative, move +backward." + (interactive "p") + (let ((page-delimiter code-cells-boundary-regexp)) + (when (and (< 0 arg) (looking-at page-delimiter)) + (forward-char)) + (forward-page arg) + (unless (eobp) + (move-beginning-of-line 1)))) + +;;;###autoload +(defun code-cells-backward-cell (&optional arg) + "Move to the previous cell boundary, or beginning of buffer. +With ARG, repeat this that many times. If ARG is negative, move +forward." + (interactive "p") + (code-cells-forward-cell (- (or arg 1)))) + +(defun code-cells--bounds (&optional count use-region no-header) + "Return the bounds of the current code cell, as a cons. + +If COUNT is non-nil, return instead a region containing COUNT +cells and starting or ending with the current cell, depending on +the sign of COUNT. + +If USE-REGION is non-nil and the region is active, return the +region bounds instead. + +If NO-HEADER is non-nil, do not include the cell boundary line." + (if (and use-region (use-region-p)) + (list (region-beginning) (region-end)) + (setq count (or count 1)) + (save-excursion + (let ((end (progn (code-cells-forward-cell (max count 1)) + (point)))) + (code-cells-backward-cell (abs count)) + (when no-header (forward-line)) + (list (point) end))))) + +(defun code-cells--bounds-of-cell-relative-from (distance) + "Return the bounds of the cell DISTANCE cells away from the current one." + (save-excursion + (when (/= 0 distance) + ;; Except when at the boundary, `(code-cells-forward-cell -1)' doesn't + ;; move out of current cell + (unless (looking-at-p code-cells-boundary-regexp) + (code-cells-backward-cell)) + (code-cells-forward-cell distance)) + (code-cells--bounds))) + +(defun code-cells-move-cell-down (arg) + "Move current code cell vertically ARG cells. +Move up when ARG is negative and move down otherwise." + (interactive "p") + (pcase-let ((`(,current-beg ,current-end) (code-cells--bounds)) + (`(,next-beg ,next-end) (code-cells--bounds-of-cell-relative-from arg))) + (unless (save-excursion + (and (/= current-beg next-beg) + (goto-char current-beg) + (looking-at-p code-cells-boundary-regexp) + (goto-char next-beg) + (looking-at-p code-cells-boundary-regexp))) + (user-error "Can't move cell")) + (transpose-regions current-beg current-end next-beg next-end))) + +;;;###autoload +(defun code-cells-move-cell-up (&optional arg) + "Move current code cell vertically up ARG cells." + (interactive "p") + (code-cells-move-cell-down (- arg))) + +;;;###autoload +(defun code-cells-mark-cell (&optional arg) + "Put point at the beginning of this cell, mark at end. +If ARG is non-nil, mark that many cells." + (interactive "p") + (pcase-let ((`(,start ,end) (code-cells--bounds arg))) + (goto-char start) + (push-mark end nil t))) + +;;;###autoload +(defun code-cells-comment-or-uncomment (&optional arg) + "Comment or uncomment the current code cell. + +ARG, if provided, is the number of comment characters to add or +remove." + (interactive "P") + (pcase-let* ((`(,header ,end) (code-cells--bounds arg)) + (start (save-excursion + (goto-char header) + (forward-line) + (point)))) + (comment-or-uncomment-region start end))) + +;;;###autoload +(defun code-cells-command (fun &rest options) + "Return an anonymous command calling FUN on the current cell. + +FUN is a function that takes two character positions as argument. +Most interactive commands that act on a region are of this form +and can be used here. + +If OPTIONS contains the keyword :use-region, the command will act +on the region instead of the current cell when appropriate. + +If OPTIONS contains the keyword :pulse, provide visual feedback +via `pulse-momentary-highlight-region'." + (let ((use-region (car (memq :use-region options))) + (pulse (car (memq :pulse options)))) + (lambda () + (interactive) + (pcase-let ((`(,start ,end) (code-cells--bounds nil use-region))) + (when pulse (pulse-momentary-highlight-region start end)) + (funcall fun start end))))) + +;;;###autoload +(defun code-cells-speed-key (command) + "Return a speed key definition, suitable for passing to `define-key'. +The resulting keybinding will only have any effect when the point +is at the beginning of a cell heading, in which case it executes +COMMAND." + (list 'menu-item nil command + :filter (lambda (d) + (when (and (bolp) + (looking-at code-cells-boundary-regexp)) + d)))) + +;;; Code evaluation + +(defcustom code-cells-eval-region-commands + `((drepl--current . drepl-eval-region) + (jupyter-repl-interaction-mode . ,(apply-partially 'jupyter-eval-region nil)) + (python-mode . python-shell-send-region) + (emacs-lisp-mode . eval-region) + (lisp-interaction-mode . eval-region)) + "Alist of commands to evaluate a region. +The keys are major or minor modes and the values are functions +taking region bounds as argument." + :type '(alist :key-type symbol :value-type symbol)) + +;;;###autoload +(defun code-cells-eval (start end) + "Evaluate code according to current modes. +The first suitable function from `code-cells-eval-region-commands' +is used to do the job. + +Interactively, evaluate the region, if active, otherwise the +current code cell. With a numeric prefix, evaluate that many +code cells. + +Called from Lisp, evaluate region between START and END." + (interactive (code-cells--bounds (prefix-numeric-value current-prefix-arg) + 'use-region + 'no-header)) + (funcall + (or (seq-some (pcase-lambda (`(,mode . ,fun)) + (when (or (and (boundp mode) (symbol-value mode)) + (derived-mode-p mode)) + fun)) + code-cells-eval-region-commands) + (user-error + "No entry for the current modes in `code-cells-eval-region-commands'")) + start end) + (pulse-momentary-highlight-region start end)) + +;;;###autoload +(defun code-cells-eval-above (arg) + "Evaluate this and all above cells. +ARG (interactively, the prefix argument) specifies how many +additional cells after point to include." + (interactive "p") + (code-cells-eval (point-min) (save-excursion + (code-cells-forward-cell arg) + (point)))) + +;;; Minor mode + +(defvar-local code-cells--saved-vars nil + "A place to save variables before activating `code-cells-mode'.") + +(defun code-cells--outline-level () + "Compute the outline level, taking code cells into account. +To be used as the value of the variable `outline-level'. + +At a cell boundary, returns the cell outline level, as determined by +`code-cells-boundary-regexp'. Otherwise, returns the sum of the +outline level as determined by the major mode and the current cell +level." + (let* ((at-boundary (looking-at-p code-cells-boundary-regexp)) + (mm-level (if at-boundary + 0 + (funcall (car code-cells--saved-vars)))) + (cell-level (if (or at-boundary + (save-excursion + (re-search-backward + code-cells-boundary-regexp nil t))) + (if (match-string 1) + (- (match-end 1) (match-beginning 1)) + 1) + 0))) + (+ cell-level mm-level))) + +(defface code-cells-header-line '((t :extend t :overline t :inherit font-lock-comment-face)) + "Face used by `code-cells-mode' to highlight cell boundaries.") + +(defun code-cells--font-lock-keywords () + "Font lock keywords to highlight cell boundaries." + `((,(rx (regexp code-cells-boundary-regexp) (* any) "\n") + 0 'code-cells-header-line append))) + +;;;###autoload +(define-minor-mode code-cells-mode + "Minor mode for cell-oriented code." + :keymap (make-sparse-keymap) + (if code-cells-mode + (progn + (setq-local + code-cells--saved-vars (list outline-level + outline-regexp + outline-heading-end-regexp + paragraph-start) + outline-level 'code-cells--outline-level + outline-regexp (rx (or (regexp code-cells-boundary-regexp) + (regexp outline-regexp))) + outline-heading-end-regexp "\n" + paragraph-separate (rx (or (regexp paragraph-separate) + (regexp code-cells-boundary-regexp)))) + (font-lock-add-keywords nil (code-cells--font-lock-keywords))) + (setq-local outline-level (pop code-cells--saved-vars) + outline-regexp (pop code-cells--saved-vars) + outline-heading-end-regexp (pop code-cells--saved-vars) + paragraph-separate (pop code-cells--saved-vars)) + (font-lock-remove-keywords nil (code-cells--font-lock-keywords))) + (font-lock-flush)) + +;;;###autoload +(defun code-cells-mode-maybe () + "Turn on `code-cells-mode' if the buffer appears to contain cells. +This function is useful when added to a major mode hook." + (when (save-excursion + (goto-char (point-min)) + (re-search-forward code-cells-boundary-regexp 5000 t)) + (code-cells-mode))) + +(let ((map (make-sparse-keymap))) + (define-key code-cells-mode-map "\C-c%" map) + (define-key map ";" 'code-cells-comment-or-uncomment) + (define-key map "@" 'code-cells-mark-cell) + (define-key map "b" 'code-cells-backward-cell) + (define-key map "f" 'code-cells-forward-cell) + (define-key map "B" 'code-cells-move-cell-up) + (define-key map "F" 'code-cells-move-cell-down) + (define-key map "e" 'code-cells-eval)) + +;;; Jupyter notebook conversion + +(defcustom code-cells-convert-ipynb-style + '(("jupytext" "--to" "ipynb") + ("jupytext" "--to" "auto:percent") + code-cells--guess-mode + code-cells-convert-ipynb-hook) + "Determines how to convert ipynb files for editing. +The first two entries are lists of strings: the command name and +arguments used, respectively, to convert to and from ipynb +format. + +The third entry is a function called with no arguments to +determine the major mode to be called. The default setting tries +to guess it from the notebook metadata. + +The fourth entry, also optional, is a hook run after the new +major mode is activated." + :type '(list (repeat string) (repeat string) function symbol)) + +(defvar code-cells-convert-ipynb-hook '(code-cells-mode) + "Hook used in the default `code-cells-convert-ipynb-style'.") + +(defun code-cells--call-process (buffer command) + "Pipe BUFFER through COMMAND, with output to the current buffer. +Returns the process exit code. COMMAND is a list of strings, the +program name followed by arguments." + (unless (executable-find (car command)) + (error "Can't find %s" (car command))) + (let ((logfile (make-temp-file "emacs-code-cells-"))) + (unwind-protect + (prog1 + (apply #'call-process-region nil nil (car command) nil + (list buffer logfile) nil + (cdr command)) + (with-temp-buffer + (insert-file-contents logfile) + (unless (zerop (buffer-size)) + (lwarn 'code-cells :warning + "Notebook conversion command %s said:\n%s" + command + (buffer-substring-no-properties + (point-min) (point-max)))))) + (delete-file logfile)))) + +(defun code-cells--guess-mode () + "Guess major mode associated to the current ipynb buffer." + (require 'json) + (declare-function json-read "json.el") + (goto-char (point-min)) + (let* ((nb (cl-letf ;; Skip over the possibly huge "cells" section + (((symbol-function 'json-read-array) 'forward-sexp)) + (json-read))) + (lang (let-alist nb + (or .metadata.kernelspec.language + .metadata.jupytext.main_language))) + (mode (intern (concat lang "-mode")))) + (alist-get mode (bound-and-true-p major-mode-remap-alist) mode))) + +;;;###autoload +(defun code-cells-convert-ipynb () + "Convert buffer from ipynb format to a regular script." + (interactive) + (let* ((mode (funcall (or (nth 2 code-cells-convert-ipynb-style) + (progn ;For backwards compatibility with v0.3 + (lwarn 'code-cells :warning "\ +The third entry of `code-cells-convert-ipynb-style' should not be nil.") + #'code-cells--guess-mode)))) + (exit (progn + (goto-char (point-min)) + (code-cells--call-process t (nth 1 code-cells-convert-ipynb-style))))) + (unless (zerop exit) + (delete-region (point-min) (point)) + (error "Error converting notebook (exit code %s)" exit)) + (delete-region (point) (point-max)) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (add-hook 'write-file-functions #'code-cells-write-ipynb 80 t) + (when (fboundp mode) + (funcall mode) + (run-hooks (nth 3 code-cells-convert-ipynb-style))))) + +;;;###autoload +(defun code-cells-write-ipynb (&optional file) + "Convert buffer to ipynb format and write to FILE. +Interactively, asks for the file name. When called from Lisp, +FILE defaults to the current buffer file name." + (interactive "F") + (let* ((file (or file buffer-file-name)) + (temp (generate-new-buffer " *cells--call-process output*")) + (exit (code-cells--call-process temp (nth 0 code-cells-convert-ipynb-style)))) + (unless (eq 0 exit) + (error "Error converting notebook (exit code %s)" exit)) + (with-current-buffer temp + (write-region nil nil file) + (kill-buffer)) + (when (eq file buffer-file-name) + (set-buffer-modified-p nil) + (set-visited-file-modtime)) + 'job-done)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.ipynb\\'" . code-cells-convert-ipynb)) + +(provide 'code-cells) +;;; code-cells.el ends here diff --git a/lisp/deferred/deferred-pkg.el b/lisp/deferred/deferred-pkg.el new file mode 100644 index 00000000..1f6b11b7 --- /dev/null +++ b/lisp/deferred/deferred-pkg.el @@ -0,0 +1,14 @@ +(define-package "deferred" "20170901.1330" "Simple asynchronous functions for emacs lisp" + '((emacs "24.4")) + :commit "2239671d94b38d92e9b28d4e12fd79814cfb9c16" :authors + '(("SAKURAI Masashi ")) + :maintainers + '(("SAKURAI Masashi ")) + :maintainer + '("SAKURAI Masashi ") + :keywords + '("deferred" "async") + :url "https://github.com/kiwanami/emacs-deferred") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/lisp/deferred/deferred.el b/lisp/deferred/deferred.el new file mode 100644 index 00000000..041c90b0 --- /dev/null +++ b/lisp/deferred/deferred.el @@ -0,0 +1,971 @@ +;;; deferred.el --- Simple asynchronous functions for emacs lisp -*- lexical-binding: t; -*- + +;; Copyright (C) 2010-2016 SAKURAI Masashi + +;; Author: SAKURAI Masashi +;; Version: 0.5.1 +;; Keywords: deferred, async +;; Package-Requires: ((emacs "24.4")) +;; URL: https://github.com/kiwanami/emacs-deferred + +;; 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 of the License, 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 this program. If not, see . + +;;; Commentary: + +;; 'deferred.el' is a simple library for asynchronous tasks. +;; [https://github.com/kiwanami/emacs-deferred] + +;; The API is almost the same as JSDeferred written by cho45. See the +;; JSDeferred and Mochikit.Async web sites for further documentations. +;; [https://github.com/cho45/jsdeferred] +;; [http://mochikit.com/doc/html/MochiKit/Async.html] + +;; A good introduction document (JavaScript) +;; [http://cho45.stfuawsc.com/jsdeferred/doc/intro.en.html] + +;;; Samples: + +;; ** HTTP Access + +;; (require 'url) +;; (deferred:$ +;; (deferred:url-retrieve "http://www.gnu.org") +;; (deferred:nextc it +;; (lambda (buf) +;; (insert (with-current-buffer buf (buffer-string))) +;; (kill-buffer buf)))) + +;; ** Invoking command tasks + +;; (deferred:$ +;; (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png") +;; (deferred:nextc it +;; (lambda (x) (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg"))) +;; (deferred:nextc it +;; (lambda (x) +;; (insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil))))) + +;; See the readme for further API documentation. + +;; ** Applications + +;; *Inertial scrolling for Emacs +;; [https://github.com/kiwanami/emacs-inertial-scroll] + +;; This program makes simple multi-thread function, using +;; deferred.el. + +(require 'cl-lib) +(require 'subr-x) + +(declare-function pp-display-expression 'pp) + +(defvar deferred:version nil "deferred.el version") +(setq deferred:version "0.5.0") + +;;; Code: + +(defmacro deferred:aand (test &rest rest) + "[internal] Anaphoric AND." + (declare (debug ("test" form &rest form))) + `(let ((it ,test)) + (if it ,(if rest `(deferred:aand ,@rest) 'it)))) + +(defmacro deferred:$ (&rest elements) + "Anaphoric function chain macro for deferred chains." + (declare (debug (&rest form))) + `(let (it) + ,@(cl-loop for i in elements + collect + `(setq it ,i)) + it)) + +(defmacro deferred:lambda (args &rest body) + "Anaphoric lambda macro for self recursion." + (declare (debug ("args" form &rest form))) + (let ((argsyms (cl-loop repeat (length args) collect (cl-gensym)))) + `(lambda (,@argsyms) + (let (self) + (setq self (lambda( ,@args ) ,@body)) + (funcall self ,@argsyms))))) + +(cl-defmacro deferred:try (d &key catch finally) + "Try-catch-finally macro. This macro simulates the +try-catch-finally block asynchronously. CATCH and FINALLY can be +nil. Because of asynchrony, this macro does not ensure that the +task FINALLY should be called." + (let ((chain + (if catch `((deferred:error it ,catch))))) + (when finally + (setq chain (append chain `((deferred:watch it ,finally))))) + `(deferred:$ ,d ,@chain))) + +(defun deferred:setTimeout (f msec) + "[internal] Timer function that emulates the `setTimeout' function in JS." + (run-at-time (/ msec 1000.0) nil f)) + +(defun deferred:cancelTimeout (id) + "[internal] Timer cancellation function that emulates the `cancelTimeout' function in JS." + (cancel-timer id)) + +(defun deferred:run-with-idle-timer (sec f) + "[internal] Wrapper function for run-with-idle-timer." + (run-with-idle-timer sec nil f)) + +(defun deferred:call-lambda (f &optional arg) + "[internal] Call a function with one or zero argument safely. +The lambda function can define with zero and one argument." + (condition-case err + (funcall f arg) + ('wrong-number-of-arguments + (display-warning 'deferred "\ +Callback that takes no argument may be specified. +Passing callback with no argument is deprecated. +Callback must take one argument. +Or, this error is coming from somewhere inside of the callback: %S" err) + (condition-case nil + (funcall f) + ('wrong-number-of-arguments + (signal 'wrong-number-of-arguments (cdr err))))))) ; return the first error + +;; debug + +(eval-and-compile + (defvar deferred:debug nil "Debug output switch.")) +(defvar deferred:debug-count 0 "[internal] Debug output counter.") + +(defmacro deferred:message (&rest args) + "[internal] Debug log function." + (when deferred:debug + `(progn + (with-current-buffer (get-buffer-create "*deferred:debug*") + (save-excursion + (goto-char (point-max)) + (insert (format "%5i %s\n" deferred:debug-count (format ,@args))))) + (cl-incf deferred:debug-count)))) + +(defun deferred:message-mark () + "[internal] Debug log function." + (interactive) + (deferred:message "==================== mark ==== %s" + (format-time-string "%H:%M:%S" (current-time)))) + +(defun deferred:pp (d) + (require 'pp) + (deferred:$ + (deferred:nextc d + (lambda (x) + (pp-display-expression x "*deferred:pp*"))) + (deferred:error it + (lambda (e) + (pp-display-expression e "*deferred:pp*"))) + (deferred:nextc it + (lambda (_x) (pop-to-buffer "*deferred:pp*"))))) + +(defvar deferred:debug-on-signal nil +"If non nil, the value `debug-on-signal' is substituted this +value in the `condition-case' form in deferred +implementations. Then, Emacs debugger can catch an error occurred +in the asynchronous tasks.") + +(defmacro deferred:condition-case (var protected-form &rest handlers) + "[internal] Custom condition-case. See the comment for +`deferred:debug-on-signal'." + (declare (debug condition-case) + (indent 2)) + `(let ((debug-on-signal + (or debug-on-signal deferred:debug-on-signal))) + (condition-case ,var + ,protected-form + ,@handlers))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Back end functions of deferred tasks + +(defvar deferred:tick-time 0.001 + "Waiting time between asynchronous tasks (second). +The shorter waiting time increases the load of Emacs. The end +user can tune this parameter. However, applications should not +modify it because the applications run on various environments.") + +(defvar deferred:queue nil + "[internal] The execution queue of deferred objects. +See the functions `deferred:post-task' and `deferred:worker'.") + +(defmacro deferred:pack (a b c) + `(cons ,a (cons ,b ,c))) + +(defun deferred:schedule-worker () + "[internal] Schedule consuming a deferred task in the execution queue." + (run-at-time deferred:tick-time nil 'deferred:worker)) + +(defun deferred:post-task (d which &optional arg) + "[internal] Add a deferred object to the execution queue +`deferred:queue' and schedule to execute. +D is a deferred object. WHICH is a symbol, `ok' or `ng'. ARG is +an argument value for execution of the deferred task." + (push (deferred:pack d which arg) deferred:queue) + (deferred:message "QUEUE-POST [%s]: %s" + (length deferred:queue) (deferred:pack d which arg)) + (deferred:schedule-worker) + d) + +(defun deferred:clear-queue () + "Clear the execution queue. For test and debugging." + (interactive) + (deferred:message "QUEUE-CLEAR [%s -> 0]" (length deferred:queue)) + (setq deferred:queue nil)) + +(defun deferred:worker () + "[internal] Consume a deferred task. +Mainly this function is called by timer asynchronously." + (when deferred:queue + (let* ((pack (car (last deferred:queue))) + (d (car pack)) + (which (cadr pack)) + (arg (cddr pack)) value) + (setq deferred:queue (nbutlast deferred:queue)) + (condition-case err + (setq value (deferred:exec-task d which arg)) + (error + (deferred:message "ERROR : %s" err) + (message "deferred error : %s" err))) + value))) + +(defun deferred:flush-queue! () + "Call all deferred tasks synchronously. For test and debugging." + (let (value) + (while deferred:queue + (setq value (deferred:worker))) + value)) + +(defun deferred:sync! (d) + "Wait for the given deferred task. For test and debugging. +Error is raised if it is not processed within deferred chain D." + (progn + (let ((last-value 'deferred:undefined*) + uncaught-error) + (deferred:try + (deferred:nextc d + (lambda (x) (setq last-value x))) + :catch + (lambda (err) (setq uncaught-error err))) + (while (and (eq 'deferred:undefined* last-value) + (not uncaught-error)) + (sit-for 0.05) + (sleep-for 0.05)) + (when uncaught-error + (deferred:resignal uncaught-error)) + last-value))) + + + +;; Struct: deferred +;; +;; callback : a callback function (default `deferred:default-callback') +;; errorback : an errorback function (default `deferred:default-errorback') +;; cancel : a canceling function (default `deferred:default-cancel') +;; next : a next chained deferred object (default nil) +;; status : if 'ok or 'ng, this deferred has a result (error) value. (default nil) +;; value : saved value (default nil) +;; +(cl-defstruct deferred + (callback 'deferred:default-callback) + (errorback 'deferred:default-errorback) + (cancel 'deferred:default-cancel) + next status value) + +(defun deferred:default-callback (i) + "[internal] Default callback function." + (identity i)) + +(defun deferred:default-errorback (err) + "[internal] Default errorback function." + (deferred:resignal err)) + +(defun deferred:resignal (err) + "[internal] Safely resignal ERR as an Emacs condition. + +If ERR is a cons (ERROR-SYMBOL . DATA) where ERROR-SYMBOL has an +`error-conditions' property, it is re-signaled unchanged. If ERR +is a string, it is signaled as a generic error using `error'. +Otherwise, ERR is formatted into a string as if by `print' before +raising with `error'." + (cond ((and (listp err) + (symbolp (car err)) + (get (car err) 'error-conditions)) + (signal (car err) (cdr err))) + ((stringp err) + (error "%s" err)) + (t + (error "%S" err)))) + +(defun deferred:default-cancel (d) + "[internal] Default canceling function." + (deferred:message "CANCEL : %s" d) + (setf (deferred-callback d) 'deferred:default-callback) + (setf (deferred-errorback d) 'deferred:default-errorback) + (setf (deferred-next d) nil) + d) + +(defvar deferred:onerror nil + "Default error handler. This value is nil or a function that + have one argument for the error message.") + +(defun deferred:exec-task (d which &optional arg) + "[internal] Executing deferred task. If the deferred object has +next deferred task or the return value is a deferred object, this +function adds the task to the execution queue. +D is a deferred object. WHICH is a symbol, `ok' or `ng'. ARG is +an argument value for execution of the deferred task." + (deferred:message "EXEC : %s / %s / %s" d which arg) + (when (null d) (error "deferred:exec-task was given a nil.")) + (let ((callback (if (eq which 'ok) + (deferred-callback d) + (deferred-errorback d))) + (next-deferred (deferred-next d))) + (cond + (callback + (deferred:condition-case err + (let ((value (deferred:call-lambda callback arg))) + (cond + ((deferred-p value) + (deferred:message "WAIT NEST : %s" value) + (if next-deferred + (deferred:set-next value next-deferred) + value)) + (t + (if next-deferred + (deferred:post-task next-deferred 'ok value) + (setf (deferred-status d) 'ok) + (setf (deferred-value d) value) + value)))) + (error + (cond + (next-deferred + (deferred:post-task next-deferred 'ng err)) + (deferred:onerror + (deferred:call-lambda deferred:onerror err)) + (t + (deferred:message "ERROR : %S" err) + (message "deferred error : %S" err) + (setf (deferred-status d) 'ng) + (setf (deferred-value d) err) + err))))) + (t ; <= (null callback) + (cond + (next-deferred + (deferred:exec-task next-deferred which arg)) + ((eq which 'ok) arg) + (t ; (eq which 'ng) + (deferred:resignal arg))))))) + +(defun deferred:set-next (prev next) + "[internal] Connect deferred objects." + (setf (deferred-next prev) next) + (cond + ((eq 'ok (deferred-status prev)) + (setf (deferred-status prev) nil) + (let ((ret (deferred:exec-task + next 'ok (deferred-value prev)))) + (if (deferred-p ret) ret + next))) + ((eq 'ng (deferred-status prev)) + (setf (deferred-status prev) nil) + (let ((ret (deferred:exec-task next 'ng (deferred-value prev)))) + (if (deferred-p ret) ret + next))) + (t + next))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic functions for deferred objects + +(defun deferred:new (&optional callback) + "Create a deferred object." + (if callback + (make-deferred :callback callback) + (make-deferred))) + +(defun deferred:callback (d &optional arg) + "Start deferred chain with a callback message." + (deferred:exec-task d 'ok arg)) + +(defun deferred:errorback (d &optional arg) + "Start deferred chain with an errorback message." + (deferred:exec-task d 'ng arg)) + +(defun deferred:callback-post (d &optional arg) + "Add the deferred object to the execution queue." + (deferred:post-task d 'ok arg)) + +(defun deferred:errorback-post (d &optional arg) + "Add the deferred object to the execution queue." + (deferred:post-task d 'ng arg)) + +(defun deferred:cancel (d) + "Cancel all callbacks and deferred chain in the deferred object." + (deferred:message "CANCEL : %s" d) + (funcall (deferred-cancel d) d) + d) + +(defun deferred:status (d) + "Return a current status of the deferred object. The returned value means following: +`ok': the callback was called and waiting for next deferred. +`ng': the errorback was called and waiting for next deferred. + nil: The neither callback nor errorback was not called." + (deferred-status d)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic utility functions + +(defun deferred:succeed (&optional arg) + "Create a synchronous deferred object." + (let ((d (deferred:new))) + (deferred:exec-task d 'ok arg) + d)) + +(defun deferred:fail (&optional arg) + "Create a synchronous deferred object." + (let ((d (deferred:new))) + (deferred:exec-task d 'ng arg) + d)) + +(defun deferred:next (&optional callback arg) + "Create a deferred object and schedule executing. This function +is a short cut of following code: + (deferred:callback-post (deferred:new callback))." + (let ((d (if callback + (make-deferred :callback callback) + (make-deferred)))) + (deferred:callback-post d arg) + d)) + +(defun deferred:nextc (d callback) + "Create a deferred object with OK callback and connect it to the given deferred object." + (let ((nd (make-deferred :callback callback))) + (deferred:set-next d nd))) + +(defun deferred:error (d callback) + "Create a deferred object with errorback and connect it to the given deferred object." + (let ((nd (make-deferred :errorback callback))) + (deferred:set-next d nd))) + +(defun deferred:watch (d callback) + "Create a deferred object with watch task and connect it to the given deferred object. +The watch task CALLBACK can not affect deferred chains with +return values. This function is used in following purposes, +simulation of try-finally block in asynchronous tasks, progress +monitoring of tasks." + (let* ((callback callback) + (normal (lambda (x) (ignore-errors (deferred:call-lambda callback x)) x)) + (err (lambda (e) + (ignore-errors (deferred:call-lambda callback e)) + (deferred:resignal e)))) + (let ((nd (make-deferred :callback normal :errorback err))) + (deferred:set-next d nd)))) + +(defun deferred:wait (msec) + "Return a deferred object scheduled at MSEC millisecond later." + (let ((d (deferred:new)) (start-time (float-time)) timer) + (deferred:message "WAIT : %s" msec) + (setq timer (deferred:setTimeout + (lambda () + (deferred:exec-task d 'ok + (* 1000.0 (- (float-time) start-time))) + nil) msec)) + (setf (deferred-cancel d) + (lambda (x) + (deferred:cancelTimeout timer) + (deferred:default-cancel x))) + d)) + +(defun deferred:wait-idle (msec) + "Return a deferred object which will run when Emacs has been +idle for MSEC millisecond." + (let ((d (deferred:new)) (start-time (float-time)) timer) + (deferred:message "WAIT-IDLE : %s" msec) + (setq timer + (deferred:run-with-idle-timer + (/ msec 1000.0) + (lambda () + (deferred:exec-task d 'ok + (* 1000.0 (- (float-time) start-time))) + nil))) + (setf (deferred-cancel d) + (lambda (x) + (deferred:cancelTimeout timer) + (deferred:default-cancel x))) + d)) + +(defun deferred:call (f &rest args) + "Call the given function asynchronously." + (deferred:next + (lambda (_x) + (apply f args)))) + +(defun deferred:apply (f &optional args) + "Call the given function asynchronously." + (deferred:next + (lambda (_x) + (apply f args)))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Utility functions + +(defun deferred:empty-p (times-or-seq) + "[internal] Return non-nil if TIMES-OR-SEQ is the number zero or nil." + (or (and (numberp times-or-seq) (<= times-or-seq 0)) + (and (sequencep times-or-seq) (= (length times-or-seq) 0)))) + +(defun deferred:loop (times-or-seq func) + "Return a iteration deferred object." + (deferred:message "LOOP : %s" times-or-seq) + (if (deferred:empty-p times-or-seq) (deferred:next) + (let* (items (rd + (cond + ((numberp times-or-seq) + (cl-loop for i from 0 below times-or-seq + with ld = (deferred:next) + do + (push ld items) + (setq ld + (let ((i i)) + (deferred:nextc ld + (lambda (_x) (deferred:call-lambda func i))))) + finally return ld)) + ((sequencep times-or-seq) + (cl-loop for i in (append times-or-seq nil) ; seq->list + with ld = (deferred:next) + do + (push ld items) + (setq ld + (let ((i i)) + (deferred:nextc ld + (lambda (_x) (deferred:call-lambda func i))))) + finally return ld))))) + (setf (deferred-cancel rd) + (lambda (x) (deferred:default-cancel x) + (cl-loop for i in items + do (deferred:cancel i)))) + rd))) + +(defun deferred:trans-multi-args (args self-func list-func main-func) + "[internal] Check the argument values and dispatch to methods." + (cond + ((and (= 1 (length args)) (consp (car args)) (not (functionp (car args)))) + (let ((lst (car args))) + (cond + ((or (null lst) (null (car lst))) + (deferred:next)) + ((deferred:aand lst (car it) (or (functionp it) (deferred-p it))) + ;; a list of deferred objects + (funcall list-func lst)) + ((deferred:aand lst (consp it)) + ;; an alist of deferred objects + (funcall main-func lst)) + (t (error "Wrong argument type. %s" args))))) + (t (funcall self-func args)))) + +(defun deferred:parallel-array-to-alist (lst) + "[internal] Translation array to alist." + (cl-loop for d in lst + for i from 0 below (length lst) + collect (cons i d))) + +(defun deferred:parallel-alist-to-array (alst) + "[internal] Translation alist to array." + (cl-loop for pair in + (sort alst (lambda (x y) + (< (car x) (car y)))) + collect (cdr pair))) + +(defun deferred:parallel-func-to-deferred (alst) + "[internal] Normalization for parallel and earlier arguments." + (cl-loop for pair in alst + for d = (cdr pair) + collect + (progn + (unless (deferred-p d) + (setf (cdr pair) (deferred:next d))) + pair))) + +(defun deferred:parallel-main (alst) + "[internal] Deferred alist implementation for `deferred:parallel'. " + (deferred:message "PARALLEL" ) + (let ((nd (deferred:new)) + (len (length alst)) + values) + (cl-loop for pair in + (deferred:parallel-func-to-deferred alst) + with cd ; current child deferred + do + (let ((name (car pair))) + (setq cd + (deferred:nextc (cdr pair) + (lambda (x) + (push (cons name x) values) + (deferred:message "PARALLEL VALUE [%s/%s] %s" + (length values) len (cons name x)) + (when (= len (length values)) + (deferred:message "PARALLEL COLLECTED") + (deferred:post-task nd 'ok (nreverse values))) + nil))) + (deferred:error cd + (lambda (e) + (push (cons name e) values) + (deferred:message "PARALLEL ERROR [%s/%s] %s" + (length values) len (cons name e)) + (when (= (length values) len) + (deferred:message "PARALLEL COLLECTED") + (deferred:post-task nd 'ok (nreverse values))) + nil)))) + nd)) + +(defun deferred:parallel-list (lst) + "[internal] Deferred list implementation for `deferred:parallel'. " + (deferred:message "PARALLEL" ) + (let* ((pd (deferred:parallel-main (deferred:parallel-array-to-alist lst))) + (rd (deferred:nextc pd 'deferred:parallel-alist-to-array))) + (setf (deferred-cancel rd) + (lambda (x) (deferred:default-cancel x) + (deferred:cancel pd))) + rd)) + +(defun deferred:parallel (&rest args) + "Return a deferred object that calls given deferred objects or +functions in parallel and wait for all callbacks. The following +deferred task will be called with an array of the return +values. ARGS can be a list or an alist of deferred objects or +functions." + (deferred:message "PARALLEL : %s" args) + (deferred:trans-multi-args args + 'deferred:parallel 'deferred:parallel-list 'deferred:parallel-main)) + +(defun deferred:earlier-main (alst) + "[internal] Deferred alist implementation for `deferred:earlier'. " + (deferred:message "EARLIER" ) + (let ((nd (deferred:new)) + (len (length alst)) + value results) + (cl-loop for pair in + (deferred:parallel-func-to-deferred alst) + with cd ; current child deferred + do + (let ((name (car pair))) + (setq cd + (deferred:nextc (cdr pair) + (lambda (x) + (push (cons name x) results) + (cond + ((null value) + (setq value (cons name x)) + (deferred:message "EARLIER VALUE %s" (cons name value)) + (deferred:post-task nd 'ok value)) + (t + (deferred:message "EARLIER MISS [%s/%s] %s" (length results) len (cons name value)) + (when (eql (length results) len) + (deferred:message "EARLIER COLLECTED")))) + nil))) + (deferred:error cd + (lambda (e) + (push (cons name e) results) + (deferred:message "EARLIER ERROR [%s/%s] %s" (length results) len (cons name e)) + (when (and (eql (length results) len) (null value)) + (deferred:message "EARLIER FAILED") + (deferred:post-task nd 'ok nil)) + nil)))) + nd)) + +(defun deferred:earlier-list (lst) + "[internal] Deferred list implementation for `deferred:earlier'. " + (deferred:message "EARLIER" ) + (let* ((pd (deferred:earlier-main (deferred:parallel-array-to-alist lst))) + (rd (deferred:nextc pd (lambda (x) (cdr x))))) + (setf (deferred-cancel rd) + (lambda (x) (deferred:default-cancel x) + (deferred:cancel pd))) + rd)) + + +(defun deferred:earlier (&rest args) + "Return a deferred object that calls given deferred objects or +functions in parallel and wait for the first callback. The +following deferred task will be called with the first return +value. ARGS can be a list or an alist of deferred objects or +functions." + (deferred:message "EARLIER : %s" args) + (deferred:trans-multi-args args + 'deferred:earlier 'deferred:earlier-list 'deferred:earlier-main)) + +(defmacro deferred:timeout (timeout-msec timeout-form d) + "Time out macro on a deferred task D. If the deferred task D +does not complete within TIMEOUT-MSEC, this macro cancels the +deferred task and return the TIMEOUT-FORM." + `(deferred:earlier + (deferred:nextc (deferred:wait ,timeout-msec) + (lambda (x) ,timeout-form)) + ,d)) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Application functions + +(defvar deferred:uid 0 "[internal] Sequence number for some utilities. See the function `deferred:uid'.") + +(defun deferred:uid () + "[internal] Generate a sequence number." + (cl-incf deferred:uid)) + +(defun deferred:buffer-string (strformat buf) + "[internal] Return a string in the buffer with the given format." + (format strformat + (with-current-buffer buf (buffer-string)))) + +(defun deferred:process (command &rest args) + "A deferred wrapper of `start-process'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process' are generated by this function automatically. +The next deferred object receives stdout and stderr string from +the command process." + (deferred:process-gen 'start-process command args)) + +(defun deferred:process-shell (command &rest args) + "A deferred wrapper of `start-process-shell-command'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process-shell-command' are generated by this function automatically. +The next deferred object receives stdout and stderr string from +the command process." + (deferred:process-gen 'start-process-shell-command command args)) + +(defun deferred:process-buffer (command &rest args) + "A deferred wrapper of `start-process'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process' are generated by this function automatically. +The next deferred object receives stdout and stderr buffer from +the command process." + (deferred:process-buffer-gen 'start-process command args)) + +(defun deferred:process-shell-buffer (command &rest args) + "A deferred wrapper of `start-process-shell-command'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process-shell-command' are generated by this function automatically. +The next deferred object receives stdout and stderr buffer from +the command process." + (deferred:process-buffer-gen 'start-process-shell-command command args)) + +(defun deferred:process-gen (f command args) + "[internal]" + (let ((pd (deferred:process-buffer-gen f command args)) d) + (setq d (deferred:nextc pd + (lambda (buf) + (prog1 + (with-current-buffer buf (buffer-string)) + (kill-buffer buf))))) + (setf (deferred-cancel d) + (lambda (_x) + (deferred:default-cancel d) + (deferred:default-cancel pd))) + d)) + +(defun deferred:process-buffer-gen (f command args) + "[internal]" + (let ((d (deferred:next)) (uid (deferred:uid))) + (let ((proc-name (format "*deferred:*%s*:%s" command uid)) + (buf-name (format " *deferred:*%s*:%s" command uid)) + (pwd default-directory) + (env process-environment) + (con-type process-connection-type) + (nd (deferred:new)) proc-buf proc) + (deferred:nextc d + (lambda (_x) + (setq proc-buf (get-buffer-create buf-name)) + (condition-case err + (let ((default-directory pwd) + (process-environment env) + (process-connection-type con-type)) + (setq proc + (if (null (car args)) + (apply f proc-name buf-name command nil) + (apply f proc-name buf-name command args))) + (set-process-sentinel + proc + (lambda (proc event) + (unless (process-live-p proc) + (if (zerop (process-exit-status proc)) + (deferred:post-task nd 'ok proc-buf) + (let ((msg (format "Deferred process exited abnormally:\n command: %s\n exit status: %s %s\n event: %s\n buffer contents: %S" + command + (process-status proc) + (process-exit-status proc) + (string-trim-right event) + (if (buffer-live-p proc-buf) + (with-current-buffer proc-buf + (buffer-string)) + "(unavailable)")))) + (kill-buffer proc-buf) + (deferred:post-task nd 'ng msg)))))) + (setf (deferred-cancel nd) + (lambda (x) (deferred:default-cancel x) + (when proc + (kill-process proc) + (kill-buffer proc-buf))))) + (error (deferred:post-task nd 'ng err))) + nil)) + nd))) + +(defmacro deferred:processc (d command &rest args) + "Process chain of `deferred:process'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process ,command ,@args)))) + +(defmacro deferred:process-bufferc (d command &rest args) + "Process chain of `deferred:process-buffer'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-buffer ,command ,@args)))) + +(defmacro deferred:process-shellc (d command &rest args) + "Process chain of `deferred:process'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-shell ,command ,@args)))) + +(defmacro deferred:process-shell-bufferc (d command &rest args) + "Process chain of `deferred:process-buffer'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-shell-buffer ,command ,@args)))) + +;; Special variables defined in url-vars.el. +(defvar url-request-data) +(defvar url-request-method) +(defvar url-request-extra-headers) + +(declare-function url-http-symbol-value-in-buffer "url-http" + (symbol buffer &optional unbound-value)) + +(declare-function deferred:url-param-serialize "request" (params)) + +(declare-function deferred:url-escape "request" (val)) + +(eval-after-load "url" + ;; for url package + ;; TODO: proxy, charaset + ;; List of gloabl variables to preserve and restore before url-retrieve call + '(let ((url-global-variables '(url-request-data + url-request-method + url-request-extra-headers))) + + (defun deferred:url-retrieve (url &optional cbargs silent inhibit-cookies) + "A wrapper function for url-retrieve. The next deferred +object receives the buffer object that URL will load +into. Values of dynamically bound 'url-request-data', 'url-request-method' and +'url-request-extra-headers' are passed to url-retrieve call." + (let ((nd (deferred:new)) + buf + (local-values (mapcar (lambda (symbol) (symbol-value symbol)) url-global-variables))) + (deferred:next + (lambda (_x) + (cl-progv url-global-variables local-values + (condition-case err + (setq buf + (url-retrieve + url (lambda (_xx) (deferred:post-task nd 'ok buf)) + cbargs silent inhibit-cookies)) + (error (deferred:post-task nd 'ng err))) + nil))) + (setf (deferred-cancel nd) + (lambda (_x) + (when (buffer-live-p buf) + (kill-buffer buf)))) + nd)) + + (defun deferred:url-delete-header (buf) + (with-current-buffer buf + (let ((pos (url-http-symbol-value-in-buffer + 'url-http-end-of-headers buf))) + (when pos + (delete-region (point-min) (1+ pos))))) + buf) + + (defun deferred:url-delete-buffer (buf) + (when (and buf (buffer-live-p buf)) + (kill-buffer buf)) + nil) + + (defun deferred:url-get (url &optional params &rest args) + "Perform a HTTP GET method with `url-retrieve'. PARAMS is +a parameter list of (key . value) or key. ARGS will be appended +to deferred:url-retrieve args list. The next deferred +object receives the buffer object that URL will load into." + (when params + (setq url + (concat url "?" (deferred:url-param-serialize params)))) + (let ((d (deferred:$ + (apply 'deferred:url-retrieve url args) + (deferred:nextc it 'deferred:url-delete-header)))) + (deferred:set-next + d (deferred:new 'deferred:url-delete-buffer)) + d)) + + (defun deferred:url-post (url &optional params &rest args) + "Perform a HTTP POST method with `url-retrieve'. PARAMS is +a parameter list of (key . value) or key. ARGS will be appended +to deferred:url-retrieve args list. The next deferred +object receives the buffer object that URL will load into." + (let ((url-request-method "POST") + (url-request-extra-headers + (append url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded")))) + (url-request-data (deferred:url-param-serialize params))) + (let ((d (deferred:$ + (apply 'deferred:url-retrieve url args) + (deferred:nextc it 'deferred:url-delete-header)))) + (deferred:set-next + d (deferred:new 'deferred:url-delete-buffer)) + d))) + + (defun deferred:url-escape (val) + "[internal] Return a new string that is VAL URI-encoded." + (unless (stringp val) + (setq val (format "%s" val))) + (url-hexify-string + (encode-coding-string val 'utf-8))) + + (defun deferred:url-param-serialize (params) + "[internal] Serialize a list of (key . value) cons cells +into a query string." + (when params + (mapconcat + 'identity + (cl-loop for p in params + collect + (cond + ((consp p) + (concat + (deferred:url-escape (car p)) "=" + (deferred:url-escape (cdr p)))) + (t + (deferred:url-escape p)))) + "&"))) + )) + + +(provide 'deferred) +;;; deferred.el ends here diff --git a/lisp/ein/ein-cell.el b/lisp/ein/ein-cell.el new file mode 100644 index 00000000..48da1bab --- /dev/null +++ b/lisp/ein/ein-cell.el @@ -0,0 +1,1109 @@ +;;; ein-cell.el --- Cell module -*- lexical-binding:t -*- + +;; (C) 2012 - Takafumi Arakaki +;; (C) 2017 - John M. Miller + +;; Author: Takafumi Arakaki +;; Author: John Miller + +;; This file is NOT part of GNU Emacs. + +;; ein-cell.el 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 of the License, or +;; (at your option) any later version. + +;; ein-cell.el 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 ein-cell.el. If not, see . + +;;; Commentary: + +;; Implementation note. Current implementation of cell has redundant +;; and not-guaranteed-to-be consistent information: `element' and +;; `ein:$node'. This part must be moved to ein-node.el module to +;; make it well capsuled. + +;; IPython has cell.js, codecell.js and textcell.js. +;; But let's start with one file. + +;;; Code: + +(require 'ansi-color) +(require 'comint) +(require 'ein-core) +(require 'ein-classes) +(require 'ein-log) +(require 'ein-node) +(require 'ein-kernel) +(require 'ein-output-area) +(require 'ein-shared-output) + +(autoload 'mm-encode-buffer "mm-encode") +(autoload 'mm-possibly-verify-or-decrypt "mm-decode") +(autoload 'mm-dissect-singlepart "mm-decode") +(autoload 'mm-display-external "mm-decode") +(autoload 'mm-handle-media-type "mm-decode") + +(defun ein:cell--ewoc-delete (ewoc &rest nodes) + "Delete NODES from EWOC." + (ewoc--set-buffer-bind-dll-let* ewoc + ((L nil) (R nil) (last (ewoc--last-node ewoc))) + (dolist (node nodes) + (let ((inhibit-read-only t) + (buffer-undo-list t)) + ;; If we are about to delete the node pointed at by last-node, + ;; set last-node to nil. + (when (eq last node) + (setf last nil (ewoc--last-node ewoc) nil)) + (delete-region (ewoc--node-start-marker node) + (ewoc--node-start-marker (ewoc--node-next dll node))) + (set-marker (ewoc--node-start-marker node) nil) + (setf L (ewoc--node-left node) + R (ewoc--node-right node) + ;; Link neighbors to each other. + (ewoc--node-right L) R + (ewoc--node-left R) L + ;; Forget neighbors. + (ewoc--node-left node) nil + (ewoc--node-right node) nil))))) + +(defun ein:cell--ewoc-invalidate (ewoc &rest nodes) + "Call EWOC's pretty-printer (`ein:worksheet-pp') for each element in NODES." + (ewoc--set-buffer-bind-dll-let* ewoc + ((pp (ewoc--pretty-printer ewoc))) + (save-excursion + (dolist (node nodes) + (let ((inhibit-read-only t) + (buffer-undo-list t) + (m (ewoc--node-start-marker node)) + (R (ewoc--node-right node))) + ;; First, remove the string from the buffer: + (delete-region m (ewoc--node-start-marker R)) + ;; Calculate and insert the string. + (goto-char m) + (funcall pp (ewoc--node-data node)) + (ewoc--adjust m (point) R dll)))))) + +;;; Faces + +(defface ein:basecell-input-area-face + `((((class color) (background light)) + :background "honeydew1" ,@(when (>= emacs-major-version 27) '(:extend t))) + (((class color) (background dark)) + :background "#383838" ,@(when (>= emacs-major-version 27) '(:extend t)))) + "Face for cell input area" + :group 'ein) + +(defface ein:cell-output-area + '() + "Face for cell output area" + :group 'ein) + +(defface ein:cell-output-area-error + '() + "Face for cell output area errors" + :group 'ein) + +(defface ein:cell-output-prompt + '((t :inherit header-line)) + "Face for cell output prompt" + :group 'ein) + +(defface ein:cell-output-stderr + '((((class color) (background light)) + :background "PeachPuff" ,@(when (>= emacs-major-version 27) '(:extend t))) + (((class color) (background dark)) + :background "#8c5353" ,@(when (>= emacs-major-version 27) '(:extend t)))) + "Face for stderr cell output" + :group 'ein) + +(defface ein:pos-tip-face + '((t (:inherit 'popup-tip-face))) + "Face for tooltip when using pos-tip backend." + :group 'ein) + +;;; Customization + +(make-obsolete-variable 'ein:enable-dynamic-javascript nil "0.17.0") + +(defcustom ein:cell-traceback-level 1 + "Number of traceback stack to show. +Hidden tracebacks are not discarded. +You can view them using \\[ein:tb-show]." + :type '(choice (integer :tag "Depth of stack to show" 1) + (const :tag "Show all traceback" nil)) + :group 'ein) + +(defcustom ein:cell-max-num-outputs nil + "Number of maximum outputs to be shown by default. +To view full output, use `ein:notebook-show-in-shared-output'." + :type '(choice (integer :tag "Number of outputs to show" 5) + (const :tag "Show all traceback" nil)) + :group 'ein) + +(defcustom ein:truncate-long-cell-output nil + "When nil do not truncate cells with long outputs. When set to +a number will limit the number of lines in a cell output." + :type '(choice (integer :tag "Number of lines to show in a cell" 5) + (const :tag "Do not truncate cells with long outputs" nil)) + :group 'ein) + +(make-obsolete-variable 'ein:on-execute-reply-functions nil "0.17.0") + +;;; EIEIO related utils + +(defmacro ein:oset-if-empty (obj slot value) + "Set the slot if it is not set or nil. +WARNING: OBJ and SLOT are evaluated multiple times, + only use symbols/variables." + `(unless (and (slot-boundp ,obj ,slot) (slot-value ,obj ,slot)) + (setf (slot-value ,obj, slot) ,value))) + +(defmacro ein:oref-safe (obj slot) + "Slot value if bound or nil. +WARNING: OBJ and SLOT are evaluated multiple times, + only use symbols/variables." + `(and (slot-boundp ,obj ,slot) + (slot-value ,obj ,slot))) + +(defun ein:make-mm-handle (image) + (let ((mime-type (mailcap-extension-to-mime + (symbol-name (plist-get (cdr image) :type))))) + (with-temp-buffer + (save-excursion (insert (plist-get (cdr image) :data))) + (let* ((encoding (mm-encode-buffer (list mime-type))) + (coded (decode-coding-string (buffer-string) 'us-ascii))) + (erase-buffer) + (insert "\n" coded) + (mm-possibly-verify-or-decrypt + (mm-dissect-singlepart (list mime-type) encoding) + (list mime-type)))))) + +(defun ein:external-image-viewer (image-type-) + ;; don't shadow image-type - a buffer-local variable in image-mode.el + (let (major ; Major encoding (text, etc) + minor ; Minor encoding (html, etc) + info ; Other info + major-info ; (assoc major mailcap-mime-data) + viewers ; Possible viewers + passed ; Viewers that passed the test + viewer ; The one and only viewer + (ctl (mail-header-parse-content-type (concat "image/" image-type-)))) + (mailcap-parse-mailcaps nil t) + (setq major (split-string (car ctl) "/")) + (setq minor (cadr major) + major (car major)) + (when (setq major-info (cdr (assoc major mailcap-mime-data))) + (when (setq viewers (mailcap-possible-viewers major-info minor)) + (setq info (mapcar (lambda (a) + (cons (symbol-name (car a)) (cdr a))) + (cdr ctl))) + (dolist (entry viewers) + (when (mailcap-viewer-passes-test entry info) + (push entry passed))) + (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) + ;; When we want to prefer entries from the user's + ;; ~/.mailcap file, then we filter out the system entries + ;; and see whether we have anything left. + (when (if (boundp 'mailcap-prefer-mailcap-viewers) + mailcap-prefer-mailcap-viewers + t) + (when-let ((user-entry + (seq-find (lambda (elem) + (eq (cdr (assq 'source elem)) 'user)) + passed))) + (setq passed (list user-entry)))) + (setq viewer (car passed)))) + (when (and (stringp (cdr (assq 'viewer viewer))) + passed) + (setq viewer (car passed))) + (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))) + +(defun ein:insert-image (image) + (condition-case-unless-debug err + (let ((buffer-undo-list t)) + (insert-image image (ein:propertize-read-only "."))) + (error (ein:log 'warn "Could not insert image: %s" (error-message-string err))))) + +(defun ein:cell-class-from-type (type) + (ein:case-equal type + (("code") 'ein:codecell) + (("text") 'ein:textcell) + (("html") 'ein:htmlcell) + (("markdown") 'ein:markdowncell) + (("raw") 'ein:rawcell) + (("shared-output") 'ein:shared-output-cell) + (t (error "No cell type called %S" type)))) + +(defun ein:cell-from-type (type &rest args) + (apply (ein:cell-class-from-type type) args)) + +(defun ein:cell--determine-cell-type (json-data) + (plist-get json-data :cell_type)) + +(defun ein:cell-from-json (data &rest args) + (let ((cell (ein:cell-init (apply #'ein:cell-from-type + (ein:cell--determine-cell-type data) args) + data))) + (awhen (plist-get data :id) + (setf (slot-value cell 'cell-id) it)) + (awhen (plist-get data :metadata) + (ein:oset-if-empty cell 'metadata it)) + cell)) + +(cl-defmethod ein:cell-init ((cell ein:codecell) data) + (ein:oset-if-empty cell 'outputs (mapcar (lambda (o) + (if (and (plist-member o :metadata) + (not (plist-get o :metadata))) + (plist-put o :metadata (make-hash-table)) + o)) + (plist-get data :outputs))) + (ein:oset-if-empty cell 'input (or (plist-get data :input) + (plist-get data :source))) + (aif (plist-get data :prompt_number) + (ein:oset-if-empty cell 'input-prompt-number it) + (aif (plist-get data :execution_count) + (ein:oset-if-empty cell 'input-prompt-number it))) + (ein:oset-if-empty cell 'collapsed + (let ((v (or (plist-get data :collapsed) + (plist-get (slot-value cell 'metadata) + :collapsed)))) + (if (eql v json-false) nil v))) + cell) + +(cl-defmethod ein:cell-init ((cell ein:textcell) data) + (awhen (plist-get data :source) + (setf (slot-value cell 'input) it)) + cell) + +(cl-defmethod ein:cell-convert ((cell ein:basecell) type) + (let ((new (ein:cell-from-type type))) + ;; copy attributes + (cl-loop for k in '(read-only ewoc) + do (setf (slot-value new k) (slot-value cell k))) + ;; copy input + (setf (slot-value new 'input) (if (ein:cell-active-p cell) + (ein:cell-get-text cell) + (slot-value cell 'input))) + ;; copy output when the new cell has it + (when (memq :output (slot-value new 'element-names)) + (setf (slot-value new 'outputs) (mapcar 'identity (slot-value cell 'outputs)))) + new)) + +(cl-defmethod ein:cell-convert ((cell ein:codecell) _type) + (let ((new (cl-call-next-method))) + (when (and (cl-typep new 'ein:codecell) + (slot-boundp cell :kernel)) + (setf (slot-value new 'kernel) (slot-value cell 'kernel))) + new)) + +(cl-defmethod ein:cell-copy ((cell ein:basecell)) + (ein:cell-convert cell (slot-value cell 'cell-type))) + +(cl-defmethod ein:cell-convert-inplace ((cell ein:basecell) type) + "Convert CELL to TYPE and redraw corresponding ewoc nodes." + (let ((new (ein:cell-convert cell type))) + ;; copy element attribute + (cl-loop for k in (slot-value new 'element-names) + with old-element = (slot-value cell 'element) + do (progn + (setf (slot-value new 'element) + (plist-put (slot-value new 'element) k + (plist-get old-element k))))) + ;; setting ewoc nodes + (cl-loop for en in (ein:cell-all-element cell) + for node = (ewoc-data en) + do (setf (ein:$node-data node) new)) + (let ((inhibit-read-only t) + (buffer-undo-list t)) + ;; delete ewoc nodes that is not copied + (apply + #'ewoc-delete (slot-value new 'ewoc) + (apply + #'append + (cl-loop for name in (slot-value cell 'element-names) + unless (memq name (slot-value new 'element-names)) + collect (let ((ens (ein:cell-element-get cell name))) + (if (listp ens) ens (list ens)))))) + ;; draw ewoc node + (cl-loop with ewoc = (slot-value new 'ewoc) + for en in (ein:cell-all-element new) + do (ein:cell--ewoc-invalidate ewoc en))) + new)) + +;;; Getter/setter + +(cl-defmethod ein:cell-num-outputs ((cell ein:codecell)) + (length (slot-value cell 'outputs))) + +(cl-defmethod ein:cell-num-outputs ((_cell ein:textcell)) + 0) + +(cl-defmethod ein:cell-element-get ((cell ein:basecell) prop &rest _args) + "Return ewoc node named PROP in CELL. + If PROP is `:output' a list of ewoc nodes is returned. + A specific node can be specified using optional ARGS." + (if (memq prop (slot-value cell 'element-names)) + (plist-get (slot-value cell 'element) prop) + (error "PROP %s is not supported." prop))) + +(cl-defmethod ein:cell-element-get ((cell ein:codecell) prop &optional index) + (let ((element (slot-value cell 'element))) + (if index + (progn + (cl-assert (eql prop :output)) + (nth index (plist-get element prop))) + (cl-case prop + (:after-input + (aif (nth 0 (plist-get element :output)) + it + (plist-get element :footer))) + (:after-output (plist-get element :footer)) + (:before-input (plist-get element :prompt)) + (:before-output (plist-get element :input)) + (:last-output + (aif (plist-get element :output) + (car (last it)) + (plist-get element :input))) + (t (cl-call-next-method)))))) + +(cl-defmethod ein:cell-element-get ((cell ein:textcell) prop &rest _args) + (let ((element (slot-value cell 'element))) + (cl-case prop + (:after-input (plist-get element :footer)) + (:before-input (plist-get element :prompt)) + (t (cl-call-next-method))))) + +(cl-defmethod ein:cell-all-element ((cell ein:basecell)) + (list (ein:cell-element-get cell :prompt) + (ein:cell-element-get cell :input) + (ein:cell-element-get cell :footer))) + +(cl-defmethod ein:cell-all-element ((cell ein:codecell)) + (append (cl-call-next-method) + (ein:cell-element-get cell :output))) + +(cl-defmethod ein:cell-language ((_cell ein:basecell)) + "Programming language used for CELL. +Return language name as a string or `nil' when not defined. + (fn cell)") + +(cl-defmethod ein:cell-language ((cell ein:codecell)) + (ein:and-let* ((kernel (ein:oref-safe cell 'kernel)) + (kernelspec (ein:$kernel-kernelspec kernel))) + (ein:$kernelspec-language kernelspec))) +(cl-defmethod ein:cell-language ((_cell ein:markdowncell)) nil "markdown") +(cl-defmethod ein:cell-language ((_cell ein:htmlcell)) nil "html") +(cl-defmethod ein:cell-language ((_cell ein:rawcell)) nil "rst") + +(defun ein:cell-make-element (make-node num-outputs) + (let ((buffer-undo-list t)) ; disable undo recording + (list + :prompt (funcall make-node 'prompt) + :input (funcall make-node 'input) + :output (cl-loop for i from 0 below num-outputs + collect (funcall make-node 'output i)) + :footer (funcall make-node 'footer)))) + +(cl-defmethod ein:cell-enter-last ((cell ein:basecell)) + (let* ((ewoc (slot-value cell 'ewoc)) + ;; Use `cell' as data for ewoc. Use the whole cell data even + ;; if it is not used, to access it from the notebook buffer. + ;; It is equivalent to `this.element.data("cell", this)' in + ;; IPython.Cell (see cell.js). + (make-node + (lambda (&rest path) + (ewoc-enter-last ewoc (ein:node-new `(cell ,@path) cell)))) + (element (ein:cell-make-element make-node + (ein:cell-num-outputs cell)))) + (setf (slot-value cell 'element) element) + cell)) + +(cl-defmethod ein:cell-enter-first ((cell ein:basecell)) + (let* ((ewoc (slot-value cell 'ewoc)) + (node nil) + (make-node + (lambda (&rest path) + (let ((ewoc-data (ein:node-new `(cell ,@path) cell))) + (setq node + (if node + (ewoc-enter-after ewoc node ewoc-data) + (ewoc-enter-first ewoc ewoc-data)))))) + (element (ein:cell-make-element make-node + (ein:cell-num-outputs cell)))) + (setf (slot-value cell 'element) element) + cell)) + +(cl-defmethod ein:cell-insert-below ((base-cell ein:basecell) other-cell) + (let* ((ewoc (slot-value base-cell 'ewoc)) + (node (ein:cell-element-get base-cell :footer)) + (make-node + (lambda (&rest path) + (setq node (ewoc-enter-after + ewoc node (ein:node-new `(cell ,@path) other-cell))))) + (element (ein:cell-make-element make-node + (ein:cell-num-outputs other-cell)))) + (setf (slot-value other-cell 'element) element) + other-cell)) + +(defun ein:cell-pp (path data) + (cl-case (car path) + (prompt (ein:cell-insert-prompt data)) + (input (ein:cell-insert-input data)) + (output (ein:cell-insert-output (cadr path) data)) + (footer (ein:cell-insert-footer data)))) + +(declare-function ein:cell-input-prompt-face "ein-cell") +(declare-function ein:cell-input-area-face "ein-cell") + +(cl-defmethod ein:cell-insert-prompt ((cell ein:codecell)) + "Insert prompt of the CELL in the buffer. + Called from ewoc pretty printer via `ein:cell-pp'." + (ein:insert-read-only + (format "In [%s]:" (or (ein:oref-safe cell 'input-prompt-number) " ")) + 'font-lock-face (ein:cell-input-prompt-face cell))) + +(cl-defmethod ein:cell-insert-prompt ((cell ein:textcell)) + (ein:insert-read-only + (format "%s:" (slot-value cell 'cell-type)) + 'font-lock-face (ein:cell-input-prompt-face cell))) + +(cl-defmethod ein:cell-insert-input ((cell ein:basecell)) + "Insert input of the CELL in the buffer. + Called from ewoc pretty printer via `ein:cell-pp'." + (let ((start (1+ (point)))) + ;; Newlines must allow insertion before/after its position. + (insert (propertize "\n" 'read-only t 'rear-nonsticky t)) + (insert (or (ein:oref-safe cell 'input) "") + (propertize "\n" 'read-only t)) + ;; Highlight background using overlay. + (let ((ol (make-overlay start (point)))) + (overlay-put ol 'face (ein:cell-input-area-face cell)) + ;; `evaporate' = `t': Overlay is deleted when the region become empty. + (overlay-put ol 'evaporate t) + (overlay-put ol 'category 'ein)))) + +(cl-defmethod ein:cell-get-output-area-face-for-output-type (output-type) + "Return the face (symbol) for output area." + (ein:case-equal output-type + (("pyout") 'ein:cell-output-area) + (("pyerr") 'ein:cell-output-area-error) + (("error") 'ein:cell-output-area-error) + (("display_data") 'ein:cell-output-area) + (("execute_result") 'ein:cell-output-area) + (("stream") 'ein:cell-output-area))) + +(defun ein:cell-insert-output (index cell) + "Insert INDEX-th output of the CELL in the buffer. + Called from ewoc pretty printer via `ein:cell-pp'." + (if (or (slot-value cell 'collapsed) + (and ein:cell-max-num-outputs + (>= index ein:cell-max-num-outputs))) + (progn + (when (and (not (slot-value cell 'collapsed)) + (= index ein:cell-max-num-outputs) + (> (point) (line-beginning-position))) + ;; The first output which exceeds `ein:cell-max-num-outputs'. + (ein:insert-read-only "\n")) + (ein:insert-read-only ".")) + (let ((out (nth index (slot-value cell 'outputs)))) + ;; Handle newline for previous stream output. + ;; In IPython JS, it is handled in `append_stream' because JS + ;; does not need to care about newline (DOM does it for JS). + ;; FIXME: Maybe I should abstract ewoc in some way and get rid + ;; of this. + (when-let ((last-out (and (> index 0) + (nth (1- index) (slot-value cell 'outputs))))) + ;; If previous output is stream type, consider adding newline + (when (equal (plist-get last-out :output_type) "stream") + ;; but don't if we're merely continuing the previous stream + (unless (and (equal (plist-get out :output_type) "stream") + (equal (plist-get out :stream) + (plist-get last-out :stream))) + (ein:cell-append-stream-text-fontified "\n" last-out)))) + ;; Finally insert real data + (let ((start (point)) + (output-type (plist-get out :output_type))) + (ein:case-equal output-type + (("pyout") (ein:cell-append-pyout cell out)) + (("pyerr") (ein:cell-append-pyerr cell out)) + (("error") (ein:cell-append-pyerr cell out)) + (("display_data") (ein:cell-append-display-data cell out)) + (("execute_result") (ein:cell-append-pyout cell out)) + (("stream") (ein:cell-append-stream cell out))) + (let ((ol (make-overlay start (point)))) + (overlay-put ol 'face (ein:cell-get-output-area-face-for-output-type output-type)) + (overlay-put ol 'evaporate t) + (overlay-put ol 'category 'ein)))))) + +(cl-defmethod ein:cell-insert-footer ((_cell ein:basecell)) + "Insert footer (just a new line) of the CELL in the buffer. + Called from ewoc pretty printer via `ein:cell-pp'." + (ein:insert-read-only "\n")) + +(cl-defmethod ein:cell-insert-footer :before ((cell ein:codecell)) + (if (or (slot-value cell 'collapsed) + (and ein:cell-max-num-outputs + (> (ein:cell-num-outputs cell) ein:cell-max-num-outputs))) + ;; Add a newline after the last ".". + (unless (zerop (ein:cell-num-outputs cell)) + (ein:insert-read-only "\n")) + (let ((last-out (car (last (slot-value cell 'outputs))))) + (when (equal (plist-get last-out :output_type) "stream") + (ein:cell-append-stream-text-fontified "\n" last-out))))) + +(defun ein:cell-node-p (node &optional element-name) + (let* ((path (ein:$node-path node)) + (p0 (car path)) + (p1 (cadr path)) + (cell (ein:$node-path node))) + (and cell (eql p0 'cell) (or (not element-name) (eql p1 element-name))))) + +(defun ein:cell-ewoc-node-p (ewoc-node &optional element-name) + (ein:cell-node-p (ewoc-data ewoc-node) element-name)) + +(defun ein:cell-from-ewoc-node (ewoc-node) + (ein:aand ewoc-node (ewoc-data it) (ein:$node-data it))) + +(cl-defmethod ein:cell-input-pos-min ((cell ein:basecell)) + "Return editable minimum point in the input area of the CELL. + If the input area of the CELL does not exist, return `nil'" + (let* ((input-node (ein:cell-element-get cell :input))) + ;; 1+ for skipping newline + (when input-node (1+ (ewoc-location input-node))))) + +(cl-defmethod ein:cell-input-pos-max ((cell ein:basecell)) + "Return editable maximum point in the input area of the CELL. + If the input area of the CELL does not exist, return `nil'" + (let* ((ewoc (slot-value cell 'ewoc)) + (input-node (ein:cell-element-get cell :input))) + ;; 1- for skipping newline + (when input-node (1- (ewoc-location (ewoc-next ewoc input-node)))))) + +(cl-defmethod ein:cell-get-text ((cell ein:basecell)) + "Grab text in the input area of the cell at point." + (if (ein:cell-active-p cell) + (let* ((beg (ein:cell-input-pos-min cell)) + (end (ein:cell-input-pos-max cell))) + (buffer-substring beg end)) + (slot-value cell 'input))) + +(cl-defmethod ein:cell-set-text ((cell ein:basecell) text) + (let* ((input-node (ein:cell-element-get cell :input)) + (ewoc (slot-value cell 'ewoc)) + ;; 1+/1- is for skipping newline + (beg (1+ (ewoc-location input-node))) + (end (1- (ewoc-location (ewoc-next ewoc input-node))))) + (save-excursion + ;; probably it is better to set :input and update via ewoc? + (goto-char beg) + (delete-region beg end) + (insert text)))) + +(cl-defmethod ein:cell-save-text ((cell ein:basecell)) + (setf (slot-value cell 'input) (ein:cell-get-text cell))) + +(cl-defmethod ein:cell-deactivate ((cell ein:basecell)) + (setf (slot-value cell 'element) nil) + cell) + +(cl-defmethod ein:cell-active-p ((cell ein:basecell)) + (slot-value cell 'element)) + +(cl-defmethod ein:cell-running-set ((cell ein:codecell) running) + "FIXME: change the appearance of the cell" + (setf (slot-value cell 'running) running)) + +(cl-defmethod ein:cell-set-collapsed ((cell ein:codecell) collapsed) + "Set `:collapsed' slot of CELL and invalidate output ewoc nodes." + (unless (eq (slot-value cell 'collapsed) collapsed) + (setf (slot-value cell 'collapsed) collapsed) + (let ((inhibit-read-only t) + (buffer-undo-list t)) + (apply #'ein:cell--ewoc-invalidate + (slot-value cell 'ewoc) + (append (ein:cell-element-get cell :output) + (list (ein:cell-element-get cell :footer))))))) + +(cl-defmethod ein:cell-collapse ((cell ein:codecell)) + (ein:cell-set-collapsed cell t)) + +(cl-defmethod ein:cell-expand ((cell ein:codecell)) + (ein:cell-set-collapsed cell nil)) + +(cl-defmethod ein:cell-toggle-output ((cell ein:codecell)) + "Toggle `:collapsed' slot of CELL and invalidate output ewoc nodes." + (ein:cell-set-collapsed cell (not (slot-value cell 'collapsed)))) + +(cl-defmethod ein:cell-invalidate-prompt ((cell ein:codecell)) + (let ((inhibit-read-only t) + (buffer-undo-list t)) + (ein:cell--ewoc-invalidate (slot-value cell 'ewoc) + (ein:cell-element-get cell :prompt)))) + +(cl-defmethod ein:cell-set-input-prompt ((cell ein:codecell) &optional number) + (setf (slot-value cell 'input-prompt-number) number) + (ein:cell-invalidate-prompt cell)) + +(cl-defmethod ein:cell-goto ((cell ein:basecell) &optional relpos prop) + "Go to the input area of the given CELL. +RELPOS is the position relative to the input area. Default is 0. +PROP is a name of cell element. Default is `:input'. + +\(fn cell relpos prop)" + (unless relpos (setq relpos 0)) + (unless prop (setq prop :input)) + (ewoc-goto-node (slot-value cell 'ewoc) (ein:cell-element-get cell prop)) + (let ((offset (cl-case prop + ((:input :before-output) 1) + (:after-input -1) + (t 0)))) + (forward-char (+ relpos offset)))) + +(cl-defmethod ein:cell-goto-line ((cell ein:basecell) &optional inputline prop) + "Go to the input area of the given CELL. +INPUTLINE is the line number relative to the input area. Default is 1. +PROP is a name of cell element. Default is `:input'. + +\(fn cell inputline prop)" + (unless inputline (setq inputline 1)) + (unless prop (setq prop :input)) + (let ((goal-column nil)) + (ewoc-goto-node (slot-value cell 'ewoc) (ein:cell-element-get cell prop))) + (let ((offset (cl-case prop + ((:input :before-output) 1) + (:after-input -1) + (t 0)))) + (forward-char offset) + (forward-line (- inputline 1)))) + + +(cl-defmethod ein:cell-relative-point ((cell ein:basecell) &optional pos) + "Return the point relative to the input area of CELL. +If the position POS is not given, current point is considered." + (unless pos (setq pos (point))) + (- pos (1+ (ewoc-location (ein:cell-element-get cell :input))))) + +(cl-defmethod ein:cell-location ((cell ein:basecell) &optional elm end) + "Return the starting location of CELL. +ELM is a name (keyword) of element that `ein:cell-element-get' +understands. Note that you can't use `:output' since it returns +a list. Use `:after-input' instead. +If END is non-`nil', return the location of next element." + (unless elm (setq elm :prompt)) + (when end + (setq elm (cl-case elm + (:prompt :input) + (:input :after-input) + (:output :after-output))) + (unless elm + (setq cell (ein:cell-next cell)) + (setq elm :prompt))) + (if cell + (ewoc-location (ein:cell-element-get cell elm)) + (cl-assert end) + (point-max))) + +(cl-defmethod ein:cell-buffer ((cell ein:basecell)) + "Return a buffer associated by CELL (if any)." + (ein:aand (ein:oref-safe cell 'ewoc) (ewoc-buffer it))) + +(cl-defmethod ein:cell-clear-output ((cell ein:codecell) stdout stderr other) + "codecell.js in IPython implements it using timeout and callback. + As it is unclear why timeout is needed, just clear output + instantaneously for now." + (ein:log 'debug "cell-clear-output stdout=%s stderr=%s other=%s" + stdout stderr other) + (setf (slot-value cell 'traceback) nil) + (let ((ewoc (slot-value cell 'ewoc)) + (output-nodes (ein:cell-element-get cell :output))) + (if (and stdout stderr other) + (progn + ;; clear all + (apply #'ein:cell--ewoc-delete ewoc output-nodes) + (plist-put (slot-value cell 'element) :output nil) + (setf (slot-value cell 'outputs) nil)) + (let* ((ewoc-node-list + (append + (when stdout (ein:node-filter output-nodes :is 'output-stdout)) + (when stderr (ein:node-filter output-nodes :is 'output-stderr)) + (when stdout (ein:node-filter output-nodes + :is 'output-subarea + :not 'output-stderr + :not 'output-stdout)))) + (indices + (mapcar (lambda (n) (last (ein:$node-path (ewoc-data n)))) + ewoc-node-list))) + ;; remove from buffer + (apply #'ein:cell--ewoc-delete ewoc ewoc-node-list) + ;; remove from `:element' + (let* ((element (slot-value cell 'element)) + (old-output (plist-get element :output)) + (new-output (ein:remove-by-index old-output indices))) + (plist-put element :output new-output)) + ;; remove cleared outputs from internal data + (setf (slot-value cell 'outputs) + (ein:remove-by-index (slot-value cell 'outputs) indices)))) + ;; Footer may have extra (possibly colored) newline due to the + ;; last output type. So invalidate it here. + ;; See `ein:cell-insert-footer' (for codecell). + (ein:cell--ewoc-invalidate ewoc (ein:cell-element-get cell :footer)))) + +(defun ein:cell-output-json-to-class (json) + (ein:case-equal (plist-get json :output_type) + (("pyout") + '(output-subarea)) + (("pyerr") + '(output-subarea)) + (("error") + '(output-subarea)) + (("display_data") + '(output-subarea)) + (("execute_result") + '(output-subarea)) + (("stream") + (list 'output-stream 'output-subarea + (intern (format "output-%s" (plist-get json :stream))))))) + +(cl-defmethod ein:cell-append-output ((cell ein:codecell) json) + "When there is a python error, we actually get two identical tracebacks back + from the kernel, one from the \"shell\" channel, and one from the \"iopub\" + channel. As a workaround, we remember the cell's traceback and ignore + traceback outputs that are identical to the one we already have." + (let ((new-tb (append (plist-get json :traceback) nil)) + (old-tb (slot-value cell 'traceback))) + (when (or + (null old-tb) + (null new-tb) + (not (cl-equalp new-tb old-tb))) + (ein:cell-actually-append-output cell json)) + (setf (slot-value cell 'traceback) new-tb))) + +(cl-defmethod ein:cell-actually-append-output ((cell ein:codecell) json) + (ein:cell-expand cell) + (setf (slot-value cell 'outputs) + (append (slot-value cell 'outputs) (list json))) + (let* ((ewoc (slot-value cell 'ewoc)) + (index (1- (ein:cell-num-outputs cell))) + (path `(cell output ,index)) + (class (ein:cell-output-json-to-class json)) + (data (ein:node-new path cell class)) + (last-node (ein:cell-element-get cell :last-output)) + (ewoc-node (ewoc-enter-after ewoc last-node data)) + (element (slot-value cell 'element))) + (plist-put element :output + (append (plist-get element :output) (list ewoc-node))) + (ein:cell--ewoc-invalidate ewoc (ein:cell-element-get cell :footer)))) + +(cl-defmethod ein:cell-append-pyout ((cell ein:codecell) json) + "Insert pyout type output in the buffer. +Called from ewoc pretty printer via `ein:cell-insert-output'." + (ein:insert-read-only (format "Out [%s]:" + (or (plist-get json :prompt_number) + (plist-get json :execution_count) + " ")) + 'font-lock-face 'ein:cell-output-prompt) + (ein:insert-read-only "\n") + (ein:cell-append-mime-type json (not (ein:oref-safe cell 'kernel))) + (ein:insert-read-only "\n")) + +(cl-defmethod ein:cell-append-pyerr ((_cell ein:codecell) json) + "Insert pyerr type output in the buffer. +Called from ewoc pretty printer via `ein:cell-insert-output'." + (mapc (lambda (tb) + (ein:cell-append-text tb) + (ein:cell-append-text "\n")) + (let ((tb (append (plist-get json :traceback) nil)) + (level ein:cell-traceback-level)) + (if (and level (> (- (length tb) 2) level)) + (cons (substitute-command-keys + "\nTruncated Traceback (Use \\\\[ein:tb-show-km] to view full TB):") + (last tb (1+ level))) + tb))) + (ein:insert-read-only "\n")) + +(ein:deflocal ein:%cell-append-stream-last-cell% nil + "The last cell in which `ein:cell-append-stream' is used.") + +(cl-defmethod ein:cell-append-stream ((cell ein:codecell) json) + "Insert stream type output in the buffer. +Called from ewoc pretty printer `ein:worksheet-pp'." + (unless (eq cell ein:%cell-append-stream-last-cell%) + ;; Avoid applying unclosed ANSI escape code in the cell. Note + ;; that I don't need to distinguish stdout/stderr because it looks + ;; like normal terminal does not. + (setq ansi-color-context nil)) + (ein:cell-append-stream-text-fontified (or (plist-get json :text) "") json) + + ;; NOTE: newlines for stream is handled in `ein:cell-insert-output'. + ;; So do not insert newline here. + (setq ein:%cell-append-stream-last-cell% cell)) + +(defun ein:cell-append-stream-text-fontified (text json) + "Insert TEXT with font properties defined by JSON data." + (if (equal (plist-get json :stream) "stderr") + (ein:cell-append-text text 'font-lock-face 'ein:cell-output-stderr) + (ein:cell-append-text text))) + +(cl-defmethod ein:cell-append-display-data ((cell ein:codecell) json) + "Insert display-data type output in the buffer. +Called from ewoc pretty printer via `ein:cell-insert-output'." + (ein:cell-append-mime-type json (not (ein:oref-safe cell 'kernel))) + (ein:insert-read-only "\n")) + +(make-obsolete-variable 'ein:output-type-preference nil "0.17.0") + +(defun ein:cell-extract-image-format (mime-type) + "From :image/svg+xml to \"svg\"." + (let* ((mime-str (if (symbolp mime-type) (symbol-name mime-type) mime-type)) + (minor-kw (car (nreverse (split-string mime-str "/")))) + (minor (car (nreverse (split-string minor-kw ":"))))) + (cl-subseq minor 0 (cl-search "+" minor)))) + +(defun ein:cell-append-mime-type (json starting-p) + (ein:output-area-case-type + json + (cl-case type + ((:text/html) + (funcall (ein:output-area-get-html-renderer) value)) + ((:image/svg+xml :image/png :image/jpeg) + (-if-let* ((img-type (intern-soft (ein:cell-extract-image-format type))) + (supported (image-type-available-p img-type)) + (image (apply #'create-image + (condition-case nil + (base64-decode-string value) + (error value)) + img-type + t + ein:output-area-inlined-image-properties))) + (if ein:output-area-inlined-images + (ein:insert-image image) + (ein:insert-read-only " ") + (unless starting-p ;; don't display on ein:worksheet-render + (let* ((handle (ein:make-mm-handle image)) + (type (mm-handle-media-type handle)) + (method (seq-some (lambda (i) (cdr (assoc 'viewer i))) + (mailcap-mime-info type 'all)))) + (when (and (stringp method) (string-match "^[^% \t]+$" method)) + (setq method (concat method " %s"))) + (if (and (stringp method) (> (length method) 0)) + (unless noninteractive + (save-excursion + (with-temp-buffer + (mm-display-external handle method)))) + (ein:log 'warn "ein:cell-append-mime-type: %s" + "no viewer method found in mailcap"))))) + (ein:log 'warn "ein:cell-append-mime-type: %s not supported" type))) + ((:text/plain) + (ein:insert-read-only (ansi-color-apply value))) + (otherwise + (ein:insert-read-only value))))) + +(defun ein:cell-append-text (data &rest properties) + "escape ANSI in plaintext:" + (apply #'ein:insert-read-only (ansi-color-apply data) properties)) + +(defun ein:cell-safe-read-eval-insert (text) + (ein:insert-read-only + (condition-case err + (save-excursion + ;; given code can be `pop-to-buffer' or something. + (format "%S" (eval (read text)))) + (error + (ein:log 'warn "Got an error while executing: '%s'" + text) + (format "Error: %S" err))))) + +(cl-defmethod ein:cell-to-json ((cell ein:codecell)) + "Return json-ready alist." + `((input . ,(ein:cell-get-text cell)) + (cell_type . "code") + ,@(aif (ein:oref-safe cell 'input-prompt-number) + `((prompt_number . ,it))) + (outputs . ,(apply #'vector (slot-value cell 'outputs))) + (language . ,(or (ein:cell-language cell) "python")) + (collapsed . ,(if (slot-value cell 'collapsed) t json-false)))) + +(cl-defmethod ein:cell-to-nb4-json ((cell ein:codecell) _wsidx) + (let ((execute-count (aif (ein:oref-safe cell 'input-prompt-number) + (and (numberp it) it))) + (metadata (slot-value cell 'metadata)) + (cell-id (slot-value cell 'cell-id))) + `((source . ,(ein:cell-get-text cell)) + (cell_type . "code") + (execution_count . ,execute-count) + (outputs . ,(apply #'vector (slot-value cell 'outputs))) + (metadata . ,(plist-put metadata :collapsed (if (slot-value cell 'collapsed) t + json-false))) + (id . ,cell-id)))) + + +(cl-defmethod ein:cell-to-json ((cell ein:textcell)) + `((cell_type . ,(slot-value cell 'cell-type)) + (source . ,(ein:cell-get-text cell)))) + +(cl-defmethod ein:cell-to-nb4-json ((cell ein:textcell) _wsidx) + (let ((metadata (slot-value cell 'metadata)) + (cell-id (slot-value cell 'cell-id))) + `((cell_type . ,(slot-value cell 'cell-type)) + (source . ,(ein:cell-get-text cell)) + (metadata . ,(plist-put metadata :collapsed json-false)) + (id . ,cell-id)))) + +(cl-defmethod ein:cell-next ((cell ein:basecell)) + "Return next cell of the given CELL or nil if CELL is the last one." + (awhen (ewoc-next (slot-value cell 'ewoc) + (ein:cell-element-get cell :footer)) + (let ((cell (ein:$node-data (ewoc-data it)))) + (when (cl-typep cell 'ein:basecell) + cell)))) + +(cl-defmethod ein:cell-prev ((cell ein:basecell)) + "Return previous cell of the given CELL or nil if CELL is the first one." + (awhen (ewoc-prev (slot-value cell 'ewoc) + (ein:cell-element-get cell :prompt)) + (let ((cell (ein:$node-data (ewoc-data it)))) + (when (cl-typep cell 'ein:basecell) + cell)))) + +(cl-defmethod ein:cell-set-kernel ((cell ein:codecell) kernel) + (setf (slot-value cell 'kernel) kernel)) + + +(cl-defmethod ein:cell-execute ((cell ein:codecell)) + (ein:cell-execute-internal cell + (slot-value cell 'kernel) + (ein:cell-get-text cell) + :silent nil)) + +(cl-defmethod ein:cell-execute-internal ((cell ein:codecell) + kernel code &rest args) + (ein:cell-running-set cell t) + (ein:cell-clear-output cell t t t) + (ein:cell-set-input-prompt cell "*") + (apply #'ein:kernel-execute kernel code (ein:cell-make-callbacks cell) args)) + +(cl-defmethod ein:cell-make-callbacks ((cell ein:codecell)) + (list + :execute_reply (cons #'ein:cell--handle-execute-reply cell) + :output (cons #'ein:cell--handle-output cell) + :clear_output (cons #'ein:cell--handle-clear-output cell) + :set_next_input (cons #'ein:cell--handle-set-next-input cell))) + +(cl-defmethod ein:cell--handle-execute-reply ((cell ein:codecell) content metadata) + (when (buffer-live-p (ein:cell-buffer cell)) + (ein:cell-set-input-prompt cell (plist-get content :execution_count)) + (ein:cell-running-set cell nil) + (if (equal (plist-get content :status) "error") + (ein:cell--handle-output cell "error" content metadata) + (let ((events (slot-value cell 'events))) + (ein:events-trigger events 'set_dirty.Worksheet (list :value t :cell cell)) + (ein:events-trigger events 'maybe_reset_undo.Worksheet cell))))) + +(cl-defmethod ein:cell--handle-set-next-input ((cell ein:codecell) text) + (when (buffer-live-p (ein:cell-buffer cell)) + (let ((events (slot-value cell 'events))) + (ein:events-trigger events 'set_next_input.Worksheet + (list :cell cell :text text)) + (ein:events-trigger events 'maybe_reset_undo.Worksheet cell)))) + +(cl-defmethod ein:cell--handle-output ((cell ein:codecell) msg-type content _metadata) + (ein:log 'debug "ein:cell--handle-output (cell ein:codecell): %s" msg-type) + (when-let ((json `(:output_type ,msg-type)) + (live-p (buffer-live-p (ein:cell-buffer cell)))) + (cl-macrolet ((copy-props + (src tgt props) + `(mapc (lambda (kw) + (let ((val (plist-get ,src kw))) + (when (and (null val) (plist-member ,src kw)) + (setq val (make-hash-table))) + (setq ,tgt (plist-put ,tgt kw val)))) + ,props))) + (ein:case-equal msg-type + (("stream") + (copy-props content json '(:name :text))) + (("display_data") + (copy-props content json '(:data :metadata))) + (("execute_result" "pyout") + (copy-props content json '(:execution_count :data :metadata))) + (("error" "pyerr") + (copy-props content json '(:ename :evalue :traceback))) + (t + (ein:log 'error "ein:cell--handle-output: unhandled msg_type '%s'" msg-type) + (setq json nil)))) + (when json + (ein:cell-append-output cell json) + (ein:events-trigger (slot-value cell 'events) 'maybe_reset_undo.Worksheet cell)))) + +(cl-defmethod ein:cell--handle-clear-output ((cell ein:codecell) _content _metadata) + "Spec 5.0 no longer has stdout fields for clear_output." + (when (buffer-live-p (ein:cell-buffer cell)) + (ein:cell-clear-output cell t t t) + (ein:events-trigger (slot-value cell 'events) 'maybe_reset_undo.Worksheet cell))) + +(cl-defmethod ein:cell-has-image-output-p ((cell ein:codecell)) + "Return `t' if given cell has image output, `nil' otherwise." + (seq-some (lambda (out) + (or (plist-member out :image/svg+xml) + (plist-member out :image/png) + (plist-member out :image/jpeg))) + (slot-value cell 'outputs))) + +(cl-defmethod ein:cell-has-image-output-p ((_cell ein:textcell)) + nil) + +(cl-defmethod ein:cell-get-tb-data ((cell ein:codecell)) + (cl-loop for out in (slot-value cell 'outputs) + when (and (plist-get out :traceback) + (member (plist-get out :output_type) '("pyerr" "error"))) + return (plist-get out :traceback))) + +(defun ein:cell-recursively-define (what children parent fun1 fun2) + (cl-loop for child in children + append (when-let ((spuds (eieio-class-children child))) + (ein:cell-recursively-define + what + spuds + (intern (concat (symbol-name child) "-" what)) + fun1 fun2)) + collect (macroexpand-1 `(,fun1 ,child)) + collect (when parent (macroexpand-1 `(,fun2 ,child ,parent))))) + +(defmacro ein:cell-defface-input-prompt (class parent) + `(defface ,(intern (concat (symbol-name class) "-input-prompt-face")) + '((t :inherit ,parent)) + "Face for cell input prompt" + :group 'ein)) + +(defmacro ein:cell-defface-input-area (class parent) + `(defface ,(intern (concat (symbol-name class) "-input-area-face")) + '((t :inherit ,parent)) + "Face for cell input area" + :group 'ein)) + +(defmacro ein:cell-defmethod-input-prompt (class) + `(cl-defmethod ein:cell-input-prompt-face ((cell ,class)) + (quote ,(intern (concat (symbol-name class) "-input-prompt-face"))))) + +(defmacro ein:cell-defmethod-input-area (class) + `(cl-defmethod ein:cell-input-area-face ((cell ,class)) + (quote ,(intern (concat (symbol-name class) "-input-area-face"))))) + +(mapc #'eval (ein:cell-recursively-define "input-prompt-face" + (list 'ein:basecell) 'header-line + 'ein:cell-defmethod-input-prompt + 'ein:cell-defface-input-prompt)) + +(mapc #'eval (ein:cell-recursively-define "input-area-face" + (list 'ein:basecell) nil + 'ein:cell-defmethod-input-area + 'ein:cell-defface-input-area)) + +(provide 'ein-cell) + +;;; ein-cell.el ends here diff --git a/lisp/ein/ein-classes.el b/lisp/ein/ein-classes.el new file mode 100644 index 00000000..7a6ff102 --- /dev/null +++ b/lisp/ein/ein-classes.el @@ -0,0 +1,331 @@ +;;; ein-classes.el --- Classes and structures. -*- lexical-binding:t -*- + +;; Copyright (C) 2017 John M. Miller + +;; Author: John M Miller + +;; This file is NOT part of GNU Emacs. + +;; ein-classes.el 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 of the License, or +;; (at your option) any later version. + +;; ein-classes.el 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 ein-worksheet.el. If not, see . + +;;; Commentary: + +;;; Content +(require 'eieio) + +(cl-defstruct ein:$content + "Content returned from the Jupyter notebook server: +`ein:$content-url-or-port' + URL or port of Jupyter server. + +`ein:$content-name' + The name/filename of the content. Always equivalent to the last + part of the path field + +`ein:$content-path' + The full file path. It will not start with /, and it will be /-delimited. + +`ein:$content-type' + One of three values: :directory, :file, :notebook. + +`ein:$content-writable' + Indicates if requester has permission to modified the requested content. + +`ein:$content-created' + +`ein:$content-last-modified' + +`ein:$content-mimetype' + Specify the mime-type of :file content, null otherwise. + +`ein:$content-raw-content' + Contents of resource as returned by Jupyter. Depending on content-type will hold: + :directory : JSON list of models for each item in the directory. + :file : Text of file as a string or base64 encoded string if mimetype + is other than 'text/plain'. + :notebook : JSON structure of the file. + +`ein:$content-format' + Value will depend on content-type: + :directory : :json. + :file : Either :text or :base64 + :notebook : :json. + +" + url-or-port + notebook-api-version + name + path + type + writable + created + last-modified + mimetype + raw-content + format + session-p) +;;; Websockets + +(cl-defstruct ein:$websocket + "A wrapper object of `websocket'. + +`ein:$websocket-ws' : an instance returned by `websocket-open' +`ein:$websocket-kernel' : kernel at the time of instantiation +`ein:$websocket-closed-by-client' : t/nil' +" + ws + kernel + closed-by-client) + +;;; Notebook +(cl-defstruct ein:$notebook + "Hold notebook variables. + +`ein:$notebook-url-or-port' + URL or port of IPython server. + +`ein:$notebook-notebook-id' : string + uuid string (as of ipython 2.0 this is the same is notebook-name). + +`ein:$notebook-notebook-path' : string + Path to notebook. + +`ein:$notebook-kernel' : `ein:$kernel' + `ein:$kernel' instance. + +`ein:$notebook-kernelspec' : `ein:$kernelspec' + Jupyter kernel specification for the notebook. + +`ein:$notebook-kernelinfo' : `ein:kernelinfo' + `ein:kernelinfo' instance. + +`ein:$notebook-pager' + Variable for `ein:pager-*' functions. See ein-pager.el. + +`ein:$notebook-dirty' : boolean + Set to `t' if notebook has unsaved changes. Otherwise `nil'. + +`ein:$notebook-metadata' : plist + Notebook meta data (e.g., notebook name). + +`ein:$notebook-name' : string + Notebook name. + +`ein:$notebook-nbformat' : integer + Notebook file format version. + +`ein:$notebook-nbformat-minor' : integer + Notebook file format version. + +`ein:$notebook-events' : `ein:$events' + Event handler instance. + +`ein:$notebook-worksheets' : list of `ein:worksheet' + List of worksheets. + +`ein:$notebook-scratchsheets' : list of `ein:worksheet' + List of scratch worksheets. + +`ein:$notebook-api-version' : integer + Major version of the IPython notebook server we are talking to. +" + url-or-port + notebook-id ;; In IPython-2.0 this is "[:path]/[:name].ipynb" + notebook-path + kernel + kernelinfo + kernelspec + pager + dirty + metadata + notebook-name + nbformat + nbformat-minor + events + worksheets + scratchsheets + api-version) + + +;;; Worksheet +(defclass ein:worksheet () + ((nbformat :initarg :nbformat :type integer) + (notebook-path :initarg :notebook-path :type function + :accessor ein:worksheet--notebook-path) + (saved-cells :initarg :saved-cells :initform nil + :accessor ein:worksheet--saved-cells + :documentation + "Slot to cache cells for worksheet without buffer") + (dont-save-cells :initarg :dont-save-cells :initform nil :type boolean + :accessor ein:worksheet--dont-save-cells-p + :documentation "Don't cache cells when this flag is on.") + (ewoc :initarg :ewoc :type ewoc :accessor ein:worksheet--ewoc) + (kernel :initarg :kernel :type ein:$kernel :accessor ein:worksheet--kernel) + (dirty :initarg :dirty :type boolean :initform nil :accessor ein:worksheet--dirty-p) + (metadata :initarg :metadata :initform nil :accessor ein:worksheet--metadata) + (events :initarg :events :accessor ein:worksheet--events))) + +;;; Kernel +(cl-defstruct ein:$kernelspec + "Kernel specification as return by the Jupyter notebook server. + +`ein:$kernelspec-name' : string + Name used to identify the kernel (like python2, or python3). + +`ein:$kernelspec-display-name' : string + Name used to display kernel to user. + +`ein:$kernelspec-language' : string + Programming language supported by kernel, like 'python'. + +`ein:$kernelspec-resources' : plist + Resources, if any, used by the kernel. + +`ein:$kernelspec-spec' : plist + How the outside world defines kernelspec: + https://ipython.org/ipython-doc/dev/development/kernels.html#kernelspecs +" + name + display-name + resources + spec + language) + +(cl-defstruct ein:$kernel + "Should be named ein:$session. We glom session and kernel as +defined by the server as just ein:$kernel in the client." + url-or-port + path + kernelspec + events + api-version + session-id + kernel-id + shell-channel + iopub-channel + websocket ; For IPython 3.x+ + base-url ; /api/kernels/ + kernel-url ; /api/kernels/ + ws-url ; ws://[:] + username + msg-callbacks + oinfo-cache + after-start-hook + after-execute-hook) + +;;; Cells + +(defclass ein:basecell () + ((cell-type :initarg :cell-type :type string :accessor ein:cell-type) + (read-only :initarg :read-only :initform nil :type boolean) + (ewoc :initarg :ewoc :type ewoc :accessor ein:basecell--ewoc) + (element :initarg :element :initform nil :type list + :documentation "ewoc nodes") + (element-names :initarg :element-names) + (input :initarg :input :type string + :documentation "Place to hold data until it is rendered via `ewoc'.") + (outputs :initarg :outputs :initform nil :type list) + (metadata :initarg :metadata :initform nil :type list :accessor ein:cell-metadata) + (events :initarg :events :type ein:events) + (cell-id :initarg :cell-id :initform (ein:utils-uuid) :type string + :accessor ein:cell-id)) + "Notebook cell base class") + +(defclass ein:codecell (ein:basecell) + ((traceback :initform nil :initarg :traceback :type list) + (cell-type :initarg :cell-type :initform "code") + (kernel :initarg :kernel :type ein:$kernel :accessor ein:cell-kernel) + (element-names :initform '(:prompt :input :output :footer)) + (input-prompt-number :initarg :input-prompt-number + :documentation "\ +Integer or \"*\" (running state). +Implementation note: +Typed `:input-prompt-number' becomes a problem when reading a +notebook that saved "*". So don't add `:type'!") + (collapsed :initarg :collapsed :initform nil :type boolean) + (running :initarg :running :initform nil :type boolean))) + +(defclass ein:textcell (ein:basecell) + ((cell-type :initarg :cell-type :initform "text") + (element-names :initform '(:prompt :input :footer)))) + +(defclass ein:htmlcell (ein:textcell) + ((cell-type :initarg :cell-type :initform "html"))) + +(defclass ein:markdowncell (ein:textcell) + ((cell-type :initarg :cell-type :initform "markdown"))) + +(defclass ein:rawcell (ein:textcell) + ((cell-type :initarg :cell-type :initform "raw"))) + +;;; Notifications + +(defclass ein:notification-status () + ((status :initarg :status :initform nil) + (message :initarg :message :initform nil) + (s2m :initarg :s2m)) + "Hold status and its string representation (message).") + +(defclass ein:notification-tab () + ((get-list :initarg :get-list :type function) + (get-current :initarg :get-current :type function)) + ;; These "methods" are for not depending on what the TABs for. + ;; Probably I'd want change this to be a separated Emacs lisp + ;; library at some point. + "See `ein:notification-setup' for explanation.") + +(defclass ein:notification () + ((buffer :initarg :buffer :type buffer :document "Notebook buffer") + (tab :initarg :tab :type ein:notification-tab) + (execution-count + :initform "y" :initarg :execution-count + :documentation "Last `execution_count' sent by `execute_reply'.") + (notebook + :initarg :notebook + :initform + (ein:notification-status + "NotebookStatus" + :s2m + '((notebook_saving.Notebook . "Saving notebook...") + (notebook_saved.Notebook . "Notebook saved") + (notebook_save_failed.Notebook . "Failed saving notebook!"))) + :type ein:notification-status) + (kernel + :initarg :kernel + :initform + (ein:notification-status + "KernelStatus" + :s2m + '((status_idle.Kernel . nil) + (status_busy.Kernel . "Kernel busy...") + (status_restarting.Kernel . "Kernel restarting...") + (status_restarted.Kernel . "Kernel restarted") + (status_dead.Kernel . "Kernel requires restart \\\\[ein:notebook-restart-session-command-km]") + (status_reconnecting.Kernel . "Kernel reconnecting...") + (status_reconnected.Kernel . "Kernel reconnected") + (status_disconnected.Kernel . "Kernel requires reconnect \\\\[ein:notebook-reconnect-session-command-km]"))) + :type ein:notification-status)) + "Notification widget for Notebook.") + +;;; Events + +(defclass ein:events () + ((callbacks :initarg :callbacks :type hash-table + :initform (make-hash-table :test 'eq))) + "Event handler class.") + + +(provide 'ein-classes) + +;;; ein-classes.el ends here diff --git a/lisp/ein/ein-completer.el b/lisp/ein/ein-completer.el new file mode 100644 index 00000000..41d98c8e --- /dev/null +++ b/lisp/ein/ein-completer.el @@ -0,0 +1,34 @@ +;;; -*- mode: emacs-lisp; lexical-binding: t -*- +;;; ein-completer.el --- Completion module + +;; Copyright (C) 2018- Takafumi Arakaki / John Miller + +;; Author: Takafumi Arakaki / John Miller + +;; This file is NOT part of GNU Emacs. + +;; ein-completer.el 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 of the License, or +;; (at your option) any later version. + +;; ein-completer.el 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 ein-completer.el. If not, see . + +;;; Commentary: + +;; This needs to get re-written. + +;;; Code: + +(make-obsolete-variable 'ein:complete-on-dot nil "0.15.0") +(make-obsolete-variable 'ein:completion-backend nil "0.17.0") + +(provide 'ein-completer) + +;;; ein-completer.el ends here diff --git a/lisp/ein/ein-contents-api.el b/lisp/ein/ein-contents-api.el new file mode 100644 index 00000000..4faccf58 --- /dev/null +++ b/lisp/ein/ein-contents-api.el @@ -0,0 +1,353 @@ +;;; ein-contents-api.el --- Interface to Jupyter's Contents API -*- lexical-binding:t -*- + +;; Copyright (C) 2015 - John Miller + +;; Authors: Takafumi Arakaki +;; John M. Miller + +;; This file is NOT part of GNU Emacs. + +;; ein-contents-api.el 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 of the License, or +;; (at your option) any later version. + +;; ein-contents-api.el 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 ein-notebooklist.el. If not, see . + +;;; Commentary: +;;; +;;; An interface to the Jupyter Contents API as described in +;;; https://github.com/ipython/ipython/wiki/IPEP-27%3A-Contents-Service. +;;; + +;; + +;;; Code: + +(require 'ein-core) +(require 'ein-classes) +(require 'ein-utils) +(require 'ein-log) +(require 'ein-query) + +(declare-function ein:notebook-to-json "ein-notebook") +(declare-function ein:notebooklist-url "ein-notebooklist") + +(defcustom ein:content-query-max-depth 2 + "Don't recurse the directory tree deeper than this." + :type 'integer + :group 'ein) + +(defcustom ein:content-query-max-branch 6 + "Don't descend into more than this number of directories per depth. +The total number of parallel queries should therefore be +O({max_branch}^{max_depth})." + :type 'integer + :group 'ein) + +(make-obsolete-variable 'ein:content-query-timeout nil "0.17.0") + +(defcustom ein:force-sync nil + "When non-nil, force synchronous http requests." + :type 'boolean + :group 'ein) + +(defun ein:content-query-contents (url-or-port path &optional callback errback iteration) + "Register CALLBACK of arity 1 for the contents at PATH from the URL-OR-PORT. +ERRBACK of arity 1 for the contents." + (setq callback (or callback #'ignore)) + (setq errback (or errback #'ignore)) + (setq iteration (or iteration 0)) + (ein:query-singleton-ajax + (ein:notebooklist-url url-or-port path) + :type "GET" + :parser #'ein:json-read + :complete (apply-partially #'ein:content-query-contents--complete url-or-port path) + :success (apply-partially #'ein:content-query-contents--success url-or-port path callback) + :error (apply-partially #'ein:content-query-contents--error url-or-port path callback errback iteration))) + +(cl-defun ein:content-query-contents--complete + (_url-or-port _path + &key data _symbol-status response &allow-other-keys + &aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data))) + (ein:log 'debug "ein:query-contents--complete %s" resp-string)) + +(cl-defun ein:content-query-contents--error + (url-or-port path callback errback iteration + &key symbol-status response error-thrown data &allow-other-keys + &aux + (response-status (request-response-status-code response)) + (hub-p (request-response-header response "x-jupyterhub-version"))) + (cl-case response-status + (404 (ein:log 'error "ein:content-query-contents--error %s %s" + response-status (plist-get data :message)) + (when errback (funcall errback url-or-port response-status))) + (t (if (< iteration 3) + (if (and hub-p data (eq response-status 405)) + (ein:content-query-contents--success url-or-port path callback :data data) + (ein:log 'verbose "Retry content-query-contents #%s in response to %s" + iteration response-status) + (sleep-for 0 (* (1+ iteration) 500)) + (ein:content-query-contents url-or-port path callback errback (1+ iteration))) + (ein:log 'error "ein:content-query-contents--error %s REQUEST-STATUS %s DATA %s" + (concat (file-name-as-directory url-or-port) path) + symbol-status (cdr error-thrown)) + (when errback (funcall errback url-or-port response-status)))))) + +(cl-defun ein:content-query-contents--success + (url-or-port path callback + &key data _symbol-status _response &allow-other-keys) + (when callback + (funcall callback (ein:new-content url-or-port path data)))) + +(defun ein:content-to-json (content) + (let ((path (if (>= (ein:$content-notebook-api-version content) 3) + (ein:$content-path content) + (substring (ein:$content-path content) + 0 + (or (cl-position ?/ (ein:$content-path content) :from-end t) + 0))))) + (ignore-errors + (ein:json-encode `((type . ,(ein:$content-type content)) + (name . ,(ein:$content-name content)) + (path . ,path) + (format . ,(or (ein:$content-format content) "json")) + (content ,@(ein:$content-raw-content content))))))) + +(defun ein:content-from-notebook (nb) + (let ((nb-content (ein:notebook-to-json nb))) + (make-ein:$content :name (ein:$notebook-notebook-name nb) + :path (ein:$notebook-notebook-path nb) + :url-or-port (ein:$notebook-url-or-port nb) + :type "notebook" + :notebook-api-version (ein:$notebook-api-version nb) + :raw-content (append nb-content nil)))) + +;;; Managing/listing the content hierarchy + +(defvar *ein:content-hierarchy* (make-hash-table :test #'equal) + "Content tree keyed by URL-OR-PORT.") + +(defun ein:content-need-hierarchy (url-or-port) + "Callers assume ein:content-query-hierarchy succeeded. If not, nil." + (aif (gethash url-or-port *ein:content-hierarchy*) it + (ein:log 'warn "No recorded content hierarchy for %s" url-or-port) + nil)) + +(defun ein:new-content (url-or-port path data) + ;; data is like (:size 72 :content nil :writable t :path Untitled7.ipynb :name Untitled7.ipynb :type notebook) + (let ((content (make-ein:$content + :url-or-port url-or-port + :notebook-api-version (ein:notebook-api-version-numeric url-or-port) + :path path)) + (raw-content (if (vectorp (plist-get data :content)) + (append (plist-get data :content) nil) + (plist-get data :content)))) + (setf (ein:$content-name content) (plist-get data :name) + (ein:$content-path content) (plist-get data :path) + (ein:$content-type content) (plist-get data :type) + (ein:$content-created content) (plist-get data :created) + (ein:$content-last-modified content) (plist-get data :last_modified) + (ein:$content-format content) (plist-get data :format) + (ein:$content-writable content) (plist-get data :writable) + (ein:$content-mimetype content) (plist-get data :mimetype) + (ein:$content-raw-content content) raw-content) + content)) + +(defun ein:content-query-hierarchy* (url-or-port path callback sessions depth content) + "Returns list (tree) of content objects. CALLBACK accepts tree." + (let* ((url-or-port url-or-port) + (path path) + (callback callback) + (items (ein:$content-raw-content content)) + (directories (if (< depth ein:content-query-max-depth) + (cl-loop for item in items + until (>= (length result) ein:content-query-max-branch) + if (string= "directory" (plist-get item :type)) + collect (ein:new-content url-or-port path item) + into result + end + finally return result))) + (others (cl-loop for item in items + with c0 + if (not (string= "directory" (plist-get item :type))) + do (setf c0 (ein:new-content url-or-port path item)) + (setf (ein:$content-session-p c0) + (gethash (ein:$content-path c0) sessions)) + and collect c0 + end))) + (deferred:$ + (apply + #'deferred:parallel + (cl-loop for c0 in directories + collect + (let ((c0 c0) + (d0 (deferred:new #'identity))) + (ein:content-query-contents + url-or-port + (ein:$content-path c0) + (apply-partially #'ein:content-query-hierarchy* + url-or-port + (ein:$content-path c0) + (lambda (tree) + (deferred:callback-post d0 (cons c0 tree))) + sessions (1+ depth)) + (lambda (&rest _args) (deferred:callback-post d0 (cons c0 nil)))) + d0))) + (deferred:nextc it + (lambda (tree) + (let ((result (append others tree))) + (when (string= path "") + (setf (gethash url-or-port *ein:content-hierarchy*) (-flatten result))) + (funcall callback result))))))) + +(defun ein:content-query-hierarchy (url-or-port &optional callback) + "Get hierarchy of URL-OR-PORT with CALLBACK arity 1 for which hierarchy." + (setq callback (or callback #'ignore)) + (ein:content-query-sessions + url-or-port + (apply-partially (lambda (url-or-port* callback* sessions) + (ein:content-query-contents url-or-port* "" + (apply-partially #'ein:content-query-hierarchy* + url-or-port* + "" + callback* sessions 0) + (lambda (&rest _ignore) + (when callback* (funcall callback* nil))))) + url-or-port callback) + callback)) + +;;; Save Content + +(defsubst ein:content-url (content) + (ein:notebooklist-url (ein:$content-url-or-port content) + (ein:$content-path content))) + +(defun ein:content-save (content &optional callback cbargs errcb errcbargs) + (ein:query-singleton-ajax + (ein:content-url content) + :type "PUT" + :headers '(("Content-Type" . "application/json")) + :data (encode-coding-string (ein:content-to-json content) buffer-file-coding-system) + :success (apply-partially #'ein:content-save-success callback cbargs) + :error (apply-partially #'ein:content-save-error + (ein:content-url content) errcb errcbargs))) + +(cl-defun ein:content-save-success (callback cbargs &key _status _response &allow-other-keys) + (when callback + (apply callback cbargs))) + +(cl-defun ein:content-save-error (url errcb errcbargs &key response &allow-other-keys) + (ein:log 'error + "ein:content-save-error: %s %s." + url (error-message-string (request-response-error-thrown response))) + (when errcb + (apply errcb errcbargs))) + +(defun ein:content-rename (content new-path &optional callback cbargs) + (ein:query-singleton-ajax + (ein:content-url content) + :type "PATCH" + :data (ein:json-encode `((path . ,new-path))) + :parser #'ein:json-read + :success (apply-partially #'update-content-path content callback cbargs) + :error (apply-partially #'ein:content-rename-error (ein:$content-path content)))) + +(defun ein:session-rename (url-or-port session-id new-path) + (ein:query-singleton-ajax + (ein:url url-or-port "api/sessions" session-id) + :type "PATCH" + :data (ein:json-encode `((path . ,new-path))) + :complete #'ein:session-rename--complete)) + +(cl-defun ein:session-rename--complete (&key data response _symbol-status &allow-other-keys + &aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data))) + (ein:log 'debug "ein:session-rename--complete %s" resp-string)) + +(cl-defun update-content-path (content callback cbargs &key data &allow-other-keys) + (setf (ein:$content-path content) (plist-get data :path) + (ein:$content-name content) (plist-get data :name) + (ein:$content-last-modified content) (plist-get data :last_modified)) + (when callback + (apply callback cbargs))) + +(cl-defun ein:content-rename-error (path &key response data &allow-other-keys) + (ein:log 'error + "Renaming content %s failed %s %s." + path (request-response-error-thrown response) (plist-get data :message))) + +;;; Sessions + +(defun ein:content-query-sessions (url-or-port &optional callback errback iteration) + "Register CALLBACK of arity 1 to retrieve the sessions. +Call ERRBACK of arity 1 (contents) upon failure." + (setq callback (or callback #'ignore)) + (setq errback (or errback #'ignore)) + (setq iteration (or iteration 0)) + (ein:query-singleton-ajax + (ein:url url-or-port "api/sessions") + :type "GET" + :parser #'ein:json-read + :complete (apply-partially #'ein:content-query-sessions--complete url-or-port callback) + :success (apply-partially #'ein:content-query-sessions--success url-or-port callback) + :error (apply-partially #'ein:content-query-sessions--error url-or-port callback errback iteration))) + +(cl-defun ein:content-query-sessions--success (url-or-port callback &key data &allow-other-keys) + (cl-flet ((read-name (nb-json) + (if (< (ein:notebook-api-version-numeric url-or-port) 3) + (if (string= (plist-get nb-json :path) "") + (plist-get nb-json :name) + (format "%s/%s" (plist-get nb-json :path) (plist-get nb-json :name))) + (plist-get nb-json :path)))) + (let ((session-hash (make-hash-table :test 'equal))) + (dolist (s (append data nil) (funcall callback session-hash)) + (setf (gethash (read-name (plist-get s :notebook)) session-hash) + (cons (plist-get s :id) (plist-get s :kernel))))))) + +(cl-defun ein:content-query-sessions--error + (url-or-port callback errback iteration + &key data response error-thrown &allow-other-keys + &aux + (response-status (request-response-status-code response)) + (hub-p (request-response-header response "x-jupyterhub-version"))) + (if (< iteration 3) + (if (and hub-p data (eq response-status 405)) + (ein:content-query-sessions--success url-or-port callback :data data) + (ein:log 'verbose "Retry sessions #%s in response to %s %S" iteration response-status response) + (sleep-for 0 (* (1+ iteration) 500)) + (ein:content-query-sessions url-or-port callback errback (1+ iteration))) + (ein:log 'error "ein:content-query-sessions--error %s: ERROR %s DATA %s" url-or-port (car error-thrown) (cdr error-thrown)) + (when errback (funcall errback nil)))) + +(cl-defun ein:content-query-sessions--complete + (_url-or-port _callback + &key data response &allow-other-keys + &aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data))) + (ein:log 'debug "ein:query-sessions--complete %s" resp-string)) + +;;; Uploads + + +(defun ein:get-local-file (path) + "Get contents of PATH. +Guess type of file (one of file, notebook, or directory) +and content format (one of json, text, or base64)." + (unless (file-readable-p path) + (error "File %s is not accessible and cannot be uploaded." path)) + (let ((name (file-name-nondirectory path)) + (type (file-name-extension path))) + (with-temp-buffer + (insert-file-contents path) + (cond ((string= type "ipynb") + (list name "notebook" "json" (buffer-string))) + ((eql buffer-file-coding-system 'no-conversion) + (list name "file" "base64" (buffer-string))) + (t (list name "file" "text" (buffer-string))))))) + +(provide 'ein-contents-api) diff --git a/lisp/ein/ein-core.el b/lisp/ein/ein-core.el new file mode 100644 index 00000000..0bb2c26a --- /dev/null +++ b/lisp/ein/ein-core.el @@ -0,0 +1,174 @@ +;;; ein-core.el --- EIN core -*- lexical-binding:t -*- + +;; Copyright (C) 2012 Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; ein-core.el 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 of the License, or +;; (at your option) any later version. + +;; ein-core.el 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 ein-core.el. +;; If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ein) ; get autoloaded functions into namespace +(require 'ein-utils) +(require 'anaphora) +(require 'request) + +(defgroup ein nil + "IPython notebook client in Emacs" + :group 'applications + :prefix "ein:") + +(define-obsolete-variable-alias 'ein:url-or-port 'ein:urls "0.17.0") +(defcustom ein:urls nil + "List of default urls." + :type '(repeat (choice (string :tag "Remote url") + (integer :tag "Local port" 8888))) + :group 'ein) + +(make-obsolete-variable 'ein:default-url-or-port nil "0.17.0") + +(defconst ein:source-dir (file-name-directory load-file-name) + "Directory in which `ein*.el` files are located.") + +(defun ein:version (&optional interactively copy-to-kill) + "Return a longer version string. +With prefix argument, copy the string to kill ring. +The result contains `ein:version' and either git revision (if +the source is in git repository) or elpa version." + (interactive (list t current-prefix-arg)) + (let* ((version + (or (and (ein:git-root-p + (concat (file-name-as-directory ein:source-dir) "..")) + (let ((default-directory ein:source-dir)) + (ein:git-revision-dirty))) + (and (string-match "/ein-\\([0-9\\.]*\\)/$" ein:source-dir) + (match-string 1 ein:source-dir))))) + (when interactively + (message "EIN version is %s" version)) + (when copy-to-kill + (kill-new version)) + version)) + +;;; Server attribute getters. These should be moved to ein-open.el + +(defvar *ein:notebook-api-version* (make-hash-table :test #'equal) + "url-or-port to major notebook version") + +(defvar *ein:kernelspecs* (make-hash-table :test #'equal) + "url-or-port to kernelspecs") + +(defun ein:get-kernelspec (url-or-port name &optional lang) + (let* ((kernelspecs (ein:need-kernelspecs url-or-port)) + (name (if (stringp name) + (intern (format ":%s" name)) + name)) + (ks (or (plist-get kernelspecs name) + (cl-loop for (_key spec) on (ein:plist-exclude kernelspecs '(:default)) by 'cddr + if (string= (ein:$kernelspec-language spec) lang) + return spec + end)))) + (cond ((stringp ks) + (ein:get-kernelspec url-or-port ks)) + (t ks)))) + +(defun ein:need-kernelspecs (url-or-port) + "Callers assume ein:query-kernelspecs succeeded. If not, nil." + (aif (gethash url-or-port *ein:kernelspecs*) it + (ein:log 'warn "No recorded kernelspecs for %s" url-or-port) + nil)) + +(defsubst ein:notebook-api-version-numeric (url-or-port) + (truncate (string-to-number (ein:need-notebook-api-version url-or-port)))) + +(defun ein:need-notebook-api-version (url-or-port) + "Callers assume `ein:query-notebook-api-version' succeeded. +If not, we hardcode a guess." + (aif (gethash url-or-port *ein:notebook-api-version*) it + (ein:log 'warn "No recorded notebook version for %s" url-or-port) + "5")) + +(defun ein:generic-getter (func-list) + "Internal function for generic getter functions (`ein:get-*'). + +FUNC-LIST is a list of function which takes no argument and +return what is desired or nil. Each function in FUNC-LIST is +called one by one and the first non-nil result will be used. The +function is not called when it is not bound. So, it is safe to +give functions defined in lazy-loaded sub-modules. + +This is something similar to dispatching in generic function such +as `defgeneric' in EIEIO, but it takes no argument. Actual +implementation is chosen based on context (buffer, point, etc.). +This helps writing generic commands which requires same object +but can operate in different contexts." + (cl-loop for func in func-list + if (and (functionp func) (funcall func)) + return it)) + +(defun ein:get-url-or-port () + (ein:generic-getter '(ein:get-url-or-port--notebooklist + ein:get-url-or-port--notebook + ein:get-url-or-port--worksheet + ein:get-url-or-port--shared-output))) + +(defun ein:get-kernel () + (ein:generic-getter '(ein:get-kernel--notebook + ein:get-kernel--worksheet + ein:get-kernel--shared-output + ein:get-kernel--connect))) + +(defun ein:get-kernel-or-error () + (or (ein:get-kernel) + (error "No kernel related to the current buffer."))) + +(defun ein:get-cell-at-point () + (ein:generic-getter '(ein:get-cell-at-point--worksheet + ein:get-cell-at-point--shared-output))) + +(defun ein:get-traceback-data () + (append (ein:generic-getter '(ein:get-traceback-data--worksheet + ein:get-traceback-data--shared-output + ein:get-traceback-data--connect)) + nil)) + +;;; Emacs utilities + +(defun ein:clean-compiled-files () + (let* ((files (directory-files ein:source-dir 'full "^ein-.*\\.elc$"))) + (mapc #'delete-file files) + (message "Removed %s byte-compiled files." (length files)))) + +(defun ein:byte-compile-ein () + "Byte compile EIN files." + (interactive) + (ein:clean-compiled-files) + (let* ((files (directory-files ein:source-dir 'full "^ein-.*\\.el$")) + (errors (cl-mapcan (lambda (f) (unless (byte-compile-file f) (list f))) + files))) + (aif errors + (error "Got %s errors while compiling these files: %s" + (length errors) + (ein:join-str " " (mapcar #'file-name-nondirectory it)))) + (message "Compiled %s files" (length files)))) + +(provide 'ein-core) + +;;; ein-core.el ends here diff --git a/lisp/ein/ein-dev.el b/lisp/ein/ein-dev.el new file mode 100644 index 00000000..42f9ce63 --- /dev/null +++ b/lisp/ein/ein-dev.el @@ -0,0 +1,230 @@ +;;; ein-dev.el --- Development tools -*- lexical-binding:t -*- + +;; Copyright (C) 2012- Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; ein-dev.el 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 of the License, or +;; (at your option) any later version. + +;; ein-dev.el 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 ein-dev.el. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ein-notebook) + +(defvar ein:dev-trace-curl nil "Turn on to really go after it.") + +;;;###autoload +(defun ein:dev-start-debug () + "Start logging a bunch of stuff." + (interactive) + (setq debug-on-error t) + (setq request-log-level (quote debug)) + (let ((curl-trace (concat temporary-file-directory "curl-trace"))) + (setq request-curl-options + (append request-curl-options `("--trace-ascii" ,curl-trace))) + (add-function :after + (symbol-function 'request--curl-callback) + (lambda (&rest _args) + (when ein:dev-trace-curl + (if (file-readable-p curl-trace) + (with-temp-buffer + (insert-file-contents curl-trace) + (request-log 'debug (buffer-string))) + (request-log 'debug "%s unreadable" curl-trace)))))) + (setq request-message-level (quote verbose)) + (setq websocket-debug t) + (setq websocket-callback-debug-on-error t) + (ein:log-set-level 'debug) + (ein:log-set-message-level 'verbose)) + +;;;###autoload +(defun ein:dev-stop-debug () + "Inverse of `ein:dev-start-debug'. +Impossible to maintain because it needs to match start." + (interactive) + (setq debug-on-error nil) + (setq websocket-debug nil) + (setq request-log-level -1) + (setq request-message-level 'warn) + (setq websocket-callback-debug-on-error nil) + (ein:log-set-level 'verbose) + (ein:log-set-message-level 'info) + (let ((curl-trace (concat temporary-file-directory "curl-trace"))) + (setq request-curl-options + (cl-remove-if (lambda (x) (member x `("--trace-ascii" ,curl-trace))) + request-curl-options)))) + +(defun ein:dev-stdout-program (command args) + "Safely call COMMAND with ARGS and return its stdout." + (aand (executable-find command) + (with-temp-buffer + (erase-buffer) + (apply #'call-process it nil t nil args) + (buffer-string)))) + +(defun ein:dev-packages () + (with-temp-buffer + (insert-file-contents (locate-library "ein")) + (mapcar (lambda (x) (symbol-name (cl-first x))) + (package-desc-reqs (package-buffer-info))))) + +(defun ein:dev-sys-info () + "Returns a list." + (cl-flet ((lib-info + (name) + (let* ((libsym (intern-soft name)) + (version-var (cl-loop for fmt in '("%s-version" "%s:version") + if (intern-soft (format fmt name)) + return it)) + (version (symbol-value version-var))) + (list :name name + :path (aand (locate-library name) (abbreviate-file-name it)) + :featurep (featurep libsym) + :version-var version-var + :version version))) + (dump-vars + (names) + (cl-loop for var in names + collect (intern (format ":%s" var)) + collect (symbol-value (intern (format "ein:%s" var)))))) + (list + "EIN system info" + :emacs-version (emacs-version) + :window-system window-system + :emacs-variant + (cond ((boundp 'spacemacs-version) (concat "spacemacs" spacemacs-version)) + ((boundp 'doom-version) (concat "doom-" doom-version))) + :build system-configuration-options + :os (list + :uname (ein:dev-stdout-program "uname" '("-a")) + :lsb-release (ein:dev-stdout-program "lsb_release" '("-a"))) + :jupyter (ein:dev-stdout-program "jupyter" '("--version")) + :image-types (ein:eval-if-bound 'image-types) + :image-types-available (seq-filter #'image-type-available-p + (ein:eval-if-bound 'image-types)) + :request-backend request-backend + :ein (append (list :version (ein:version)) + (dump-vars '("source-dir"))) + :lib (seq-filter (lambda (info) (plist-get info :path)) + (mapcar #'lib-info (ein:dev-packages)))))) + +;;;###autoload +(defun ein:dev-bug-report-template () + "Open a buffer with bug report template." + (interactive) + (let ((buffer (generate-new-buffer "*ein:bug-report*"))) + (with-current-buffer buffer + (erase-buffer) + (insert "## Problem description\n\n" + "## Steps to reproduce the problem\n\n" + "\n" + "## System info:\n\n" + "```cl\n") + (condition-case err + (ein:dev-pp-sys-info buffer) + (error (insert (format "ein:dev-sys-info erred: %s" (error-message-string err))))) + (insert "```\n" + "## Logs:\n") + (ein:dev-dump-logs buffer) + (goto-char (point-min)) + (pop-to-buffer buffer)))) + +(defvar *ein:jupyter-server-buffer-name*) +(defun ein:dev-dump-logs (&optional stream) + (interactive) + (dolist (notebook (ein:notebook-opened-notebooks)) + (-when-let* ((kernel (ein:$notebook-kernel notebook)) + (websocket (ein:$kernel-websocket kernel)) + (ws (ein:$websocket-ws websocket)) + (ws-buf (websocket-get-debug-buffer-create ws))) + (let (dump) + (with-current-buffer ws-buf + (setq dump (buffer-substring-no-properties + (point-min) (point-max)))) + (if (zerop (length dump)) + (kill-buffer ws-buf) + (mapc (lambda (s) + (princ (format "%s\n" s) (or stream standard-output))) + (list + (format "#### `%s`:" (ein:url (ein:$kernel-url-or-port kernel) + (ein:$kernel-path kernel))) + "```" + (string-trim dump) + "```")))))) + (cl-macrolet ((dump + (name) + `(awhen (get-buffer ,name) + (with-current-buffer it + (mapc (lambda (s) + (princ (format "%s\n" s) + (or stream standard-output))) + (list + (format "#### %s:" ,name) + "```" + (string-trim (buffer-substring-no-properties + (point-min) (point-max))) + "```")))))) + (dump request-log-buffer-name) + (dump ein:log-all-buffer-name) + (dump *ein:jupyter-server-buffer-name*))) + +(defun ein:dev-pp-sys-info (&optional stream) + (interactive) + (princ (ein:dev-obj-to-string (ein:dev-sys-info)) + (or stream standard-output))) + +(defvar pp-escape-newlines) +(defun ein:dev-obj-to-string (object) + (with-temp-buffer + (erase-buffer) + (let ((pp-escape-newlines nil)) + (pp object (current-buffer))) + (goto-char (point-min)) + (let ((emacs-lisp-mode-hook nil)) + (emacs-lisp-mode)) + (ein:dev-pp-sexp) + (buffer-string))) + +(defun ein:dev-pp-sexp () + "Prettify s-exp at point recursively. +Use this function in addition to `pp' (see `ein:dev-obj-to-string')." + (down-list) + (condition-case nil + (while t + (forward-sexp) + ;; Prettify nested s-exp. + (when (looking-back ")" (1- (point))) + (save-excursion + (backward-sexp) + (ein:dev-pp-sexp))) + ;; Add newline before keyword symbol. + (when (looking-at-p " :") + (newline-and-indent)) + ;; Add newline before long string literal. + (when (and (looking-at-p " \"") + (let ((end (save-excursion + (forward-sexp) + (point)))) + (> (- end (point)) 80))) + (newline-and-indent))) + (scan-error))) + +(provide 'ein-dev) + +;;; ein-dev.el ends here diff --git a/lisp/ein/ein-events.el b/lisp/ein/ein-events.el new file mode 100644 index 00000000..f7ce8097 --- /dev/null +++ b/lisp/ein/ein-events.el @@ -0,0 +1,63 @@ +;;; ein-events.el --- Event module -*- lexical-binding:t -*- + +;; Copyright (C) 2012- Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; ein-events.el 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 of the License, or +;; (at your option) any later version. + +;; ein-events.el 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 ein-events.el. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'eieio) + +(require 'ein-core) +(require 'ein-classes) +(require 'ein-log) + +(defun ein:events-new () + "Return a new event handler instance." + (make-instance 'ein:events)) + +(defun ein:events-trigger (events event-type &optional data) + "Trigger EVENT-TYPE and let event handler EVENTS handle that event." + (ein:log 'debug "Event: %S" event-type) + (aif (gethash event-type (slot-value events 'callbacks)) + (mapc (lambda (cb-arg) (ein:funcall-packed cb-arg data)) it) + (ein:log 'info "Unknown event: %S" event-type))) + + +(cl-defmethod ein:events-on ((events ein:events) event-type + callback &optional arg) + "Set event trigger hook. + +When EVENT-TYPE is triggered on the event handler EVENTS, +CALLBACK is called. CALLBACK must take two arguments: +ARG as the first argument and DATA, which is passed via +`ein:events-trigger', as the second." + (cl-assert (symbolp event-type) t "%s not symbol" event-type) + (let* ((table (slot-value events 'callbacks)) + (cbs (gethash event-type table))) + (push (cons callback arg) cbs) + (puthash event-type cbs table))) + + +(provide 'ein-events) + +;;; ein-events.el ends here diff --git a/lisp/ein/ein-file.el b/lisp/ein/ein-file.el new file mode 100644 index 00000000..6c470692 --- /dev/null +++ b/lisp/ein/ein-file.el @@ -0,0 +1,63 @@ +;;; ein-file.el --- Editing files downloaded from jupyter -*- lexical-binding:t -*- + +;; Copyright (C) 2017- John M. Miller + +;; Authors: Takafumi Arakaki +;; John M. Miller + +;; This file is NOT part of GNU Emacs. + +;; ein-file.el 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 of the License, or +;; (at your option) any later version. + +;; ein-file.el 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 ein-notebooklist.el. If not, see . + +;;; Commentary: + +(defvar *ein:file-buffername-template* "'/ein:%s:%s") +(ein:deflocal ein:content-file-buffer--content nil) + +;; (push '("^ein:.*" . ein:content-file-handler) +;; file-name-handler-alist) + +(defun ein:file-buffer-name (urlport path) + (format *ein:file-buffername-template* + urlport + path)) + +(defun ein:file-open (url-or-port path) + (interactive (ein:notebooklist-parse-nbpath (ein:notebooklist-ask-path "file"))) + (ein:content-query-contents url-or-port path #'ein:file-open-finish nil)) + +(defun ein:file-open-finish (content) + (with-current-buffer (get-buffer-create (ein:file-buffer-name (ein:$content-url-or-port content) + (ein:$content-path content))) + (setq ein:content-file-buffer--content content) + (let ((raw-content (ein:$content-raw-content content))) + (if (eq system-type 'windows-nt) + (insert (decode-coding-string raw-content 'utf-8)) + (insert raw-content))) + (set-visited-file-name (buffer-name)) + (set-auto-mode) + (add-hook 'write-contents-functions 'ein:content-file-save nil t) ;; FIXME Brittle, will not work + ;; if user changes major mode. + (ein:log 'verbose "Opened file %s" (ein:$content-name content)) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (pop-to-buffer (buffer-name)))) + +(defun ein:content-file-save () + (setf (ein:$content-raw-content ein:content-file-buffer--content) (buffer-string)) + (ein:content-save ein:content-file-buffer--content) + (set-buffer-modified-p nil) + t) + +(provide 'ein-file) diff --git a/lisp/ein/ein-gat.el b/lisp/ein/ein-gat.el new file mode 100644 index 00000000..d761ce50 --- /dev/null +++ b/lisp/ein/ein-gat.el @@ -0,0 +1,729 @@ +;;; ein-gat.el --- hooks to gat -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 The Authors + +;; Authors: dickmao + +;; This file is NOT part of GNU Emacs. + +;; ein-gat.el 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 of the License, or +;; (at your option) any later version. + +;; ein-gat.el 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 ein-gat.el. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'compile) +(require 'seq) +(require 'magit-process nil t) +(autoload 'ein:jupyter-running-notebook-directory "ein-jupyter") + +;; (declare-function magit--process-coding-system "magit-process") +;; (declare-function magit-call-process "magit-process") +;; (declare-function magit-start-process "magit-process") +;; (declare-function magit-process-sentinel "magit-process") + +(defconst ein:gat-status-cd 7 "gat exits 7 if requiring a change directory.") + +(defcustom ein:gat-python-command (if (equal system-type 'windows-nt) + (or (executable-find "py") + (executable-find "pythonw") + "python") + "python") + "Python executable name." + :type (append '(choice) + (let (result) + (dolist (py '("python" "python3" "pythonw" "py") result) + (setq result (append result `((const :tag ,py ,py)))))) + '((string :tag "Other"))) + :group 'ein) + +(defsubst ein:gat-shell-command (command) + (string-trim (shell-command-to-string (concat "2>/dev/null " command)))) + +(defcustom ein:gat-version + (ein:gat-shell-command "gat --project - --region - --zone - version") + "Currently, aws or gce." + :type 'string + :group 'ein) + +(defconst ein:gat-required-version "0.0.4-pre") + +(defvar ein:gat-machine-history nil + "History of user entered machine type.") + +(defcustom ein:gat-vendor + (ein:gat-shell-command "gat --project - --region - --zone - vendor") + "Currently, aws or gce." + :type '(choice (const :tag "aws" "aws") (const :tag "gce" "gce")) + :group 'ein + :set (lambda (symbol value) + (setq ein:gat-machine-history nil) + (set-default symbol value))) + +(defcustom ein:gat-gce-zone (ein:gat-shell-command "gcloud config get-value compute/zone") + "gcloud project zone." + :type 'string + :group 'ein) + +(defcustom ein:gat-gce-region (ein:gat-shell-command "gcloud config get-value compute/region") + "gcloud project region." + :type 'string + :group 'ein) + +(defcustom ein:gat-aws-region (ein:gat-shell-command "aws configure get region") + "gcloud project region." + :type 'string + :group 'ein) + +(defcustom ein:gat-gce-project (ein:gat-shell-command "gcloud config get-value core/project") + "gcloud project id." + :type 'string + :group 'ein) + +(defcustom ein:gat-aws-machine-types (split-string (ein:gat-shell-command "aws ec2 describe-instance-type-offerings --location-type=region --page-size=1000 --filter Name=location,Values=us-east-2 --query 'sort_by(InstanceTypeOfferings, &InstanceType)[].InstanceType' --output text")) + "gcloud machine types." + :type '(repeat string) + :group 'ein) + +(defcustom ein:gat-gce-machine-types (split-string (ein:gat-shell-command (format "gcloud compute machine-types list --filter=\"zone:%s\" --format=\"value[terminator=' '](name)\"" ein:gat-gce-zone))) + "gcloud machine types." + :type '(repeat string) + :group 'ein) + +;; https://accounts.google.com/o/oauth2/auth?client_id=[client-id]&redirect_uri=urn:ietf:wg:oauth:2.0:oob&scope=https://www.googleapis.com/auth/compute&response_type=code +;; curl -d code=[page-code] -d client_id=[client-id] -d client_secret=[client-secret] -d redirect_uri=urn:ietf:wg:oauth:2.0:oob -d grant_type=authorization_code https://accounts.google.com/o/oauth2/token +;; curl -sLk -H "Authorization: Bearer [access-token]" https://compute.googleapis.com/compute/v1/projects/[project-id]/zones/[zone-id]/acceleratorTypes | jq -r -c '.items[].selfLink' +(defcustom ein:gat-gpu-types (split-string "nvidia-tesla-t4 nvidia-tesla-v100") + "Gat gpu types." + :type '(repeat string) + :group 'ein) + +(defcustom ein:gat-base-images '("dickmao/tensorflow-gpu" + "dickmao/scipy-gpu" + "dickmao/pytorch-gpu") + "Known https://hub.docker.com/u/jupyter images." + :type '(repeat (string :tag "FROM-appropriate docker image")) + :group 'ein) + +(defvar ein:gat-previous-worktree nil) + +(defvar ein:gat-urls nil) + +(defconst ein:gat-master-worktree "master") + +(defvar ein:gat-current-worktree ein:gat-master-worktree) + +(defvar ein:gat-disksizegb-history '("default") + "History of user entered disk size.") + +(defvar ein:gat-gpus-history '("0") + "History of user entered gpu count.") + +(defvar ein:gat-gpu-type-history nil + "History of user entered gpu types.") + +(defvar ein:gat-keyname-history nil + "History of user entered aws ssh keyname.") + +(defvar ein:gat-preemptible-history nil + "History of preemptible opt-in.") + +(defun ein:gat-where-am-i (&optional print-message) + (interactive "p") + (let ((from-end (cl-search "/.gat" default-directory :from-end))) + (cond ((and (string= major-mode "magit-process-mode") + (string-prefix-p "ein-gat:" (buffer-name))) + (aprog1 default-directory + (when print-message + (message it)))) + ((string= major-mode "ein:ipynb-mode") + (aprog1 (directory-file-name (file-name-directory (buffer-file-name))) + (when print-message + (message it)))) + ((file-directory-p + (concat (file-name-as-directory default-directory) ".gat")) + (aprog1 default-directory + (when print-message + (message it)))) + (from-end + (aprog1 (file-name-as-directory + (cl-subseq default-directory 0 from-end)) + (when print-message + (message it)))) + (t + (if-let ((notebook-dir (ein:jupyter-running-notebook-directory)) + (notebook (ein:get-notebook)) + (where (directory-file-name + (concat (file-name-as-directory notebook-dir) + (file-name-directory (ein:$notebook-notebook-path notebook)))))) + (aprog1 where + (when print-message + (message it))) + (prog1 nil + (when print-message + (message "nowhere")))))))) + +(cl-defun ein:gat-jupyter-login (ipynb-name notebook-dir callback &rest args &key public-ip-address) + (if public-ip-address + (let ((url-or-port (ein:url (format "http://%s:8888" public-ip-address)))) + (setf (alist-get (intern url-or-port) ein:gat-urls) notebook-dir) + (ein:login url-or-port + (lambda (buffer url-or-port) + (pop-to-buffer buffer) + (ein:notebook-open url-or-port ipynb-name nil callback)))) + (ein:log 'error "ein:gat-jupyter-login: no public ip address"))) + +(defun ein:gat-process-filter (proc string) + "Copied `magit-process-filter' with added wrinkle of `ansi-color'. +Advising `insert' in `magit-process-filter' is a little sus, and +moreover, how would I avoid messing `magit-process-filter' of +other processes?" + (with-current-buffer (process-buffer proc) + (let ((inhibit-read-only t)) + (goto-char (process-mark proc)) + ;; Find last ^M in string. If one was found, ignore + ;; everything before it and delete the current line. + (when-let ((ret-pos (cl-position ?\r string :from-end t))) + (cl-callf substring string (1+ ret-pos)) + (delete-region (line-beginning-position) (point))) + (insert (propertize (ansi-color-filter-apply string) 'magit-section + (process-get proc 'section))) + (set-marker (process-mark proc) (point))))) + +;; (defvar magit-process-popup-time) +;; (defvar inhibit-magit-refresh) +;; (defvar magit-process-raise-error) +;; (defvar magit-process-display-mode-line-error) +(cl-defun ein:gat-chain (buffer callback exec &rest args &key public-ip-address notebook-dir &allow-other-keys) + (declare (indent 0)) + (let* ((default-directory (or notebook-dir (ein:gat-where-am-i))) + (default-process-coding-system (magit--process-coding-system)) + (magit-inhibit-refresh t) + (_ (awhen (getenv "GAT_APPLICATION_CREDENTIALS") + (push (concat "GOOGLE_APPLICATION_CREDENTIALS=" it) process-environment))) + (activate-with-editor-mode + (when (string= (car exec) with-editor-emacsclient-executable) + (lambda () (when (string= (buffer-name) (car (last exec))) + (with-editor-mode 1))))) + (process (let ((magit-buffer-name-format "%xein-gat%v: %t%x")) + (apply #'magit-start-process exec)))) + (when activate-with-editor-mode + (add-hook 'find-file-hook activate-with-editor-mode)) + ;; (with-current-buffer (process-buffer process) + ;; (special-mode)) + (with-editor-set-process-filter process #'ein:gat-process-filter) + (set-process-sentinel + process + (lambda (proc event) + (let* ((gat-status (process-exit-status proc)) + (process-buf (process-buffer proc)) + (section (process-get proc 'section)) + (gat-status-cd-p (= gat-status ein:gat-status-cd)) + worktree-dir new-public-ip-address) + (when activate-with-editor-mode + (remove-hook 'find-file-hook activate-with-editor-mode)) + (let ((magit-process-display-mode-line-error + (if gat-status-cd-p nil magit-process-display-mode-line-error)) + (magit-process-raise-error + (if gat-status-cd-p nil magit-process-raise-error)) + (short-circuit (lambda (&rest _args) (when gat-status-cd-p 0)))) + (add-function :before-until (symbol-function 'process-exit-status) + short-circuit) + (unwind-protect + (magit-process-sentinel proc event) + (remove-function (symbol-function 'process-exit-status) short-circuit))) + (cond + ((or (zerop gat-status) gat-status-cd-p) + (alet (and (bufferp process-buf) + (with-current-buffer process-buf + (when (integer-or-marker-p (oref section content)) + (buffer-substring-no-properties (oref section content) + (oref section end))))) + (when it + (when gat-status-cd-p + (setq worktree-dir (when (string-match "^cd\\s-+\\(\\S-+\\)" it) + (string-trim (match-string 1 it))))) + (when-let ((last-line (car (last (split-string (string-trim it) "\n"))))) + (setq new-public-ip-address + (when (string-match "^\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" last-line) + (string-trim (match-string 1 last-line)))))) + (when callback + (when (buffer-live-p buffer) + (set-buffer buffer)) + (let ((magit-process-popup-time 0)) + (apply callback + (append + (when worktree-dir + `(:worktree-dir ,worktree-dir)) + (when-let ((address (or new-public-ip-address + public-ip-address))) + `(:public-ip-address ,address)))))))) + (t + (ein:log 'error "ein:gat-chain: %s exited %s" + (car exec) (process-exit-status proc))))))) + process)) + +(defun ein:gat--path (archepath worktree-dir) + "Form relative path from ARCHEPATH root, WORKTREE-DIR subroot, ARCHEPATH leaf. + +With WORKTREE-DIR of 3/4/1/2/.gat/fantab, +1/2/eager.ipynb -> 1/2/.gat/fantab/eager.ipynb +1/2/.gat/fubar/subdir/eager.ipynb -> 1/2/.gat/fantab/subdir/eager.ipynb + +With WORKTREE-DIR of /home/dick/gat/test-repo2 +.gat/getout/eager.ipynb -> eager.ipynb +" + (when-let ((root (directory-file-name (or (awhen (cl-search ".gat/" archepath :from-end) + (cl-subseq archepath 0 it)) + (file-name-directory archepath) + "")))) + (if (zerop (length root)) + (concat (replace-regexp-in-string + "^\\./" "" + (file-name-as-directory + (cl-subseq worktree-dir + (or (cl-search ".gat/" worktree-dir :from-end) + (length worktree-dir))))) + (file-name-nondirectory archepath)) + (concat (file-name-as-directory + (cl-subseq worktree-dir + (cl-search root worktree-dir :from-end))) + (or (awhen (string-match "\\(\\.gat/[^/]+/\\)" archepath) + (cl-subseq archepath (+ it (length (match-string 1 archepath))))) + (file-name-nondirectory archepath)))))) + +(defun ein:gat-zone () + (interactive) + (cl-case (intern ein:gat-vendor) + (gce ein:gat-gce-zone) + (otherwise "-"))) + +(defun ein:gat-region () + (interactive) + (cl-case (intern ein:gat-vendor) + (aws ein:gat-aws-region) + (gce ein:gat-gce-region) + (otherwise (or ein:gat-aws-region ein:gat-gce-region)))) + +(defun ein:gat-project () + (interactive) + (cl-case (intern ein:gat-vendor) + (gce ein:gat-gce-project) + (otherwise "-"))) + +(defun ein:gat-machine-types () + (interactive) + (cl-case (intern ein:gat-vendor) + (aws ein:gat-aws-machine-types) + (gce ein:gat-gce-machine-types) + (otherwise (or ein:gat-aws-machine-types ein:gat-gce-machine-types)))) + +(defsubst ein:gat-need-upgrade () + (version-list-< (version-to-list ein:gat-version) + (version-to-list ein:gat-required-version))) + +(defmacro ein:gat-install-gat (&rest body) + `(if (and (executable-find "gat") + (not (ein:gat-need-upgrade))) + (progn ,@body) + (if (zerop (length (ein:gat-region))) + (ein:log 'error "ein:gat-install-gat: no cloud utilities detected") + (ein:log 'info "ein:gat-install-gat: %s gat..." + (if (executable-find "gat") "Upgrading" "Installing")) + (let* ((orig-buf (current-buffer)) + (bufname "*gat-install*") + (dir (make-temp-file "gat-install" t)) + (commands `(,(format "cd %s" dir) + ,(format "git clone --depth=1 --single-branch --branch=%s https://github.com/dickmao/gat.git" (if noninteractive "dev" ein:gat-required-version)) + "make -C gat install")) + (compile (format "bash -ex -c '%s'" (mapconcat #'identity commands "; "))) + (callback (lambda (_buf msg) + (when (cl-search "finished" msg) + (with-current-buffer orig-buf + (custom-set-default + 'ein:gat-version + (ein:gat-shell-command + "gat --project - --region - --zone - version")) + ,@body))))) + (let ((compilation-scroll-output t)) + (compilation-start compile nil (lambda (&rest _args) bufname))) + (with-current-buffer bufname + (add-hook 'compilation-finish-functions callback nil t)))))) + +(defun ein:gat-edit (&optional _refresh) + (interactive "P") + (ein:gat-install-gat + (if-let ((default-directory (ein:gat-where-am-i)) + (gat-chain-args `("gat" nil "--project" ,(ein:gat-project) + "--region" ,(ein:gat-region) "--zone" ,(ein:gat-zone)))) + (if (special-variable-p 'magit-process-popup-time) + (let ((magit-process-popup-time -1) + (notebook (ein:get-notebook))) + (ein:gat-chain + (current-buffer) + (cl-function + (lambda (&rest args &key worktree-dir &allow-other-keys) + (if notebook + (ein:notebook-open + (ein:$notebook-url-or-port notebook) + (ein:gat--path (ein:$notebook-notebook-path notebook) + worktree-dir) + (ein:$notebook-kernelspec notebook)) + (cd worktree-dir)))) + (append gat-chain-args + (list "edit" + (alet (ein:gat-elicit-worktree t) + (setq ein:gat-previous-worktree ein:gat-current-worktree) + (setq ein:gat-current-worktree it)))))) + (error "ein:gat-create: magit not installed")) + (message "ein:gat-edit: not a notebook buffer")))) + +;;;###autoload +(defun ein:gat-create (&optional _refresh) + (interactive "P") + (ein:gat-install-gat + (if-let ((default-directory (ein:gat-where-am-i)) + (notebook (ein:get-notebook)) + (gat-chain-args `("gat" nil "--project" ,(ein:gat-project) + "--region" ,(ein:gat-region) "--zone" " -"))) + (if (special-variable-p 'magit-process-popup-time) + (let ((magit-process-popup-time 0)) + (ein:gat-chain + (current-buffer) + (cl-function + (lambda (&rest args &key worktree-dir &allow-other-keys) + (ein:notebook-open + (ein:$notebook-url-or-port notebook) + (ein:gat--path (ein:$notebook-notebook-path notebook) + worktree-dir) + (ein:$notebook-kernelspec notebook)))) + (append gat-chain-args + (list "create" + (alet (ein:gat-elicit-worktree nil) + (setq ein:gat-previous-worktree ein:gat-current-worktree) + (setq ein:gat-current-worktree it)))))) + (error "ein:gat-create: magit not installed")) + (message "ein:gat-create: not a notebook buffer")))) + +;;;###autoload +(defun ein:gat-run-local-batch (&optional refresh) + (interactive "P") + (ein:gat--run nil t refresh)) + +;;;###autoload +(defun ein:gat-run-local (&optional refresh) + (interactive "P") + (ein:gat--run nil nil refresh)) + +;;;###autoload +(defun ein:gat-run-remote-batch (&optional refresh) + (interactive "P") + (ein:gat--run t t refresh)) + +;;;###autoload +(defun ein:gat-run-remote (&optional refresh) + (interactive "P") + (ein:gat--run t nil refresh)) + +(defun ein:gat-hash-password (raw-password) + (let ((gat-hash-password-python + (format "%s - <= answer 0) + finally return answer)) + +(defun ein:gat-elicit-worktree (extant) + (let ((already (split-string + (ein:gat-shell-command + (format "gat --project %s --region %s --zone %s list" + (ein:gat-project) (ein:gat-region) (ein:gat-zone)))))) + (if extant + (ein:completing-read + "Experiment: " already nil t nil nil + ein:gat-previous-worktree) + (read-string "New experiment: ")))) + +(defun ein:gat-elicit-disksizegb () + "Return nil for default [currently max(8, 6 + image size)]." + (interactive) + (cl-loop with answer + do (setq answer (ein:completing-read + (format "Disk GiB%s: " + (format " [%s]" + (or (car ein:gat-disksizegb-history) + "default"))) + '("default") nil nil nil + 'ein:gat-disksizegb-history + (car ein:gat-disksizegb-history))) + if (string= answer "default") + do (setq answer nil) + else + do (setq answer (string-to-number answer)) + end + until (or (null answer) (> answer 0)) + finally return answer)) + +(defun ein:gat-dockerfiles-state () + "Return cons of (pre-Dockerfile . post-Dockerfile). +Pre-Dockerfile is Dockerfile. if extant, else Dockerfile." + (-if-let* ((default-directory (ein:gat-where-am-i)) + (notebook-name (cond ((string= major-mode "ein:ipynb-mode") + (file-name-nondirectory (buffer-file-name))) + (t + (aand (ein:get-notebook) (ein:$notebook-notebook-name it))))) + (dockers (directory-files (file-name-as-directory default-directory) + nil "^Dockerfile"))) + (let* ((pre-docker-p (lambda (f) (or (string= f (format "Dockerfile.%s" (file-name-sans-extension notebook-name))) + (string= f "Dockerfile")))) + (pre-docker (seq-find pre-docker-p (sort (cl-copy-list dockers) #'string>))) + (post-docker-p (lambda (f) (string= f (format "%s.gat" pre-docker)))) + (post-docker (and (stringp pre-docker) (seq-find post-docker-p (sort (cl-copy-list dockers) #'string>))))) + `(,pre-docker . ,post-docker)) + '(nil))) + +(provide 'ein-gat) diff --git a/lisp/ein/ein-ipdb.el b/lisp/ein/ein-ipdb.el new file mode 100644 index 00000000..cef38aa9 --- /dev/null +++ b/lisp/ein/ein-ipdb.el @@ -0,0 +1,126 @@ +;;; ein-ipdb.el --- Support ipython debugger (ipdb) -*- lexical-binding:t -*- + +;; Copyright (C) 2015 - John Miller + +;; Author: John Miller + +;; This file is NOT part of GNU Emacs. + +;; ein-ipdb.el 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 of the License, or +;; (at your option) any later version. + +;; ein-ipdb.el 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 ein-kernel.el. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'cl-lib) + +(defvar *ein:ipdb-sessions* (make-hash-table) + "Kernel Id to ein:$ipdb-session.") + +(declare-function ein:kernel--get-msg "ein-kernel") + +(cl-defstruct ein:$ipdb-session buffer kernel prompt notebook) + +(defun ein:ipdb-get-session (kernel) + (gethash (ein:$kernel-kernel-id kernel) *ein:ipdb-sessions*)) + +(defun ein:ipdb-start-session (kernel prompt notebook) + (let* ((buffer (get-buffer-create + (format "*ipdb: %s*" + (ein:$kernel-kernel-id kernel)))) + (session (make-ein:$ipdb-session :buffer buffer + :kernel kernel + :prompt prompt + :notebook notebook))) + (puthash (ein:$kernel-kernel-id kernel) session *ein:ipdb-sessions*) + (with-current-buffer buffer + (kill-all-local-variables) + (add-hook 'kill-buffer-hook + (apply-partially #'ein:ipdb-quit-session session) nil t) + (ein:ipdb-mode) + (setq comint-use-prompt-regexp t) + (setq comint-prompt-regexp (concat "^" (regexp-quote prompt))) + (setq comint-input-sender (apply-partially #'ein:ipdb-input-sender session)) + (setq comint-prompt-read-only t) + (set (make-local-variable 'comint-output-filter-functions) + '(ansi-color-process-output)) + (let ((proc (start-process "ein:ipdb" buffer "cat")) + (sentinel (lambda (process _event) + (when (memq (process-status process) '(exit signal)) + (ein:ipdb-cleanup-session session))))) + (set-process-query-on-exit-flag proc nil) + (set-process-sentinel proc sentinel) + (set-marker (process-mark proc) (point)) + (comint-output-filter proc (concat "\n" (ein:$ipdb-session-prompt session))))) + (pop-to-buffer buffer))) + +(defun ein:ipdb-quit-session (session) + (let* ((kernel (ein:$ipdb-session-kernel session)) + (msg (ein:kernel--get-msg kernel "input_reply" (list :value "exit")))) + (ein:websocket-send-stdin-channel kernel msg))) + +(defun ein:ipdb-stop-session (session) + (awhen (get-buffer-process (ein:$ipdb-session-buffer session)) + (when (process-live-p it) + (kill-process it)))) + +(defun ein:ipdb-cleanup-session (session) + (let ((kernel (ein:$ipdb-session-kernel session)) + (notebook (ein:$ipdb-session-notebook session)) + (buffer (ein:$ipdb-session-buffer session))) + (remhash (ein:$kernel-kernel-id kernel) *ein:ipdb-sessions*) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (insert "\nFinished\n"))) + (awhen (ein:notebook-buffer notebook) + (when (buffer-live-p it) + (pop-to-buffer it))))) + +(defun ein:ipdb--handle-iopub-reply (kernel packet) + (cl-destructuring-bind + (&key content &allow-other-keys) + (ein:json-read-from-string packet) + (-when-let* ((session (ein:ipdb-get-session kernel)) + (buffer (ein:$ipdb-session-buffer session)) + (prompt (ein:$ipdb-session-prompt session)) + (proc (get-buffer-process buffer)) + (proc-live-p (process-live-p proc))) + (let ((text (plist-get content :text)) + (ename (plist-get content :ename))) + (when (stringp text) + (comint-output-filter proc text)) + (if (and (stringp ename) (string-match-p "bdbquit" ename)) + (ein:ipdb-stop-session session) + (comint-output-filter proc prompt)))))) + +(defun ein:ipdb-input-sender (session proc input) + ;; in case of eof, comint-input-sender-no-newline is t + (if comint-input-sender-no-newline + (ein:ipdb-quit-session session) + (when (process-live-p proc) + (with-current-buffer (process-buffer proc) + (let* ((buffer-read-only nil) + (kernel (ein:$ipdb-session-kernel session)) + (content (list :value input)) + (msg (ein:kernel--get-msg kernel "input_reply" content))) + (ein:websocket-send-stdin-channel kernel msg)))))) + +(define-derived-mode ein:ipdb-mode comint-mode "ein:debugger" + "Run an EIN debug session. + +\\") + +(provide 'ein-ipdb) diff --git a/lisp/ein/ein-ipynb-mode.el b/lisp/ein/ein-ipynb-mode.el new file mode 100644 index 00000000..f39a0248 --- /dev/null +++ b/lisp/ein/ein-ipynb-mode.el @@ -0,0 +1,81 @@ +;;; ein-ipynb-mode.el --- A simple mode for ipynb file -*- lexical-binding:t -*- + +;; Copyright (C) 2012 Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; ein-ipynb-mode.el 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 of the License, or +;; (at your option) any later version. + +;; ein-ipynb-mode.el 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 ein-ipynb-mode.el. +;; If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ein-process) +(require 'js) + +;;;###autoload +(define-derived-mode ein:ipynb-mode js-mode "ein:ipynb" + "A simple mode for ipynb file. + +\\{ein:ipynb-mode-map} +" + :group 'ein + :after-hook + (let* ((filename (file-name-nondirectory buffer-file-truename)) + (remote-filename (concat (file-name-as-directory "run-remote") filename))) + ;; fragile hack to refresh s3fuse + (call-process "cat" nil nil nil remote-filename) + (when (and (file-readable-p remote-filename) + (file-newer-than-file-p remote-filename filename) + (prog1 + (let ((inhibit-quit t)) + (prog1 + (with-local-quit + (y-or-n-p "Corresponding run-remote is newer. Replace? (will first backup) ")) + (setq quit-flag nil))) + (message ""))) + (if-let ((make-backup-files t) + (where-to (funcall make-backup-file-name-function buffer-file-name))) + (let* (backup-inhibited + (orig-hooks find-file-hook) + (reassure (lambda () + (message "Backed up to %s" where-to) + (setq find-file-hook orig-hooks)))) + (backup-buffer) + (copy-file remote-filename filename t t) + (add-hook 'find-file-hook reassure nil) + (find-file-noselect filename t)) + (message "Backup failed. Not replaced"))))) + +(let ((map ein:ipynb-mode-map)) + (set-keymap-parent map js-mode-map) + (define-key map "\C-c\C-z" 'ein:process-find-file-callback) + (define-key map "\C-c\C-o" 'ein:process-find-file-callback) + (define-key map "\C-c\C-r" 'ein:gat-run-remote) + (easy-menu-define ein:ipynb-menu map "EIN IPyNB Mode Menu" + `("EIN IPyNB File" + ,@(ein:generate-menu + '(("Open notebook" ein:process-find-file-callback)))))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.ipynb\\'" . ein:ipynb-mode)) + +(provide 'ein-ipynb-mode) + +;;; ein-ipynb-mode.el ends here diff --git a/lisp/ein/ein-jupyter.el b/lisp/ein/ein-jupyter.el new file mode 100644 index 00000000..a5758e08 --- /dev/null +++ b/lisp/ein/ein-jupyter.el @@ -0,0 +1,435 @@ +;;; ein-jupyter.el --- Manage the jupyter notebook server -*- lexical-binding:t -*- + +;; Copyright (C) 2017 John M. Miller + +;; Authors: John M. Miller + +;; This file is NOT part of GNU Emacs. + +;; ein-jupyter.el 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 of the License, or +;; (at your option) any later version. + +;; ein-jupyter.el 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 ein-jupyter.el. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ein-core) +(require 'ein-notebooklist) +(require 'ein-dev) +(require 'exec-path-from-shell nil t) +(autoload 'ein:gat-chain "ein-gat") +(autoload 'ein:gat-project "ein-gat") +(autoload 'ein:gat-region "ein-gat") +(autoload 'ein:gat-zone "ein-gat") + +(defcustom ein:jupyter-use-containers nil + "Take EIN in a different direcsh." + :group 'ein + :type 'boolean) + +(defcustom ein:jupyter-docker-image "jupyter/datascience-notebook" + "Docker pull whichever jupyter image you prefer. This defaults to +the `jupyter docker stacks` on hub.docker.com. + +Optionally append ':tag', e.g., ':latest' in the customary way." + :group 'ein + :type 'string) + +(defcustom ein:jupyter-docker-mount-point "/home/jovyan/ipynb" + "Where in docker image to mount `ein:jupyter-default-notebook-directory'." + :group 'ein + :type 'string) + +(defcustom ein:jupyter-docker-additional-switches "-e JUPYTER_ENABLE_LAB=no --rm" + "Additional options to the `docker run` call. + +Note some options like '-v' and '-network' are imposed by EIN." + :group 'ein + :type 'string) + +(defcustom ein:jupyter-cannot-find-jupyter nil + "Use purcell's `exec-path-from-shell'" + :group 'ein + :type 'boolean) + +(defcustom ein:jupyter-server-command "jupyter" + "The default command to start a jupyter notebook server. +Changing this to `jupyter-notebook' requires customizing +`ein:jupyter-server-use-subcommand' to nil." + :group 'ein + :type 'string + :set-after '(ein:jupyter-cannot-find-jupyter) + :set (lambda (symbol value) + (set-default symbol value) + (when (and (featurep 'exec-path-from-shell) + ein:jupyter-cannot-find-jupyter + (memq window-system '(mac ns x))) + (eval `(let (,@(when (boundp 'exec-path-from-shell-check-startup-files) + (list 'exec-path-from-shell-check-startup-files))) + (exec-path-from-shell-initialize)))))) + +(defcustom ein:jupyter-default-server-command ein:jupyter-server-command + "Obsolete alias for `ein:jupyter-server-command'" + :group 'ein + :type 'string + :set-after '(ein:jupyter-server-command) + :set (lambda (symbol value) + (set-default symbol value) + (set-default 'ein:jupyter-server-command value))) + +;;;###autoload +(defcustom ein:jupyter-server-use-subcommand "notebook" + "For JupyterLab 3.0+ change the subcommand to \"server\". +Users of \"jupyter-notebook\" (as opposed to \"jupyter notebook\") select Omit." + :group 'ein + :type '(choice (string :tag "Subcommand" "notebook") + (const :tag "Omit" nil))) + +(defcustom ein:jupyter-server-args '("--no-browser") + "Add any additional command line options you wish to include +with the call to the jupyter notebook." + :group 'ein + :type '(repeat string)) + +(defcustom ein:jupyter-default-notebook-directory nil + "Default location of ipynb files." + :group 'ein + :type 'directory) + +(defcustom ein:jupyter-default-kernel 'first-alphabetically + "With which of ${XDG_DATA_HOME}/jupyter/kernels to create new notebooks." + :group 'ein + :type (append + '(choice (other :tag "First alphabetically" first-alphabetically)) + (condition-case err + (mapcar + (lambda (x) `(const :tag ,(cdr x) ,(car x))) + (cl-loop + for (k . spec) in + (alist-get + 'kernelspecs + (let ((json-object-type 'alist)) + (json-read-from-string ;; intentionally not ein:json-read-from-string + (shell-command-to-string + (format "2>/dev/null %s kernelspec list --json" + ein:jupyter-server-command))))) + collect `(,k . ,(alist-get 'display_name (alist-get 'spec spec))))) + (error (ein:log 'warn "ein:jupyter-default-kernel: %s" err) + '((string :tag "Ask")))))) + +(defconst *ein:jupyter-server-process-name* "ein server") +(defconst *ein:jupyter-server-buffer-name* + (format "*%s*" *ein:jupyter-server-process-name*)) +(defvar-local ein:jupyter-server-notebook-directory nil + "Keep track of prevailing --notebook-dir argument.") + +(defun ein:jupyter-running-notebook-directory () + (when (ein:jupyter-server-process) + (buffer-local-value 'ein:jupyter-server-notebook-directory + (get-buffer *ein:jupyter-server-buffer-name*)))) + +(defun ein:jupyter-get-default-kernel (kernels) + (cond (ein:%notebooklist-new-kernel% + (ein:$kernelspec-name ein:%notebooklist-new-kernel%)) + ((eq ein:jupyter-default-kernel 'first-alphabetically) + (car (car kernels))) + ((stringp ein:jupyter-default-kernel) + ein:jupyter-default-kernel) + (t + (symbol-name ein:jupyter-default-kernel)))) + +(defun ein:jupyter-process-lines (_url-or-port command &rest args) + "If URL-OR-PORT registered as a k8s url, preface COMMAND ARGS +with `kubectl exec'." + (if-let ((found (executable-find command))) + (with-temp-buffer + (let ((status (apply #'call-process found nil t nil args))) + (if (zerop status) + (progn + (goto-char (point-min)) + (let (lines) + (while (not (eobp)) + (setq lines (cons (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)) + lines)) + (forward-line 1)) + (nreverse lines))) + (prog1 nil + (ein:log 'warn "ein:jupyter-process-lines: '%s %s' returned %s" + found (ein:join-str " " args) status))))) + (prog1 nil + (ein:log 'warn "ein:jupyter-process-lines: cannot find %s" command)))) + +(defsubst ein:jupyter-server-process () + "Return the emacs process object of our session." + (get-buffer-process (get-buffer *ein:jupyter-server-buffer-name*))) + +(defun ein:jupyter-server--run (buf user-cmd dir &optional args) + (get-buffer-create buf) + (let* ((cmd (if ein:jupyter-use-containers "docker" user-cmd)) + (vargs (cond (ein:jupyter-use-containers + (split-string + (format "run --network host -v %s:%s %s %s" + dir + ein:jupyter-docker-mount-point + ein:jupyter-docker-additional-switches + ein:jupyter-docker-image))) + (t + (append (split-string (or ein:jupyter-server-use-subcommand "")) + (when dir + (list (format "--notebook-dir=%s" + (convert-standard-filename dir)))) + args + (let ((copy (cl-copy-list ein:jupyter-server-args))) + (when (ein:debug-p) + (cl-pushnew "--debug" copy :test #'equal)) + copy))))) + (proc (apply #'start-process + *ein:jupyter-server-process-name* buf cmd vargs))) + (ein:log 'info "ein:jupyter-server--run: %s %s" cmd (ein:join-str " " vargs)) + (set-process-query-on-exit-flag proc nil) + proc)) + +(defun ein:jupyter-my-url-or-port () + (when-let ((my-pid (aand (ein:jupyter-server-process) (process-id it)))) + (catch 'done + (dolist (json (ein:jupyter-crib-running-servers)) + (cl-destructuring-bind (&key pid url &allow-other-keys) + json + (when (equal my-pid pid) + (throw 'done (ein:url url)))))))) + +(defun ein:jupyter-server-ready-p () + (when (ein:jupyter-server-process) + (with-current-buffer *ein:jupyter-server-buffer-name* + (save-excursion + (goto-char (point-max)) + (re-search-backward (format "Process %s" *ein:jupyter-server-process-name*) + nil "") ;; important if we start-stop-start + (re-search-forward + "\\([[:alnum:]]+\\) is\\( now\\)? running" + nil t))))) + +(defun ein:jupyter-server-login-and-open (url-or-port &optional callback) + "Log in and open a notebooklist buffer for a running jupyter notebook server. + +Determine if there is a running jupyter server (started via a +call to `ein:jupyter-server-start') and then try to guess if +token authentication is enabled. If a token is found use it to +generate a call to `ein:notebooklist-login' and once +authenticated open the notebooklist buffer via a call to +`ein:notebooklist-open'." + (if-let ((token (ein:notebooklist-token-or-password url-or-port))) + (ein:notebooklist-login url-or-port callback nil nil token) + (ein:log 'error "`(ein:notebooklist-token-or-password %s)` must return non-nil" + url-or-port))) + +(defsubst ein:set-process-sentinel (proc url-or-port) + "URL-OR-PORT might get redirected. +This is currently only the case for jupyterhub. Once login +handshake provides the new URL-OR-PORT, we set various state as +pertains our singleton jupyter server process here." + + ;; Would have used `add-function' if it didn't produce gv-ref warnings. + (set-process-sentinel + proc + (apply-partially (lambda (url-or-port* sentinel proc* event) + (aif sentinel (funcall it proc* event)) + (funcall #'ein:notebooklist-sentinel url-or-port* proc* event)) + url-or-port (process-sentinel proc)))) + +;;;###autoload +(defun ein:jupyter-crib-token (url-or-port) + "Shell out to jupyter for its credentials knowledge. Return list +of (PASSWORD TOKEN)." + (aif (cl-loop for line in + (apply #'ein:jupyter-process-lines url-or-port + ein:jupyter-server-command + (append + (split-string (or ein:jupyter-server-use-subcommand "")) + '("list" "--json"))) + with token0 + with password0 + when (cl-destructuring-bind + (&key password url token &allow-other-keys) + (ein:json-read-from-string line) + (prog1 (equal (ein:url url) url-or-port) + (setq password0 password) ;; t or :json-false + (setq token0 token))) + return (list password0 token0)) + it (list nil nil))) + +;;;###autoload +(defun ein:jupyter-crib-running-servers () + "Shell out to jupyter for running servers." + (cl-loop for line in + (apply #'ein:jupyter-process-lines nil + ein:jupyter-server-command + (append + (split-string (or ein:jupyter-server-use-subcommand "")) + '("list" "--json"))) + collecting (ein:json-read-from-string line))) + +;;;###autoload +(defun ein:jupyter-server-start (server-command + notebook-directory + &optional no-login-p login-callback port) + "Start SERVER-COMMAND with `--notebook-dir' NOTEBOOK-DIRECTORY. + +Login after connection established unless NO-LOGIN-P is set. +LOGIN-CALLBACK takes two arguments, the buffer created by +`ein:notebooklist-open--finish', and the url-or-port argument +of `ein:notebooklist-open*'. + +With \\[universal-argument] prefix arg, prompt the user for the +server command." + (interactive + (list (let ((default-command (executable-find ein:jupyter-server-command))) + (if (and (not ein:jupyter-use-containers) + (or current-prefix-arg (not default-command))) + (let (command result) + (while (not (setq + result + (executable-find + (setq + command + (read-string + (format + "%sServer command: " + (if command + (format "[%s not executable] " command) + "")) + nil nil ein:jupyter-server-command)))))) + result) + default-command)) + (let ((default-dir ein:jupyter-default-notebook-directory) + result) + (while (or (not result) (not (file-directory-p result))) + (setq result (read-directory-name + (format "%sNotebook directory: " + (if result + (format "[%s not a directory]" result) + "")) + default-dir default-dir t))) + result) + nil + (lambda (buffer _url-or-port) + (pop-to-buffer buffer)) + nil)) + (when (ein:jupyter-server-process) + (error "ein:jupyter-server-start: First `M-x ein:stop'")) + (let ((proc (ein:jupyter-server--run *ein:jupyter-server-buffer-name* + server-command + notebook-directory + (when (numberp port) + `("--port" ,(format "%s" port) + "--port-retries" "0"))))) + (cl-loop repeat 30 + until (ein:jupyter-server-ready-p) + do (sleep-for 0 500) + finally do + (if-let ((buffer (get-buffer *ein:jupyter-server-buffer-name*)) + (url-or-port (ein:jupyter-my-url-or-port))) + (with-current-buffer buffer + (setq ein:jupyter-server-notebook-directory + (convert-standard-filename notebook-directory)) + (add-hook 'kill-buffer-query-functions + (lambda () (or (not (ein:jupyter-server-process)) + (ein:jupyter-server-stop t url-or-port))) + nil t)) + (ein:log 'warn "Jupyter server failed to start, cancelling operation"))) + (when-let ((login-p (not no-login-p)) + (url-or-port (ein:jupyter-my-url-or-port))) + (unless login-callback + (setq login-callback #'ignore)) + (add-function :after (var login-callback) + (apply-partially (lambda (proc* _buffer url-or-port) + (ein:set-process-sentinel proc* url-or-port)) + proc)) + (ein:jupyter-server-login-and-open + url-or-port + login-callback)))) + +;;;###autoload +(defalias 'ein:run 'ein:jupyter-server-start) + +;;;###autoload +(defalias 'ein:stop 'ein:jupyter-server-stop) + +(defvar ein:gat-urls) +(defvar ein:gat-aws-region) +;;;###autoload +(defun ein:jupyter-server-stop (&optional ask-p url-or-port) + (interactive + (list t (awhen (ein:get-notebook) + (ein:$notebook-url-or-port it)))) + (let ((my-url-or-port (ein:jupyter-my-url-or-port)) + (all-p t)) + (dolist (url-or-port + (if url-or-port (list url-or-port) (ein:notebooklist-keys)) + (prog1 all-p + (when (and (null (ein:notebooklist-keys)) + (ein:shared-output-healthy-p)) + (kill-buffer (ein:shared-output-buffer))))) + (let* ((gat-dir (alist-get (intern url-or-port) + (awhen (bound-and-true-p ein:gat-urls) it))) + (my-p (string= url-or-port my-url-or-port)) + (close-p (or (not ask-p) + (prog1 (y-or-n-p (format "Close %s?" url-or-port)) + (message ""))))) + (if (not close-p) + (setq all-p nil) + (ein:notebook-close-notebooks + (lambda (notebook) + (string= url-or-port (ein:$notebook-url-or-port notebook))) + t) + (cl-loop repeat 10 + until (null (seq-some (lambda (proc) + (cl-search "request curl" + (process-name proc))) + (process-list))) + do (sleep-for 0 500)) + (cond (my-p + (-when-let* ((proc (ein:jupyter-server-process)) + (pid (process-id proc))) + (run-at-time 2 nil + (lambda () + (signal-process pid (if (eq system-type 'windows-nt) 9 15)))) + ;; NotebookPasswordApp::shutdown_server() also ignores req response. + (ein:query-singleton-ajax (ein:url url-or-port "api/shutdown") + :type "POST"))) + (gat-dir + (with-current-buffer (ein:notebooklist-get-buffer url-or-port) + (-when-let* ((gat-chain-args `("gat" nil + "--project" ,(ein:gat-project) + "--region" ,(ein:gat-region) + "--zone" ,(ein:gat-zone))) + (now (truncate (float-time))) + (gat-log-exec (append gat-chain-args + (list "log" "--after" (format "%s" now) + "--vendor" (aif (bound-and-true-p ein:gat-vendor) it "aws") + "--nextunit" "shutdown.service"))) + (magit-process-popup-time 0)) + (ein:gat-chain (current-buffer) nil gat-log-exec :notebook-dir gat-dir) + ;; NotebookPasswordApp::shutdown_server() also ignores req response. + (ein:query-singleton-ajax (ein:url url-or-port "api/shutdown") + :type "POST"))))) + ;; `ein:notebooklist-sentinel' frequently does not trigger + (ein:notebooklist-list-remove url-or-port) + (maphash (lambda (k _v) (when (equal (car k) url-or-port) + (remhash k *ein:notebook--pending-query*))) + *ein:notebook--pending-query*) + (kill-buffer (ein:notebooklist-get-buffer url-or-port))))))) + +(provide 'ein-jupyter) diff --git a/lisp/ein/ein-kernel.el b/lisp/ein/ein-kernel.el new file mode 100644 index 00000000..e0845b0a --- /dev/null +++ b/lisp/ein/ein-kernel.el @@ -0,0 +1,612 @@ +;;; ein-kernel.el --- Communicate with IPython notebook server -*- lexical-binding:t -*- + +;; Copyright (C) 2012- Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; ein-kernel.el 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 of the License, or +;; (at your option) any later version. + +;; ein-kernel.el 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 ein-kernel.el. If not, see . + +;;; Commentary: +;; `ein:kernel' is the proxy class of notebook server state. +;; It agglomerates both the "kernel" and "session" objects of server described here +;; https://github.com/jupyter/jupyter/wiki/Jupyter-Notebook-Server-API +;; It may have been better to keep them separate to allow parallel reasoning with +;; the notebook server, but that time is past. + +;;; Code: + +(require 'ansi-color) + +(require 'ein-core) +(require 'ein-classes) +(require 'ein-log) +(require 'ein-websocket) +(require 'ein-events) +(require 'ein-query) +(require 'ein-ipdb) + +(declare-function ein:notebook-get-opened-notebook "ein-notebook") +(declare-function ein:notebooklist-get-buffer "ein-notebooklist") +(declare-function ein:notebooklist-reload "ein-notebooklist") + +(defun ein:$kernel-session-url (kernel) + (concat "/api/sessions/" (ein:$kernel-session-id kernel))) + +;;;###autoload +(defalias 'ein:kernel-url-or-port 'ein:$kernel-url-or-port) + +;;;###autoload +(defalias 'ein:kernel-id 'ein:$kernel-kernel-id) + +(make-obsolete-variable 'ein:pre-kernel-execute-functions nil "0.17.0") +(make-obsolete-variable 'ein:on-shell-reply-functions nil "0.17.0") +(make-obsolete-variable 'ein:on-kernel-connect-functions nil "0.17.0") + +(defun ein:kernel-new (url-or-port path kernelspec base-url events &optional api-version) + (make-ein:$kernel + :url-or-port url-or-port + :path path + :kernelspec kernelspec + :events events + :api-version (or api-version 5) + :session-id (ein:utils-uuid) + :kernel-id nil + :websocket nil + :base-url base-url + :oinfo-cache (make-hash-table :test #'equal) + :username "username" + :msg-callbacks (make-hash-table :test 'equal))) + +(defun ein:kernel-del (kernel) + "Destructor for `ein:$kernel'." + (ein:kernel-disconnect kernel)) + +(defun ein:kernel--get-msg (kernel msg-type content) + (list + :header (list + :msg_id (ein:utils-uuid) + :username (ein:$kernel-username kernel) + :session (ein:$kernel-session-id kernel) + :version "5.0" + :date (format-time-string "%Y-%m-%dT%T" (current-time)) ; ISO 8601 timestamp + :msg_type msg-type) + :metadata (make-hash-table) + :content content + :parent_header (make-hash-table))) + +(cl-defun ein:kernel-session-p (kernel callback &optional iteration) + "Don't make any changes on the server side. CALLBACK with arity +2, kernel and a boolean whether session exists on server." + (unless iteration + (setq iteration 0)) + (let ((session-id (ein:$kernel-session-id kernel))) + (ein:query-singleton-ajax + (ein:url (ein:$kernel-url-or-port kernel) "api/sessions" session-id) + :type "GET" + :parser #'ein:json-read + :complete (apply-partially #'ein:kernel-session-p--complete session-id) + :success (apply-partially #'ein:kernel-session-p--success kernel session-id callback) + :error (apply-partially #'ein:kernel-session-p--error kernel callback iteration)))) + +(cl-defun ein:kernel-session-p--complete (_session-id + &key data response + &allow-other-keys + &aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data))) + (ein:log 'debug "ein:kernel-session-p--complete %s" resp-string)) + +(cl-defun ein:kernel-session-p--error (kernel callback iteration + &key error-thrown _symbol-status data + &allow-other-keys) + (if (ein:aand (plist-get data :message) (cl-search "not found" it)) + (when callback (funcall callback kernel nil)) + (let* ((max-tries 3) + (tries-left (1- (- max-tries iteration)))) + (ein:log 'verbose "ein:kernel-session-p--error [%s], %s tries left" + (car error-thrown) tries-left) + (if (> tries-left 0) + (ein:kernel-session-p kernel callback (1+ iteration)))))) + +(cl-defun ein:kernel-session-p--success (kernel session-id callback + &key data &allow-other-keys) + (let ((session-p (equal (plist-get data :id) session-id))) + (ein:log 'verbose "ein:kernel-session-p--success: session-id=%s session-p=%s" + session-id session-p) + (when callback (funcall callback kernel session-p)))) + +(cl-defun ein:kernel-restart-session (kernel) + "Server side delete of KERNEL session and subsequent restart with all new state" + (ein:kernel-delete-session + (lambda (kernel) + (ein:events-trigger (ein:$kernel-events kernel) 'status_restarting.Kernel) + (ein:kernel-retrieve-session kernel 0 + (lambda (kernel) + (ein:events-trigger (ein:$kernel-events kernel) + 'status_restarted.Kernel)))) + :kernel kernel)) + +(cl-defun ein:kernel-retrieve-session (kernel &optional iteration callback) + "Formerly ein:kernel-start, but that was a misnomer. + +The server 1. really starts a session (and an accompanying +kernel), and 2. may not even start a session if one exists for +the same path. + +If picking up from where we last left off, that is, we restart +emacs and reconnect to same server, jupyter will hand us back the +original, still running session. + +CALLBACK of arity 1, the kernel." +;; The server logic is here (could not find other documentation) +;; https://github.com/jupyter/notebook/blob/04a686dbaf9dfe553324a03cb9e6f778cf1e3da1/notebook/services/sessions/handlers.py#L56-L81 + (unless iteration + (setq iteration 0)) + (if (<= (ein:$kernel-api-version kernel) 2) + (error "Api %s unsupported" (ein:$kernel-api-version kernel)) + (let ((kernel-id (ein:$kernel-kernel-id kernel)) + (kernelspec (ein:$kernel-kernelspec kernel)) + (path (ein:$kernel-path kernel))) + (ein:query-singleton-ajax + (ein:url (ein:$kernel-url-or-port kernel) "api/sessions") + :type "POST" + :data (ein:json-encode + `((path . ,path) + (type . "notebook") + ,@(if kernelspec + `((kernel . + ((name . ,(ein:$kernelspec-name kernelspec)) + ,@(if kernel-id + `((id . ,kernel-id))))))))) + :parser #'ein:json-read + :complete (apply-partially #'ein:kernel-retrieve-session--complete kernel callback) + :success (apply-partially #'ein:kernel-retrieve-session--success kernel callback) + :error (apply-partially #'ein:kernel-retrieve-session--error kernel iteration callback))))) + +(cl-defun ein:kernel-retrieve-session--complete + (_kernel _callback + &key data response + &allow-other-keys + &aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data))) + (ein:log 'debug "ein:kernel-retrieve-session--complete %s" resp-string)) + +(cl-defun ein:kernel-retrieve-session--error + (kernel iteration callback + &key error-thrown _symbol-status &allow-other-keys) + (let* ((max-tries 3) + (tries-left (1- (- max-tries iteration)))) + (ein:log 'verbose "ein:kernel-retrieve-session--error [%s], %s tries left" + (car error-thrown) tries-left) + (sleep-for 0 (* (1+ iteration) 500)) + (if (> tries-left 0) + (ein:kernel-retrieve-session kernel (1+ iteration) callback)))) + +(cl-defun ein:kernel-retrieve-session--success (kernel callback &key data &allow-other-keys) + (let ((session-id (plist-get data :id))) + (if (plist-get data :kernel) + (setq data (plist-get data :kernel))) + (cl-destructuring-bind (&key id &allow-other-keys) data + (ein:log 'verbose "ein:kernel-retrieve-session--success: kernel-id=%s session-id=%s" + id session-id) + (setf (ein:$kernel-kernel-id kernel) id) + (setf (ein:$kernel-session-id kernel) session-id) + (setf (ein:$kernel-ws-url kernel) (ein:kernel--ws-url (ein:$kernel-url-or-port kernel))) + (setf (ein:$kernel-kernel-url kernel) + (concat (file-name-as-directory (ein:$kernel-base-url kernel)) id))) + (ein:kernel-start-websocket kernel callback))) + +(defun ein:kernel-reconnect-session (kernel &optional callback) + "If session does not already exist, prompt user to create a new session. +Otherwise, return extant session. +`ein:kernel-retrieve-session; both retrieves and creates. +CALLBACK takes one argument kernel (e.g., execute cell now that +we're reconnected)." + (ein:kernel-disconnect kernel) + (ein:kernel-session-p + kernel + (apply-partially + (lambda (callback* kernel session-p) + (when (or session-p + (and (not noninteractive) (y-or-n-p "Session not found. Restart?"))) + (ein:events-trigger (ein:$kernel-events kernel) 'status_reconnecting.Kernel) + (ein:kernel-retrieve-session + kernel 0 + (apply-partially + (lambda (callback** kernel) + (ein:events-trigger (ein:$kernel-events kernel) + 'status_reconnected.Kernel) + (when callback** (funcall callback** kernel))) + callback*)))) + callback))) + +(defun ein:kernel--ws-url (url-or-port) + "Assuming URL-OR-PORT already normalized by `ein:url'. +See https://github.com/ipython/ipython/pull/3307" + (let* ((parsed-url (url-generic-parse-url url-or-port)) + (protocol (if (string= (url-type parsed-url) "https") "wss" "ws"))) + (format "%s://%s:%s%s" + protocol + (url-host parsed-url) + (url-port parsed-url) + (url-filename parsed-url)))) + +(defun ein:kernel--handle-websocket-reply (kernel _ws frame) + (-when-let* ((packet (websocket-frame-payload frame)) + (channel (plist-get (ein:json-read-from-string packet) :channel))) + (cond ((string-equal channel "iopub") + (ein:kernel--handle-iopub-reply kernel packet)) + ((string-equal channel "shell") + (ein:kernel--handle-shell-reply kernel packet)) + ((string-equal channel "stdin") + (ein:kernel--handle-stdin-reply kernel packet)) + (t (ein:log 'warn "Received reply from unforeseen channel %s" channel))))) + +(defun ein:start-single-websocket (kernel open-callback) + "OPEN-CALLBACK (kernel) (e.g., execute cell)" + (let ((ws-url (concat (ein:$kernel-ws-url kernel) + (ein:$kernel-kernel-url kernel) + "/channels?session_id=" + (ein:$kernel-session-id kernel)))) + (ein:log 'verbose "WS start: %s" ws-url) + (setf (ein:$kernel-websocket kernel) + (ein:websocket ws-url kernel + (apply-partially #'ein:kernel--handle-websocket-reply kernel) + (lambda (ws) + (-if-let* ((websocket (websocket-client-data ws)) + (kernel (ein:$websocket-kernel websocket))) + (unless (ein:$websocket-closed-by-client websocket) + (ein:log 'verbose "WS closed unexpectedly: %s" (websocket-url ws)) + (ein:kernel-disconnect kernel)) + (ein:log 'error "ein:start-single-websocket: on-close no client data for %s." (websocket-url ws)))) + (apply-partially + (lambda (cb ws) + (-if-let* ((websocket (websocket-client-data ws)) + (kernel (ein:$websocket-kernel websocket))) + (progn + (awhen (and (ein:kernel-live-p kernel) cb) + (funcall it kernel)) + (ein:log 'verbose "WS opened: %s" (websocket-url ws))) + (ein:log 'error "ein:start-single-websocket: on-open no client data for %s." (websocket-url ws)))) + open-callback))))) + +(defun ein:kernel-start-websocket (kernel callback) + (cond ((<= (ein:$kernel-api-version kernel) 2) + (error "Api version %s unsupported" (ein:$kernel-api-version kernel))) + (t (ein:start-single-websocket kernel callback)))) + +(defun ein:kernel-on-connect (_kernel _content _metadata) + (ein:log 'info "Kernel connect_request_reply received.")) + +(defun ein:kernel-disconnect (kernel) + "Close websocket connection to running kernel, but do not +delete the kernel on the server side" + (ein:events-trigger (ein:$kernel-events kernel) 'status_disconnected.Kernel) + (aif (ein:$kernel-websocket kernel) + (progn (ein:websocket-close it) + (setf (ein:$kernel-websocket kernel) nil)))) + +(defun ein:kernel-live-p (kernel) + (and (ein:$kernel-p kernel) + (ein:aand (ein:$kernel-websocket kernel) (ein:websocket-open-p it)))) + +(defun ein:kernel-when-ready (kernel callback) + "Execute CALLBACK of arity 1 (the kernel) when KERNEL is ready. +Warn user otherwise." + (if (ein:kernel-live-p kernel) + (funcall callback kernel) + (ein:log 'verbose "Kernel %s unavailable" (ein:$kernel-kernel-id kernel)) + (ein:kernel-reconnect-session kernel callback))) + +(defun ein:kernel-object-info-request (kernel objname callbacks &optional cursor-pos detail-level) + "Send object info request of OBJNAME to KERNEL. + +When calling this method pass a CALLBACKS structure of the form: + + (:object_info_reply (FUNCTION . ARGUMENT)) + +Call signature:: + + (`funcall' FUNCTION ARGUMENT CONTENT METADATA) + +CONTENT and METADATA are given by `object_info_reply' message. + +`object_info_reply' message is documented here: +http://ipython.org/ipython-doc/dev/development/messaging.html#object-information +" + (cl-assert (ein:kernel-live-p kernel) nil "object_info_reply: Kernel is not active.") + (when objname + (if (<= (ein:$kernel-api-version kernel) 2) + (error "Api version %s unsupported" (ein:$kernel-api-version kernel))) + (let* ((content (if (< (ein:$kernel-api-version kernel) 5) + (list + ;; :text "" + :oname (format "%s" objname) + :cursor_pos (or cursor-pos 0) + :detail_level (or detail-level 0)) + (list + :code (format "%s" objname) + :cursor_pos (or cursor-pos 0) + :detail_level (or detail-level 0)))) + (msg (ein:kernel--get-msg kernel "inspect_request" + (append content (list :detail_level 1)))) + (msg-id (plist-get (plist-get msg :header) :msg_id))) + (ein:websocket-send-shell-channel kernel msg) + (ein:kernel-set-callbacks-for-msg kernel msg-id callbacks)))) + +(cl-defun ein:kernel-execute (kernel code &optional callbacks + &key + (silent t) + (store-history t) + (user-expressions (make-hash-table)) + (allow-stdin t) + (stop-on-error nil)) + "Execute CODE on KERNEL. + +The CALLBACKS plist looks like: + + (:execute_reply EXECUTE-REPLY-CALLBACK + :output OUTPUT-CALLBACK + :clear_output CLEAR-OUTPUT-CALLBACK + :set_next_input SET-NEXT-INPUT) + +Right hand sides ending -CALLBACK above are of the form (FUNCTION +ARG1 ... ARGN). + +(Hindsight: this was all much better implemented using `apply-partially') + +Return randomly generated MSG-ID tag uniquely identifying +expectation of a kernel response." + (cl-assert (ein:kernel-live-p kernel) nil "execute_reply: Kernel is not active.") + (let* ((content (list + :code code + :silent (or silent json-false) + :store_history (or store-history json-false) + :user_expressions user-expressions + :allow_stdin allow-stdin + :stop_on_error (or stop-on-error json-false))) + (msg (ein:kernel--get-msg kernel "execute_request" content)) + (msg-id (plist-get (plist-get msg :header) :msg_id))) + (ein:log 'debug "ein:kernel-execute: code=%s msg_id=%s" code msg-id) + (ein:websocket-send-shell-channel kernel msg) + (ein:kernel-set-callbacks-for-msg kernel msg-id callbacks) + (unless silent + (mapc #'ein:funcall-packed + (ein:$kernel-after-execute-hook kernel))) + msg-id)) + +(defun ein:kernel-connect-request (kernel callbacks) + "Request basic information for a KERNEL. + +When calling this method pass a CALLBACKS structure of the form:: + + (:connect_reply (FUNCTION . ARGUMENT)) + +Call signature:: + + (`funcall' FUNCTION ARGUMENT CONTENT METADATA) + +CONTENT and METADATA are given by `kernel_info_reply' message. + +`connect_request' message is documented here: +http://ipython.org/ipython-doc/dev/development/messaging.html#connect + +Example:: + + (ein:kernel-connect-request + (ein:get-kernel) + \\='(:kernel_connect_reply (message . \"CONTENT: %S\\nMETADATA: %S\"))) +" + ;(cl-assert (ein:kernel-live-p kernel) nil "connect_reply: Kernel is not active.") + (let* ((msg (ein:kernel--get-msg kernel "connect_request" (make-hash-table))) + (msg-id (plist-get (plist-get msg :header) :msg_id))) + (ein:websocket-send-shell-channel kernel msg) + (ein:kernel-set-callbacks-for-msg kernel msg-id callbacks) + msg-id)) + +(defun ein:kernel-interrupt (kernel) + (when (ein:kernel-live-p kernel) + (ein:log 'info "Interrupting kernel") + (ein:query-singleton-ajax + (ein:url (ein:$kernel-url-or-port kernel) + (ein:$kernel-kernel-url kernel) + "interrupt") + :type "POST" + :success (lambda (&rest _ignore) + (ein:log 'info "Sent interruption command."))))) + +(defvar ein:force-sync) +(declare-function ein:content-query-sessions "ein-contents-api") +(cl-defun ein:kernel-delete-session (&optional callback + &key url-or-port path kernel + &aux (session-id)) + "Regardless of success or error, we clear all state variables of +kernel and funcall CALLBACK (kernel)" + (cond (kernel + (setq url-or-port (ein:$kernel-url-or-port kernel)) + (setq path (ein:$kernel-path kernel)) + (setq session-id (ein:$kernel-session-id kernel))) + ((and url-or-port path) + (aif (ein:notebook-get-opened-notebook url-or-port path) + (progn + (setq kernel (ein:$notebook-kernel it)) + (setq session-id (ein:$kernel-session-id kernel))) + (let ((ein:force-sync t)) + (ein:content-query-sessions + url-or-port + (lambda (session-hash) + (setq session-id (car (gethash path session-hash)))) + nil)))) + (t (error "ein:kernel-delete-session: need kernel, or url-or-port and path"))) + (if session-id + (ein:query-singleton-ajax + (ein:url url-or-port "api/sessions" session-id) + :type "DELETE" + :complete (apply-partially #'ein:kernel-delete-session--complete kernel session-id callback) + :error (apply-partially #'ein:kernel-delete-session--error session-id nil) + :success (apply-partially #'ein:kernel-delete-session--success session-id + (aif (ein:notebooklist-get-buffer url-or-port) + (buffer-local-value 'ein:%notebooklist% it)) + nil)) + (ein:log 'verbose "ein:kernel-delete-session: no sessions found for %s" path) + (when callback + (funcall callback kernel)))) + +(cl-defun ein:kernel-delete-session--error (session-id _callback + &key _response error-thrown + &allow-other-keys) + (ein:log 'error "ein:kernel-delete-session--error %s: ERROR %s DATA %s" + session-id (car error-thrown) (cdr error-thrown))) + +(cl-defun ein:kernel-delete-session--success (session-id nblist _callback + &key _data _symbol-status _response + &allow-other-keys) + (ein:log 'verbose "ein:kernel-delete-session--success: %s deleted" session-id) + (when nblist + (ein:notebooklist-reload nblist))) + +(cl-defun ein:kernel-delete-session--complete (kernel _session-id callback + &key data response + &allow-other-keys + &aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data))) + (ein:log 'verbose "ein:kernel-delete-session--complete %s" resp-string) + (when kernel + (ein:kernel-disconnect kernel)) + (when callback (funcall callback kernel))) + +;; Reply handlers. +(defun ein:kernel-get-callbacks-for-msg (kernel msg-id) + (gethash msg-id (ein:$kernel-msg-callbacks kernel))) + +(defun ein:kernel-set-callbacks-for-msg (kernel msg-id callbacks) + "Set up promise for MSG-ID." + (puthash msg-id callbacks (ein:$kernel-msg-callbacks kernel))) + +(defun ein:kernel--handle-stdin-reply (kernel packet) + (cl-destructuring-bind + (&key header _parent_header _metadata content &allow-other-keys) + (ein:json-read-from-string packet) + (let ((msg-type (plist-get header :msg_type)) + (msg-id (plist-get header :msg_id)) + (password (plist-get content :password))) + (ein:log 'debug "ein:kernel--handle-stdin-reply: msg_type=%s msg_id=%s" + msg-type msg-id) + (cond ((string-equal msg-type "input_request") + (if (not (eql password :json-false)) + (let* ((passwd (read-passwd (plist-get content :prompt))) + (content (list :value passwd)) + (msg (ein:kernel--get-msg kernel "input_reply" content))) + (ein:websocket-send-stdin-channel kernel msg)) + (cond ((string-match "^\\(ipdb> \\|(Pdb) \\)" + (plist-get content :prompt)) + (aif (ein:ipdb-get-session kernel) + (pop-to-buffer (ein:$ipdb-session-buffer it)) + (let* ((url-or-port (ein:$kernel-url-or-port kernel)) + (path (ein:$kernel-path kernel)) + (notebook (ein:notebook-get-opened-notebook + url-or-port path))) + (ein:ipdb-start-session + kernel + (match-string 1 (plist-get content :prompt)) + notebook)))) + (t (let* ((in (read-string (plist-get content :prompt))) + (content (list :value in)) + (msg (ein:kernel--get-msg kernel "input_reply" content))) + (ein:websocket-send-stdin-channel kernel msg)))))))))) + +(defun ein:kernel--handle-payload (kernel callbacks payload) + (cl-loop with events = (ein:$kernel-events kernel) + for p in (append payload nil) + for text = (or (plist-get p :text) (plist-get (plist-get p :data) :text/plain)) + for source = (plist-get p :source) + if (member source '("IPython.kernel.zmq.page.page" + "IPython.zmq.page.page" + "page")) + do (unless (equal (ein:trim text) "") + (ein:events-trigger + events 'open_with_text.Pager (list :text text))) + else if + (member + source + '("IPython.kernel.zmq.zmqshell.ZMQInteractiveShell.set_next_input" + "IPython.zmq.zmqshell.ZMQInteractiveShell.set_next_input" + "set_next_input")) + do (let ((cb (plist-get callbacks :set_next_input))) + (when cb (ein:funcall-packed cb text))))) + +(defun ein:kernel--handle-shell-reply (kernel packet) + (cl-destructuring-bind + (&key header content metadata parent_header &allow-other-keys) + (ein:json-read-from-string packet) + (let* ((msg-type (plist-get header :msg_type)) + (msg-id (plist-get parent_header :msg_id)) + (callbacks (ein:kernel-get-callbacks-for-msg kernel msg-id))) + (ein:log 'debug "ein:kernel--handle-shell-reply: msg_type=%s msg_id=%s" + msg-type msg-id) + (aif (plist-get callbacks (intern-soft (format ":%s" msg-type))) + (ein:funcall-packed it content metadata) + (ein:log 'info "ein:kernel--handle-shell-reply: No :%s callback for msg_id=%s" + msg-type msg-id)) + (aif (plist-get content :payload) + (ein:kernel--handle-payload kernel callbacks it)) + (let ((events (ein:$kernel-events kernel))) + (ein:case-equal msg-type + (("execute_reply") + (aif (plist-get content :execution_count) + (ein:events-trigger events 'execution_count.Kernel it)))))))) + +(defun ein:kernel--handle-iopub-reply (kernel packet) + (cl-destructuring-bind + (&key content metadata parent_header header &allow-other-keys) + (ein:json-read-from-string packet) + (let* ((msg-type (plist-get header :msg_type)) + (msg-id (plist-get header :msg_id)) + (parent-id (plist-get parent_header :msg_id)) + (callbacks (ein:kernel-get-callbacks-for-msg kernel parent-id)) + (events (ein:$kernel-events kernel))) + (ein:log 'debug + "ein:kernel--handle-iopub-reply: msg_type=%s msg_id=%s parent_id=%s" + msg-type msg-id parent-id) + (ein:case-equal msg-type + (("stream" "display_data" "pyout" "pyerr" "error" "execute_result") + (aif (plist-get callbacks :output) ;; ein:cell--handle-output + (ein:funcall-packed it msg-type content metadata) + (ein:log 'warn (concat "ein:kernel--handle-iopub-reply: " + "No :output callback for parent_id=%s") + parent-id)) + (when (ein:ipdb-get-session kernel) + (ein:ipdb--handle-iopub-reply kernel packet))) + (("status") + (ein:case-equal (plist-get content :execution_state) + (("busy") + (ein:events-trigger events 'status_busy.Kernel)) + (("idle") + (ein:events-trigger events 'status_idle.Kernel) + (awhen (ein:ipdb-get-session kernel) + (ein:ipdb-stop-session it))) + (("dead") + (ein:kernel-disconnect kernel) + (awhen (ein:ipdb-get-session kernel) + (ein:ipdb-stop-session it))))) + (("data_pub") + (ein:log 'verbose "ein:kernel--handle-iopub-reply: data_pub %S" packet)) + (("clear_output") + (aif (plist-get callbacks :clear_output) + (ein:funcall-packed it content metadata) + (ein:log 'info (concat "ein:kernel--handle-iopub-reply: " + "No :clear_output callback for parent_id=%s") + parent-id))))))) + +(provide 'ein-kernel) + +;;; ein-kernel.el ends here diff --git a/lisp/ein/ein-kernelinfo.el b/lisp/ein/ein-kernelinfo.el new file mode 100644 index 00000000..2d4ac0be --- /dev/null +++ b/lisp/ein/ein-kernelinfo.el @@ -0,0 +1,56 @@ +;;; ein-kernelinfo.el --- Kernel info module -*- lexical-binding:t -*- + +;; Copyright (C) 2012 Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; ein-kernelinfo.el 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 of the +;; License, or (at your option) any later version. + +;; ein-kernelinfo.el 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 ein-kernelinfo.el. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'eieio) +(require 'ein-kernel) + +(defclass ein:kernelinfo () + ((kernel + :initarg :kernel :type ein:$kernel + :documentation "Kernel instance.") + (get-buffers + :initarg :get-buffers + :documentation "A packed function to get buffers associated +with the kernel. The buffer local `default-directory' variable +in these buffer will be synced with the kernel's cwd.") + (hostname + :initarg :hostname :type string + :documentation "Host name of the machine where the kernel is running on.") + (ccwd + :initarg :ccwd :type string + :documentation "cached CWD (last time checked CWD).")) + :documentation "Info related (but unimportant) to kernel") + +(defun ein:kernelinfo-new (kernel get-buffers) + "Make a new `ein:kernelinfo' instance based on KERNEL and GET-BUFFERS." + (let ((kerinfo (make-instance 'ein:kernelinfo))) + (setf (slot-value kerinfo 'kernel) kernel) + (setf (slot-value kerinfo 'get-buffers) get-buffers) + kerinfo)) +(provide 'ein-kernelinfo) + +;;; ein-kernelinfo.el ends here diff --git a/lisp/ein/ein-kill-ring.el b/lisp/ein/ein-kill-ring.el new file mode 100644 index 00000000..9b9675b9 --- /dev/null +++ b/lisp/ein/ein-kill-ring.el @@ -0,0 +1,55 @@ +;;; ein-kill-ring.el --- Kill-ring for cells -*- lexical-binding:t -*- + +;; Copyright (C) 2012- Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; ein-kill-ring.el 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 of the License, or +;; (at your option) any later version. + +;; ein-kill-ring.el 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 ein-kill-ring.el. If not, see . + +;;; Commentary: + +;; Stolen from simple.el. + +;;; Code: + +(defvar ein:kill-ring nil) +(defvar ein:kill-ring-yank-pointer nil) +(defvar ein:kill-ring-max kill-ring-max) + +(defun ein:kill-new (obj) + "Make OBJ the latest kill in the kill ring `ein:kill-ring'. +Set `ein:kill-ring-yank-pointer' to point to it." + (push obj ein:kill-ring) + (if (> (length ein:kill-ring) ein:kill-ring-max) + (setcdr (nthcdr (1- ein:kill-ring-max) ein:kill-ring) nil)) + (setq ein:kill-ring-yank-pointer ein:kill-ring)) + +(defun ein:current-kill (n &optional do-not-move) + "Rotate the yanking point by N places, and then return that kill. +If optional arg DO-NOT-MOVE is non-nil, then don't actually +move the yanking point; just return the Nth kill forward." + (unless ein:kill-ring (error "Kill ring is empty")) + (let ((ARGth-kill-element + (nthcdr (mod (- n (length ein:kill-ring-yank-pointer)) + (length ein:kill-ring)) + ein:kill-ring))) + (unless do-not-move + (setq ein:kill-ring-yank-pointer ARGth-kill-element)) + (car ARGth-kill-element))) + +(provide 'ein-kill-ring) + +;;; ein-kill-ring.el ends here diff --git a/lisp/ein/ein-log.el b/lisp/ein/ein-log.el new file mode 100644 index 00000000..696c5e91 --- /dev/null +++ b/lisp/ein/ein-log.el @@ -0,0 +1,116 @@ +;;; ein-log.el --- Logging module for ein.el -*- lexical-binding:t -*- + +;; Copyright (C) 2012- Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; ein-log.el 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 of the License, or +;; (at your option) any later version. + +;; ein-log.el 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 ein-log.el. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ein-core) + +(defvar ein:log-all-buffer-name "*ein:log-all*") + +(defvar ein:log-level-def + '(;; debugging + (blather . 60) (trace . 50) (debug . 40) + ;; information + (verbose . 30) (info . 20) + ;; errors + (warn . 10) (error . 0)) + "Named logging levels.") +;; Some names are stolen from supervisord (http://supervisord.org/logging.html) + +(defvar ein:log-level 30) +(defvar ein:log-message-level 20) + +(defvar ein:log-print-length 10 "`print-length' for `ein:log'") +(defvar ein:log-print-level 1 "`print-level' for `ein:log'") +(defvar ein:log-max-string 1000) + +(defun ein:log-set-level (level) + (setq ein:log-level (ein:log-level-name-to-int level))) + +(defun ein:log-set-message-level (level) + (setq ein:log-message-level (ein:log-level-name-to-int level))) + +(defun ein:log-level-int-to-name (int) + (cl-loop for (n . i) in ein:log-level-def + when (>= int i) + return n + finally 'error)) + +(defun ein:log-level-name-to-int (name) + (cdr (assq name ein:log-level-def))) + +(defsubst ein:log-strip-timestamp (msg) + (replace-regexp-in-string "^[0-9: ]+" "" msg)) + +(defun ein:log-wrapper (level func) + (setq level (ein:log-level-name-to-int level)) + (when (<= level ein:log-level) + (let* ((levname (ein:log-level-int-to-name level)) + (print-level ein:log-print-level) + (print-length ein:log-print-length) + (msg (format "%s: [%s] %s" (format-time-string "%H:%M:%S:%3N") levname (funcall func))) + (orig-buffer (current-buffer))) + (if (and ein:log-max-string + (> (length msg) ein:log-max-string)) + (setq msg (substring msg 0 ein:log-max-string))) + (ein:with-read-only-buffer (get-buffer-create ein:log-all-buffer-name) + (goto-char (point-max)) + (insert msg (format " @%S" orig-buffer) "\n")) + (when (<= level ein:log-message-level) + (message "ein: %s" (ein:log-strip-timestamp msg)))))) + +(make-obsolete-variable 'ein:debug nil "0.17.0") + +(defmacro ein:log (level string &rest args) + (declare (indent 1)) + `(ein:log-wrapper ,level (lambda () (format ,string ,@args)))) + +(defsubst ein:debug-p () + "Set to non-`nil' to raise errors instead of suppressing it. +Change the behavior of `ein:log-ignore-errors'." + (>= ein:log-level (alist-get 'debug ein:log-level-def))) + +(defun ein:log-pop-to-ws-buffer () + (interactive) + (-if-let* ((kernel (ein:get-kernel--notebook)) + (websocket (ein:$kernel-websocket kernel))) + (pop-to-buffer + (websocket-get-debug-buffer-create + (ein:$websocket-ws websocket))) + (message "Must be run from notebook buffer"))) + +(defun ein:log-pop-to-request-buffer () + (interactive) + (aif (get-buffer request-log-buffer-name) + (pop-to-buffer it) + (message "No buffer %s" request-log-buffer-name))) + +(defun ein:log-pop-to-all-buffer () + (interactive) + (pop-to-buffer (get-buffer-create ein:log-all-buffer-name))) + +(provide 'ein-log) + +;;; ein-log.el ends here diff --git a/lisp/ein/ein-markdown-mode.el b/lisp/ein/ein-markdown-mode.el new file mode 100644 index 00000000..4680ffb0 --- /dev/null +++ b/lisp/ein/ein-markdown-mode.el @@ -0,0 +1,8082 @@ +;;; ein:markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- + +;; Copyright (C) 2007-2017 Jason R. Blevins and markdown-mode +;; contributors. + +;; Author: Jason R. Blevins + +;; This file is not part of GNU Emacs. + +;; 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 of the License, 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 this program. If not, see . + +;;; Commentary: + +;; Pare markdown-mode for EIN (and fix some bugs) + +;;; Code: + +(require 'easymenu) +(require 'outline) +(require 'thingatpt) +(require 'cl-lib) +(require 'url-parse) +(require 'button) +(require 'color) +(require 'rx) + +(defvar jit-lock-start) +(defvar jit-lock-end) +(defvar flyspell-generic-check-word-predicate) + +(declare-function eww-open-file "eww") +(declare-function url-path-and-query "url-parse") + + +;;; Constants ================================================================= + +(defconst ein:markdown-mode-version "2.4-dev" + "ein:markdown mode version number.") + +(defconst ein:markdown-output-buffer-name "*markdown-output*" + "Name of temporary buffer for markdown command output.") + + +;;; Global Variables ========================================================== + +(defvar ein:markdown-reference-label-history nil + "History of used reference labels.") + +;;; Customizable Variables ==================================================== + +(defvar ein:markdown-mode-hook nil + "Hook run when entering Markdown mode.") + +(defgroup ein:markdown nil + "Major mode for editing text files in Markdown format." + :prefix "ein:markdown-" + :group 'text) + +(defcustom ein:markdown-command "ein:markdown" + "Command to run markdown." + :group 'ein:markdown + :type '(choice (string :tag "Shell command") function)) + +(defcustom ein:markdown-command-needs-filename nil + "Set to non-nil if `markdown-command' does not accept input from stdin. +Instead, it will be passed a filename as the final command line +option. As a result, you will only be able to run Markdown from +buffers which are visiting a file." + :group 'ein:markdown + :type 'boolean) + +(defcustom ein:markdown-open-command nil + "Command used for opening Markdown files directly. +For example, a standalone Markdown previewer. This command will +be called with a single argument: the filename of the current +buffer. It can also be a function, which will be called without +arguments." + :group 'ein:markdown + :type '(choice file function (const :tag "None" nil))) + +(defcustom ein:markdown-hr-strings + '("-------------------------------------------------------------------------------" + "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" + "---------------------------------------" + "* * * * * * * * * * * * * * * * * * * *" + "---------" + "* * * * *") + "Strings to use when inserting horizontal rules. +The first string in the list will be the default when inserting a +horizontal rule. Strings should be listed in decreasing order of +prominence (as in headings from level one to six) for use with +promotion and demotion functions." + :group 'ein:markdown + :type '(repeat string)) + +(defcustom ein:markdown-bold-underscore nil + "Use two underscores when inserting bold text instead of two asterisks." + :group 'ein:markdown + :type 'boolean) + +(defcustom ein:markdown-italic-underscore nil + "Use underscores when inserting italic text instead of asterisks." + :group 'ein:markdown + :type 'boolean) + +(defcustom ein:markdown-marginalize-headers nil + "When non-nil, put opening atx header markup in a left margin. + +This setting goes well with `markdown-asymmetric-header'. But +sadly it conflicts with `linum-mode' since they both use the +same margin." + :group 'ein:markdown + :type 'boolean + :safe 'booleanp + :package-version '(ein:markdown-mode . "2.4")) + +(defcustom ein:markdown-marginalize-headers-margin-width 6 + "Character width of margin used for marginalized headers. +The default value is based on there being six heading levels +defined by Markdown and HTML. Increasing this produces extra +whitespace on the left. Decreasing it may be preferred when +fewer than six nested heading levels are used." + :group 'ein:markdown + :type 'natnump + :safe 'natnump + :package-version '(ein:markdown-mode . "2.4")) + +(defcustom ein:markdown-asymmetric-header nil + "Determines if atx header style will be asymmetric. +Set to a non-nil value to use asymmetric header styling, placing +header markup only at the beginning of the line. By default, +balanced markup will be inserted at the beginning and end of the +line around the header title." + :group 'ein:markdown + :type 'boolean) + +(defcustom ein:markdown-indent-function 'ein:markdown-indent-line + "Function to use to indent." + :group 'ein:markdown + :type 'function) + +(defcustom ein:markdown-indent-on-enter t + "Determines indentation behavior when pressing \\[newline]. +Possible settings are nil, t, and \\='indent-and-new-item. + +When non-nil, pressing \\[newline] will call `newline-and-indent' +to indent the following line according to the context using +`markdown-indent-function'. In this case, note that +\\[electric-newline-and-maybe-indent] can still be used to insert +a newline without indentation. + +When set to \\='indent-and-new-item and the point is in a list item +when \\[newline] is pressed, the list will be continued on the next +line, where a new item will be inserted. + +When set to nil, simply call `newline' as usual. In this case, +you can still indent lines using \\[ein:markdown-cycle] and continue +lists with \\[ein:markdown-insert-list-item]. + +Note that this assumes the variable `electric-indent-mode' is +non-nil (enabled). When it is *disabled*, the behavior of +\\[newline] and `\\[electric-newline-and-maybe-indent]' are +reversed." + :group 'ein:markdown + :type '(choice (const :tag "Don't automatically indent" nil) + (const :tag "Automatically indent" t) + (const :tag "Automatically indent and insert new list items" indent-and-new-item))) + +(defcustom ein:markdown-uri-types + '("acap" "cid" "data" "dav" "fax" "file" "ftp" + "gopher" "http" "https" "imap" "ldap" "mailto" + "mid" "message" "modem" "news" "nfs" "nntp" + "pop" "prospero" "rtsp" "service" "sip" "tel" + "telnet" "tip" "urn" "vemmi" "wais") + "Link types for syntax highlighting of URIs." + :group 'ein:markdown + :type '(repeat (string :tag "URI scheme"))) + +(defcustom ein:markdown-url-compose-char + '(?∞ ?… ?⋯ ?# ?★ ?⚓) + "Placeholder character for hidden URLs. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :type '(choice + (character :tag "Single URL replacement character") + (repeat :tag "List of possible URL replacement characters" + character)) + :package-version '(ein:markdown-mode . "2.3")) + +(defcustom ein:markdown-blockquote-display-char + '("▌" "┃" ">") + "String to display when hiding blockquote markup. +This may be a single string or a list of string. In case of a +list, the first one that satisfies `char-displayable-p' will be +used." + :type 'string + :type '(choice + (string :tag "Single blockquote display string") + (repeat :tag "List of possible blockquote display strings" string)) + :package-version '(ein:markdown-mode . "2.3")) + +(defcustom ein:markdown-hr-display-char + '(?─ ?━ ?-) + "Character for hiding horizontal rule markup. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :group 'ein:markdown + :type '(choice + (character :tag "Single HR display character") + (repeat :tag "List of possible HR display characters" character)) + :package-version '(ein:markdown-mode . "2.3")) + +(defcustom ein:markdown-definition-display-char + '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) + "Character for replacing definition list markup. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :type '(choice + (character :tag "Single definition list character") + (repeat :tag "List of possible definition list characters" character)) + :package-version '(ein:markdown-mode . "2.3")) + +(defcustom ein:markdown-enable-math nil + "Syntax highlighting for inline LaTeX and itex expressions. +Set this to a non-nil value to turn on math support by default. +Math support can be enabled, disabled, or toggled later using +`markdown-toggle-math' or \\[ein:markdown-toggle-math]." + :group 'ein:markdown + :type 'boolean + :safe 'booleanp) +(make-variable-buffer-local 'ein:markdown-enable-math) + +(defcustom ein:markdown-enable-html t + "Enable font-lock support for HTML tags and attributes." + :group 'ein:markdown + :type 'boolean + :safe 'booleanp + :package-version '(ein:markdown-mode . "2.4")) + +(defcustom ein:markdown-css-paths nil + "URL of CSS file to link to in the output XHTML." + :group 'ein:markdown + :type '(repeat (string :tag "CSS File Path"))) + +(defcustom ein:markdown-content-type "text/html" + "Content type string for the http-equiv header in XHTML output. +When set to an empty string, this attribute is omitted. Defaults to +`text/html'." + :group 'ein:markdown + :type 'string) + +(defcustom ein:markdown-coding-system nil + "Character set string for the http-equiv header in XHTML output. +Defaults to `buffer-file-coding-system' (and falling back to +`utf-8' when not available). Common settings are `iso-8859-1' +and `iso-latin-1'. Use `list-coding-systems' for more choices." + :group 'ein:markdown + :type 'coding-system) + +(defcustom ein:markdown-xhtml-header-content "" + "Additional content to include in the XHTML block." + :group 'ein:markdown + :type 'string) + +(defcustom ein:markdown-xhtml-body-preamble "" + "Content to include in the XHTML block, before the output." + :group 'ein:markdown + :type 'string + :safe 'stringp + :package-version '(ein:markdown-mode . "2.4")) + +(defcustom ein:markdown-xhtml-body-epilogue "" + "Content to include in the XHTML block, after the output." + :group 'ein:markdown + :type 'string + :safe 'stringp + :package-version '(ein:markdown-mode . "2.4")) + +(defcustom ein:markdown-xhtml-standalone-regexp + "^\\(<\\?xml\\|\\[ein:markdown-follow-thing-at-point] and \\[ein:markdown-follow-link-at-point] +call this function with the filename as only argument whenever +they encounter a filename (instead of a URL) to be visited and +use its return value instead of the filename in the link. For +example, if absolute filenames are actually relative to a server +root directory, you can set +`markdown-translate-filename-function' to a function that +prepends the root directory to the given filename." + :group 'ein:markdown + :type 'function + :risky t + :package-version '(ein:markdown-mode . "2.4")) + +(defcustom ein:markdown-max-image-size nil + "Maximum width and height for displayed inline images. +This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). +When nil, use the actual size. Otherwise, use ImageMagick to +resize larger images to be of the given maximum dimensions. This +requires Emacs to be built with ImageMagick support." + :group 'ein:markdown + :package-version '(ein:markdown-mode . "2.4") + :type '(choice + (const :tag "Use actual image width" nil) + (cons (choice (sexp :tag "Maximum width in pixels") + (const :tag "No maximum width" nil)) + (choice (sexp :tag "Maximum height in pixels") + (const :tag "No maximum height" nil))))) + + +;;; Markdown-Specific `rx' Macro ============================================== + +;; Based on python-rx from python.el. +(eval-and-compile + (defconst ein:markdown-rx-constituents + `((newline . ,(rx "\n")) + (indent . ,(rx (or (repeat 4 " ") "\t"))) + (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end)))) + (numeral . ,(rx (and (one-or-more (any "0-9#")) "."))) + (bullet . ,(rx (any "*+:-"))) + (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".") + (any "*+:-")))) + (checkbox . ,(rx "[" (any " xX") "]"))) + "ein:markdown-specific sexps for `markdown-rx'") + + (defun ein:markdown-rx-to-string (form &optional no-group) + "ein:markdown mode specialized `rx-to-string' function. +This variant supports named Markdown expressions in FORM. +NO-GROUP non-nil means don't put shy groups around the result." + (let ((rx-constituents (append ein:markdown-rx-constituents rx-constituents))) + (rx-to-string form no-group))) + + (defmacro ein:markdown-rx (&rest regexps) + "ein:markdown mode specialized rx macro. +This variant of `rx' supports common Markdown named REGEXPS." + (cond ((null regexps) + (error "No regexp")) + ((cdr regexps) + (ein:markdown-rx-to-string `(and ,@regexps) t)) + (t + (ein:markdown-rx-to-string (car regexps) t))))) + + +;;; Regular Expressions ======================================================= + +(defconst ein:markdown-regex-comment-start + "") + (setq-local comment-start-skip " \\([0-9]+\\)" nil t)) + (re-search-forward "^[\t ]*File.+line \\([0-9]+\\)$" nil t)) + (string-to-number (match-string 1)))) + +(cl-defmethod org-babel-jupyter-transform-code (code changelist &context (jupyter-lang python)) + (when (plist-get changelist :dir) + (setq code + (format "\ +import os +__JUPY_saved_dir = os.getcwd() +os.chdir(\"%s\") +try: + get_ipython().run_cell(r\"\"\"%s\"\"\") +finally: + os.chdir(__JUPY_saved_dir)" + (plist-get changelist :dir) code))) + code) + +(provide 'jupyter-python) + +;;; jupyter-python.el ends here diff --git a/lisp/jupyter/jupyter-repl.el b/lisp/jupyter/jupyter-repl.el new file mode 100644 index 00000000..c68e731e --- /dev/null +++ b/lisp/jupyter/jupyter-repl.el @@ -0,0 +1,2179 @@ +;;; jupyter-repl-client.el --- A Jupyter REPL client -*- lexical-binding: t -*- + +;; Copyright (C) 2018-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 08 Jan 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 Jupyter REPL for Emacs. +;; +;; The main entry points are `jupyter-run-repl' and `jupyter-connect-repl'. +;; +;; When called interactively, `jupyter-run-repl' asks for a kernel to +;; start, connects a `jupyter-repl-client' to the selected kernel, and +;; pops up a REPL buffer. The main difference of +;; `jupyter-connect-repl' is that it will obtain the kernel's +;; connection info by asking for the JSON file containing it to start +;; connection to a kernel. +;; +;; Additionally, `jupyter-repl-associate-buffer' associates the +;; `current-buffer' with a REPL client appropriate for the buffer's +;; `major-mode'. Associating a buffer with a REPL client enables the minor +;; mode `jupyter-repl-interaction-mode'. +;; +;; `jupyter-repl-interaction-mode' adds the following keybindings for +;; interacting with a REPL client: +;; +;; C-c C-c `jupyter-eval-line-or-region' +;; C-c C-l `jupyter-eval-file' +;; M-i `jupyter-inspect-at-point' +;; C-c C-r `jupyter-repl-restart-kernel' +;; C-c C-i `jupyter-repl-interrupt-kernel' +;; C-c C-z `jupyter-repl-pop-to-buffer' + +;;; Code: + +(defgroup jupyter-repl nil + "A Jupyter REPL client" + :group 'jupyter) + +(eval-when-compile (require 'subr-x)) +(eval-and-compile (require 'jupyter-client)) +(require 'jupyter-base) +(require 'jupyter-mime) +(require 'jupyter-kernelspec) +(require 'jupyter-widget-client) +(require 'ring) + +(declare-function jupyter-notebook-process "jupyter-server") +(declare-function jupyter-launch-notebook "jupyter-server") +(declare-function jupyter-server "jupyter-server") + +;;; User variables + +(defface jupyter-repl-input-prompt + '((((class color) (min-colors 88) (background light)) + :foreground "darkseagreen2") + (((class color) (min-colors 88) (background dark)) + :foreground "darkolivegreen")) + "Face used for the input prompt." + :group 'jupyter-repl) + +(defface jupyter-repl-output-prompt + '((((class color) (min-colors 88) (background light)) + :foreground "indianred3") + (((class color) (min-colors 88) (background dark)) + :foreground "darkred")) + "Face used for the output prompt." + :group 'jupyter-repl) + +(defface jupyter-repl-traceback + '((((class color) (min-colors 88) (background light)) + :background "LightYellow2") + (((class color) (min-colors 88) (background dark)) + :background "firebrick")) + "Face used for a traceback." + :group 'jupyter-repl) + +(defcustom jupyter-repl-maximum-size 1024 + "Maximum number of lines before the buffer is truncated." + :type 'integer + :group 'jupyter-repl) + +(defcustom jupyter-repl-maximum-is-complete-timeout 2 + "Maximum number of seconds to wait for an is-complete reply. +When no is-complete reply is received from the kernel within this +timeout, the built-in is-complete handler is used." + :type 'integer + :group 'jupyter-repl) + +(defcustom jupyter-repl-history-maximum-length 100 + "The maximum number of history elements to keep track of." + :type 'integer + :group 'jupyter-repl) + +(defcustom jupyter-repl-prompt-margin-width 12 + "The width of the margin which displays prompt strings." + :type 'integer + :group 'jupyter-repl) + +(defcustom jupyter-repl-cell-pre-send-hook nil + "Hook run before sending the contents of an input cell to a kernel. +The hook is run with `point' at the cell code beginning position +and before the contents of the cell are extracted from the buffer +for sending to the kernel." + :type 'hook + :group 'jupyter-repl) + +(defcustom jupyter-repl-cell-post-send-hook nil + "Hook run after sending the contents of an input cell to a kernel. +The hook is run with `point' at the cell code beginning +position." + :type 'hook + :group 'jupyter-repl) + +(defcustom jupyter-repl-allow-RET-when-busy nil + "Allow RET to insert a newline when the kernel is busy. +Normally when the kernel is busy, pressing RET at an input cell +is disallowed. This is because, when the kernel is busy, it does +not respond to an `:is-complete-request' message and that message +is used to avoid sending incomplete code to the kernel. + +If this variable is non-nil, RET is allowed to insert a newline. +In this case, pressing RET on an empty line, i.e. RET RET, will +send the code to the kernel." + :type 'boolean + :group 'jupyter-repl) + +(defcustom jupyter-repl-echo-eval-p nil + "Copy evaluation input to a REPL cell if non-nil. +If non-nil, and when calling the `jupyter-eval-*' functions like +`jupyter-eval-line-or-region', copy the input into a REPL cell. +Otherwise the evaluation request is sent to the kernel without +displaying the code of the request in the REPL. + +Note, output generated by requests will always be sent to the +REPL buffer whenever this variable is non-nil. When the REPL +buffer isn't visible, output will also be sent to pop-up buffers +as is done when this variable is nil." + :type 'boolean + :group 'jupyter-repl) + +(defcustom jupyter-repl-completion-at-point-hook-depth nil + "The DEPTH of `jupyter-completion-at-point' in `completion-at-point-functions'. + +`completion-at-point-functions' hooks are tried in order. A value of nil for +this variable means `jupyter-completion-at-point' will be added to the head of +the list, which means it will be tried first on completion attempts. This might +prevent other hooks like `lsp-completion-at-point' from running. + +If you'd prefer to give `jupyter-completion-at-point' lower priority, set this +variable to something like 1. Check `add-hook' documentation for more details +about DEPTH." + :type 'integer + :group 'jupyter-repl) + +;;; Implementation + +(defclass jupyter-repl-client (jupyter-widget-client jupyter-kernel-client) + ((buffer + :type (or null buffer) + :initform nil + :documentation "The REPL buffer whose +`jupyter-current-client' is this client.") + (wait-to-clear + :type boolean + :initform nil + :documentation "Whether or not we should wait to clear the +current output of the cell. Set when the kernel sends a +`:clear-output' message."))) + +(defvar-local jupyter-repl-lang-buffer nil + "A buffer with the `major-mode' set to the REPL language's `major-mode'.") + +(defvar-local jupyter-repl-lang-mode nil + "The `major-mode' corresponding to the REPL's language.") + +(defvar-local jupyter-repl-history nil + "The history of the current Jupyter REPL.") + +(defvar-local jupyter-repl-use-builtin-is-complete nil + "Whether or not to send `:is-complete-request's to a kernel. +If a Jupyter kernel does not respond to an is_complete_request, +the buffer local value of this variable is set to t and code in a +cell is considered complete if the last line in a code cell is a +blank line, i.e. if RET is pressed twice in a row.") + +(cl-generic-define-context-rewriter jupyter-repl-mode (mode &rest modes) + `(jupyter-repl-lang-mode (derived-mode ,mode ,@modes))) + +;;; Macros + +(defmacro jupyter-with-repl-buffer (client &rest body) + "Switch to CLIENT's REPL buffer and evaluate BODY. +`inhibit-read-only' is let bound to t while evaluating +BODY. After evaluation, if the current buffer is visible in some +window, set the window point to the value of `point' in the +buffer." + (declare (indent 1) (debug (symbolp &rest form))) + `(with-current-buffer (oref ,client buffer) + (let ((inhibit-read-only t)) + (prog1 (progn ,@body) + (let ((win (get-buffer-window))) + (when win (set-window-point win (point)))))))) + +(defvar jupyter-repl-inhibit-continuation-prompts nil + "Non-nil when continuation prompts are suppressed. +See `jupyter-repl-insert-continuation-prompts'.") + +(defmacro jupyter-repl-without-continuation-prompts (&rest body) + "Evaluate BODY without inserting continuation prompts." + (declare (debug (&rest form))) + `(let ((jupyter-repl-inhibit-continuation-prompts t)) + ,@body)) + +(defmacro jupyter-repl-append-output (client req &rest body) + "Switch to CLIENT's buffer, move to the end of REQ, and evaluate BODY. +REQ is a `jupyter-request' previously made using CLIENT, a REPL +client. + +`point' is moved to the `jupyter-repl-cell-beginning-position' of +the cell *after* REQ, this position is where any newly generated +output of REQ should be inserted. + +Also handles any terminal control codes in the appended output." + (declare (indent 2) (debug (symbolp &rest form))) + `(jupyter-with-repl-buffer ,client + (let ((buffer-undo-list t)) + (save-excursion + (jupyter-repl-goto-cell ,req) + (jupyter-repl-next-cell) + (jupyter-with-insertion-bounds + beg end (jupyter-with-control-code-handling ,@body) + (put-text-property beg end 'read-only t) + (set-buffer-modified-p nil)))))) + +(defmacro jupyter-with-repl-lang-buffer (&rest body) + "Evaluate BODY in the `jupyter-repl-lang-buffer' of the `current-buffer'. +The contents of `jupyter-repl-lang-buffer' is erased before +evaluating BODY." + (declare (indent 0) (debug (&rest form))) + (let ((client (make-symbol "clientvar"))) + `(let ((,client jupyter-current-client)) + (with-current-buffer jupyter-repl-lang-buffer + (let ((inhibit-read-only t) + (jupyter-current-client ,client)) + (erase-buffer) + ,@body))))) + +(defmacro jupyter-with-repl-cell (&rest body) + "Narrow to the current cell, evaluate BODY, then widen. +The cell is narrowed to the region between and including +`jupyter-repl-cell-code-beginning-position' and +`jupyter-repl-cell-code-end-position'." + (declare (indent 0) (debug (&rest form))) + `(save-excursion + (save-restriction + (narrow-to-region (jupyter-repl-cell-code-beginning-position) + (jupyter-repl-cell-code-end-position)) + ,@body))) + +(defmacro jupyter-repl-with-single-undo (&rest body) + "Evaluate BODY, remove all undo boundaries created during its evaluation." + (declare (indent 0) (debug (&rest form))) + (let ((handle (make-symbol "handle"))) + `(let ((,handle (prepare-change-group))) + (unwind-protect + (progn + (activate-change-group ,handle) + ,@body) + (undo-amalgamate-change-group ,handle) + (accept-change-group ,handle))))) + +;;; Text insertion + +(defun jupyter-repl-newline () + "Insert a read-only newline into the `current-buffer'." + (insert (propertize "\n" 'read-only t))) + +(cl-defmethod jupyter-insert :around (mime-or-plist + &context (major-mode jupyter-repl-mode) &rest _ignore) + "If MIME was inserted, mark the region that was inserted as read only. +Do this only when the `major-mode' is `jupyter-repl-mode'." + (if (listp mime-or-plist) (cl-call-next-method) + (jupyter-with-insertion-bounds + beg end (cl-call-next-method) + (add-text-properties beg end '(read-only t))))) + +(cl-defmethod jupyter-insert ((_mime (eql :application/vnd.jupyter.widget-view+json)) data + &context ((and (require 'websocket nil t) + (require 'simple-httpd nil t) + (and jupyter-current-client + (object-of-class-p + jupyter-current-client + 'jupyter-widget-client)) + t) + (eql t)) + &optional _metadata) + (jupyter-widgets-display-model jupyter-current-client (plist-get data :model_id))) + +;;; Util + +(defun jupyter-repl-completing-read-repl-buffer (&optional mode) + "Return a REPL buffer, selecting from all available ones. +Return nil if no REPL buffers are available. + +MODE has the same meaning as in +`jupyter-repl-available-repl-buffers'." + (when-let* ((buffers (jupyter-repl-available-repl-buffers mode)) + (names (mapcar #'buffer-name buffers)) + (buffer (completing-read "REPL buffer: " names nil t))) + (when (equal buffer "") + (error "No REPL buffer selected")) + (get-buffer buffer))) + +;;; Prompt + +(defconst jupyter-repl-input-prompt-format "In [%d] ") +(defconst jupyter-repl-output-prompt-format "Out [%d] ") +(defconst jupyter-repl-busy-prompt "In [*] ") + +(defsubst jupyter-repl--prompt-string (ov) + (nth 0 (overlay-get ov 'jupyter-prompt))) + +(defsubst jupyter-repl--prompt-face (ov) + (nth 1 (overlay-get ov 'jupyter-prompt))) + +(defun jupyter-repl--prompt-margin-alignment (str) + (- jupyter-repl-prompt-margin-width (length str))) + +(defun jupyter-repl--prompt-display-value (str face) + "Return the margin display value for a prompt STR. +FACE is the `font-lock-face' to use for STR." + (list '(margin left-margin) + (propertize + (concat + (make-string (jupyter-repl--prompt-margin-alignment str) ?\s) str) + 'fontified t + 'font-lock-face face))) + +(defun jupyter-repl--reset-prompt-display (ov) + (when-let* ((prompt (jupyter-repl--prompt-string ov)) + (face (or (jupyter-repl--prompt-face ov) + 'jupyter-repl-input-prompt)) + (md (jupyter-repl--prompt-display-value prompt face))) + (overlay-put ov 'after-string (propertize " " 'display md)))) + +(defun jupyter-repl--reset-prompts () + "Re-calculate all prompt strings in the buffer. +Also set the local value of `left-margin-width' to +`jupyter-repl-prompt-margin-width'." + (setq-local left-margin-width jupyter-repl-prompt-margin-width) + (dolist (ov (overlays-in (point-min) (point-max))) + (jupyter-repl--reset-prompt-display ov))) + +(defun jupyter-repl--make-prompt (str face props) + "Make a prompt overlay for the character before POS. +STR is used as the prompt string and FACE is its +`font-lock-face'. Add PROPS as text properties to the character." + (when (< (jupyter-repl--prompt-margin-alignment str) 0) + (setq-local jupyter-repl-prompt-margin-width + (+ jupyter-repl-prompt-margin-width + (abs (jupyter-repl--prompt-margin-alignment str)))) + (jupyter-repl--reset-prompts)) + (let ((ov (make-overlay (1- (point)) (point) nil t))) + (overlay-put ov 'jupyter-prompt (list str face)) + (overlay-put ov 'evaporate t) + (jupyter-repl--reset-prompt-display ov) + (add-text-properties (overlay-start ov) (overlay-end ov) props) + (overlay-recenter (point)))) + +(defun jupyter-repl-insert-prompt (&optional type count) + "Insert a REPL prompt according to TYPE. +TYPE can either be `in', `out', or `continuation'. A nil TYPE is +interpreted as `in'. + +When TYPE is `in' and COUNT is a number, insert a prompt with a +count equal to COUNT. For TYPE `in' and COUNT not a number, the +execution-count of the `jupyter-current-client' will be used as +count. COUNT is ignored otherwise." + (setq type (or type 'in)) + (unless (memq type '(in out continuation)) + (error "Prompt type can only be (`in', `out', or `continuation')")) + (jupyter-repl-without-continuation-prompts + (let ((inhibit-read-only t)) + ;; The newline that `jupyter-repl--make-prompt' will overlay. + (insert (propertize "\n" 'read-only (not (eq type 'continuation)))) + (cond + ((eq type 'in) + (let ((count (if (numberp count) count + (oref jupyter-current-client execution-count)))) + (jupyter-repl--make-prompt + (format jupyter-repl-input-prompt-format count) + 'jupyter-repl-input-prompt + `(jupyter-cell (beginning ,count)))) + ;; Prevent prompt overlay from inheriting text properties of code at the + ;; beginning of a cell. + ;; + ;; The rear-nonsticky property prevents code inserted after + ;; this character from inheriting any of this character's text + ;; properties. + ;; + ;; The front-sticky property prevents `point' from being + ;; trapped between the newline of the prompt overlay and this + ;; invisible character. + (insert (propertize " " + 'read-only t 'invisible t + 'rear-nonsticky t 'front-sticky t)) + ;; The insertion of a new prompt starts a new cell, don't consider the + ;; buffer modified anymore. This is also an indicator for when undo's + ;; can be made in the buffer. + (set-buffer-modified-p nil) + (setq buffer-undo-list '((t . 0)))) + ((eq type 'out) + ;; Output is normally inserted by first going to the end of the output + ;; for the request. The end of the ouput for a request is at the + ;; beginning of the next cell after the request which is why we get the + ;; cell count of the previous cell + (let ((count (jupyter-repl-previous-cell-count))) + (jupyter-repl--make-prompt + (format jupyter-repl-output-prompt-format count) + 'jupyter-repl-output-prompt + `(jupyter-cell (out ,count)))) + ;; See the note above about the invisible character for input prompts + (insert (propertize " " 'read-only t 'invisible t 'front-sticky t))) + ((eq type 'continuation) + (jupyter-repl--make-prompt + ;; This needs to be two characters wide for some + ;; reason, otherwise the continuation prompts will + ;; be missing one character. + " " 'jupyter-repl-input-prompt + `(read-only nil rear-nonsticky t))))))) + +(defun jupyter-repl-prompt-string () + "Return the prompt string of the current input cell." + (jupyter-repl--prompt-string + (car (overlays-at (jupyter-repl-cell-beginning-position))))) + +(defun jupyter-repl-cell-reset-prompt () + "Reset the current prompt back to its default." + (jupyter-repl-cell-update-prompt + (format jupyter-repl-input-prompt-format (jupyter-repl-cell-count)))) + +(defun jupyter-repl-cell-update-prompt (str &optional face) + "Update the current cell's input prompt. +STR is the replacement prompt string. If FACE is non-nil, it +should be a face that the prompt will use and defaults to +`jupyter-repl-input-prompt'." + (when-let* ((ov (car (overlays-at (jupyter-repl-cell-beginning-position))))) + (overlay-put ov 'jupyter-prompt (list str face)) + (jupyter-repl--reset-prompt-display ov))) + +(defun jupyter-repl-cell-mark-busy () + "Mark the current cell as busy." + (when (equal (jupyter-repl-prompt-string) + (format jupyter-repl-input-prompt-format + (jupyter-repl-cell-count))) + (jupyter-repl-cell-update-prompt jupyter-repl-busy-prompt))) + +(defun jupyter-repl-cell-unmark-busy () + "Un-mark the current cell as busy." + (when (equal (jupyter-repl-prompt-string) jupyter-repl-busy-prompt) + (jupyter-repl-cell-update-prompt + (format jupyter-repl-input-prompt-format + (jupyter-repl-cell-count))))) + +(defun jupyter-repl-update-cell-count (n) + "Set the current cell count to N." + (when (or (jupyter-repl-cell-beginning-p) + (zerop (save-excursion (jupyter-repl-previous-cell)))) + (setf (nth 1 (get-text-property + (jupyter-repl-cell-beginning-position) + 'jupyter-cell)) + n) + (when (string-match-p "In \\[[0-9]+\\]" (jupyter-repl-prompt-string)) + (jupyter-repl-cell-reset-prompt)))) + +(defun jupyter-repl-cell-count () + "Return the cell count of the cell at `point'." + (let ((pos (if (jupyter-repl-cell-beginning-p) (point) + (save-excursion + (jupyter-repl-previous-cell) + (point))))) + (nth 1 (get-text-property pos 'jupyter-cell)))) + +(defun jupyter-repl-previous-cell-count () + "Return the cell count of the previous cell before `point'." + (save-excursion + (jupyter-repl-previous-cell) + (jupyter-repl-cell-count))) + +(defun jupyter-repl-cell-request () + "Return the `jupyter-request' of the current cell." + (get-text-property (jupyter-repl-cell-beginning-position) 'jupyter-request)) + +;;; Cell motions + +(defun jupyter-repl-cell-beginning-position () + "Return the cell beginning position of the current cell. +If `point' is already at the beginning of the current cell, +return `point'. + +If the end of a cell is found before the beginning of one, i.e. +when `point' is somewhere inside the output of a cell, raise an +error. + +If the beginning of the buffer is found before the beginning of a +cell, raise a `beginning-of-buffer' error." + (let ((pos (point))) + (while (not (jupyter-repl-cell-beginning-p pos)) + (setq pos (previous-single-property-change pos 'jupyter-cell)) + (if pos (when (jupyter-repl-cell-end-p pos) + (error "Found end of previous cell")) + (if (jupyter-repl-cell-beginning-p (point-min)) + (setq pos (point-min)) + (signal 'beginning-of-buffer nil)))) + pos)) + +(defun jupyter-repl-cell-end-position () + "Return the cell ending position of the current cell. +This is similar to `jupyter-repl-cell-beginning-position' except +the position at the end of the current cell is returned and an +error is raised if the beginning of a cell is found before an +end. + +Note: If the current cell is the last cell in the buffer, +`point-max' is considered the end of the cell." + (let ((pos (point))) + (catch 'unfinalized + (while (not (jupyter-repl-cell-end-p pos)) + (setq pos (next-single-property-change pos 'jupyter-cell)) + (if pos (when (jupyter-repl-cell-beginning-p pos) + (error "Found beginning of next cell")) + ;; Any unfinalized cell must be at the end of the buffer. + (throw 'unfinalized (point-max)))) + pos))) + +(defun jupyter-repl-cell-code-beginning-position () + "Return the beginning of the current cell's code. +The code beginning position is + + `jupyter-repl-cell-beginning-position' + 2 + +There is an extra invisible character after the prompt." + (+ (jupyter-repl-cell-beginning-position) 2)) + +(defun jupyter-repl-cell-code-end-position () + "Return the end of the current cell's code. +In the case of the last cell in the REPL buffer, i.e. an +unfinalized cell, the code ending position is `point-max'." + (jupyter-repl-cell-end-position)) + +(defun jupyter-repl-next-cell (&optional N) + "Go to the beginning of the next cell. +Move N times where N defaults to 1. Return the count of cells +left to move." + (or N (setq N 1)) + (catch 'done + (while (> N 0) + (let ((pos (next-single-property-change (point) 'jupyter-cell))) + (while (and pos (not (jupyter-repl-cell-beginning-p pos))) + (setq pos (next-single-property-change pos 'jupyter-cell))) + (unless (when pos (goto-char pos) (setq N (1- N))) + (goto-char (point-max)) + (throw 'done t))))) + N) + +(defun jupyter-repl-previous-cell (&optional N) + "Go to the beginning of the previous cell. +Move N times where N defaults to 1. Return the count of cells +left to move. + +Note, if `point' is not at the beginning of the current cell, the +first move is to the beginning of the current cell." + (or N (setq N 1)) + (catch 'done + (let ((starting-pos (point))) + (while (> N 0) + (let ((pos (previous-single-property-change (point) 'jupyter-cell))) + (while (and pos (not (jupyter-repl-cell-beginning-p pos))) + (setq pos (previous-single-property-change pos 'jupyter-cell))) + (unless (when pos (goto-char pos) (setq N (1- N))) + (goto-char (point-min)) + ;; Handle edge case when the first cell is at the beginning of the + ;; buffer. This happens, for example, when erasing the buffer. + (when (and (/= (point) starting-pos) + (jupyter-repl-cell-beginning-p (point))) + (setq N (1- N))) + (throw 'done t)))))) + N) + +(defun jupyter-repl-goto-cell (req) + "Go to the cell beginning position of REQ. +REQ should be a `jupyter-request' associated with a cell in the + `current-buffer'. Note that the `current-buffer' is assumed to + be a Jupyter REPL buffer." + (goto-char (point-max)) + (unless (catch 'done + (while (= (jupyter-repl-previous-cell) 0) + (when (eq (jupyter-repl-cell-request) req) + (throw 'done t)))) + (error "Cell for request not found"))) + +(defun jupyter-repl-forward-cell (&optional arg) + "Go to the code beginning of the cell after the current one. +ARG is the number of cells to move and defaults to 1." + (interactive "^p") + (or arg (setq arg 1)) + (jupyter-repl-next-cell arg) + (goto-char (jupyter-repl-cell-code-beginning-position))) + +(defun jupyter-repl-backward-cell (&optional arg) + "Go to the code beginning of the cell before the current one. +ARG is the number of cells to move and defaults to 1." + (interactive "^p") + (or arg (setq arg 1)) + ;; Ignore the case when `point' is in the output of a cell, in this case + ;; `jupyter-repl-previous-cell' will go to the previous cell. + (ignore-errors (goto-char (jupyter-repl-cell-beginning-position))) + (jupyter-repl-previous-cell arg) + (goto-char (jupyter-repl-cell-code-beginning-position))) + +(defun jupyter-repl-map-cells (beg end input output) + "Call INPUT or OUTPUT on the corresponding cells between BEG and END. +For every input or output cell between BEG and END, call INPUT or +OUTPUT, respectively, with the buffer narrowed to the cell. +INPUT and OUTPUT are functions of no arguments. + +Note the narrowed regions may not be full input/output cells if +BEG and END are within an input/output cell." + (declare (indent 2)) + (save-excursion + (save-restriction + (let (next) + (while (/= beg end) + (widen) + (cond + ((eq (get-text-property beg 'field) 'cell-code) + (setq next (min end (field-end beg t))) + (narrow-to-region beg next) + (funcall input)) + (t + (setq next (or (text-property-any + beg end 'field 'cell-code) + end)) + (narrow-to-region beg next) + (funcall output))) + (setq beg next)))))) + +;;; Predicates + +(defun jupyter-repl-cell-beginning-p (&optional pos) + "Is POS the beginning of a cell? +POS defaults to `point'." + (setq pos (or pos (point))) + (eq (nth 0 (get-text-property pos 'jupyter-cell)) 'beginning)) + +(defun jupyter-repl-cell-end-p (&optional pos) + "Is POS the end of a cell? +POS defaults to `point'." + (setq pos (or pos (point))) + (or (= pos (point-max)) + (eq (nth 0 (get-text-property pos 'jupyter-cell)) 'end))) + +(defun jupyter-repl-multiline-p (text) + "Is TEXT a multi-line string?" + (string-match-p "\n" text)) + +(defun jupyter-repl-cell-line-p () + "Is the current line a cell input line?" + (let ((pos (point))) + (ignore-errors + (save-excursion + (unless (= pos (jupyter-repl-cell-beginning-position)) + (jupyter-repl-previous-cell)) + (<= (jupyter-repl-cell-code-beginning-position) + pos + (jupyter-repl-cell-code-end-position)))))) + +(defun jupyter-repl-cell-finalized-p () + "Has the current cell been finalized?" + (or (not (jupyter-repl-cell-line-p)) + (/= (jupyter-repl-cell-end-position) (point-max)))) + +(defun jupyter-repl-connected-p () + "Is the `jupyter-current-client' connected to its kernel?" + (and jupyter-current-client + (jupyter-connected-p jupyter-current-client))) + +;;; Modifying cell code, truncating REPL buffer + +(defun jupyter-repl-cell-output () + "Return the output of the current cell." + (unless (jupyter-repl-cell-finalized-p) + (error "Cell not finalized")) + (let ((beg (jupyter-repl-cell-end-position)) + (end (save-excursion + (jupyter-repl-next-cell) + (jupyter-repl-cell-beginning-position)))) + (buffer-substring beg end))) + +(defun jupyter-repl-cell-code () + "Return the code of the current cell." + (buffer-substring + (jupyter-repl-cell-code-beginning-position) + (jupyter-repl-cell-code-end-position))) + +(defun jupyter-repl-cell-code-position () + "Return the relative position of `point' with respect to the cell code." + (unless (jupyter-repl-cell-line-p) + (error "Not in code of cell")) + (1+ (- (point) (jupyter-repl-cell-code-beginning-position)))) + +(defun jupyter-repl-finalize-cell (req) + "Finalize the current input cell. +REQ is the `jupyter-request' to associate with the current cell. +Place `point' at `point-max'." + (goto-char (point-max)) + (let ((beg (jupyter-repl-cell-beginning-position)) + (count (jupyter-repl-cell-count))) + (jupyter-repl-newline) + (put-text-property (1- (point)) (point) 'jupyter-cell `(end ,count)) + (put-text-property beg (1+ beg) 'jupyter-request req) + ;; Remove this property so that text can't be inserted at the start of the + ;; cell or after any continuation prompts. See + ;; `jupyter-repl-insert-prompt'. + (remove-text-properties beg (point) '(rear-nonsticky)) + (add-text-properties beg (point) '(read-only t)) + ;; reset the undo list so that a completed cell doesn't get undone. + (setq buffer-undo-list '((t . 0))))) + +(defun jupyter-repl-replace-cell-code (new-code) + "Replace the current cell code with NEW-CODE. +If NEW-CODE is a buffer use `replace-buffer-contents' to replace +the cell code. Otherwise NEW-CODE should be a string, the current +cell code will be erased and NEW-CODE inserted in its place." + (if (bufferp new-code) + (jupyter-with-repl-cell + (jupyter-repl-with-single-undo + ;; Need to create a single undo step here because + ;; `replace-buffer-contents' adds in unwanted undo boundaries. + ;; + ;; Tests failing on Appveyor due to `replace-buffer-contents' not + ;; supplying the right arguments to `after-change-functions' so call + ;; the change functions manually. Seen on Emacs 26.1. + ;; + ;; For reference see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278 + (let ((inhibit-modification-hooks t) + (beg (point-min)) + (end (point-max)) + (new-len (with-current-buffer new-code + (- (point-max) (point-min))))) + (run-hook-with-args + 'before-change-functions beg end) + (replace-buffer-contents new-code) + (run-hook-with-args + 'after-change-functions + beg (+ beg new-len) (- end beg))))) + (goto-char (jupyter-repl-cell-code-beginning-position)) + (delete-region (point) (jupyter-repl-cell-code-end-position)) + (insert-and-inherit new-code))) + +(defun jupyter-repl-truncate-buffer () + "Truncate the `current-buffer' based on `jupyter-repl-maximum-size'. +The `current-buffer' is assumed to be a Jupyter REPL buffer. If +the `current-buffer' is larger than `jupyter-repl-maximum-size' +lines, truncate it to something less than +`jupyter-repl-maximum-size' lines." + (save-excursion + (when (= (forward-line (- jupyter-repl-maximum-size)) 0) + (jupyter-repl-next-cell) + (delete-region (point-min) (point))))) + +(defun jupyter-repl-clear-cells () + "Clear the input and output cells of the current buffer." + (interactive) + (jupyter-repl-without-continuation-prompts + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (when (get-text-property (point) 'jupyter-banner) + (goto-char (next-single-property-change (point) 'jupyter-banner))) + (delete-region (point) (point-max)) + (jupyter-repl-insert-prompt 'in)))) + (goto-char (point-max))) + +(defun jupyter-repl-clear-input () + "Clear the contents of the input cell." + (interactive) + (goto-char (point-max)) + (delete-region + (jupyter-repl-cell-code-beginning-position) + (point-max))) + +;;; Handlers + +(defun jupyter-repl-history-add (code) + "Add CODE as the newest element in the REPL history." + ;; Ensure the newest element is actually the newest element and not the most + ;; recently navigated history element. + (while (not (eq (ring-ref jupyter-repl-history -1) 'jupyter-repl-history)) + (ring-insert jupyter-repl-history (ring-remove jupyter-repl-history))) + ;; Remove the second to last element when the ring is full to preserve the + ;; sentinel. + (when (eq (ring-length jupyter-repl-history) + (ring-size jupyter-repl-history)) + (ring-remove jupyter-repl-history -2)) + (ring-remove+insert+extend jupyter-repl-history code)) + +(defun jupyter-repl-execute-cell (&optional client) + "Execute the last REPL cell of CLIENT. +Return the `jupyter-request' representing the executed code." + (or client (setq client jupyter-current-client)) + (cl-check-type client jupyter-repl-client) + (jupyter-with-repl-buffer client + (jupyter-repl-truncate-buffer) + (save-excursion + (goto-char (jupyter-repl-cell-code-beginning-position)) + (run-hooks 'jupyter-repl-cell-pre-send-hook)) + (let ((code (string-trim (jupyter-repl-cell-code)))) + (jupyter-run-with-client client + (jupyter-mlet* ((req (jupyter-execute-request + :code code + ;; Handle empty code cells as just an update + ;; of the prompt number + :silent (and (= (length code) 0) t)))) + (jupyter-repl-without-continuation-prompts + (jupyter-repl-cell-mark-busy) + (jupyter-repl-finalize-cell req) + (jupyter-repl-history-add code) + (jupyter-repl-insert-prompt + 'in (1+ (oref client execution-count)))) + (save-excursion + (jupyter-repl-backward-cell) + (run-hooks 'jupyter-repl-cell-post-send-hook)) + (jupyter-sent (jupyter-return req))))))) + +(cl-defmethod jupyter-handle-payload ((_source (eql set_next_input)) pl + &context (major-mode jupyter-repl-mode)) + (goto-char (point-max)) + (jupyter-repl-previous-cell) + (jupyter-repl-replace-cell-code (plist-get pl :text))) + +(cl-defmethod jupyter-handle-execute-reply ((client jupyter-repl-client) _req msg) + (jupyter-with-repl-buffer client + (jupyter-with-message-content msg (payload) + (when payload + (jupyter-handle-payload payload))))) + +(cl-defmethod jupyter-handle-execute-result ((client jupyter-repl-client) req msg) + ;; Only handle our results + (when req + (jupyter-repl-append-output client req + (jupyter-repl-insert-prompt 'out) + (jupyter-with-message-content msg (data metadata) + (jupyter-insert data metadata))))) + +(cl-defmethod jupyter-handle-display-data ((client jupyter-repl-client) req msg) + (let ((clear (prog1 (oref client wait-to-clear) + (oset client wait-to-clear nil))) + (req (if (equal (jupyter-message-parent-type msg) "comm_msg") + ;; For comm messages which produce a display_data message, + ;; the request is assumed to be the most recently completed + ;; one. + (jupyter-with-repl-buffer client + (save-excursion + (goto-char (point-max)) + (jupyter-repl-previous-cell 2) + (jupyter-repl-cell-request))) + req))) + (jupyter-repl-append-output client req + (jupyter-with-message-content msg (data metadata transient) + (cl-destructuring-bind (&key display_id &allow-other-keys) + transient + (if display_id + (jupyter-insert display_id data metadata) + (let ((inhibit-redisplay (not debug-on-error))) + (when clear + (jupyter-repl-clear-last-cell-output client) + ;; Prevent slight flickering of prompt margin and text, this is + ;; needed in addition to `inhibit-redisplay'. It also seems that + ;; it can be placed anywhere within this let and it will prevent + ;; flickering. + (sit-for 0.1 t)) + (jupyter-insert data metadata)))))))) + +(cl-defmethod jupyter-handle-update-display-data ((client jupyter-repl-client) _req msg) + (jupyter-with-message-content msg (data metadata transient) + (cl-destructuring-bind (&key display_id &allow-other-keys) + transient + (unless display_id + (error "No display ID in `update_display_data' message")) + (jupyter-with-repl-buffer client + (jupyter-update-display display_id data metadata))))) + +(defun jupyter-repl-clear-last-cell-output (client) + "In CLIENT's REPL buffer, clear the output of the last completed cell." + (jupyter-with-repl-buffer client + (goto-char (point-max)) + (jupyter-repl-previous-cell 2) + (delete-region (1+ (jupyter-repl-cell-end-position)) + (progn + (jupyter-repl-next-cell) + (point))))) + +(cl-defmethod jupyter-handle-clear-output ((client jupyter-repl-client) _req msg) + (unless (oset client wait-to-clear + (jupyter-with-message-content msg (wait) + (eq wait t))) + (cond + ((equal (jupyter-message-parent-type msg) "comm_msg") + (with-current-buffer (jupyter-get-buffer-create "output") + (erase-buffer))) + (t + (jupyter-repl-clear-last-cell-output client))))) + +(cl-defmethod jupyter-handle-status ((client jupyter-repl-client) req msg) + (when (equal "idle" + (jupyter-with-message-content msg (execution_state) + execution_state)) + (jupyter-with-repl-buffer client + (save-excursion + (when (ignore-errors + (progn (jupyter-repl-goto-cell req) t)) + (jupyter-repl-cell-unmark-busy)) + ;; Update the cell count and reset the prompt + (goto-char (point-max)) + (jupyter-repl-update-cell-count (oref client execution-count))))) + (force-mode-line-update)) + +(defun jupyter-repl-display-other-output (client stream text) + "Display output not originating from CLIENT. +STREAM is the name of a stream which will be used to select the +buffer to display TEXT." + (let* ((bname (buffer-name (oref client buffer))) + (stream-buffer + (concat (substring bname 0 (1- (length bname))) "-" stream "*"))) + ;; FIXME: Reset this on the next request + (jupyter-with-display-buffer stream-buffer nil + (let ((pos (point))) + (jupyter-insert-ansi-coded-text text) + (fill-region pos (point))) + (jupyter-display-current-buffer-reuse-window)))) + +(cl-defmethod jupyter-handle-stream ((client jupyter-repl-client) req msg) + (jupyter-with-message-content msg (name text) + (if (null req) + (jupyter-repl-display-other-output client name text) + (cond + ((equal (jupyter-message-parent-type + (jupyter-request-last-message req)) + "comm_msg") + (jupyter-with-display-buffer "output" req + (jupyter-insert-ansi-coded-text text) + (jupyter-display-current-buffer-reuse-window))) + (t + (jupyter-repl-append-output client req + (jupyter-insert-ansi-coded-text text))))))) + +(cl-defmethod jupyter-handle-error ((client jupyter-repl-client) req msg) + (when req + (jupyter-with-message-content msg (traceback) + (cond + ((equal (jupyter-message-parent-type msg) "comm_msg") + (jupyter-display-traceback traceback)) + (t + (jupyter-repl-append-output client req + (jupyter-with-insertion-bounds + beg end (jupyter-insert-ansi-coded-text + (concat (mapconcat #'identity traceback "\n") "\n")) + (font-lock-prepend-text-property + beg end 'font-lock-face 'jupyter-repl-traceback)))))))) + +(defun jupyter-repl-history--rotate (n) + "Rotate the REPL history ring N times. +The direction of rotation is determined by the sign of N. For N +positive rotate to newer history elements, for N negative rotate +to older elements. + +Return nil if the sentinel value is found before completing the +required number of rotations, otherwise return the element +rotated to, i.e. the one at index 0." + (let (ifun cidx ridx) + (if (> n 0) + (setq ifun 'ring-insert cidx -1 ridx -1) + (setq ifun 'ring-insert-at-beginning cidx 1 ridx 0)) + (cl-loop + repeat (abs n) + ;; Check that the next index to rotate to is not the sentinel + if (eq (ring-ref jupyter-repl-history cidx) 'jupyter-repl-history) + return nil else do + ;; if it isn't, remove an element at RIDX and insert it using IFUN back + ;; into the history ring, thereby rotating the history + (funcall ifun jupyter-repl-history + (ring-remove jupyter-repl-history ridx)) + ;; after N successful rotations, return the element rotated to + finally return (let ((el (ring-ref jupyter-repl-history 0))) + (unless (eq el 'jupyter-repl-history) + el))))) + +(defun jupyter-repl-history--match-input (regexp arg) + "Return the index of the ARGth REGEXP match. +Or nil, on failure. If ARG is positive, search backward from the most +recent history element. If negative, search forward through items +previously visited during this input session. If ARG is zero, do +nothing." + ;; Adapted from `comint-previous-matching-input-string-position' + (let* ((direction (if (> arg 0) +1 -1)) + (i (if (= direction -1) 0 -1)) ; adjust for initial increment + (failed (zerop arg)) + ;; + code) + ;; Search ARG times + (while (not (or failed (zerop arg))) + (while (not (or (setq code (ring-ref jupyter-repl-history + (cl-incf i direction)) + failed (eq 'jupyter-repl-history code)) + (string-match-p regexp code)))) + (setq arg (- arg direction))) + (unless failed i))) + +(defun jupyter-repl-history-previous-matching (&optional n) + "Search input history for the input pending before point. +On success, replace the current input with the matching code element +while preserving and returning point. Ding on failure. If N is negative, +find the Nth next match; if positive, the Nth previous. If N is zero or +nil, pretend it's one." + ;; Adapted from: `comint-previous-matching-input-from-input' and friends + (interactive "p") + (when (or (null n) (zerop n)) (setq n 1)) + (let ((opoint (point)) + (code (jupyter-repl-cell-code)) + (is-prev (> n 0)) + (input-string (buffer-substring + (jupyter-repl-cell-code-beginning-position) (point))) + found) + ;; Look past an initial duplicate + (when (equal code (ring-ref jupyter-repl-history (if is-prev 0 -1))) + (cl-incf n (if is-prev 1 -1))) + (if (not (setq found (jupyter-repl-history--match-input + (concat "^" (regexp-quote input-string)) n))) + (user-error "No %s matching input" (if is-prev "earlier" "later")) + (setq code (ring-ref jupyter-repl-history found)) + (jupyter-repl-history--rotate (- found)) + (jupyter-repl-replace-cell-code code) + (goto-char opoint)))) + +(defun jupyter-repl-history-next-matching (&optional n) + "Search existing history session for an element matching input. +Only consider the text before point. If N is negative, find the Nth +previous match, otherwise the Nth next. If N is zero or nil, make it +one. \"Existing history session\" means those history elements already +visited while forming the current input." + (interactive "p") + (when (or (null n) (zerop n)) (setq n 1)) + (jupyter-repl-history-previous-matching (- n))) + +(defun jupyter-repl-history-next (&optional n) + "Go to the next history element. +Navigate through the REPL history to the next (newer) history +element and insert it as the last code cell. For N positive move +forward in history that many times. If N is negative, move to +older history elements." + (interactive "p") + (or n (setq n 1)) + (if (< n 0) (jupyter-repl-history-previous (- n)) + (goto-char (point-max)) + (let ((code (jupyter-repl-history--rotate n))) + (if (and (null code) (equal (jupyter-repl-cell-code) "")) + (error "End of history") + (if (null code) + ;; When we have reached the last history element in the forward + ;; direction and the cell code is not empty, make it empty. + (jupyter-repl-replace-cell-code "") + (jupyter-repl-replace-cell-code code)))))) + +(defun jupyter-repl-history-previous (&optional n) + "Go to the previous history element. +Similar to `jupyter-repl-history-next' but for older history +elements. If N is negative in this case, move to newer history +elements." + (interactive "p") + (or n (setq n 1)) + (if (< n 0) (jupyter-repl-history-next (- n)) + (goto-char (point-max)) + (unless (equal (jupyter-repl-cell-code) + (ring-ref jupyter-repl-history 0)) + (setq n (1- n))) + (let ((code (jupyter-repl-history--rotate (- n)))) + (if (null code) + (error "Beginning of history") + (jupyter-repl-replace-cell-code code))))) + +(cl-defmethod jupyter-handle-history-reply ((client jupyter-repl-client) _req msg) + (jupyter-with-repl-buffer client + (cl-loop for elem across (jupyter-with-message-content msg (history) history) + for input-output = (aref elem 2) + do (ring-remove+insert+extend jupyter-repl-history input-output)))) + +(cl-defmethod jupyter-handle-is-complete-reply ((client jupyter-repl-client) _req msg) + (jupyter-with-repl-buffer client + (jupyter-with-message-content msg (status indent) + ;; `run-at-time' is used here so that the waiting done in + ;; `jupyter-repl-ret' completes before a cell is executed. + (pcase status + ("complete" + (run-at-time 0 nil (lambda () (jupyter-repl-execute-cell client)))) + ("incomplete" + (insert "\n") + (if (= (length indent) 0) (jupyter-repl-indent-line) + (insert indent))) + ("invalid" + ;; Force an execute to produce a traceback + (run-at-time 0 nil (lambda () (jupyter-repl-execute-cell client)))) + ("unknown" + ;; Let the kernel decide if the code is complete + (run-at-time 0 nil (lambda () (jupyter-repl-execute-cell client)))))))) + +(defun jupyter-repl--insert-banner-and-prompt (client) + (jupyter-with-repl-buffer client + (goto-char (point-max)) + (unless (jupyter-repl-cell-finalized-p) + (jupyter-repl-finalize-cell nil)) + (jupyter-repl-newline) + (jupyter-repl-insert-banner + (plist-get (jupyter-kernel-info client) :banner)) + (jupyter-repl-insert-prompt 'in) + (jupyter-repl-update-cell-count 1))) + +(cl-defmethod jupyter-handle-shutdown-reply ((client jupyter-repl-client) _req msg) + (jupyter-with-repl-buffer client + (jupyter-repl-without-continuation-prompts + (goto-char (point-max)) + (let ((shutdown-handled-p (jupyter-repl-cell-finalized-p))) + (unless (jupyter-repl-cell-finalized-p) + (jupyter-repl-finalize-cell nil)) + ;; Only run the following once. The Python kernel sends a shutdown-reply + ;; on both the shell and iopub which is mainly the reason why this is + ;; needed. + (unless shutdown-handled-p + (jupyter-repl-newline) + (jupyter-repl-newline) + (jupyter-with-message-content msg (restart) + ;; TODO: Add a slot mentioning that the kernel is shutdown so that we can + ;; block sending requests or delay until it has restarted. + (insert (propertize (concat "kernel " (if restart "restart" "shutdown")) + 'read-only t 'font-lock-face 'warning)) + (jupyter-repl-newline) + (when restart + (jupyter-repl--insert-banner-and-prompt client)))))))) + +(defun jupyter-repl-ret (&optional force) + "Send the current cell code to the kernel. +If `point' is before the last cell in the REPL buffer move to +`point-max', i.e. move to the last cell. Otherwise if `point' is +at some position within the last cell, either insert a newline or +ask the kernel to execute the cell code depending on the kernel's +response to an `:is-complete-request'. + +If a prefix argument is given, FORCE the kernel to execute the +current cell code without sending an `:is-complete-request'. See +`jupyter-repl-use-builtin-is-complete' for yet another way to +execute the current cell." + (interactive "P") + (condition-case nil + (let ((cell-beginning (save-excursion + (goto-char (point-max)) + (jupyter-repl-cell-beginning-position)))) + (if (< (point) cell-beginning) + (goto-char (point-max)) + (unless (jupyter-repl-connected-p) + (error "Kernel not alive")) + ;; NOTE: kernels allow execution requests to queue up, but we prevent + ;; sending a request when the kernel is busy because of the + ;; is-complete request. Some kernels don't respond to this request + ;; when the kernel is busy. + (when (and (jupyter-kernel-busy-p jupyter-current-client) + (not jupyter-repl-allow-RET-when-busy)) + (error "Kernel busy")) + (cond + (force (jupyter-repl-execute-cell)) + ((or jupyter-repl-use-builtin-is-complete + (and jupyter-repl-allow-RET-when-busy + (jupyter-kernel-busy-p jupyter-current-client))) + (goto-char (point-max)) + (let ((complete-p (equal (buffer-substring-no-properties + (line-beginning-position) (point)) + ""))) + (jupyter-handle-is-complete-reply + jupyter-current-client + nil `(:content + (:status ,(if complete-p "complete" "incomplete") + :indent ""))))) + (t + (condition-case nil + (jupyter-run-with-client jupyter-current-client + (jupyter-idle + (jupyter-is-complete-request + :code (jupyter-repl-cell-code) + :handlers '("is_complete_reply")) + jupyter-repl-maximum-is-complete-timeout)) + (jupyter-timeout-before-idle + (message "\ +Kernel did not respond to is-complete-request, using built-in is-complete. +Reset `jupyter-repl-use-builtin-is-complete' to nil if this is only temporary.") + (setq jupyter-repl-use-builtin-is-complete t) + (jupyter-repl-ret force))))))) + (beginning-of-buffer + ;; No cells in the current buffer, just insert one + (jupyter-repl-insert-prompt 'in)))) + +(cl-defgeneric jupyter-indent-line () + (call-interactively #'indent-for-tab-command)) + +(defun jupyter-repl-indent-line () + "Indent the line according to the language of the REPL." + (when-let* ((pos (and (jupyter-repl-cell-line-p) + (jupyter-repl-cell-code-position))) + (code (jupyter-repl-cell-code)) + (replacement + (jupyter-with-repl-lang-buffer + (insert code) + (goto-char pos) + (let ((tick (buffer-chars-modified-tick))) + (jupyter-indent-line) + (unless (eq tick (buffer-chars-modified-tick)) + (setq pos (point)) + (current-buffer)))))) + ;; Don't modify the buffer when unnecessary, this allows + ;; `company-indent-or-complete-common' to work. + (when replacement + (jupyter-repl-replace-cell-code replacement) + (goto-char (+ pos (jupyter-repl-cell-code-beginning-position)))))) + +;;; Buffer change functions + +(defun jupyter-repl-yank-handle-field-property (val beg end) + "If VAL is not cell-code, remove the field property between BEG and END. +Yanking text into a REPL cell normally removes the field +property (see `yank-excluded-properties') but this property is +added in `jupyter-repl-after-change' to mark text in an input cell. + +The problem is that the after change functions run *before* +`insert-for-yank' removes the field property. This function is +added to `yank-handled-properties' to prevent the removal of +field when the associated text is part of the input to a REPL +cell." + ;; Assume that text with a field value of cell-code is due to + ;; `jupyter-repl-mark-as-cell-code'. + (unless (eq val 'cell-code) + (remove-text-properties beg end '(field)))) + +(defun jupyter-repl-insert-continuation-prompts (bound) + "Insert continuation prompts if needed, stopping at BOUND. +Return the new BOUND since inserting continuation prompts may add +more characters than were initially in the buffer. + +If `jupyter-repl-inhibit-continuation-prompts' is non-nil return +BOUND without inserting any continuation prompts." + (if jupyter-repl-inhibit-continuation-prompts + bound + (setq bound (set-marker (make-marker) bound)) + (set-marker-insertion-type bound t) + ;; Don't record these changes. They add unnecessary undo + ;; information that interferes with undo. + (let ((buffer-undo-list t)) + (while (and (< (point) bound) + (search-forward "\n" bound 'noerror)) + ;; Delete the newline that is re-added by prompt insertion + ;; FIXME: Why not just overlay the newline? + (delete-char -1) + (jupyter-repl-insert-prompt 'continuation))) + (prog1 (marker-position bound) + (set-marker bound nil)))) + +(defun jupyter-repl-mark-as-cell-code (beg end) + "Add the field property to text between (BEG . END) if within a code cell." + ;; Handle field boundary at the front of the cell code + (when (< beg end) + (when (= beg (jupyter-repl-cell-code-beginning-position)) + (put-text-property beg (1+ beg) 'front-sticky t)) + (when (text-property-not-all beg end 'field 'cell-code) + (font-lock-fillin-text-property beg end 'field 'cell-code)))) + +(defun jupyter-repl-do-after-change (beg end len) + "Call `jupyter-repl-after-change' when the current cell code is changed. +`jupyter-repl-after-change' is only called when BEG is a position +on a `jupyter-repl-cell-line-p'. BEG, END, and LEN have the same +meaning as in `after-change-functions'." + (when (eq major-mode 'jupyter-repl-mode) + (with-demoted-errors "Jupyter error after buffer change: %S" + (save-restriction + ;; Take into account insertions that may have the buffer narrowed since + ;; functions like `jupyter-repl-cell-code-beginning-position' need to + ;; look at parts of the buffer not necessarily within the narrowed + ;; region. See #38. + ;; + ;; TODO: Does it really make sense to widen the buffer? To get around + ;; this, how can functions like + ;; `jupyter-repl-cell-code-beginning-position' and + ;; `jupyter-repl-cell-line-p' only rely on the `field' text property? + (widen) + (when (save-excursion + (goto-char beg) + (jupyter-repl-cell-line-p)) + (cond + ((= len 0) + (jupyter-repl-after-change 'insert beg end)) + ((and (= beg end) (not (zerop len))) + (jupyter-repl-after-change 'delete beg len)) + ;; Text property changes + ((= (- end beg) len) + ;; Revert changes made by `insert-for-yank'. See #14. + (when (and (= len 1) + (get-text-property beg 'rear-nonsticky) + (= end (jupyter-repl-cell-end-position))) + (remove-text-properties beg end '(rear-nonsticky)))) + ;; Post change inserted text in the region + ((> (- end beg) len) + (jupyter-repl-after-change 'insert beg end)) + ;; Post change deleted text + (t + ;; FIXME: This is probably wrong. + (jupyter-repl-after-change 'delete beg (- len (- end beg)))))))))) + +(cl-defgeneric jupyter-repl-after-change (_type _beg _end-or-len) + "Called from the `after-change-functions' of a REPL buffer. +Modify the text just inserted or deleted. TYPE is either insert +or delete to signify if the change was due to insertion or +deletion of text. BEG is always the beginning of the insertion or +deletion. END-OR-LEN is the end of the insertion when TYPE is +insert and is the length of the deleted text when TYPE is delete. + +The `after-change-functions' of the REPL buffer are only called +for changes to input cells and not for output generated by the +kernel. + +Note, the overriding method should call `cl-call-next-method'. + +Also note, any buffer narrowing will be temporarily removed when +this method is called." + nil) + +(cl-defmethod jupyter-repl-after-change ((_type (eql insert)) beg end) + (goto-char beg) + ;; Avoid doing anything on self insertion + (unless (and (= (point) (1- end)) + (not (eq (char-after) ?\n))) + (setq end (jupyter-repl-insert-continuation-prompts end))) + (jupyter-repl-mark-as-cell-code beg end) + (goto-char end)) + +(cl-defmethod jupyter-repl-after-change ((_type (eql delete)) beg _len) + ;; Ensure that the `front-sticky' property at the beginning of cell code is + ;; added after deleting text at the beginning of a cell. + (jupyter-repl-mark-as-cell-code beg (min (point-max) (+ beg 1)))) + +(defvar jupyter-repl-interaction-mode) + +(defun jupyter-repl--deactivate-interaction-buffers () + (cl-loop + with client = jupyter-current-client + for buffer in (buffer-list) + do (with-current-buffer buffer + (when (and jupyter-repl-interaction-mode + (eq jupyter-current-client client)) + (jupyter-repl-interaction-mode -1))))) + +(defun jupyter-repl-kill-buffer-query-function () + "Ask to shutdown the kernel before killing a REPL buffer. +If the current client is not connected to a kernel, kill the +buffer. If the current client is connected to a kernel, only +kill the buffer if the user wants to also shutdown the kernel. + +Before shutting down the kernel, deactivate +`jupyter-repl-interaction-mode' in all buffers associated with +the REPL." + (when (eq major-mode 'jupyter-repl-mode) + (let ((connected-p (jupyter-connected-p jupyter-current-client))) + (or (not connected-p) + (when (y-or-n-p (format "Jupyter REPL (%s) still connected. Shutdown kernel? " + (buffer-name (current-buffer)))) + (jupyter-repl--deactivate-interaction-buffers) + (jupyter-shutdown-kernel jupyter-current-client) + t))))) + +(defun jupyter-repl-error-before-major-mode-change () + "Error if attempting to change the `major-mode' in a REPL buffer." + (when (eq major-mode 'jupyter-repl-mode) + (error "Attempting to change `major-mode' in the REPL buffer!"))) + +(defun jupyter-repl-preserve-window-margins (&optional window) + "Ensure that the margins of a REPL window are present. +If WINDOW is showing a REPL buffer and the margins are not set to +`jupyter-repl-prompt-margin-width', set them to the proper +value." + ;; NOTE: Sometimes the margins will disappear after the window configuration + ;; changes which is why `window-configuration-change-hook' is not used. + (when (and (eq major-mode 'jupyter-repl-mode) + (let ((margins (window-margins window))) + (not (and (consp margins) + (car margins) + (= (car margins) jupyter-repl-prompt-margin-width))))) + (set-window-buffer window (current-buffer)))) + +;;; Completion + +(cl-defmethod jupyter-code-context ((_type (eql completion)) + &context (major-mode jupyter-repl-mode)) + (list (jupyter-repl-cell-code) + (1- (jupyter-repl-cell-code-position)))) + +(cl-defmethod jupyter-completion-prefix (&context (major-mode jupyter-repl-mode)) + (and (not (get-text-property (point) 'read-only)) + (cl-call-next-method))) + +;;; Evaluation + +(cl-defmethod jupyter-read-expression (&context ((and + jupyter-current-client + (object-of-class-p + jupyter-current-client + 'jupyter-repl-client) + t) + (eql t))) + (jupyter-with-repl-buffer jupyter-current-client + (jupyter-set jupyter-current-client 'jupyter-eval-expression-history + (delq 'jupyter-repl-history + (ring-elements jupyter-repl-history))) + (let ((ex (cl-call-next-method))) + (prog1 ex + (jupyter-repl-history-add ex))))) + +(cl-defmethod jupyter-eval-string (str &context (jupyter-current-client jupyter-repl-client) + &optional insert beg end) + (cond + (jupyter-repl-echo-eval-p + (jupyter-with-repl-buffer jupyter-current-client + (goto-char (point-max)) + (let ((code (jupyter-repl-cell-code))) + (jupyter-repl-replace-cell-code str) + (prog1 (jupyter-repl-execute-cell) + (jupyter-repl-replace-cell-code code))))) + (t + (jupyter-run-with-client jupyter-current-client + (jupyter-sent + (let ((req + (jupyter-execute-request + :code str + :store-history jupyter-repl-echo-eval-p + :handlers '("input_request")))) + (if (and jupyter-repl-echo-eval-p + (get-buffer-window + (oref jupyter-current-client buffer) + 'visible)) + req + ;; Add callbacks to display evaluation output in pop-up + ;; buffers either when we aren't copying the input to a + ;; REPL cell or, if we are, when the REPL buffer isn't + ;; visible. + ;; + ;; Make sure we do this in the original buffer where + ;; STR originated from when BEG and END are non-nil. + (jupyter-message-subscribed + req (jupyter-eval-callbacks insert beg end))))))))) + +;;; Kernel management + +(defun jupyter-repl--get-client () + (or jupyter-current-client + ;; Also allow this command to be called from an Org mode buffer by + ;; selecting a client based on the REPL buffer. + (buffer-local-value + 'jupyter-current-client + (or (jupyter-repl-completing-read-repl-buffer) + (error "No REPLs available"))))) + +(defun jupyter-repl-interrupt-kernel (&optional client) + "Interrupt the kernel CLIENT is connected to, if possible. +CLIENT defaults to `jupyter-current-client'." + (interactive) + (or client (setq client (jupyter-repl--get-client))) + (cl-check-type client jupyter-repl-client) + (jupyter-interrupt-kernel client)) + +(defun jupyter-repl-shutdown-kernel (&optional client) + "Shutdown the kernel CLIENT is connected to. +CLIENT defaults to `jupyter-current-client'." + (interactive) + (or client (setq client (jupyter-repl--get-client))) + (cl-check-type client jupyter-repl-client) + ;; FIXME: The heartbeat channel is no longer used. + (jupyter-hb-pause client) + (jupyter-with-repl-buffer client + (setq jupyter-repl-use-builtin-is-complete nil)) + (message "Shutting down kernel...") + (when (jupyter-kernel-alive-p client) + (jupyter-shutdown-kernel client))) + +(defun jupyter-repl-restart-kernel (&optional client) + "Restart the kernel CLIENT is connected to. +CLIENT defaults to `jupyter-current-client'." + (interactive) + (or client (setq client (jupyter-repl--get-client))) + (cl-check-type client jupyter-repl-client) + (jupyter-hb-pause client) + (jupyter-with-repl-buffer client + (setq jupyter-repl-use-builtin-is-complete nil)) + (if (jupyter-kernel-alive-p client) + (jupyter-restart-kernel client) + (message "Starting dead kernel...") + (jupyter-kernel-action client #'jupyter-launch)) + (jupyter-repl--insert-banner-and-prompt client) + (jupyter-hb-unpause client)) + +;;; Isearch +;; Adapted from isearch in `comint', see `comint-history-isearch-search' for +;; details + +(defun jupyter-repl-isearch-setup () + "Setup Isearch to search through the input history." + (setq-local isearch-search-fun-function + #'jupyter-repl-history-isearch-search) + (setq-local isearch-wrap-function + #'jupyter-repl-history-isearch-wrap) + (setq-local isearch-push-state-function + #'jupyter-repl-history-isearch-push-state)) + +;; Adapted from `comint-history-isearch-search' +(defun jupyter-repl-history-isearch-search () + "Return a search function to search through a REPL's input history." + (lambda (string bound noerror) + (let ((search-fun (isearch-search-fun-default)) found) + (setq isearch-lazy-highlight-start-limit + (jupyter-repl-cell-beginning-position)) + (or + ;; 1. First try searching in the initial cell text + (funcall search-fun string + (or bound + (unless isearch-forward + (jupyter-repl-cell-code-beginning-position))) + noerror) + ;; 2. If the above search fails, start putting next/prev history + ;; elements in the cell successively, and search the string in them. Do + ;; this only when bound is nil (i.e. not while lazy-highlighting search + ;; strings in the current cell text). + (unless bound + (condition-case err + (progn + (while (not found) + (cond (isearch-forward + ;; `jupyter-repl-history-next' clears the cell if the + ;; last element is the sentinel, prevent that. + (if (eq (ring-ref jupyter-repl-history -1) + 'jupyter-repl-history) + (error "End of history") + (jupyter-repl-history-next)) + (goto-char (jupyter-repl-cell-code-beginning-position))) + (t + (jupyter-repl-history-previous) + (goto-char (point-max)))) + ;; After putting the next/prev history element, search the + ;; string in them again, until an error is thrown at the + ;; beginning/end of history. + (setq found (funcall search-fun string + (unless isearch-forward + (jupyter-repl-cell-code-beginning-position)) + 'noerror))) + ;; Return point of the new search result + (point)) + (error + (unless noerror + (signal (car err) (cdr err)))))))))) + +(defun jupyter-repl-history-isearch-wrap () + "Wrap the input history search when search fails. +Go to the oldest history element for a forward search or to the +newest history element for a backward search." + (jupyter-repl-history--rotate + (* (if isearch-forward -1 1) + (ring-length jupyter-repl-history))) + (jupyter-repl-replace-cell-code (ring-ref jupyter-repl-history 0)) + (goto-char (if isearch-forward (jupyter-repl-cell-code-beginning-position) + (point-max)))) + +(defun jupyter-repl-history-isearch-push-state () + "Save a function restoring the state of input history search. +Save the element at index 0 in `jupyter-repl-history'. When +restoring the state, the `jupyter-repl-history' ring is rotated, +in the appropriate direction, to the saved element." + (let ((code (jupyter-repl-cell-code))) + (cond + ((equal code (ring-ref jupyter-repl-history 0)) + (let ((elem (ring-ref jupyter-repl-history 0))) + (lambda (_cmd) + (when isearch-wrapped + (jupyter-repl-history--rotate + (* (if isearch-forward 1 -1) + (ring-length jupyter-repl-history)))) + (let ((dir (if isearch-forward -1 1))) + (while (not (eq (ring-ref jupyter-repl-history 0) elem)) + (jupyter-repl-history--rotate dir))) + (jupyter-repl-replace-cell-code (ring-ref jupyter-repl-history 0))))) + (t + (let ((elem code)) + (lambda (_cmd) + (jupyter-repl-replace-cell-code elem))))))) + +;;; `jupyter-repl-mode' + +(defun jupyter-repl-scratch-buffer () + "Switch to a scratch buffer connected to the current REPL in another window. +Return the buffer switched to." + (interactive) + (if (jupyter-repl-connected-p) + (let* ((client jupyter-current-client) + (name (replace-regexp-in-string "^*jupyter-repl" + "*jupyter-scratch" + (buffer-name) (oref client buffer)))) + (unless (get-buffer name) + (with-current-buffer (get-buffer-create name) + (funcall (jupyter-kernel-language-mode client)) + (jupyter-repl-associate-buffer client) + (insert + (substitute-command-keys + "Jupyter scratch buffer for evaluation. +\\[jupyter-eval-line-or-region] to evaluate the line or region. +\\[jupyter-eval-buffer] to evaluate the whole buffer. +\\[jupyter-repl-pop-to-buffer] to show the REPL buffer.")) + (comment-region (point-min) (point-max)) + (insert "\n\n"))) + (switch-to-buffer-other-window name)) + (error "Not in a valid REPL buffer"))) + +(defvar jupyter-repl-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "q" nil) + (define-key map [remap backward-sentence] #'jupyter-repl-backward-cell) + (define-key map [remap forward-sentence] #'jupyter-repl-forward-cell) + (define-key map (kbd "RET") #'jupyter-repl-ret) + (define-key map (kbd "M-n") #'jupyter-repl-history-next) + (define-key map (kbd "M-p") #'jupyter-repl-history-previous) + (define-key map (kbd "C-c C-o") #'jupyter-repl-clear-cells) + (define-key map (kbd "C-c C-u") #'jupyter-repl-clear-input) + (define-key map (kbd "C-c M-r") #'jupyter-repl-history-previous-matching) + (define-key map (kbd "C-c M-s") #'jupyter-repl-history-next-matching) + map)) + +(put 'jupyter-repl-mode 'mode-class 'special) +(define-derived-mode jupyter-repl-mode fundamental-mode + "Jupyter-REPL" + "A Jupyter REPL major mode." + (cl-check-type jupyter-current-client jupyter-repl-client) + ;; This is a better setting for rendering language banners. + (setq-local show-trailing-whitespace nil) + ;; This is a better setting when rendering HTML tables + (setq-local truncate-lines t) + (setq-local indent-line-function #'jupyter-repl-indent-line) + (setq-local left-margin-width jupyter-repl-prompt-margin-width) + (setq-local yank-handled-properties + (append '((field . jupyter-repl-yank-handle-field-property)) + yank-handled-properties)) + (setq-local yank-excluded-properties (remq 'field yank-excluded-properties)) + ;; Initialize a buffer using the major-mode correponding to the kernel's + ;; language. This will be used for indentation and to capture font lock + ;; properties. + (let* ((info (jupyter-kernel-info jupyter-current-client)) + (language (plist-get (plist-get info :language_info) :name))) + (jupyter-load-language-support jupyter-current-client) + (cl-destructuring-bind (mode syntax) + (jupyter-kernel-language-mode-properties jupyter-current-client) + (setq jupyter-repl-lang-mode mode) + (setq jupyter-repl-lang-buffer + (get-buffer-create + (format " *jupyter-repl-lang-%s*" language))) + (set-syntax-table syntax) + (jupyter-with-repl-lang-buffer + (unless (eq major-mode mode) + (funcall mode)))) + ;; Get history from kernel + (setq jupyter-repl-history + (make-ring (1+ jupyter-repl-history-maximum-length))) + ;; The sentinel value keeps track of the newest/oldest elements of the + ;; history since next/previous navigation is implemented by rotations on the + ;; ring. + (ring-insert jupyter-repl-history 'jupyter-repl-history) + (jupyter-run-with-client jupyter-current-client + (jupyter-sent + (jupyter-history-request + :n jupyter-repl-history-maximum-length + :raw t + :unique t + :handlers '(not "status")))) + (erase-buffer) + ;; Add local hooks + (add-hook 'kill-buffer-query-functions #'jupyter-repl-kill-buffer-query-function nil t) + (add-hook 'kill-buffer-hook #'jupyter-repl--deactivate-interaction-buffers nil t) + (add-hook 'after-change-functions 'jupyter-repl-do-after-change nil t) + (add-hook 'pre-redisplay-functions 'jupyter-repl-preserve-window-margins nil t) + ;; Initialize the REPL + (jupyter-repl-initialize-fontification) + (jupyter-repl-isearch-setup) + (jupyter-repl-sync-execution-state) + (jupyter-repl-interaction-mode) + ;; Do this last so that it runs before any other `change-major-mode-hook's. + (add-hook 'change-major-mode-hook #'jupyter-repl-error-before-major-mode-change nil t))) + +(cl-defgeneric jupyter-repl-after-init () + "Hook function called whenever `jupyter-repl-mode' is enabled/disabled. +You may override this function for a particular language using a +jupyter-lang &context specializer. For example, to do something +when the language of the REPL is python the method signature +would look like + + (cl-defmethod jupyter-repl-after-init (&context (jupyter-lang python)))" + nil) + +(add-hook 'jupyter-repl-mode-hook 'jupyter-repl-after-init) + +(defun jupyter-repl-font-lock-fontify-region (fontify-fun beg end &optional verbose) + "Use FONTIFY-FUN to fontify input cells between BEG and END. +VERBOSE has the same meaning as in +`font-lock-fontify-region-function'." + (jupyter-repl-map-cells beg end + ;; Ensure that the buffer is narrowed to the actual cell code before calling + ;; the REPL language's `major-mode' specific fontification functions since + ;; those functions don't know anything about input cells or output cells and + ;; may traverse cell boundaries. + ;; + ;; It is OK that we do not update BEG and END using the return value of this + ;; function as long as the default value of + ;; `font-lock-extend-region-functions' is used since an input cell always + ;; starts at the beginning of a line and ends at the end of a line and does + ;; not use the font-lock-multiline property (2018-12-20). + (lambda () (funcall fontify-fun (point-min) (point-max) verbose)) + ;; Unfontify the region mainly to remove the font-lock-multiline property in + ;; the output, e.g. added by markdown. These regions will get highlighted + ;; syntactically in some scenarios. + (lambda () (font-lock-unfontify-region (point-min) (point-max)))) + `(jit-lock-bounds ,beg . ,end)) + +(defun jupyter-repl-syntax-propertize-function (propertize-fun beg end) + "Use PROPERTIZE-FUN to syntax propertize text between BEG and END." + (jupyter-repl-map-cells beg end + ;; See note in `jupyter-repl-font-lock-fontify-region' on why the buffer + ;; should be narrowed to the input cell before calling this function. + (lambda () (funcall propertize-fun (point-min) (point-max))) + ;; Treat parenthesis and string characters as punctuation when parsing the + ;; syntax of the output. Although we don't fontify output regions, + ;; `syntax-ppss' still looks at the whole contents of the buffer. If there + ;; are unmatched parenthesis or string delimiters in the output, it will + ;; interfere with `syntax-ppss'. Note, this requires + ;; `parse-sexp-lookup-properties' to be non-nil so that `syntax-ppss' will + ;; look at the `syntax-table' property. + (lambda () + (goto-char (point-min)) + (skip-syntax-forward "^()\"") + (while (not (eobp)) + (put-text-property (point) (1+ (point)) 'syntax-table '(1 . ?.)) + (forward-char) + (skip-syntax-forward "^()\""))))) + +(cl-defgeneric jupyter-repl-initialize-fontification () + "Initialize fontification for the current REPL buffer." + (let (fld frf sff spf comment) + (jupyter-with-repl-lang-buffer + (setq fld font-lock-defaults + frf (or font-lock-fontify-region-function #'ignore) + sff (or font-lock-syntactic-face-function #'ignore) + spf (or syntax-propertize-function #'ignore) + comment comment-start)) + ;; Set `font-lock-defaults' to a copy of the font lock defaults for the + ;; REPL language but with a modified syntactic fontification function + (cl-destructuring-bind (kws &optional kws-only case-fold syntax-alist + &rest vars) + (or fld (list nil)) + (setq vars + (append vars + (list + ;; See `jupyter-repl-font-lock-fontify-region' + (cons 'parse-sexp-lookup-properties t) + (cons 'syntax-propertize-function + (apply-partially + #'jupyter-repl-syntax-propertize-function spf)) + (cons 'font-lock-fontify-region-function + (apply-partially + #'jupyter-repl-font-lock-fontify-region frf)) + (cons 'font-lock-syntactic-face-function sff)))) + (setq-local comment-start comment) + (setq font-lock-defaults + (apply #'list kws kws-only case-fold syntax-alist vars))) + (font-lock-mode))) + +(defun jupyter-repl-insert-banner (banner) + "Insert BANNER into the `current-buffer'. +Make the text of BANNER read only and apply the `shadow' face to +it." + (jupyter-repl-without-continuation-prompts + (insert (propertize banner + 'read-only t 'jupyter-banner t + 'font-lock-face 'shadow 'fontified t + 'font-lock-fontified t)) + (jupyter-repl-newline))) + +(defun jupyter-repl-sync-execution-state () + "Synchronize the `jupyter-current-client's kernel state. +Also update the cell count of the current REPL input prompt using +the updated state." + (jupyter-run-with-client jupyter-current-client + (jupyter-mlet* ((_msg (jupyter-reply + (jupyter-execute-request + :code "" + :silent t + :handlers nil) + ;; Waiting longer here to account for initial + ;; startup of the Jupyter kernel. Sometimes + ;; the idle message won't be received if + ;; another long running execute request is + ;; sent right after. + jupyter-long-timeout)) + (client (jupyter-get-state))) + (unless (equal (jupyter-execution-state client) "busy") + ;; Set the cell count and update the prompt + (jupyter-with-repl-buffer client + (save-excursion + (goto-char (point-max)) + (jupyter-repl-update-cell-count + (oref client execution-count))))) + (jupyter-return nil)))) + +;;; `jupyter-repl-interaction-mode' + +(defvar jupyter-repl-interaction-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-x C-e") #'jupyter-eval-line-or-region) + (define-key map (kbd "C-c C-c") #'jupyter-eval-line-or-region) + (define-key map (kbd "C-M-x") #'jupyter-eval-defun) + (define-key map (kbd "C-c C-o") #'jupyter-eval-remove-overlays) + (define-key map (kbd "C-c C-s") #'jupyter-repl-scratch-buffer) + (define-key map (kbd "C-c C-b") #'jupyter-eval-buffer) + (define-key map (kbd "C-c C-l") #'jupyter-load-file) + (define-key map (kbd "C-c M-:") #'jupyter-eval-string-command) + (define-key map (kbd "M-i") #'jupyter-inspect-at-point) + (define-key map (kbd "C-c C-r") #'jupyter-repl-restart-kernel) + (define-key map (kbd "C-c C-i") #'jupyter-repl-interrupt-kernel) + (define-key map (kbd "C-c C-z") #'jupyter-repl-pop-to-buffer) + map)) + +(define-minor-mode jupyter-repl-interaction-mode + "Minor mode for interacting with a Jupyter REPL. +When this minor mode is enabled you may evaluate code from the +current buffer using the associated REPL (see +`jupyter-repl-associate-buffer' to associate a REPL). + +In addition any new buffers opened with the same `major-mode' as +the `current-buffer' will automatically have +`jupyter-repl-interaction-mode' enabled for them. + +\\{jupyter-repl-interaction-mode-map}" + :group 'jupyter-repl + :lighter (:eval (jupyter-repl-interaction-mode-line)) + :init-value nil + (cond + (jupyter-repl-interaction-mode + (add-hook 'completion-at-point-functions + 'jupyter-completion-at-point + jupyter-repl-completion-at-point-hook-depth + t) + (add-hook 'after-revert-hook 'jupyter-repl-interaction-mode nil t)) + (t + (remove-hook 'completion-at-point-functions 'jupyter-completion-at-point t) + (remove-hook 'after-revert-hook 'jupyter-repl-interaction-mode t) + (unless (eq major-mode 'jupyter-repl-mode) + (kill-local-variable 'jupyter-current-client))))) + +(defun jupyter-repl-interaction-mode-reenable () + "Re-enable `jupyter-repl-interaction-mode' in the current buffer. +Do so only if possible in the `current-buffer'." + (when (and (not jupyter-repl-interaction-mode) + (cl-typep jupyter-current-client 'jupyter-repl-client) + (eq major-mode + (jupyter-kernel-language-mode jupyter-current-client))) + (jupyter-repl-interaction-mode))) + +(defun jupyter-repl-interaction-mode-line () + "Return a mode line string with the status of the kernel. +`*' means the kernel is busy, `-' means the kernel is idle and +the REPL is connected, `x' means the REPL is disconnected +from the kernel." + (and (cl-typep jupyter-current-client 'jupyter-repl-client) + (concat " JuPy[" + (cond + ((not (jupyter-hb-beating-p jupyter-current-client)) "x") + ((equal (jupyter-execution-state jupyter-current-client) "busy") + "*") + (t "-")) + "]"))) + +(defun jupyter-repl-pop-to-buffer () + "Switch to the REPL buffer of the `jupyter-current-client'." + (interactive) + (if jupyter-current-client + (jupyter-with-repl-buffer jupyter-current-client + (goto-char (point-max)) + (pop-to-buffer (current-buffer))) + (error "Buffer not associated with a REPL, see `jupyter-repl-associate-buffer'"))) + +(defun jupyter-repl-available-repl-buffers (&optional mode first) + "Return a list of REPL buffers that are connected to live kernels. +If MODE is non-nil, return all REPL buffers whose +`jupyter-repl-lang-mode' is MODE. + +If FIRST is non-nil, only return the first REPL buffer that matches." + (cl-loop + for client in (jupyter-all-objects 'jupyter--clients) + for match = + (when (and (object-of-class-p client 'jupyter-repl-client) + (buffer-live-p (oref client buffer))) + (with-current-buffer (oref client buffer) + (and (or (null mode) + (provided-mode-derived-p mode jupyter-repl-lang-mode)) + (jupyter-repl-connected-p) + (buffer-name)))) + if (and match first) return (oref client buffer) + else if match collect (oref client buffer))) + +;;;###autoload +(defun jupyter-repl-associate-buffer (client) + "Associate the `current-buffer' with a REPL CLIENT. +If the `major-mode' of the `current-buffer' is the +`jupyter-repl-lang-mode' of CLIENT, call the function +`jupyter-repl-interaction-mode' to enable the corresponding mode. + +CLIENT should be the symbol `jupyter-repl-client' or the symbol +of a subclass. If CLIENT is a buffer or the name of a buffer, use +the `jupyter-current-client' local to the buffer." + (interactive + (list + (when-let* ((buffer (jupyter-repl-completing-read-repl-buffer major-mode))) + (buffer-local-value 'jupyter-current-client buffer)))) + (if (not client) + (when (y-or-n-p "No REPL for `major-mode' exists. Start one? ") + (call-interactively #'jupyter-run-repl)) + (setq client (if (or (bufferp client) (stringp client)) + (with-current-buffer client + jupyter-current-client) + client)) + (unless (object-of-class-p client 'jupyter-repl-client) + (error "Not a REPL client (%s)" client)) + (unless (eq (jupyter-kernel-language-mode client) major-mode) + (error "Cannot associate buffer to REPL. Wrong `major-mode'")) + (setq-local jupyter-current-client client) + (unless jupyter-repl-interaction-mode + (jupyter-repl-interaction-mode)))) + +(defun jupyter-repl-propagate-client (buffer &rest _) + "Set the `jupyter-current-client' in BUFFER. +If BUFFER's value of the variable `jupyter-repl-interaction-mode' +is nil and the buffer has the same `major-mode' as the +`jupyter-current-client's language mode, set the buffer local +value of `jupyter-current-client' in BUFFER to the current value +of that variable." + (when (and jupyter-current-client + (cl-typep jupyter-current-client 'jupyter-repl-client) + (or (bufferp buffer) (stringp buffer)) + (setq buffer (get-buffer buffer)) + (buffer-live-p buffer) + (null (buffer-local-value 'jupyter-repl-interaction-mode buffer)) + (eq (buffer-local-value 'major-mode buffer) + (jupyter-kernel-language-mode jupyter-current-client))) + (let ((client jupyter-current-client)) + (with-current-buffer buffer + (jupyter-repl-associate-buffer client))))) + +(defun jupyter-repl--before-switch-to-buffer (buffer &rest _) + "Call `jupyter-repl-propagate-client' on BUFFER, handling a nil BUFFER. +When BUFFER is nil use `other-buffer'." + (jupyter-repl-propagate-client (or buffer (other-buffer)))) + +(defun jupyter-repl--before-set-window-buffer (_ buffer &rest __) + "Call `jupyter-repl-propagate-client' on BUFFER." + (jupyter-repl-propagate-client buffer)) + +;;; `jupyter-repl-persistent-mode' + +;;;###autoload +(define-minor-mode jupyter-repl-persistent-mode + "Global minor mode to persist Jupyter REPL connections. +When the `jupyter-current-client' of the current buffer is a REPL +client, its value is propagated to all buffers switched to that +have the same `major-mode' as the client's kernel language and +`jupyter-repl-interaction-mode' is enabled in those buffers." + :group 'jupyter-repl + :global t + :keymap nil + :init-value nil + (cond + (jupyter-repl-persistent-mode + (advice-add 'switch-to-buffer :before #'jupyter-repl--before-switch-to-buffer) + (advice-add 'display-buffer :before #'jupyter-repl-propagate-client) + (advice-add 'set-window-buffer :before #'jupyter-repl--before-set-window-buffer) + (add-hook 'after-change-major-mode-hook 'jupyter-repl-interaction-mode-reenable)) + (t + (advice-remove 'switch-to-buffer #'jupyter-repl--before-switch-to-buffer) + (advice-remove 'display-buffer #'jupyter-repl-propagate-client) + (advice-remove 'set-window-buffer #'jupyter-repl--before-set-window-buffer) + (remove-hook 'after-change-major-mode-hook 'jupyter-repl-interaction-mode-reenable)))) + +;;; Starting a REPL + +(cl-defgeneric jupyter-bootstrap-repl (client &optional repl-name associate-buffer display) + "Initialize a new REPL buffer based on CLIENT, return CLIENT. +CLIENT should be a REPL client already connected to its kernel. + +A new REPL buffer communicating with CLIENT's kernel is created +and set as CLIENT's buffer slot. If CLIENT already has a non-nil +buffer slot, do nothing. + +REPL-NAME is a string that will be used to generate the buffer +name. If nil or empty, a default will be used. + +If ASSOCIATE-BUFFER is non-nil, attempt to \"connect\" the +`current-buffer' to the REPL (see +`jupyter-repl-associate-buffer') if it is compatible with the +underlying kernel. + +If DISPLAY is non-nil, display the REPL buffer after +completing all of the above.") + +(cl-defmethod jupyter-bootstrap-repl :before ((_client jupyter-repl-client) + &optional _repl-name _associate-buffer _display) + "Enable `jupyter-repl-persistent-mode' if needed." + (unless jupyter-repl-persistent-mode (jupyter-repl-persistent-mode))) + +(cl-defmethod jupyter-bootstrap-repl :after ((client jupyter-repl-client) + &optional _repl-name associate-buffer display) + (when (and associate-buffer + (eq major-mode (jupyter-kernel-language-mode client))) + (jupyter-repl-associate-buffer client)) + (when display + (pop-to-buffer (oref client buffer)))) + +(cl-defmethod jupyter-bootstrap-repl ((client jupyter-repl-client) + &optional repl-name _associate-buffer _display) + (prog1 client + (unless (oref client buffer) + (cl-destructuring-bind (&key language_info + banner + &allow-other-keys) + (jupyter-kernel-info client) + (let ((language-name (plist-get language_info :name)) + (language-version (plist-get language_info :version))) + (oset client buffer + (generate-new-buffer + (format "*jupyter-repl[%s]*" + (if (zerop (length repl-name)) + (format "%s %s" language-name language-version) + repl-name)))) + (jupyter-with-repl-buffer client + (setq-local jupyter-current-client client) + (jupyter-repl-mode) + (jupyter-repl-insert-banner banner) + (jupyter-repl-insert-prompt 'in))))))) + +(defvar jupyter--repl-server nil) + +(defun jupyter-repl-server () + "Return a `jupyter-server' that can be used to launch REPLs with. +The server is used by the `jupyter-run-repl' command to launch +all of its REPLs if `jupyter-use-zmq' is nil." + (let ((server jupyter--repl-server)) + (if (and server + (process-live-p + (jupyter-notebook-process server))) + server + (let* ((port (jupyter-launch-notebook)) + (url (format "http://localhost:%s" port))) + (setq jupyter--repl-server + (jupyter-server :url url)))))) + +;;;###autoload +(defun jupyter-run-repl (kernel-name &optional repl-name associate-buffer client-class display) + "Run a Jupyter REPL connected to a kernel with name, KERNEL-NAME. +KERNEL-NAME will be passed to `jupyter-guess-kernelspec' and the +first kernel found will be used to start the new kernel. + +With a prefix argument give a new REPL-NAME for the REPL. + +Optional argument ASSOCIATE-BUFFER, if non-nil, means to enable +the REPL interaction mode by calling the function +`jupyter-repl-interaction-mode' in the `current-buffer' and +associate it with the REPL created. When called interactively, +ASSOCIATE-BUFFER is set to t. If the `current-buffer's +`major-mode' does not correspond to the language of the kernel +started, ASSOCIATE-BUFFER has no effect. + +Optional argument CLIENT-CLASS is a subclass of +`jupyter-repl-client' that the REPL client will be an instance +of. The default is `jupyter-repl-client'. + +When called interactively, DISPLAY the new REPL buffer. +Otherwise, in a non-interactive call, return the REPL client +connected to the kernel. + +Note, if `default-directory' is a remote directory, a kernel will +start on the remote host by using the \"jupyter kernel\" shell +command on the host." + (interactive (list (jupyter-kernelspec-name + (jupyter-completing-read-kernelspec + nil current-prefix-arg)) + (when current-prefix-arg + (read-string "REPL Name: ")) + t nil t)) + (or client-class (setq client-class 'jupyter-repl-client)) + (jupyter-error-if-not-client-class-p client-class 'jupyter-repl-client) + (jupyter-bootstrap-repl + (let ((spec (jupyter-kernelspec-name + (jupyter-guess-kernelspec kernel-name)))) + (jupyter-client + (if jupyter-use-zmq + (jupyter-kernel :spec spec) + (jupyter-kernel + :server (jupyter-repl-server) + :spec spec)) + client-class)) + repl-name associate-buffer display)) + +;;;###autoload +(defun jupyter-connect-repl (file &optional repl-name associate-buffer client-class display) + "Run a Jupyter REPL using a kernel's connection FILE. +Return the REPL client connected to the kernel. When called +interactively, DISPLAY the new REPL buffer as well. With a +prefix argument give a new REPL-NAME for the REPL. + +FILE is the name of a connection file that will be read. +ASSOCIATE-BUFFER has the same meaning as in `jupyter-run-repl'. +Optional argument CLIENT-CLASS is the class of the client that +will be used to initialize the REPL and should be a class symbol +like the symbol `jupyter-repl-client', which is the default. " + (interactive (list (read-file-name "Connection file: ") + (when current-prefix-arg + (read-string "REPL Name: ")) + t nil t)) + (or client-class (setq client-class 'jupyter-repl-client)) + (jupyter-error-if-not-client-class-p client-class 'jupyter-repl-client) + (jupyter-bootstrap-repl + (jupyter-client + (jupyter-kernel + :conn-info file + :connect-p t + ;; Interrupting a kernel with a message is the only way to + ;; interrupt kernels connected to using a connection file since + ;; there is no way of telling what kind of kernel it is that is + ;; being connected to using this method. See + ;; `jupyter-interrupt-kernel'. + :spec (make-jupyter-kernelspec + :plist '(:interrupt_mode "message"))) + client-class) + repl-name associate-buffer display)) + +(provide 'jupyter-repl) + +;;; jupyter-repl.el ends here diff --git a/lisp/jupyter/jupyter-rest-api.el b/lisp/jupyter/jupyter-rest-api.el new file mode 100644 index 00000000..ffa18061 --- /dev/null +++ b/lisp/jupyter/jupyter-rest-api.el @@ -0,0 +1,1103 @@ +;;; jupyter-rest-api.el --- Jupyter REST API -*- lexical-binding: t -*- + +;; Copyright (C) 2019-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 03 Apr 2019 + +;; 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: + +;; Routines for working with the Jupyter REST API. Currently only the kernels, +;; kernelspecs, contents, and config endpoints are implemented. Functions that +;; get information from the server take the form `jupyter-api-get-*'. The lower +;; level functions that make requests have the form `jupyter-api/'. +;; Functions that alter the state of a kernel look like +;; `jupyter-api-interrupt-kernel'. Those that modify files have the appropriate +;; name familiar to Emacs-Lisp, e.g. to create a directory on the server there +;; is the function `jupyter-api-make-directory'. The exception are those that +;; actually read and write files, `jupyter-api-read-file-content' and +;; `jupyter-api-write-file-content' respectively. + +;;; Code: + +(eval-when-compile (require 'subr-x)) +(require 'jupyter-base) +(require 'websocket) +(require 'url) +(require 'url-http) + +(declare-function jupyter-decode-time "jupyter-messages") + +(defgroup jupyter-rest-api nil + "Jupyter REST API" + :group 'jupyter) + +(defcustom jupyter-api-authentication-method 'ask + "Authentication method to use for new connections." + :type '(choice (const :tag "None" none) + (const :tag "Token based" token) + (const :tag "Password" password) + (const :tag "Ask" ask)) + :group 'jupyter-rest-api) + +(defvar jupyter-api-max-authentication-attempts 3 + "Maximum number of retries used for authentication. +When attempting to authenticate a request, try this many times +before raising an error.") + +;;; Jupyter REST API + +(defmacro jupyter-api-with-subprocess-setup (&rest body) + "Return a form to load cookies, load `jupyter-rest-api', then evaluate BODY. +The paths added to `load-path' are those necessary for proper +operation of a `jupyter-rest-client'." + `(progn + (require 'url) + (setq url-cookie-file + ;; Value set by `url-do-setup' + ,(or url-cookie-file + (expand-file-name "cookies" url-configuration-directory))) + (url-do-setup) + ;; Don't save any cookies or history in a subprocess + (ignore-errors (cancel-timer url-history-timer)) + (ignore-errors (cancel-timer url-cookie-timer)) + (push ,(file-name-directory (locate-library "jupyter-base")) load-path) + (push ,(file-name-directory (locate-library "websocket")) load-path) + (require 'jupyter-rest-api) + ,@body)) + +(defclass jupyter-rest-client () + ;; convert to a url field to avoid parsing this every time + ((url + :type string + :initform "http://localhost:8888" + :initarg :url) + (ws-url + :type string + :initarg :ws-url + :documentation "The WebSocket url to use. + +If this slot is not bound when initializing an instance of this +class, it defaults to the value of the URL slot with the \"http\" +prefix replaced by \"ws\". ") + (auth + :initarg :auth + :documentation "Indicator for authentication. + +If the symbol ask, ask the user how to authenticate requests to +URL. + +If a list, then its assumed to be a list of cons cells that are +the necessary HTTP headers used to authenticate requests and will +be passed along with every request made. + +If the symbol password, ask for a login password to use. + +If the symbol token, ask for a token to use. + +If any other value, assume no steps are necessary to authenticate +requests."))) + +(cl-defmethod initialize-instance ((client jupyter-rest-client) &optional _slots) + "Set CLIENT's WS-URL slot if it isn't bound. +WS-URL will be a copy of URL with the url type equal to either ws +or wss depending on if URL has a type of http or https, +respectively." + (cl-call-next-method) + (unless (slot-boundp client 'auth) + (oset client auth jupyter-api-authentication-method)) + (unless (slot-boundp client 'ws-url) + (let ((url (url-generic-parse-url (oref client url)))) + (setf (url-type url) (if (equal (url-type url) "https") "wss" "ws")) + (oset client ws-url (url-recreate-url url)))) + (unless (gnutls-available-p) + (let ((url (url-generic-parse-url (oref client url))) + (ws-url (url-generic-parse-url (oref client ws-url)))) + (when (or (equal (url-type url) "https") (equal (url-type ws-url) "wss")) + (user-error "GnuTLS not available for HTTPS (SSL/TSL) connections"))))) + +;;; Making HTTP requests + +(define-error 'jupyter-api-http-error + "Jupyter REST API error") + +(define-error 'jupyter-api-http-redirect-limit + "Redirect limit reached" 'jupyter-api-http-error) + +;; Same as their corresponding `url-request' counterparts. We define our own +;; variables here so that it will be easier to transition away from +;; `url-retrieve' if necessary. +(defvar jupyter-api-request-headers nil) +(defvar jupyter-api-request-method nil) +(defvar jupyter-api-request-data nil) + +(defvar url-http-codes) +(defvar url-http-content-type) +(defvar url-http-end-of-headers) +(defvar url-http-response-status) +(defvar url-callback-arguments) +(defvar gnutls-verify-error) + +(defun jupyter-api-url-parse-response (buffer) + "Given a URL BUFFER parse and return its response. +BUFFER should be a URL buffer as returned by, e.g. +`url-retrieve'. Return a plist representation of its JSON +content. + +If the response indicates an error, signal a +`jupyter-api-http-error' otherwise return the parsed JSON or nil +if the content is not JSON. + +If the maximum number of redirects are reached a +`jupyter-api-http-redirect-limit' error is raised instead." + (with-current-buffer buffer + (goto-char url-http-end-of-headers) + (skip-syntax-forward "->") + (let* ((json-object-type 'plist) + (json-false nil) + (resp (when (and (equal url-http-content-type "application/json") + (not (eobp))) + (json-read)))) + (cond + ((>= url-http-response-status 400) + (cl-destructuring-bind + (&key reason message traceback &allow-other-keys) resp + (when traceback + (setq traceback + (format "%s (%s): %s" reason message + (car (last (split-string traceback "\n" t)))))) + (signal 'jupyter-api-http-error + (list url-http-response-status + (or traceback + (and (or reason message) + (concat reason + (and reason ": ") + message)) + (nth 2 (assoc url-http-response-status + url-http-codes))))))) + ;; Handle other kinds of errors, e.g. max redirects + ((and (boundp 'url-callback-arguments) + (plist-get (car url-callback-arguments) :error)) + (let ((err (plist-get (car url-callback-arguments) :error))) + (if (eq (nth 1 err) 'http-redirect-limit) + (signal 'jupyter-api-http-redirect-limit + (cons url-http-response-status + (cddr err))) + (signal (car err) (cdr err))))) + (t resp))))) + +(defun jupyter-api-url-request (url &optional async &rest async-args) + "Retrieve URL and return its JSON response. +ASYNC and ASYNC-ARGS have the same meaning as CALLBACK and CBARGS +of `url-retrieve'. + +If ASYNC is nil, retrieve URL synchronously and return its JSON +response or signal an error when something went wrong with the +request. On success, if the response obtained by URL is not JSON, +return nil otherwise the parsed JSON is returned as a plist. On +error, either an `jupyter-api-http-error' (when +`url-http-response-status' >= 400), +`jupyter-api-http-redirect-limit' (when `url-max-redirections' is +reached), or `error' (on any other kind of URL error) is signaled. + +When ASYNC is a callback function, this function does the same +thing as `url-retrieve' with its SILENT argument set to t and +INHIBIT-COOKIES set to nil." + (let ((url-package-name "jupyter") + (url-package-version jupyter-version) + (url-request-method jupyter-api-request-method) + (url-request-data jupyter-api-request-data) + (url-request-extra-headers jupyter-api-request-headers) + ;; Avoid errors when `default-directory' is a remote + ;; directory path. `url' seems to not be able to handle it. + (default-directory user-emacs-directory)) + (if async (url-retrieve url async async-args t) + (let ((buffer (url-retrieve-synchronously url t nil jupyter-long-timeout))) + (unwind-protect + (jupyter-api-url-parse-response buffer) + (url-mark-buffer-as-dead buffer)))))) + +;; See jupyter/notebook/services/api/api.yaml for HTTP +;; response codes. +(defun jupyter-api-http-request (url endpoint method &rest data) + "Send request to URL/ENDPOINT using HTTP METHOD. +DATA is encoded into a JSON string using `json-encode-plist' and +sent as the HTTP request data. If DATA is nil, don't send any +request data." + (declare (indent 3)) + (when data + (setq data (json-encode-plist data)) + (when (multibyte-string-p data) + (setq data (encode-coding-string data 'utf-8 'nocopy)))) + (let ((jupyter-api-request-method method) + (jupyter-api-request-data (or data jupyter-api-request-data)) + (jupyter-api-request-headers + (append (when data (list (cons "Content-Type" "application/json"))) + jupyter-api-request-headers))) + (jupyter-api-url-request (concat url "/" endpoint)))) + +(cl-defmethod jupyter-api-server-exists-p ((client jupyter-rest-client)) + "Return non-nil when the server at CLIENT's URL exists." + (condition-case nil + (prog1 t (jupyter-api-url-request (oref client url))) + ;; A `file-error' is raised when a server no longer exists + (file-error nil))) + +;;; Cookies and headers + +(defmacro jupyter-api--ensure-unibyte (place) + "Ensure PLACE does not hold a multibyte string. +If the value of PLACE is a multibyte string, encode it using the +us-ascii coding system. + +This is necessary when the contents of an API request contains +unicode characters. The HTTP request constructed in +`url-http-create-request' concatenates various string components +to make up the full request. If the contents are encoded, but +some other component is multibyte, the resulting string after +concatenating all elements will contain multibyte characters and +this will cause errors in the URL library." + (gv-letplace (getter setter) place + (macroexp-let2 nil old getter + `(if (multibyte-string-p ,old) + ,(funcall setter `(encode-coding-string ,old 'us-ascii)) + ,old)))) + +;; For more info on the XSRF header see +;; https://blog.jupyter.org/security-release-jupyter-notebook-4-3-1-808e1f3bb5e2 +;; and +;; http://www.tornadoweb.org/en/stable/guide/security.html#cross-site-request-forgery-protection + +(defun jupyter-api-request-xsrf-cookie (client) + "Send a request using CLIENT to retrieve the _xsrf cookie." + ;; Don't use `jupyter-api-request' here to avoid an infinite authentication + ;; loop since this function is used during authentication. + (let (jupyter-api-request-headers jupyter-api-request-data) + (jupyter-api-http-request (oref client url) "login" "GET"))) + +(defun jupyter-api-url-cookies (url) + "Return the list of cookies for URL." + (or (url-p url) (setq url (url-generic-parse-url url))) + (url-cookie-retrieve + (url-host url) (concat (url-filename url) "/") + (equal (url-type url) "https"))) + +(defun jupyter-api-xsrf-header-from-cookies (url) + "Return an alist containing an X-XSRFTOKEN header or nil. +Searches the cookies of URL for an _xsrf token, if found, sets +the value of the cookie as the value of the X-XSRFTOKEN header +returned." + (cl-loop + for cookie in (jupyter-api-url-cookies url) + if (equal (url-cookie-name cookie) "_xsrf") + return `(("X-XSRFTOKEN" . + ,(jupyter-api--ensure-unibyte + (url-cookie-value cookie)))))) + +(defun jupyter-api-copy-cookies-for-websocket (url) + "Copy URL cookies so that those under HOST are accessible under HOST:PORT. +`url-retrieve-synchronously' will store cookies under HOST +whereas `websocket-open' will expect those cookies to be under +HOST:PORT when PORT is a nonstandard port for the type of URL. + +The behavior of `url-retrieve-synchronously' (cookies being +stored without considering a PORT) appears to be the standard, +see RFC 6265." + (when-let* ((url (url-generic-parse-url url)) + (host (url-host url)) + (port (url-port-if-non-default url)) + (host-port (format "%s:%s" host port)) + (cookies (jupyter-api-url-cookies url))) + (setq url-cookies-changed-since-last-save t) + (cl-loop + for cookie in cookies + do (pcase-let (((cl-struct url-cookie name value expires + localpart secure) + cookie)) + ;; Set the expiration date if it does not have one already since + ;; `url-cookie-clean-up' (called by `url-cookie-write-file') will + ;; correctly drop any cookies that don't have an expiration date + ;; since cookies are required to have them. + ;; + ;; FIXME: This is mainly for the _xsrf cookie which does not have an + ;; expiration date. I believe this is to be interpreted as meaning + ;; the cookie should only be valid for the current session. We go + ;; through `url-cookie-write-file' so that the subprocess which + ;; starts websockets can read the required cookies. An alternative + ;; solution would be to pass the cookies directly to the subprocess. + (unless expires + (setq expires (setf (url-cookie-expires cookie) + (format-time-string "%a, %d %b %Y %T %z" + (time-add (current-time) + (days-to-time 1)))))) + (url-cookie-store name value expires host-port localpart secure))))) + +;; Adapted from `url-cookie-delete' +(defun jupyter-api--delete-cookie (cookie) + (let* ((storage (if (url-cookie-secure cookie) + 'url-cookie-secure-storage + 'url-cookie-storage)) + (cookies (symbol-value storage)) + (elem (assoc (url-cookie-domain cookie) cookies))) + (cl-callf2 delq cookie elem) + (when (zerop (length (cdr elem))) + (cl-callf2 delq elem cookies)) + (set storage cookies))) + +(defun jupyter-api-delete-cookies (url) + "Delete all cookies for URL. +All cookies associated with the HOST of URL are deleted. If URL +has a non-standard port for the type of URL, all cookies +associated with HOST:PORT are deleted as well." + (let* ((url (if (url-p url) url + (url-generic-parse-url url))) + (host (url-host url))) + (dolist (u (cons url + ;; Also delete cookies that were duplicated by + ;; `jupyter-api-copy-cookies-for-websocket'. + (when-let* ((port (url-port-if-non-default url)) + (u (copy-sequence url))) + (prog1 (list u) + (setf (url-host u) (format "%s:%s" host port)))))) + (cl-loop + for cookie in (jupyter-api-url-cookies u) + do (jupyter-api--delete-cookie cookie))) + (setq url-cookies-changed-since-last-save t) + (url-cookie-write-file))) + +(defun jupyter-api-add-websocket-headers (plist) + "Destructively modify PLIST to add a `:custom-header-alist' key. +Appends the value of `jupyter-api-request-headers' to the +`:custom-header-alist' key of PLIST, creating the key if +necessary. Before doing so, move past any non-keyword elements of +PLIST so as to only modify what looks like a property list. + +Return the modified PLIST." + (or plist (setq plist (list :custom-header-alist nil))) + (let ((head plist)) + (while (and head (not (keywordp (car head)))) + (pop head)) + (setq head (or (plist-member head :custom-header-alist) + (setcdr (last plist) + (list :custom-header-alist nil)))) + (prog1 plist + (plist-put head :custom-header-alist + (append + (plist-get head :custom-header-alist) + jupyter-api-request-headers))))) + +;;; Authentication + +(defvar jupyter-api-authentication-in-progress-p nil) + +(define-error 'jupyter-api-login-failed + "Login attempt failed") + +;; FIXME: Make the DATA this error signals consistent. +(define-error 'jupyter-api-authentication-failed + "Authentication failed") + +;; Signaled when `jupyter-api-request' receives a 403 response from the server. +;; The DATA of the signaled error will be the arguments of the +;; `jupyter-api-request' call. +(define-error 'jupyter-api-unauthenticated + "An API request returned an \"Access Forbidden\" response") + +;;;; Logging in + +(defmacro jupyter-api--without-url-http-authentication-handler (&rest body) + (declare (indent 0)) + ;; Workaround to suppress the authentication handling of `url-retrieve'. + ;; Jupyter notebook return a 401 response without a www-authenticate header + ;; and `url-http-handle-authentication' handles this by defaulting to + ;; "basic" authentication which we don't want happening. + (let ((orig (make-symbol "orig"))) + `(let ((,orig (symbol-function #'url-http-handle-authentication))) + (cl-letf (((symbol-function #'url-http-handle-authentication) + (lambda (proxy &rest args) + ;; If there is an authenticate header, let the default + ;; `url-http-handle-authentication' handle it. + (if (mail-fetch-field + (if proxy "proxy-authenticate" "www-authenticate") + nil nil t) + (apply ,orig proxy args) + ;; Otherwise assume we are authenticated to suppress the + ;; "basic" authentication handling. + t)))) + ,@body)))) + +(defun jupyter-api--verify-login (status) + (let ((err (plist-get status :error))) + (unless + (or (not err) + ;; Handle HTTP 1.0. When given a POST request, 302 redirection + ;; doesn't change the method to GET dynamically. On the Jupyter + ;; notebook, the redirected page expects a GET and will return + ;; 405 (invalid method). + (and (plist-get status :redirect) + (= (nth 2 err) 405))) + (signal 'jupyter-api-login-failed err)))) + +(defun jupyter-api-login (client) + "Attempt to login to the server using CLIENT. +Login is attempted by sending a GET request to CLIENT's login +endpoint using `url-retrieve'. To change the login information, +set `jupyter-api-request-method', `jupyter-api-request-data', and +`jupyter-api-request-headers'. + +On success, write the URL cookies to file so that they can be +used by other Emacs processes and return non-nil. + +If a response isn't received in `jupyter-long-timeout' seconds, +raise an error. + +If the login attempt failed, raise a `jupyter-api-login-failed' +error with the data being the error received by `url-retrieve'." + (jupyter-api--without-url-http-authentication-handler + (condition-case err + (let (status done) + (jupyter-api-url-request + (concat (oref client url) "/login") + (lambda (s &rest _) + (url-mark-buffer-as-dead (current-buffer)) + (setq status s done t))) + (jupyter-with-timeout + (nil jupyter-long-timeout + (error "Timeout reached during login")) + done) + (jupyter-api--verify-login status) + (jupyter-api-copy-cookies-for-websocket (oref client url)) + (url-cookie-write-file) + t) + (error + (when (eq (nth 2 err) 'connection-failed) + (signal (car err) (cdr err))))))) + +;;;; Authenticators + +(cl-defmethod jupyter-api-server-accessible-p ((client jupyter-rest-client)) + "Return non-nil if CLIENT can access the Jupyter notebook server." + (ignore-errors + (prog1 t + (let ((jupyter-api-authentication-in-progress-p t) + jupyter-api-request-data + jupyter-api-request-headers) + (jupyter-api-get-kernelspec client))))) + +(cl-defgeneric jupyter-api-authenticate (client &rest args) + (declare (indent 1))) + +(cl-defmethod jupyter-api-authenticate ((client jupyter-rest-client) (authenticator function)) + "Call AUTHENTICATOR then check if CLIENT can access the REST server. +Repeat up to `jupyter-api-max-authentication-attempts' before +signaling a `jupyter-api-authentication-failed' error if CLIENT +cannot access the server. + +AUTHENTICATOR is called with zero arguments. + +Before attempting to authenticate, save the value of the AUTH +slot of CLIENT and restore the AUTH slot on failure." + (let ((jupyter-api-authentication-in-progress-p t) + (max-tries jupyter-api-max-authentication-attempts)) + (let ((auth (oref client auth))) + (jupyter-api-request-xsrf-cookie client) + (let ((jupyter-api-request-headers + (nconc (jupyter-api-xsrf-header-from-cookies (oref client url)) + (jupyter-api-auth-headers client)))) + (while (and (not (progn + (funcall authenticator) + (jupyter-api-server-accessible-p client))) + (not (zerop (cl-decf max-tries)))))) + (when (zerop max-tries) + (oset client auth auth) + (signal 'jupyter-api-authentication-failed + (list client)))))) + +(cl-defmethod jupyter-api-authenticate ((client jupyter-rest-client) (_auth (eql password)) + &optional passwd) + "Authenticate CLIENT by asking for a password. +If PASSWD is provided it must be a function that takes zero +arguments and returns a password, it defaults to a call to +`read-passwd'. It will be called before each authentication +attempt. If CLIENT could not be authenticated raise an error." + (or (functionp passwd) + (setq passwd (lambda () (read-passwd (format "Password [%s]: " + (oref client url)))))) + (jupyter-api-authenticate client + ;; FIXME: Workaround due to the function generalizer in the base + ;; `jupyter-api-authenticate' method only recognizing function symbols or + ;; compiled functions since it currently uses `type-of' instead of + ;; `cl-typep'. This wouldn't be needed for the compiled sources, but seems + ;; to cause issues on Windows even when the sources are compiled. + (apply-partially + (lambda () + (let ((jupyter-api-request-method "POST") + (jupyter-api-request-headers + (nconc (list (cons "Content-Type" + "application/x-www-form-urlencoded")) + jupyter-api-request-headers)) + (jupyter-api-request-data + (concat "password=" (url-hexify-string (funcall passwd))))) + (jupyter-api-login client))))) + (oset client auth t)) + +(cl-defmethod jupyter-api-authenticate ((client jupyter-rest-client) (_auth (eql token))) + "Authenticate CLIENT by asking for a token. +Access to server will be checked by setting the token in the +Authorization header. + +Raise an error on failure." + (jupyter-api-authenticate client + (apply-partially + (lambda () + (let ((token (read-string (format "Token [%s]: " (oref client url))))) + (oset client auth + `(("Authorization" . + ,(concat "token " (jupyter-api--ensure-unibyte token)))))))))) + +;;; `jupyter-rest-client' methods + +(cl-defmethod jupyter-api-ensure-authenticated :around ((_client jupyter-rest-client)) + (unless jupyter-api-authentication-in-progress-p + (let ((jupyter-api-authentication-in-progress-p t)) + (cl-call-next-method)))) + +(cl-defmethod jupyter-api-ensure-authenticated ((client jupyter-rest-client)) + (with-slots (auth url) client + (when (eq auth 'ask) + (jupyter-api-request-xsrf-cookie client) + (when (jupyter-api-server-accessible-p client) + (oset client auth t))) + (unless (or (listp auth) + (not (memq auth '(ask token password)))) + (when (eq auth 'ask) + (when noninteractive + (signal 'jupyter-api-authentication-failed + (list "Can't authenticate non-interactively"))) + (cond + ((y-or-n-p (format "Token authenticated [%s]? " url)) + (oset client auth 'token)) + ((y-or-n-p (format "Password needed [%s]? " url)) + (oset client auth 'password)) + (t + (signal 'jupyter-api-authentication-failed + (list "Can only authenticate with password or token"))))) + (jupyter-api-authenticate client (oref client auth))))) + +(cl-defmethod jupyter-api-auth-headers ((client jupyter-rest-client)) + "Return the HTTP headers CLIENT is using for authentication or nil." + (jupyter-api-ensure-authenticated client) + (with-slots (auth) client + (when (listp auth) + auth))) + +;;;; Calling the REST API + +(defun jupyter-api-construct-endpoint (plist) + "Return a cons cell (ENDPOINT . REST) based on PLIST. +ENDPOINT is the API endpoint constructed from the elements at the +beginning of PLIST that are strings. REST will contain the +remainder of PLIST. + +So if PLIST looks like + + \='(\"api\" \"kernels\" :k1 ...) + +ENDPOINT will be \"api/kernels\" and REST will be \='(:k1 ...). + +If there is an alist after the strings of PLIST that make up the +ENDPOINT, the alist is interpreted as the query component of +ENDPOINT. So if PLIST looks like + + \='(\"api\" \"contents\" ((\"content\" . \"1\")) :k1 ...) + +The returned ENDPOINT will be \"api/contents?content=1\" and REST +will be \='(:k1 ...)." + (let (endpoint) + (while (and plist (or (null (car plist)) + (stringp (car plist)))) + ;; Remove any trailing empty strings or nil values so that something like + ;; ("contents?content=0" "") doesn't get turned into + ;; "api/contents?contents=0/" below. + (if (member (car plist) '(nil "")) (pop plist) + (cl-check-type (car plist) string + "Endpoint can only be constructed from strings") + (push (pop plist) endpoint))) + (setq endpoint (mapconcat #'identity + (or (nreverse endpoint) (list "")) "/")) + (when (consp (car plist)) + (setq endpoint (concat endpoint "?" + (mapconcat + (lambda (x) + (cl-check-type x cons) + (cl-check-type (car x) string) + (cl-check-type (cdr x) string) + (concat (car x) "=" (cdr x))) + (pop plist) + "&")))) + (cons endpoint plist))) + +(cl-defgeneric jupyter-api-request (client method &rest plist) + (declare (indent 2))) + +(cl-defmethod jupyter-api-request ((client jupyter-rest-client) method &rest plist) + "Send an HTTP request using CLIENT. +METHOD is the HTTP request method and PLIST contains the request. +The elements of PLIST before the first non-string form the REST +API endpoint and the rest of the PLIST after will be encoded into +a JSON object and sent as the request data. So a call like + + \(jupyter-api-request client \"POST\" \"api\" \"kernels\" :name \"python\") + +where the url slot of client is http://localhost:8888 will create +an http POST request to the url http://localhost:8888/api/kernels +using the JSON encoded from the plist (:name \"python\") as the +POST data. + +Note an empty plist (after forming the endpoint) is interpreted +as no request data at all and NOT as an empty JSON dictionary. + +A call to this method can also look like + + \(jupyter-api-request client \"GET\" + \"api\" \"contents\" \='((\"content\" . \"1\")) + +In this case, the alist after the strings that make up the base +endpoint, but before the rest of the non-strings elements of +PLIST, will be interpreted as the query component of the +resulting endpoint. So for the above example, the resulting url +will be http://localhost:8888/api/contents?content=1. + +If METHOD is \"WS\", a websocket will be opened using the REST api +url and PLIST will be used in a call to `websocket-open'. + +If the request receives a 403 \"Access Forbidden\" response, +signal a `jupyter-api-unauthenticated' error with the error data +being the arguments passed to this method. Otherwise for any +other kind of HTTP error, signal a `jupyter-api-http-error' with +error data being a list of two elements, the first being the HTTP +response code and the second being a error message returned from +the server." + (jupyter-api-ensure-authenticated client) + (let ((jupyter-api-request-headers + (append (jupyter-api-auth-headers client) + (jupyter-api-xsrf-header-from-cookies (oref client url)) + jupyter-api-request-headers))) + (cl-destructuring-bind (endpoint . rest) + (jupyter-api-construct-endpoint plist) + (pcase method + ("WS" + (jupyter-api-copy-cookies-for-websocket (oref client url)) + (apply #'websocket-open + (concat (oref client ws-url) "/" endpoint) + (jupyter-api-add-websocket-headers rest))) + (_ + (condition-case err + (apply #'jupyter-api-http-request + (oref client url) endpoint method + rest) + (jupyter-api-http-error + (if (or jupyter-api-authentication-in-progress-p + ;; Access Forbidden + (not (= (nth 1 err) 403))) + (signal (car err) (cdr err)) + (signal 'jupyter-api-unauthenticated + (cons client (cons method plist))))))))))) + +;;;; Endpoints + +(cl-defgeneric jupyter-api/kernels (client method &rest plist) + (declare (indent 2))) + +(cl-defmethod jupyter-api/kernels ((client jupyter-rest-client) method &rest plist) + "Send an HTTP request to the api/kernels endpoint to CLIENT's url. +METHOD is the HTTP method to use. PLIST has the same meaning as +in `jupyter-api-request'." + (apply #'jupyter-api-request client method "api" "kernels" plist)) + +(cl-defgeneric jupyter-api/kernelspecs (client method &rest plist) + (declare (indent 2))) + +(cl-defmethod jupyter-api/kernelspecs ((client jupyter-rest-client) method &rest plist) + "Send an HTTP request to the api/kernelspecs endpoint of CLIENT. +METHOD is the HTTP method to use. PLIST has the same meaning as +in `jupyter-api-request'." + (apply #'jupyter-api-request client method "api" "kernelspecs" plist)) + +(cl-defgeneric jupyter-api/contents (client method &rest plist) + (declare (indent 2))) + +(cl-defmethod jupyter-api/contents ((client jupyter-rest-client) method &rest plist) + "Send an HTTP request to the api/contents endpoint of CLIENT. +METHOD is the HTTP method to use. PLIST has the same meaning as +in `jupyter-api-request'." + (apply #'jupyter-api-request client method "api" "contents" plist)) + +(cl-defgeneric jupyter-api/config (client method &rest plist) + (declare (indent 2))) + +(cl-defmethod jupyter-api/config ((client jupyter-rest-client) method &rest plist) + "Send an HTTP request to the api/config endpoint of CLIENT. +METHOD is the HTTP method to use. PLIST has the same meaning as +in `jupyter-api-request'." + (apply #'jupyter-api-request client method "api" "config" plist)) + +;;; Config + +(defun jupyter-api-get-config (client section) + "Send an HTTP request using CLIENT to get the configuration for SECTION." + (jupyter-api/config client "GET" section)) + +(defun jupyter-api-update-config (client section &rest plist) + "Send a request using CLIENT to update configuration SECTION. +PLIST is a property list that will be encoded into JSON with the +requested changes." + (apply #'jupyter-api/config client "PATCH" section plist)) + +;;; Kernels API + +(defun jupyter-api-get-kernel (client &optional id) + "Send an HTTP request using CLIENT to return a plist of the kernel with ID. +If ID is nil, return models for all kernels accessible via CLIENT." + (jupyter-api/kernels client "GET" id)) + +(defun jupyter-api-start-kernel (client &optional name) + "Send an HTTP request using CLIENT to start a kernel with kernelspec NAME. +If NAME is not provided use the default kernelspec." + (apply #'jupyter-api/kernels client "POST" + (when name (list :name name)))) + +(defun jupyter-api-shutdown-kernel (client id) + "Send the HTTP request using CLIENT to shutdown a kernel with ID." + (jupyter-api/kernels client "DELETE" id)) + +(defun jupyter-api-restart-kernel (client id) + "Send an HTTP request using CLIENT to restart a kernel with ID." + (jupyter-api/kernels client "POST" id "restart")) + +(defun jupyter-api-interrupt-kernel (client id) + "Send an HTTP request using CLIENT to interrupt a kernel with ID." + (jupyter-api/kernels client "POST" id "interrupt")) + +;;;; Shutdown/interrupt kernel + +(cl-defmethod jupyter-shutdown-kernel ((client jupyter-rest-client) kernel-id + &optional restart timeout) + "Send an HTTP request using CLIENT to shutdown the kernel with KERNEL-ID. +Optionally RESTART the kernel. If TIMEOUT is provided, it is the +timeout used for the HTTP request." + (let ((jupyter-long-timeout (or timeout jupyter-long-timeout))) + (if restart (jupyter-api-restart-kernel client kernel-id) + (jupyter-api-shutdown-kernel client kernel-id)))) + +(cl-defmethod jupyter-interrupt-kernel ((client jupyter-rest-client) kernel-id + &optional timeout) + "Send an HTTP request using CLIENT to interrupt the kernel with KERNEL-ID. +If TIMEOUT is provided, it is the timeout used for the HTTP +request." + (let ((jupyter-long-timeout (or timeout jupyter-long-timeout))) + (jupyter-api-interrupt-kernel client kernel-id))) + + +;;;; Kernel websocket + +(defun jupyter-api-kernel-websocket (client id &rest plist) + "Return a websocket using CLIENT's ws-url slot. +ID identifies the kernel to connect to, PLIST will be passed to +the call to `websocket-open' to initialize the websocket. + +The `websocket-client-data' of the websocket will be a plist like + + (:id ID :session SESSION) + +where SESSION is a `jupyter-session' with a `jupyter-session-id' +equal to the one associated with the kernel on the server CLIENT +is communicating with." + (let* ((session (jupyter-session)) + (ws (apply #'jupyter-api/kernels client "WS" id "channels" + `(("session_id" . ,(jupyter-session-id session))) + plist))) + (prog1 ws + (setf (websocket-client-data ws) + (list :id id :session session))))) + +;;; Kernelspec API + +(defun jupyter-api-get-kernelspec (client &optional name) + "Send an HTTP request using CLIENT to get the kernelspec with NAME. +If NAME is not provided, return a plist of all kernelspecs +available via CLIENT." + (apply #'jupyter-api/kernelspecs client "GET" + (when name (list :name name)))) + +;;; Contents API + +;; TODO: Actually consider encoding/decoding +;; https://jupyter-notebook.readthedocs.io/en/stable/extending/contents.html#filesystem-entities + +(defun jupyter-api--strip-slashes (path) + (thread-last path + (replace-regexp-in-string "^/+" "") + (replace-regexp-in-string "/+$" ""))) + +(autoload 'tramp-drop-volume-letter "tramp") + +;; See https://jupyter-notebook.readthedocs.io/en/stable/extending/contents.html#api-paths +(defsubst jupyter-api-content-path (file) + "Return a sanitized path for locating FILE on a Jupyter REST server. +Note, if FILE is not an absolute file name, it is expanded into +one as if the `default-directory' where /." + (jupyter-api--strip-slashes + (tramp-drop-volume-letter + (expand-file-name (file-local-name file) "/")))) + +(defun jupyter-api-get-file-model (client file &optional no-content type) + "Send a request using CLIENT to get a model of FILE. +If NO-CONTENT is non-nil, tell the server to return a model +excluding the FILE's contents. Otherwise a model with contents is +returned. + +If TYPE is non-nil, signal an error if FILE is not of the +specified type. + +Note, only the `file-local-name' of FILE is considered. + +A file model is a plist that contains the following keys: + + :name - The name of the file relative to its directory + :path - The filesystem path of the file + :last_modified - The last time the file was modified + :created - The time the file was created + :content - The file's contents or, if a file is directory, a + vector of models representing the files contained + in the directory + :format - The format of the file, either \"text\", \"base64\", or nil + :mimetype - The guessed mimetype or nil + :size - The size of the file in bytes or nil + :writable - If the file can be written to + :type - Either \"directory\" or \"file\"" + (declare (indent 1)) + (jupyter-api/contents client "GET" + (jupyter-api-content-path file) + (nconc (list (cons "content" (if no-content "0" "1"))) + (when type (cons "type" type))))) + +(defun jupyter-api-delete-file (client file-or-dir) + "Send a request using CLIENT to delete FILE-OR-DIR from the server. + +Note, only the `file-local-name' of FILE-OR-DIR is considered." + (declare (indent 1)) + (jupyter-api/contents client "DELETE" + (jupyter-api-content-path file-or-dir))) + +(defun jupyter-api-rename-file (client file newname) + "Send a request using CLIENT to rename FILE to NEWNAME. + +Note, only the `file-local-name' of FILE and NEWNAME are +considered." + (declare (indent 1)) + (jupyter-api/contents client "PATCH" + (jupyter-api-content-path file) + :path (jupyter-api-content-path newname))) + +;; NOTE: The Jupyter REST API doesn't allow copying directories in an easy way +(defun jupyter-api-copy-file (client file newname) + "Send a request using CLIENT to copy FILE to NEWNAME. +NEWNAME must not be an existing file. + +Note, only the `file-local-name' of FILE and NEWNAME are +considered." + (declare (indent 1)) + (cl-destructuring-bind (&key path &allow-other-keys) + (jupyter-api/contents client "POST" + (jupyter-api-content-path (file-name-directory newname)) + :copy_from (jupyter-api-content-path file)) + (jupyter-api-rename-file client path newname))) + +(defun jupyter-api-write-file-content (client filename content &optional binary) + "Send a request using CLIENT to write CONTENT to FILENAME. + +If BINARY is non-nil, as a final step encode CONTENT as a base64 +string and set the file's format to \"base64\". Otherwise CONTENT +is encoded as UTF-8 and file's format is set to \"text\". + +Note, only the `file-local-name' of FILENAME is considered." + (declare (indent 1)) + (cl-check-type content string) + (jupyter-api/contents client "PUT" + (jupyter-api-content-path filename) + :content (if binary (thread-first content + (encode-coding-string 'no-conversion 'nocopy) + (base64-encode-string)) + ;; Encoded in `jupyter-api-http-request' + content) + :type "file" + :format (if binary "base64" "text"))) + +(defun jupyter-api-read-file-content (client file) + "Send a request using CLIENT to read the content of FILE. + +If FILE's contents are encoded, decode it first. This currently +only applies to the case where FILE's format is \"base64\". + +Note, only the `file-local-name' of FILENAME is considered." + (declare (indent 1)) + (let* ((model (jupyter-api-get-file-model client file nil "file")) + (content (plist-get model :content))) + (if (jupyter-api-binary-content-p model) + (base64-decode-string content) + (decode-coding-string content 'utf-8 'nocopy)))) + +(defun jupyter-api-make-directory (client directory) + "Send a request using CLIENT to create DIRECTORY. + +Note, only the `file-local-name' of DIRECTORY is considered." + (declare (indent 1)) + (jupyter-api/contents client "PUT" + (jupyter-api-content-path directory) + :type "directory")) + +;;;; Checkpoints + +(defun jupyter-api-get-checkpoints (client file) + "Send a request using CLIENT to get all checkpoints available for FILE. +Return a list of checkpoints of the form + + (:id ID :last_modified TIME) + +where ID is the ID of the checkpoint and TIME is the last time +FILE was modified when the checkpoint was created." + (declare (indent 1)) + (append + (jupyter-api/contents client "GET" + (jupyter-api-content-path file) "checkpoints") + nil)) + +(defun jupyter-api-get-ordered-checkpoints (client file) + "Send a request using CLIENT to get all checkpoints available for FILE. +Return a list of the checkpoints ordered most recently created first." + (declare (indent 1)) + (sort + (jupyter-api-get-checkpoints client file) + (cl-labels ((decode-time + (a) (jupyter-decode-time (plist-get a :last_modified)))) + (lambda (a b) + (time-less-p (decode-time b) (decode-time a)))))) + +(defun jupyter-api-get-latest-checkpoint (client file) + "Return the latest checkpoint for FILE on the server accessed by CLIENT. +If there are no checkpoints for FILE return nil." + (declare (indent 1)) + (car (jupyter-api-get-ordered-checkpoints client file))) + +(defun jupyter-api-make-checkpoint (client file) + "Send a request using CLIENT to create a checkpoint for FILE. +Return a plist (:id ID :last_modified TIME) where ID is the ID of +the checkpoint and TIME is the last modified time before the +checkpoint was created in ISO 8601 format." + (declare (indent 1)) + (jupyter-api/contents client "POST" + (jupyter-api-content-path file) "checkpoints")) + +(defun jupyter-api-restore-checkpoint (client file id) + "Send a request using CLIENT to restore FILE to checkpoint with ID. +ID is either a string or plist containing an :id property." + (declare (indent 1)) + (when (listp id) (setq id (plist-get id :id))) + (jupyter-api/contents client "POST" + (jupyter-api-content-path file) "checkpoints" id)) + +(defun jupyter-api-delete-checkpoint (client file id) + "Send a request using CLIENT to delete FILE's checkpoint with ID. +ID is either a string or plist containing an :id property." + (declare (indent 1)) + (when (listp id) (setq id (plist-get id :id))) + (jupyter-api/contents client "DELETE" + (jupyter-api-content-path file) "checkpoints" id)) + +;;;; Utility functions + +(defun jupyter-api-find-model (path dir-model) + "Find a model with PATH in DIR-MODEL. +PATH must be an API content path as returned by +`jupyter-api-content-path'. Recursively searches for a model +whose :path property is equal to PATH, searching for other models +in the :content property of DIR-MODEL until either one is found +or DIR-MODEL isn't a directory model. Returns the model if found, +otherwise nil." + (cond + ((equal (plist-get dir-model :path) path) dir-model) + ((equal (plist-get dir-model :type) "directory") + (cl-loop + for model across (plist-get dir-model :content) + if (equal (plist-get model :path) path) return model + else if (equal (plist-get model :type) "directory") + thereis (jupyter-api-find-model path model))))) + +(defun jupyter-api-binary-content-p (model) + "Return non-nil if MODEL corresponds to Base64 encoded content." + (equal (plist-get model :format) "base64")) + +(defun jupyter-api-notebook-p (model) + "Return non-nil if MODEL corresponds to Jupyter notebook JSON." + (equal (plist-get model :type) "notebook")) + +;; TODO: Replace the :content key with the buffer? It is redundant to have both +;; a string and a buffer holding the contents. +(defun jupyter-api-content-buffer (model) + "Return a buffer holding MODEL's content. +If MODEL's content is binary, the returned buffer will hold the +decoded content. + +The returned buffer will be a single-byte buffer, i.e. will not +contain any multibyte characters. + +Note, the returned buffer will be killed when MODEL is garbage +collected." + (cl-assert (member (plist-get model :format) '("text" "base64"))) + (unless (bufferp (plist-get model :_buffer)) + (let ((buffer (generate-new-buffer " *jupyter-api-model-content*"))) + (with-current-buffer buffer + ;; NOTE: Order of insertion matters here + (insert (or (plist-get model :content) "")) + (set-buffer-multibyte nil) + (plist-put model :_buffer (current-buffer)) + (plist-put model :_finalizer (make-finalizer + (lambda () (kill-buffer buffer)))) + (when (jupyter-api-binary-content-p model) + (base64-decode-region (point-min) (point-max)))))) + (plist-get model :_buffer)) + +(defun jupyter-api-insert-model-content (model &optional replace beg end) + "Insert the content of MODEL into the current buffer. +If REPLACE is non-nil, replace the contents of the current buffer +using `replace-buffer-contents'. BEG and END are byte offsets +into the content of MODEL, only insert the portion of MODEL's +contents bounded by BEG and END. BEG and END default to +`point-min' and `point-max' respectively." + (let ((source (jupyter-api-content-buffer model))) + (with-current-buffer source + (widen) + (when (or beg end) + (narrow-to-region (or beg (point-min)) (or end (point-max))))) + (if replace (replace-buffer-contents source) + (insert-buffer-substring source)))) + +(provide 'jupyter-rest-api) + +;;; jupyter-rest-api.el ends here diff --git a/lisp/jupyter/jupyter-server-kernel.el b/lisp/jupyter/jupyter-server-kernel.el new file mode 100644 index 00000000..a9f71774 --- /dev/null +++ b/lisp/jupyter/jupyter-server-kernel.el @@ -0,0 +1,375 @@ +;;; jupyter-server-kernel.el --- Working with kernels behind a Jupyter server -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 23 Apr 2020 + +;; 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: + +;; Holds the definitions of `jupyter-server', what communicates to the +;; Jupyter server using the REST API, and `jupyter-kernel-server' a +;; representation of a kernel on a server. + +;;; Code: + +(require 'jupyter-kernel) +(require 'jupyter-rest-api) +(require 'jupyter-monads) +(require 'websocket) + +(declare-function jupyter-encode-raw-message "jupyter-messages") +(declare-function jupyter-tramp-server-from-file-name "jupyter-tramp") +(declare-function jupyter-tramp-file-name-p "jupyter-tramp") +(declare-function jupyter-server-kernel-id-from-name "jupyter-server") + +(defgroup jupyter-server-kernel nil + "Kernel behind a Jupyter server" + :group 'jupyter) + +;;; `jupyter-server' + +(defvar-local jupyter-current-server nil + "The `jupyter-server' associated with the current buffer. +Used in, e.g. a `jupyter-server-kernel-list-mode' buffer.") + +(put 'jupyter-current-server 'permanent-local t) + +(defvar jupyter--servers nil) + +;; TODO: We should really rename `jupyter-server' to something like +;; `jupyter-server-client' since it isn't a representation of a server, but a +;; communication channel with one. +(defclass jupyter-server (jupyter-rest-client eieio-instance-tracker) + ((tracking-symbol :initform 'jupyter--servers) + (kernelspecs + :type json-plist + :initform nil + :documentation "Kernelspecs for the kernels available behind +this gateway. Access them through `jupyter-kernelspecs'."))) + +(cl-defmethod make-instance ((_class (subclass jupyter-server)) &rest slots) + (cl-assert (plist-get slots :url)) + (or (cl-loop + with url = (plist-get slots :url) + for server in jupyter--servers + if (equal url (oref server url)) return server) + (cl-call-next-method))) + +(defun jupyter-servers () + "Return a list of all `jupyter-server's." + (jupyter-gc-servers) + jupyter--servers) + +(defun jupyter-gc-servers () + "Delete `jupyter-server' instances that are no longer accessible." + (dolist (server jupyter--servers) + (unless (jupyter-api-server-exists-p server) + (jupyter-api-delete-cookies (oref server url)) + (delete-instance server)))) + +(cl-defmethod jupyter-api-request :around ((server jupyter-server) _method &rest _plist) + (condition-case nil + (cl-call-next-method) + (jupyter-api-unauthenticated + (if (memq jupyter-api-authentication-method '(ask token password)) + (oset server auth jupyter-api-authentication-method) + (error "Unauthenticated request, can't attempt re-authentication \ +with default `jupyter-api-authentication-method'")) + (prog1 (cl-call-next-method) + (jupyter-reauthenticate-websockets server))))) + +(cl-defmethod jupyter-kernelspecs ((client jupyter-rest-client) &optional _refresh) + (or (jupyter-api-get-kernelspec client) + (error "Can't retrieve kernelspecs from server @ %s" + (oref client url)))) + +(cl-defmethod jupyter-kernelspecs ((server jupyter-server) &optional refresh) + "Return the kernelspecs on SERVER. +By default the available kernelspecs are cached. To force an +update of the cached kernelspecs, give a non-nil value to +REFRESH." + (when (or refresh (null (oref server kernelspecs))) + (let ((specs (cl-call-next-method))) + (plist-put specs :kernelspecs + (cl-loop + for (_ spec) on (plist-get specs :kernelspecs) by #'cddr + for name = (plist-get spec :name) + collect (make-jupyter-kernelspec + :name name + :plist (plist-get spec :spec)))) + (oset server kernelspecs specs))) + (plist-get (oref server kernelspecs) :kernelspecs)) + +(cl-defmethod jupyter-kernelspecs :extra "server" ((host string) &optional refresh) + (if (jupyter-tramp-file-name-p host) + (jupyter-kernelspecs (jupyter-tramp-server-from-file-name host) refresh) + (cl-call-next-method))) + +(cl-defmethod jupyter-server-has-kernelspec-p ((server jupyter-server) name) + "Return non-nil if SERVER can launch kernels with kernelspec NAME." + (jupyter-guess-kernelspec name (jupyter-kernelspecs server))) + +;;; Kernel definition + +(cl-defstruct (jupyter-server-kernel + (:include jupyter-kernel)) + (server jupyter-current-server + :read-only t + :documentation "The kernel server.") + ;; TODO: Make this read only by only allowing creating + ;; representations of kernels that have already been launched and + ;; have a connection to the kernel. + (id nil + :type (or null string) + :documentation "The kernel ID.")) + +(cl-defmethod jupyter-alive-p ((kernel jupyter-server-kernel)) + (pcase-let (((cl-struct jupyter-server-kernel server id) kernel)) + (and id server + ;; TODO: Cache this call + (condition-case err + (jupyter-api-get-kernel server id) + (file-error nil) ; Non-existent server + (jupyter-api-http-error + (unless (= (nth 1 err) 404) ; Not Found + (signal (car err) (cdr err))))) + (cl-call-next-method)))) + +(defun jupyter-server-kernel (&rest args) + "Return a `jupyter-server-kernel' initialized with ARGS." + (apply #'make-jupyter-server-kernel args)) + +(cl-defmethod jupyter-kernel :extra "server" (&rest args) + "Return a representation of a kernel on a Jupyter server. +If ARGS has a :server key, return a `jupyter-server-kernel' +initialized using ARGS. If ARGS also has a :spec key, whose +value is the name of a kernelspec, the returned kernel's spec +slot will be the corresponding `jupyter-kernelspec'. + +Call the next method if ARGS does not contain :server." + (let ((server (plist-get args :server))) + (if (not server) (cl-call-next-method) + (cl-assert (object-of-class-p server 'jupyter-server)) + (let ((spec (plist-get args :spec))) + (when (stringp spec) + (plist-put args :spec + ;; TODO: (jupyter-server-kernelspec server "python3") + ;; which returns an I/O action and then arrange + ;; for that action to be bound by mlet* and set + ;; as the spec value. Or better yet, have + ;; `jupyter-kernel' return a delayed kernel with + ;; the server connection already open and + ;; kernelspecs already retrieved. + (or (jupyter-guess-kernelspec + spec (jupyter-kernelspecs server)) + ;; TODO: Return the error to the I/O context. + (error "No kernelspec matching %s @ %s" spec + (oref server url)))))) + (apply #'jupyter-server-kernel args)))) + +;;; Websocket IO + +(defvar jupyter--reauth-subscribers (make-hash-table :weakness 'key :test 'eq)) + +(defun jupyter-reauthenticate-websockets (server) + "Re-authenticate WebSocket connections of SERVER." + (when-let* ((pub (gethash server jupyter--reauth-subscribers))) + (jupyter-run-with-io pub + (jupyter-publish 'reauthenticate)))) + +(cl-defmethod jupyter-websocket-io ((kernel jupyter-server-kernel)) + "Return a list representing an IO connection to KERNEL. +The list is composed of two elements (IO-PUB ACTION-SUB), IO-PUB +is a publisher used to send/receive messages to/from KERNEL and +ACTION-SUB is a subscriber of kernel actions to perform on +KERNEL. + +To send a message to KERNEL, publish a list of the form + + (list \='send CHANNEL MSG-TYPE CONTENT MSG-ID) + +to IO-PUB, e.g. + + (jupyter-run-with-io IO-PUB + (jupyter-publish (list \='send CHANNEL MSG-TYPE CONTENT MSG-ID))) + +To receive messages from KERNEL, subscribe to IO-PUB e.g. + + (jupyter-run-with-io IO-PUB + (jupyter-subscribe + (jupyter-subscriber + (lambda (msg) + ...)))) + +The value \='interrupt or \='shutdown can be published to ACTION-SUB +to interrupt or shutdown KERNEL. The value (list \='action FN) +where FN is a single argument function can also be published, in +this case FN will be evaluated on KERNEL." + (jupyter-launch kernel) + (pcase-let* (((cl-struct jupyter-server-kernel server id) kernel)) + (letrec ((status-pub (jupyter-publisher)) + (reauth-pub (or (gethash server jupyter--reauth-subscribers) + (setf (gethash server jupyter--reauth-subscribers) + (jupyter-publisher)))) + (shutdown nil) + (kernel-io + (jupyter-publisher + (lambda (event) + (pcase event + (`(message . ,rest) (jupyter-content rest)) + (`(send ,channel ,msg-type ,content ,msg-id) + (when shutdown + (error "Attempting to send message to shutdown kernel")) + (let ((send + (lambda () + (websocket-send-text + ws (let* ((cd (websocket-client-data ws)) + (session (plist-get cd :session))) + (jupyter-encode-raw-message session msg-type + :channel channel + :msg-id msg-id + :content content)))))) + (condition-case nil + (funcall send) + (websocket-closed + (setq ws (funcall make-websocket)) + (funcall send))))) + ('start + (when shutdown + (error "Can't start I/O connection to shutdown kernel")) + (unless (websocket-openp ws) + (setq ws (funcall make-websocket)))) + ('stop (websocket-close ws)))))) + (ws-failed-to-open t) + (make-websocket + (lambda () + (jupyter-api-kernel-websocket + server id + :custom-header-alist (jupyter-api-auth-headers server) + :on-open + (lambda (_ws) + (setq ws-failed-to-open nil)) + :on-close + (lambda (_ws) + (if ws-failed-to-open + ;; TODO: Retry? + (error "Kernel connection could not be established") + (setq ws-failed-to-open t))) + ;; TODO: on-error publishes to status-pub + :on-message + (lambda (_ws frame) + (pcase (websocket-frame-opcode frame) + ((or 'text 'binary) + (let ((msg (jupyter-read-plist-from-string + (websocket-frame-payload frame)))) + (jupyter-run-with-io kernel-io + (jupyter-publish (cons 'message msg))))) + (_ + (jupyter-run-with-io status-pub + (jupyter-publish + (list 'error (websocket-frame-opcode frame)))))))))) + (ws (prog1 (funcall make-websocket) + (jupyter-run-with-io reauth-pub + (jupyter-subscribe + (jupyter-subscriber + (lambda (_reauth) + (if shutdown (jupyter-unsubscribe) + (jupyter-run-with-io kernel-io + (jupyter-do + (jupyter-publish 'stop) + (jupyter-publish 'start))))))))))) + (list kernel-io + (jupyter-subscriber + (lambda (action) + (pcase action + ('interrupt + (jupyter-interrupt kernel)) + ('shutdown + (jupyter-shutdown kernel) + (setq shutdown t) + (when (websocket-openp ws) + (websocket-close ws))) + ('restart + (jupyter-restart kernel)) + (`(action ,fn) + (funcall fn kernel))))))))) + +(cl-defmethod jupyter-io ((kernel jupyter-server-kernel)) + (jupyter-websocket-io kernel)) + +;;; Kernel management + +;; The KERNEL argument is optional here so that `jupyter-launch' +;; does not require more than one argument just to handle this case. +(cl-defmethod jupyter-launch ((server jupyter-server) &optional kernel) + (cl-check-type kernel string) + (let* ((spec (jupyter-guess-kernelspec + kernel (jupyter-kernelspecs server))) + (plist (jupyter-api-start-kernel + server (jupyter-kernelspec-name spec)))) + (jupyter-kernel :server server :id (plist-get plist :id) :spec spec))) + +;; FIXME: Don't allow creating kernels without them being launched. +(cl-defmethod jupyter-launch ((kernel jupyter-server-kernel)) + "Launch KERNEL based on its kernelspec. +When KERNEL does not have an ID yet, launch KERNEL on SERVER +using its SPEC." + (pcase-let (((cl-struct jupyter-server-kernel server id spec session) kernel)) + (unless session + (and id (setq id (or (jupyter-server-kernel-id-from-name server id) id))) + (if id + ;; When KERNEL already has an ID before it has a session, + ;; assume we are connecting to an already launched kernel. In + ;; this case, make sure the KERNEL's SPEC is the same as the + ;; one being connected to. + ;; + ;; Note, this also has the side effect of raising an error + ;; when the ID does not match one on the server. + (unless spec + (let ((model (jupyter-api-get-kernel server id))) + (setf (jupyter-kernel-spec kernel) + (jupyter-guess-kernelspec + (plist-get model :name) + (jupyter-kernelspecs server))))) + (let ((plist (jupyter-api-start-kernel + server (jupyter-kernelspec-name spec)))) + (setf (jupyter-server-kernel-id kernel) (plist-get plist :id)) + (sit-for 1))) + ;; TODO: Replace with the real session object + (setf (jupyter-kernel-session kernel) (jupyter-session)))) + (cl-call-next-method)) + +(cl-defmethod jupyter-shutdown ((kernel jupyter-server-kernel)) + (pcase-let (((cl-struct jupyter-server-kernel server id session) kernel)) + (cl-call-next-method) + (when session + (jupyter-api-shutdown-kernel server id)))) + +(cl-defmethod jupyter-restart ((kernel jupyter-server-kernel)) + (pcase-let (((cl-struct jupyter-server-kernel server id session) kernel)) + (when session + (jupyter-api-restart-kernel server id)))) + +(cl-defmethod jupyter-interrupt ((kernel jupyter-server-kernel)) + (pcase-let (((cl-struct jupyter-server-kernel server id) kernel)) + (jupyter-api-interrupt-kernel server id))) + +(provide 'jupyter-server-kernel) + +;;; jupyter-server-kernel.el ends here diff --git a/lisp/jupyter/jupyter-server.el b/lisp/jupyter/jupyter-server.el new file mode 100644 index 00000000..d095a51a --- /dev/null +++ b/lisp/jupyter/jupyter-server.el @@ -0,0 +1,574 @@ +;;; jupyter-server.el --- Support for the Jupyter kernel servers -*- lexical-binding: t -*- + +;; Copyright (C) 2019-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 02 Apr 2019 + +;; 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: + +;; Overview of implementation +;; +;; A `jupyter-server' communicates with a Jupyter kernel server (either the +;; notebook or a kernel gateway) via the Jupyter REST API. Given the URL and +;; Websocket URL for the server, the `jupyter-server' object can launch kernels +;; using the function `jupyter-server-start-new-kernel'. The kernelspecs +;; available on the server can be accessed by calling +;; `jupyter-kernelspecs'. +;; +;; Starting REPLs +;; +;; You can launch kernels without connecting clients to them by using +;; `jupyter-server-launch-kernel'. To connect a REPL to a launched kernel use +;; `jupyter-connect-server-repl'. To both launch and connect a REPL use +;; `jupyter-run-server-repl'. All of the previous commands determine the server +;; to use by using the `jupyter-current-server' function, which see. +;; +;; Managing kernels on a server +;; +;; To get an overview of all live kernels on a server you can call +;; `jupyter-server-list-kernels'. From the buffer displayed there are a number +;; of keys bound that enable you to manage the kernels on the server. See +;; `jupyter-server-kernel-list-mode-map'. +;; +;; TODO: Find where it would be appropriate to call `delete-instance' on a +;;`jupyter-server' that does not have any websockets open, clients connected, +;; or HTTP connections open, or is not bound to `jupyter-current-server' in any +;; buffer. + +;;; Code: + +(eval-when-compile (require 'subr-x)) +(require 'jupyter-repl) +(require 'jupyter-server-kernel) + +(declare-function jupyter-tramp-file-name-p "jupyter-tramp" (filename)) +(declare-function jupyter-tramp-server-from-file-name "jupyter-tramp" (filename)) +(declare-function jupyter-tramp-file-name-from-url "jupyter-tramp" (url)) + +(defgroup jupyter-server nil + "Support for the Jupyter kernel gateway" + :group 'jupyter) + +;;; Assigning names to kernel IDs + +(defvar jupyter-server-kernel-names nil + "An alist mapping URLs to alists mapping kernel IDs to human friendly names. +For example + + \((\"http://localhost:8888\" + (\"72d92ded-1275-440a-852f-90f655197305\" . \"thermo\"))\) + +You can persist this alist across Emacs sessions using `desktop', +`savehist', or any other session persistence package. For +example, when using `savehist' you can add the following to your +init file to persist the server names across Emacs sessions. + + \(savehist-mode\) + \(add-to-list \='savehist-additional-variables \='jupyter-server-kernel-names\).") + +(defun jupyter-server-cull-kernel-names (&optional server) + "Ensure all names in `jupyter-server-kernel-names' map to existing kernels. +If SERVER is non-nil only check the kernels on SERVER, otherwise +check all kernels on all existing servers." + (let ((servers (if server (list server) + (jupyter-gc-servers) + (jupyter-servers)))) + (unless server + ;; Only remove non-existing servers when culling all kernels on all + ;; servers. + (let ((urls (mapcar (lambda (x) (oref x url)) servers))) + (cl-callf2 cl-remove-if-not (lambda (x) (member (car x) urls)) + jupyter-server-kernel-names))) + (dolist (server servers) + (when-let* ((names (assoc (oref server url) jupyter-server-kernel-names))) + (setf (alist-get (oref server url) + jupyter-server-kernel-names nil nil #'equal) + (cl-loop + for kernel across (jupyter-api-get-kernel server) + for name = (assoc (plist-get kernel :id) names) + when name collect name)))))) + +(defun jupyter-server-kernel-name (server id) + "Return the associated name of the kernel with ID on SERVER. +If there is no name associated, return nil. See +`jupyter-server-kernel-names'." + (cl-check-type server jupyter-server) + (let ((kernel-names (assoc (oref server url) jupyter-server-kernel-names))) + (cdr (assoc id kernel-names)))) + +(defun jupyter-server-kernel-id-from-name (server name) + "Return the ID of the kernel that has NAME on SERVER. +If NAME does not have a kernel associated, return nil. See +`jupyter-server-kernel-names'." + (cl-check-type server jupyter-server) + (jupyter-server-cull-kernel-names server) + (let ((kernel-names (assoc (oref server url) jupyter-server-kernel-names))) + (car (rassoc name kernel-names)))) + +(defun jupyter-server-name-kernel (server id name) + "NAME the kernel with ID on SERVER. +See `jupyter-server-kernel-names'." + (cl-check-type server jupyter-server) + (setf (alist-get id + (alist-get (oref server url) + jupyter-server-kernel-names + nil nil #'equal) + nil nil #'equal) + name)) + +(defun jupyter-server-name-client-kernel (client name) + "For the kernel connected to CLIENT associate NAME. +CLIENT must be communicating with a `jupyter-server-kernel', the +CLIENT must be communicating with a `jupyter-server-kernel', see +`jupyter-server-kernel-names'." + (cl-check-type client jupyter-kernel-client) + (jupyter-kernel-action client + (lambda (kernel) + (pcase-let (((cl-struct jupyter-server-kernel server id) kernel)) + (jupyter-server-name-kernel server id name))))) + +;;; Launching notebook processes + +(defvar jupyter-notebook-procs nil) + +(defvar jupyter-default-notebook-port 8888) + +(defun jupyter-port-available-p (port) + "Return non-nil if PORT is available." + (let ((proc + (condition-case nil + (make-network-process + :name "jupyter-port-available-p" + :server t + :host "127.0.0.1" + :service port) + (file-error nil)))) + (when proc + (prog1 t + (delete-process proc))))) + +(defun jupyter-launch-notebook (&optional port authentication) + "Launch a Jupyter notebook on PORT with AUTHENTICATION. +If PORT is nil, launch the notebook on the +`jupyter-default-notebook-port' if available. Launch the +notebook on a random port otherwise. Return the actual port +used. + +If AUTHENTICATION is t, use the default, token, authentication of +a Jupyter notebook. If AUTHENTICATION is a string, it is +interpreted as the password to the notebook. Any other value of +AUTHENTICATION means the notebook is not authenticated." + (let ((port (if port + (if (jupyter-port-available-p port) + port + (error "Port %s not available" port)) + (if (jupyter-port-available-p jupyter-default-notebook-port) + jupyter-default-notebook-port + (car (jupyter-available-local-ports 1)))))) + (prog1 port + (let ((buffer (generate-new-buffer "*jupyter-notebook*")) + (args (append + (list "notebook" "--no-browser" "--debug" + (format "--NotebookApp.port=%s" port)) + (cond + ((eq authentication t) + (list)) + ((stringp authentication) + (list + "--NotebookApp.token=''" + (format "--NotebookApp.password='%s'" + authentication))) + (t + (list + "--NotebookApp.token=''" + "--NotebookApp.password=''")))))) + (setq jupyter-notebook-procs + (cl-loop for (port . proc) in jupyter-notebook-procs + if (process-live-p proc) collect (cons port proc))) + (push + (cons port + (apply #'start-file-process + "jupyter-notebook" buffer "jupyter" args)) + jupyter-notebook-procs) + (with-current-buffer buffer + (jupyter-with-timeout ((format "Launching notebook process on port %s..." port) 5) + (save-excursion + (goto-char (point-min)) + (re-search-forward "Jupyter Notebook.+running at:$" nil t)))))))) + +(defun jupyter-notebook-process (server) + "Return a process object for the notebook associated with SERVER. +Return nil if the associated notebook process was not launched by +Emacs." + (let ((url (url-generic-parse-url (oref server url)))) + (cdr (assoc (url-port url) jupyter-notebook-procs)))) + +;;; Helpers for commands + +(defun jupyter-completing-read-server-kernel (server) + "Use `completing-read' to select a kernel on SERVER. +A model of the kernel is returned as a property list and has at +least the following keys: + +- :id :: The ID used to identify the kernel on the server +- :last_activity :: The last channel activity of the kernel +- :name :: The kernelspec name used to start the kernel +- :execution_state :: The status of the kernel +- :connections :: The number of websocket connections for the kernel" + (let* ((kernels (jupyter-api-get-kernel server)) + (display-names + (if (null kernels) (error "No kernels @ %s" (oref server url)) + (mapcar (lambda (k) + (cl-destructuring-bind + (&key name id last_activity &allow-other-keys) k + (concat name " (last activity: " last_activity ", id: " id ")"))) + kernels))) + (name (completing-read "kernel: " display-names nil t))) + (when (equal name "") + (error "No kernel selected")) + (nth (- (length display-names) + (length (member name display-names))) + (append kernels nil)))) + +(define-error 'jupyter-server-non-existent + "The server doesn't exist") + +(defun jupyter-current-server (&optional ask) + "Return an existing `jupyter-server' or ASK for a new one. +If ASK is non-nil, always ask for a URL and return the +`jupyter-server' object corresponding to it. If no Jupyter server +at URL exists, `signal' a `jupyter-server-non-existent' error +with error data being URL. + +If the buffer local value of `jupyter-current-server' is non-nil, +return its value. If `jupyter-current-server' is nil and the +`jupyter-current-client' is communicating with a kernel behind a +kernel server, return the `jupyter-server' managing the +connection. + +If `jupyter-current-client' is nil or not communicating with a +kernel behind a server and if `default-directory' is a Jupyter +remote file name, return the `jupyter-server' object +corresponding to that connection. + +If all of the above fails, either return the most recently used +`jupyter-server' object if there is one or ask for one based off +a URL." + (interactive "P") + (let ((read-url-make-server + (lambda () + ;; From the list of available server + ;; (if (> (length jupyter--servers) 1) + ;; (let ((server (cdr (completing-read + ;; "Jupyter Server: " + ;; (mapcar (lambda (x) (cons (oref x url) x)) + ;; jupyter--servers))))) + ;; ) + (jupyter-gc-servers) + (let* ((url (read-string "Server URL: " "http://localhost:8888")) + (ws-url (read-string "Websocket URL: " + (let ((u (url-generic-parse-url url))) + (setf (url-type u) "ws") + (url-recreate-url u))))) + (let ((server (jupyter-server :url url :ws-url ws-url))) + (if (jupyter-api-server-exists-p server) server + (delete-instance server) + (signal 'jupyter-server-non-existent (list url)))))))) + (let ((server + (if ask (funcall read-url-make-server) + (cond + (jupyter-current-server) + ;; Server of the current kernel client + ((and jupyter-current-client + (jupyter-kernel-action + jupyter-current-client + (lambda (kernel) + (and (jupyter-server-kernel-p kernel) + (jupyter-server-kernel-server kernel)))))) + ;; Server of the current TRAMP remote context + ((and (file-remote-p default-directory) + (jupyter-tramp-file-name-p default-directory) + (jupyter-tramp-server-from-file-name default-directory))) + ;; Most recently accessed + (t + (or (car jupyter--servers) + (funcall read-url-make-server))))))) + (prog1 server + (setq jupyter--servers + (cons server (delq server jupyter--servers))))))) + +;;; Commands + +;;;###autoload +(defun jupyter-server-launch-kernel (server) + "Start a kernel on SERVER. + +With a prefix argument, ask to select a server if there are +mutiple to choose from, otherwise the most recently used server +is used as determined by `jupyter-current-server'." + (interactive (list (jupyter-current-server current-prefix-arg))) + (let* ((specs (jupyter-kernelspecs server)) + (spec (jupyter-completing-read-kernelspec specs))) + (jupyter-api-start-kernel server (jupyter-kernelspec-name spec)))) + +;;; REPL + +;; TODO: When closing the REPL buffer and it is the last connected client as +;; shown by the :connections key of a `jupyter-api-get-kernel' call, ask to +;; also shutdown the kernel. +(defun jupyter-server-repl (kernel &optional repl-name associate-buffer client-class display) + (or client-class (setq client-class 'jupyter-repl-client)) + (jupyter-error-if-not-client-class-p client-class 'jupyter-repl-client) + (jupyter-bootstrap-repl + (jupyter-client kernel client-class) + repl-name associate-buffer display)) + +;;;###autoload +(defun jupyter-run-server-repl + (server kernel-name &optional repl-name associate-buffer client-class display) + "On SERVER start a kernel with KERNEL-NAME. + +With a prefix argument, ask to select a server if there are +mutiple to choose from, otherwise the most recently used server +is used as determined by `jupyter-current-server'. + +REPL-NAME, ASSOCIATE-BUFFER, CLIENT-CLASS, and DISPLAY all have +the same meaning as in `jupyter-run-repl'." + (interactive + (let ((server (jupyter-current-server current-prefix-arg))) + (list server + (jupyter-completing-read-kernelspec + (jupyter-kernelspecs server)) + ;; FIXME: Ambiguity with `jupyter-current-server' and + ;; `current-prefix-arg' + (when (and current-prefix-arg + (y-or-n-p "Name REPL? ")) + (read-string "REPL Name: ")) + t nil t))) + (jupyter-server-repl + (jupyter-kernel :server server :spec kernel-name) + repl-name associate-buffer client-class display)) + +;;;###autoload +(defun jupyter-connect-server-repl + (server kernel-id &optional repl-name associate-buffer client-class display) + "On SERVER, connect to the kernel with KERNEL-ID. + +With a prefix argument, ask to select a server if there are +mutiple to choose from, otherwise the most recently used server +is used as determined by `jupyter-current-server'. + +REPL-NAME, ASSOCIATE-BUFFER, CLIENT-CLASS, and DISPLAY all have +the same meaning as in `jupyter-connect-repl'." + (interactive + (let ((server (jupyter-current-server current-prefix-arg))) + (list server + (completing-read + "Kernel ID: " + (mapcar (lambda (kernel) + (cl-destructuring-bind (&key id &allow-other-keys) + kernel + (or (jupyter-server-kernel-name server id) id))) + (jupyter-api-get-kernel server))) + ;; FIXME: Ambiguity with `jupyter-current-server' and + ;; `current-prefix-arg' + (when (and current-prefix-arg + (y-or-n-p "Name REPL? ")) + (read-string "REPL Name: ")) + t nil t))) + (jupyter-server-repl + (jupyter-kernel + :server server + :id (or (jupyter-server-kernel-id-from-name server kernel-id) + kernel-id)) + repl-name associate-buffer client-class display)) + +;;; `jupyter-server-kernel-list' + +(defun jupyter-server-kernel-list-do-shutdown () + "Shutdown the kernel corresponding to the current entry." + (interactive) + (when-let* ((id (tabulated-list-get-id)) + (really (yes-or-no-p + (format "Really shutdown %s kernel? " + (aref (tabulated-list-get-entry) 0))))) + (jupyter-api-shutdown-kernel jupyter-current-server id) + (tabulated-list-delete-entry))) + +(defun jupyter-server-kernel-list-do-restart () + "Restart the kernel corresponding to the current entry." + (interactive) + (when-let* ((id (tabulated-list-get-id)) + (really (yes-or-no-p "Really restart kernel? "))) + (jupyter-api-restart-kernel jupyter-current-server id) + (revert-buffer))) + +(defun jupyter-server-kernel-list-do-interrupt () + "Interrupt the kernel corresponding to the current entry." + (interactive) + (when-let* ((id (tabulated-list-get-id))) + (jupyter-api-interrupt-kernel jupyter-current-server id) + (revert-buffer))) + +(defun jupyter-server-kernel-list-new-repl () + "Connect a REPL to the kernel corresponding to the current entry." + (interactive) + (when-let* ((id (tabulated-list-get-id))) + (let ((jupyter-current-client + (jupyter-server-repl + (jupyter-kernel + :server jupyter-current-server + :id id)))) + (revert-buffer) + (jupyter-repl-pop-to-buffer)))) + +(defun jupyter-server-kernel-list-launch-kernel () + "Launch a new kernel on the server." + (interactive) + (jupyter-server-launch-kernel jupyter-current-server) + (revert-buffer)) + +(defun jupyter-server-kernel-list-name-kernel () + "Name the kernel under `point'." + (interactive) + (when-let* ((id (tabulated-list-get-id)) + (name (read-string + (let ((cname (jupyter-server-kernel-name + jupyter-current-server id))) + (if cname (format "Rename %s to: " cname) + (format "Name kernel [%s]: " id)))))) + (when (zerop (length name)) + (jupyter-server-kernel-list-name-kernel)) + (jupyter-server-name-kernel jupyter-current-server id name) + (revert-buffer))) + +(defvar jupyter-server-kernel-list-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-i") #'jupyter-server-kernel-list-do-interrupt) + (define-key map (kbd "d") #'jupyter-server-kernel-list-do-shutdown) + (define-key map (kbd "C-c C-d") #'jupyter-server-kernel-list-do-shutdown) + (define-key map (kbd "C-c C-r") #'jupyter-server-kernel-list-do-restart) + (define-key map [follow-link] nil) ;; allows mouse-1 to be activated + (define-key map [mouse-1] #'jupyter-server-kernel-list-new-repl) + (define-key map (kbd "RET") #'jupyter-server-kernel-list-new-repl) + (define-key map (kbd "C-RET") #'jupyter-server-kernel-list-launch-kernel) + (define-key map (kbd "C-") #'jupyter-server-kernel-list-launch-kernel) + (define-key map (kbd "") #'jupyter-server-kernel-list-new-repl) + (define-key map "R" #'jupyter-server-kernel-list-name-kernel) + (define-key map "r" #'revert-buffer) + (define-key map "g" #'revert-buffer) + map)) + +(define-derived-mode jupyter-server-kernel-list-mode + tabulated-list-mode "Jupyter Server Kernels" + "A list of live kernels on a Jupyter kernel server." + (tabulated-list-init-header) + (tabulated-list-print) + (let ((inhibit-read-only t) + (url (oref jupyter-current-server url))) + (overlay-put + (make-overlay 1 2) + 'before-string + (concat (propertize url 'face '(fixed-pitch default)) "\n"))) + ;; So that `dired-jump' will visit the directory of the kernel server. + (setq default-directory + (jupyter-tramp-file-name-from-url + (oref jupyter-current-server url)))) + +(defun jupyter-server--kernel-list-format () + (let* ((get-time + (lambda (a) + (or (get-text-property 0 'jupyter-time a) + (let ((time (jupyter-decode-time a))) + (prog1 time + (put-text-property 0 1 'jupyter-time time a)))))) + (time-sort + (lambda (a b) + (time-less-p + (funcall get-time (aref (nth 1 a) 2)) + (funcall get-time (aref (nth 1 b) 2))))) + (conn-sort + (lambda (a b) + (< (string-to-number (aref (nth 1 a) 4)) + (string-to-number (aref (nth 1 b) 4)))))) + `[("Name" 17 t) + ("ID" 38 nil) + ("Activity" 20 ,time-sort) + ("State" 10 nil) + ("Conns." 6 ,conn-sort)])) + +(defun jupyter-server--kernel-list-entries () + (cl-loop + with names = nil + for kernel across (jupyter-api-get-kernel jupyter-current-server) + collect + (cl-destructuring-bind + (&key name id last_activity execution_state + connections &allow-other-keys) + kernel + (let* ((time (jupyter-decode-time last_activity)) + (name (propertize + (or (jupyter-server-kernel-name jupyter-current-server id) + (let ((same (cl-remove-if-not + (lambda (x) (string-prefix-p name x)) names))) + (when same (setq name (format "%s<%d>" name (length same)))) + (push name names) + name)) + 'face 'font-lock-constant-face)) + (activity (propertize (jupyter-format-time-low-res time) + 'face 'font-lock-doc-face + 'jupyter-time time)) + (conns (propertize (number-to-string connections) + 'face 'shadow)) + (state (propertize execution_state + 'face (pcase execution_state + ("busy" 'warning) + ("idle" 'shadow) + ("starting" 'success))))) + (list id (vector name id activity state conns)))))) + +;;;###autoload +(defun jupyter-server-list-kernels (server) + "Display a list of live kernels on SERVER. +When called interactively, ask to select a SERVER when given a +prefix argument otherwise the `jupyter-current-server' will be +used." + (interactive (list (jupyter-current-server current-prefix-arg))) + (if (zerop (length (jupyter-api-get-kernel server))) + (when (yes-or-no-p (format "No kernels at %s; launch one? " + (oref server url))) + (jupyter-server-launch-kernel server) + (jupyter-server-list-kernels server)) + (with-current-buffer + (jupyter-get-buffer-create (format "kernels[%s]" (oref server url))) + (setq jupyter-current-server server) + (if (eq major-mode 'jupyter-server-kernel-list-mode) + (revert-buffer) + (setq tabulated-list-format (jupyter-server--kernel-list-format) + tabulated-list-entries #'jupyter-server--kernel-list-entries + tabulated-list-sort-key (cons "Activity" t)) + (jupyter-server-kernel-list-mode) + ;; So that `dired-jump' will visit the directory of the kernel server. + (setq default-directory + (jupyter-tramp-file-name-from-url (oref server url)))) + (jupyter-display-current-buffer-reuse-window)))) + +(provide 'jupyter-server) + +;;; jupyter-server.el ends here diff --git a/lisp/jupyter/jupyter-tramp.el b/lisp/jupyter/jupyter-tramp.el new file mode 100644 index 00000000..936eef7f --- /dev/null +++ b/lisp/jupyter/jupyter-tramp.el @@ -0,0 +1,881 @@ +;;; jupyter-tramp.el --- TRAMP interface to the Jupyter REST API -*- lexical-binding: t -*- + +;; Copyright (C) 2019-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 25 May 2019 + +;; 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: + +;; Integrate the Jupyter REST API contents endpoint with Emacs' file handling +;; facilities for remote files. Adds two new remote file methods, /jpy: and +;; /jpys:, the former being HTTP connections and the latter being HTTPS +;; connections. +;; +;; If you run a local notebook server on port 8888 then reading and writing +;; files to the server is as easy as +;; +;; (write-region "xxxx" nil "/jpy:localhost:happy.txt") +;; +;; or +;; +;; (find-file "/jpy:localhost:serious.py") +;; +;; To open a `dired' listing to the base directory of the notebook server +;; +;; (dired "/jpy:localhost:/") +;; +;; You can change the default port by changing the `tramp-default-port' entry +;; of the jpy or jpys method in `tramp-methods' or you can specify a port +;; inline using something like /jpy:localhost#8888:/. +;; +;; You can also set an entry in `tramp-default-host-alist' like +;; +;; (add-to-list 'tramp-default-host-alist (list "jpy" nil "HOST")) +;; +;; Then specifying filenames like /jpy::/foo is equivalent to /jpy:HOST: +;; +;; TODO: Same messages for implemented file operations that TRAMP and Emacs +;; give. +;; +;; TODO: How can checkpoints be used with: `auto-save-mode', +;; `diff-latest-backup-file', ... + +;;; Code: + +(eval-when-compile + (require 'subr-x) + (require 'tramp-compat)) +(require 'jupyter-rest-api) +(require 'jupyter-server) +(require 'tramp) +(require 'tramp-cache) + +(defgroup jupyter-tramp nil + "TRAMP integration with the Jupyter Contents REST API" + :group 'jupyter) + +(declare-function jupyter-decode-time "jupyter-messages" (str)) + +(defmacro jupyter-tramp-with-api-connection (file &rest body) + "Set `jupyter-current-server' based on FILE, evaluate BODY. +FILE must be a remote file name recognized as corresponding to a +file on a server that can be communicated with using the Jupyter +notebook REST API. + +Note, BODY is wrapped with a call to +`with-parsed-tramp-file-name' so that the variables method, user, +host, localname, ..., are all bound to values parsed from FILE." + (declare (indent 1) (debug ([&or stringp symbolp] body))) + `(with-parsed-tramp-file-name ,file nil + ;; FIXME: There is a dilemma here, a `jupyter-server' is a more particular + ;; object than what we need. There is really no reason to have it here, we + ;; just need a `jupyter-rest-client'. Is there a reason this needs to be + ;; here? + (let ((jupyter-current-server + (jupyter-tramp-server-from-file-name ,file))) + ,@body))) + +;;; File name handler setup + +;; Actual functions implemented by `jupyter-tramp' all the others are either +;; ignored or handled by the TRAMP handlers. +;; +;; jupyter-tramp-copy-file +;; jupyter-tramp-delete-directory +;; jupyter-tramp-delete-file +;; jupyter-tramp-expand-file-name +;; jupyter-tramp-file-attributes +;; jupyter-tramp-file-directory-p +;; jupyter-tramp-file-exists-p +;; jupyter-tramp-file-local-copy +;; jupyter-tramp-file-name-all-completions +;; jupyter-tramp-file-remote-p +;; jupyter-tramp-file-symlink-p +;; jupyter-tramp-file-writable-p +;; jupyter-tramp-make-directory-internal +;; jupyter-tramp-rename-file +;; jupyter-tramp-write-region +;;;###autoload +(defconst jupyter-tramp-file-name-handler-alist + '((access-file . tramp-handle-access-file) + (add-name-to-file . tramp-handle-add-name-to-file) + ;; `byte-compiler-base-file-name' performed by default handler. + ;; `copy-directory' performed by default handler. + (copy-file . jupyter-tramp-copy-file) + (delete-directory . jupyter-tramp-delete-directory) + (delete-file . jupyter-tramp-delete-file) + ;; TODO: Use the `checkpoint' file? I think we can only create a checkpoint + ;; or restore a file from a checkpoint so maybe we can do something with + ;; auto-save and checkpoints? + ;; `diff-latest-backup-file' performed by default handler. + (directory-file-name . tramp-handle-directory-file-name) + (directory-files . tramp-handle-directory-files) + (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) + (dired-compress-file . ignore) + (dired-uncache . tramp-handle-dired-uncache) + (expand-file-name . jupyter-tramp-expand-file-name) + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) + (file-acl . ignore) + (file-attributes . jupyter-tramp-file-attributes) + (file-directory-p . jupyter-tramp-file-directory-p) + (file-equal-p . tramp-handle-file-equal-p) + (file-executable-p . tramp-handle-file-exists-p) + (file-exists-p . jupyter-tramp-file-exists-p) + (file-in-directory-p . tramp-handle-file-in-directory-p) + (file-local-copy . jupyter-tramp-file-local-copy) + (file-modes . tramp-handle-file-modes) + (file-name-all-completions . jupyter-tramp-file-name-all-completions) + (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) + (file-name-completion . tramp-handle-file-name-completion) + (file-name-directory . tramp-handle-file-name-directory) + (file-name-nondirectory . tramp-handle-file-name-nondirectory) + ;; `file-name-sans-versions' performed by default handler. + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-handle-file-notify-valid-p) + (file-ownership-preserved-p . ignore) + (file-readable-p . tramp-handle-file-exists-p) + (file-regular-p . tramp-handle-file-regular-p) + ;; NOTE: We can't use `tramp-handle-file-remote-p' since it expects a + ;; process to check for the connected argument whereas we are using an HTTP + ;; connection which may or may not be as long lived as something like an + ;; SSH connection as the liveness depends on the Keep-Alive header of an + ;; HTTP request. + (file-remote-p . jupyter-tramp-file-remote-p) + (file-selinux-context . tramp-handle-file-selinux-context) + (file-symlink-p . jupyter-tramp-file-symlink-p) + (file-system-info . ignore) + (file-truename . tramp-handle-file-truename) + (file-writable-p . jupyter-tramp-file-writable-p) + ;; TODO: Can we do something here with checkpoints on the remote? + (find-backup-file-name . ignore) + ;; `find-file-noselect' performed by default handler. + ;; `get-file-buffer' performed by default handler. + (insert-directory . tramp-handle-insert-directory) + ;; Uses `file-local-copy' to get the contents so be sure thats implemented + (insert-file-contents . tramp-handle-insert-file-contents) + (load . tramp-handle-load) + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) + (make-directory . jupyter-tramp-make-directory) + (make-directory-internal . ignore) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) + (make-symbolic-link . tramp-handle-make-symbolic-link) + ;; `process-file' performed by default handler. + (rename-file . jupyter-tramp-rename-file) + (set-file-acl . ignore) + (set-file-modes . ignore) + (set-file-selinux-context . ignore) + (set-file-times . ignore) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) + ;; `shell-command' performed by default handler. + ;; `start-file-process' performed by default handler. + (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (temporary-file-directory . tramp-handle-temporary-file-directory) + ;; Important that we have this so that `call-process' and friends don't try + ;; to set a Jupyter notebook directory as a directory in which a process + ;; should run. + (unhandled-file-name-directory . ignore) + (vc-registered . ignore) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (write-region . jupyter-tramp-write-region)) + "Alist of handler functions for Tramp Jupyter method. +Operations not mentioned here will be handled by the default Emacs primitives.") + +;;;###autoload +(defconst jupyter-tramp-methods '("jpy" "jpys") + "Methods to connect Jupyter kernel servers.") + +;;;###autoload +(with-eval-after-load 'tramp + (mapc (lambda (method) + (add-to-list + 'tramp-methods + (list method + (list 'tramp-default-port 8888) + (list 'tramp-tmpdir "/tmp")))) + jupyter-tramp-methods) + (tramp-register-foreign-file-name-handler + 'jupyter-tramp-file-name-p 'jupyter-tramp-file-name-handler) + (add-to-list 'tramp-default-host-alist + '("\\`jpys?\\'" nil "localhost"))) + +;;;###autoload +(defsubst jupyter-tramp-file-name-method-p (method) + "Return METHOD if it corresponds to a Jupyter filename method or nil." + (and (string-match-p "\\`jpys?\\'" method) method)) + +;; Port of `tramp-ensure-dissected-file-name' in Emacs 29 +;;;###autoload +(defun jupyter-tramp-ensure-dissected-file-name (vec-or-filename) + (cond + ((tramp-file-name-p vec-or-filename) vec-or-filename) + ((tramp-tramp-file-p vec-or-filename) + (tramp-dissect-file-name vec-or-filename)))) + +;; NOTE: Needs to be a `defsubst' to avoid recursive loading. +;;;###autoload +(defsubst jupyter-tramp-file-name-p (vec-or-filename) + "If FILENAME is a Jupyter filename, return its method otherwise nil." + (when-let* ((vec (jupyter-tramp-ensure-dissected-file-name vec-or-filename))) + (jupyter-tramp-file-name-method-p (tramp-file-name-method vec)))) + +;;;###autoload +(defun jupyter-tramp-file-name-handler (operation &rest args) + (let ((handler (assq operation jupyter-tramp-file-name-handler-alist))) + (if (not handler) + (tramp-run-real-handler operation args) + (apply (cdr handler) args)))) + +;;;; Converting file names to authenticated `jupyter-rest-client' instances + +(defvar tramp-current-method) +(defvar tramp-current-user) +(defvar tramp-current-domain) +(defvar tramp-current-host) +(defvar tramp-current-port) + +(defun jupyter-tramp-read-passwd (filename &optional prompt) + "Read a password based off of FILENAME's TRAMP filename components. +Use PROMPT to prompt the user for the password if needed, PROMPT +defaults to \"Password:\"." + (unless (jupyter-tramp-file-name-p filename) + (error "Not a Jupyter filename")) + (with-parsed-tramp-file-name filename nil + (let ((tramp-current-method method) + (tramp-current-user (or user user-login-name)) + (tramp-current-domain nil) + (tramp-current-host host) + (tramp-current-port port)) + (tramp-read-passwd nil (or prompt "Password: "))))) + +;;;###autoload +(defun jupyter-tramp-file-name-from-url (url) + "Return a Jupyter TRAMP filename for the root directory of a kernel server. +The filename is based off of URL's host and port if any." + (let ((url (if (url-p url) url + (url-generic-parse-url url)))) + (format "/jpy%s:%s%s:/" + (if (equal (url-type url) "https") "s" "") + (url-host url) + (let ((port (url-port-if-non-default url))) + (if port (format "#%d" port) ""))))) + +;;;###autoload +(defun jupyter-tramp-url-from-file-name (filename) + "Return a URL string based off the method, host, and port of FILENAME." + (with-parsed-tramp-file-name filename nil + (unless port (setq port (when (functionp 'tramp-file-name-port-or-default) + ;; This function was introduced in Emacs 26.1 + (tramp-file-name-port-or-default v)))) + (format "%s://%s%s" (if (equal method "jpys") "https" "http") + host (if port (format ":%s" port) "")))) + +;;;###autoload +(defun jupyter-tramp-server-from-file-name (filename) + "Return a `jupyter-server' instance based off of FILENAME's remote components. +If the connection has not been authenticated by the server, +attempt to authenticate the connection. Raise an error if that +fails." + (unless (jupyter-tramp-file-name-p filename) + (error "Not a Jupyter filename")) + (with-parsed-tramp-file-name filename nil + (let* ((url (jupyter-tramp-url-from-file-name filename)) + (client (jupyter-server :url url))) + (prog1 client + (unless (jupyter-api-server-accessible-p client) + (cond + ((y-or-n-p (format "Login to %s using a token? " url)) + (jupyter-api-authenticate client 'token)) + (t + ;; This is here so that reading a password using + ;; `tramp-read-passwd' via `jupyter-tramp-read-passwd' will check + ;; auth sources. + (tramp-set-connection-property v "first-password-request" t) + (jupyter-api-authenticate client + 'password + (let ((remote (file-remote-p filename))) + (lambda () + (jupyter-tramp-read-passwd + filename (format "Password [%s]: " remote)))))))))))) + +;;; Getting information about file models + +(defalias 'jupyter-tramp-flush-file-properties + (if (functionp 'tramp-flush-file-properties) + ;; New in Emacs 27 + 'tramp-flush-file-properties + 'tramp-flush-file-property)) + +(defun jupyter-tramp--get-directory-or-file-model (file localname path no-content) + (cond + (no-content + (jupyter-tramp-get-file-model (file-name-directory file))) + (t + (condition-case err + ;; Unset `signal-hook-function' so that TRAMP in Emacs >= 27 does not + ;; mess with the signal data until we have a chance to look at it. + (let (signal-hook-function) + (jupyter-api-get-file-model jupyter-current-server localname)) + (jupyter-api-http-error + (cl-destructuring-bind (_ code msg) err + (if (and (eq code 404) + (string-match-p + "\\(?:No such \\)?file or directory\\(?:does not exist\\)?" + msg)) + (list :path path :name nil + ;; If a file doesn't exist we need to check if the + ;; containing directory is writable to determine if + ;; FILE is. + :writable (plist-get + (jupyter-tramp-get-file-model + (file-name-directory + (directory-file-name file)) + 'no-content) + :writable)) + (signal (car err) (cdr err))))) + (error (signal (car err) (cdr err))))))) + +(defun jupyter-tramp--get-file-model (file localname no-content) + (let* ((path (jupyter-api-content-path localname)) + (model (jupyter-tramp--get-directory-or-file-model + file localname path no-content))) + (or (jupyter-api-find-model path model) + ;; We reach here when MODEL is a directory that does + ;; not contain PATH. PATH is writable if the + ;; directory is. + (list :path path :name nil + :writable (plist-get model :writable))))) + +(defun jupyter-tramp-get-file-model (file &optional no-content) + "Return a model of FILE or raise an error. +For non-existent files the model + + (:path PATH :name nil :writable WRITABLE) + +is returned, where PATH is a local path name to FILE on the +server, i.e. excludes the remote part of FILE. WRITABLE will be t +if FILE can be created on the server or nil if PATH is outside +the base directory the server was started in. + +When NO-CONTENT is non-nil, return a model for file that excludes +:content if an actual request needs to be made. The :content key +may or may not be present in this case. If NO-CONTENT is nil, +guarantee that we request FILE's content as well. + +See `jupyter-tramp-get-file-model' for details on what a file model is." + (setq file (expand-file-name file)) + (jupyter-tramp-with-api-connection file + (let ((value (or (tramp-get-file-property v localname "model" nil) + (when no-content + (tramp-get-file-property v localname "nc-model" nil))))) + (unless value + (setq value (jupyter-tramp--get-file-model file localname no-content)) + (tramp-set-file-property + v localname (if no-content "nc-model" "model") value)) + value))) + +(defun jupyter-tramp-flush-file-and-directory-properties (filename) + (with-parsed-tramp-file-name filename nil + (jupyter-tramp-flush-file-properties v localname) + (jupyter-tramp-flush-file-properties v (file-name-directory localname)))) + +;;; Predicates + +(defun jupyter-tramp--barf-if-not-file (file) + (unless (file-exists-p file) + (error "No such file or directory: %s" file))) + +(defun jupyter-tramp--barf-if-not-regular-file (file) + (jupyter-tramp--barf-if-not-file file) + (unless (file-regular-p file) + (error "Not a file: %s" file))) + +(defun jupyter-tramp--barf-if-not-directory (directory) + (jupyter-tramp--barf-if-not-file directory) + (unless (file-directory-p directory) + (error "Not a directory: %s" (expand-file-name directory)))) + +(defun jupyter-tramp-file-writable-p (filename) + (jupyter-tramp-with-api-connection filename + (plist-get (jupyter-tramp-get-file-model filename 'no-content) :writable))) + +;; Actually this may not be true, but there is no way to tell if a file is a +;; symlink or not +(defun jupyter-tramp-file-symlink-p (_filename) + nil) + +(defun jupyter-tramp-file-directory-p (filename) + (jupyter-tramp-with-api-connection filename + (equal (plist-get (jupyter-tramp-get-file-model filename 'no-content) :type) + "directory"))) + +(defvar url-http-open-connections) + +(defun jupyter-tramp-connected-p (vec-or-filename) + "Return non-nil if connected to a Jupyter based remote host." + (let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)) + (port (tramp-file-name-port-or-default vec)) + (key (cons (tramp-file-name-host vec) + (if (numberp port) port + (string-to-number port))))) + (catch 'connected + (dolist (conn (gethash key url-http-open-connections)) + (when (memq (process-status conn) '(run open connect)) + (throw 'connected t)))))) + +(defun jupyter-tramp-file-remote-p (file &optional identification connected) + (when (file-name-absolute-p file) + (with-parsed-tramp-file-name file nil + (when (or (null connected) + (jupyter-tramp-connected-p v)) + (cl-case identification + (method method) + (host host) + (user user) + (localname localname) + (t (tramp-make-tramp-file-name v ""))))))) + +;; Adapted from `tramp-handle-file-exists-p' +(defun jupyter-tramp-file-exists-p (filename) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (or (jupyter-tramp-connected-p filename) + (not non-essential)) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-file-property v localname "file-exists-p" + (not (null (file-attributes filename))))))) + + +;;; File name manipulation + +(defun jupyter-tramp-expand-file-name (name &optional directory) + ;; From `tramp-sh-handle-expand-file-name' + (setq directory (or directory default-directory "/")) + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory directory) name))) + (if (tramp-tramp-file-p name) + (let ((v (tramp-dissect-file-name name))) + (if (jupyter-tramp-file-name-method-p (tramp-file-name-method v)) + (tramp-make-tramp-file-name + v + (tramp-drop-volume-letter + (tramp-run-real-handler + 'expand-file-name (list (tramp-file-name-localname v) "/")))) + (let ((tramp-foreign-file-name-handler-alist + (remove (cons 'jupyter-tramp-file-name-p + 'jupyter-tramp-file-name-handler) + tramp-foreign-file-name-handler-alist))) + (expand-file-name name)))) + (tramp-run-real-handler 'expand-file-name (list name directory)))) + +;;; File operations + +;; Adapted from `tramp-smb-handle-rename-file' +(defun jupyter-tramp-rename-file (filename newname &optional ok-if-already-exists) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) + + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error + (tramp-dissect-file-name + (if (tramp-tramp-file-p filename) filename newname)) + 'file-already-exists newname)) + + (with-tramp-progress-reporter + (tramp-dissect-file-name + (if (tramp-tramp-file-p filename) filename newname)) + 0 (format "Renaming %s to %s" filename newname) + + (if (and (not (file-exists-p newname)) + (tramp-equal-remote filename newname)) + ;; We can rename directly. + (jupyter-tramp-with-api-connection filename + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (jupyter-tramp-flush-file-and-directory-properties filename) + (jupyter-tramp-flush-file-and-directory-properties newname) + (jupyter-api-rename-file jupyter-current-server + filename newname)) + + ;; We must rename via copy. + (copy-file filename newname ok-if-already-exists) + (if (file-directory-p filename) + (delete-directory filename 'recursive) + (delete-file filename))))) + +;; NOTE: Deleting to trash is configured on the server. +(defun jupyter-tramp-delete-directory (directory &optional recursive _trash) + (jupyter-tramp--barf-if-not-directory directory) + (jupyter-tramp-with-api-connection directory + (jupyter-tramp-flush-file-properties v localname) + (let ((files (cl-remove-if + (lambda (x) (member x '("." ".."))) + (directory-files directory nil nil t)))) + (unless (or recursive (not files)) + (error "Directory %s not empty" directory)) + (let ((deleted + ;; Try to delete the directory, if we get an error because its not + ;; empty, manually delete all files below and then try again. + (condition-case err + (prog1 t + ;; Unset `signal-hook-function' so that TRAMP in Emacs >= 27 + ;; does not mess with the signal data until we have a chance + ;; to look at it. + (let (signal-hook-function) + (jupyter-api-delete-file + jupyter-current-server + directory))) + (jupyter-api-http-error + (unless (and (= (nth 1 err) 400) + (string-match-p "not empty" (caddr err))) + (signal (car err) (cdr err)))) + (error (signal (car err) (cdr err)))))) + (unless deleted + ;; Recursive delete, we need to do this manually since we can get a 400 + ;; error on Windows when deleting to trash and also in general when not + ;; deleting to trash if the directory isn't empty, see + ;; jupyter/notebook/notebook/services/contents/filemanager.py + (while files + (let ((file (expand-file-name (pop files) directory))) + (if (file-directory-p file) + (delete-directory file recursive) + (delete-file file)))) + (jupyter-api-delete-file jupyter-current-server directory)))) + ;; Need to uncache both the file and its directory + (jupyter-tramp-flush-file-and-directory-properties directory))) + +(defun jupyter-tramp-delete-file (filename &optional _trash) + (jupyter-tramp--barf-if-not-regular-file filename) + (jupyter-tramp-with-api-connection filename + (jupyter-api-delete-file jupyter-current-server filename) + ;; Need to uncache both the file and its directory + (jupyter-tramp-flush-file-and-directory-properties filename))) + +;; Adapted from `tramp-smb-handle-copy-file' +(defun jupyter-tramp-copy-file (filename newname &optional ok-if-already-exists + keep-date _preserve-uid-gid _preserve-permissions) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) + (with-tramp-progress-reporter + (tramp-dissect-file-name + (if (tramp-tramp-file-p filename) filename newname)) + 0 (format "Copying %s to %s" filename newname) + + (if (file-directory-p filename) + (copy-directory filename newname keep-date 'parents 'copy-contents) + + (cond + ((tramp-equal-remote filename newname) + (jupyter-tramp-with-api-connection newname + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + (jupyter-api-copy-file jupyter-current-server filename newname))) + (t + (let ((tmpfile (file-local-copy filename))) + (if tmpfile + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (and (file-directory-p newname) + (directory-name-p newname)) + (setq newname + (expand-file-name (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + + (with-temp-file newname + (insert-file-contents-literally filename))))))) + + (when (tramp-tramp-file-p newname) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (jupyter-tramp-flush-file-and-directory-properties newname))))) + +;; Ported from `trapm-skeleton-make-directory' in Emacs 29 +(defun jupyter-tramp-make-directory (dir &optional parents) + (jupyter-tramp-with-api-connection dir + (let* ((dir (directory-file-name (expand-file-name dir))) + (par (file-name-directory dir))) + (when (and (null parents) (file-exists-p dir)) + (tramp-error v 'file-already-exists dir)) + ;; Make missing directory parts. + (when parents + (unless (file-directory-p par) + (make-directory par parents))) + ;; Just do it. + (if (file-exists-p dir) t + (jupyter-tramp-flush-file-and-directory-properties dir) + (jupyter-api-make-directory jupyter-current-server dir) + nil)))) + +;;; File name completion + +(defun jupyter-tramp-file-name-all-completions (filename directory) + (when (jupyter-tramp-file-name-p directory) + (all-completions + filename (mapcar #'car (jupyter-tramp-directory-file-models directory)) + (lambda (f) + (let ((ext (file-name-extension f t))) + (and (or (null ext) (not (member ext completion-ignored-extensions))) + (or (null completion-regexp-list) + (not (cl-loop for re in completion-regexp-list + thereis (not (string-match-p re f))))))))))) + +;;; Insert file contents + +;; XXX: WIP +(defun jupyter-tramp--recover-this-file (orig) + "If the `current-buffer' is Jupyter file, revert back to a checkpoint. +If no checkpoints exist, revert back to the file that exists on +the server. For any other file, call ORIG, which is the function +`recover-this-file'" + (interactive) + (let ((file (buffer-file-name))) + (if (not (jupyter-tramp-file-name-p file)) (funcall orig) + (jupyter-tramp-with-api-connection file + (let ((checkpoint (jupyter-api-get-latest-checkpoint + jupyter-current-server + file))) + (when checkpoint + (jupyter-api-restore-checkpoint + jupyter-current-server + file checkpoint)) + (let ((tmpfile (file-local-copy file))) + (unwind-protect + (save-restriction + (widen) + (insert-file-contents tmpfile nil nil nil 'replace) + ;; TODO: What else needs to be done here + (set-buffer-modified-p nil)) + (delete-file tmpfile)))))))) + +;; TODO: Something that doesn't use advise +;; (advice-add 'recover-this-file :around 'jupyter-tramp--recover-this-file) + +;; TODO: What to do about reading and writing large files? Also the out of +;; band functions of TRAMP. +;; +;; Adapted from `tramp-sh-handle-write-region' +(defun jupyter-tramp-write-region (start end filename &optional append visit lockname mustbenew) + (setq filename (expand-file-name filename)) + (when (and mustbenew (file-exists-p filename) + (or (eq mustbenew 'excl) + (not + (y-or-n-p + (format "File %s exists; overwrite anyway? " filename))))) + (signal 'file-already-exists (list filename))) + (jupyter-tramp-with-api-connection filename + ;; Ensure we don't use stale model contents + (jupyter-tramp-flush-file-and-directory-properties filename) + (if (and append (file-exists-p filename)) + (let* ((tmpfile (file-local-copy filename)) + (model (jupyter-tramp-get-file-model filename)) + (binary (jupyter-api-binary-content-p model)) + (coding-system-for-read (if binary 'no-conversion 'utf-8)) + (coding-system-for-write (if binary 'no-conversion 'utf-8))) + (condition-case err + (tramp-run-real-handler + 'write-region + (list start end tmpfile append 'no-message lockname mustbenew)) + (error + (delete-file tmpfile) + (signal (car err) (cdr err)))) + (unwind-protect + (with-temp-buffer + (insert-file-contents-literally tmpfile) + (decode-coding-region (point-min) (point-max) 'utf-8-auto) + (jupyter-api-write-file-content + jupyter-current-server + filename (buffer-string) binary)) + (delete-file tmpfile))) + (let ((source (if (stringp start) start + (if (null start) (buffer-string) + (buffer-substring-no-properties start end)))) + (binary (coding-system-equal + (or coding-system-for-write + (if enable-multibyte-characters 'utf-8 + 'binary)) + 'binary))) + (jupyter-api-write-file-content + jupyter-current-server + filename source binary) + ;; Adapted from `tramp-sh-handle-write-region' + (when (or (eq visit t) (stringp visit)) + (let ((file-attr (file-attributes filename))) + (when (stringp visit) + (setq buffer-file-name visit)) + (set-buffer-modified-p nil) + (set-visited-file-modtime + ;; We must pass modtime explicitly, because FILENAME can + ;; be different from (buffer-file-name), f.e. if + ;; `file-precious-flag' is set. + (or (file-attribute-modification-time file-attr) + (current-time))))) + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (tramp-message v 0 "Wrote %s" filename)))) + ;; Another flush after writing for consistency + ;; TODO: Figure out more exactly where these should go + (jupyter-tramp-flush-file-and-directory-properties filename))) + +;; TODO: Set `jupyter-current-server' in every buffer that visits a file, this +;; way `jupyter-current-server' will always use the right server for file +;; operations if there happen to be more than one server. +;; +;; NOTE: Not currently used since `file-local-copy' is used as a way to get +;; files from the server and then `write-region' is used to write them back. +(defun jupyter-tramp-insert-file-contents (filename &optional visit beg end replace) + (setq filename (expand-file-name filename)) + (let ((do-visit + (lambda () + (setq buffer-file-name filename) + (set-buffer-modified-p nil)))) + (condition-case err + (jupyter-tramp--barf-if-not-file filename) + (error + (and visit (funcall do-visit)) + (signal (car err) (cdr err)))) + (jupyter-tramp-with-api-connection filename + ;; Ensure we grab a fresh model since the cached version may be out of + ;; sync with the server. + (jupyter-tramp-flush-file-properties v localname) + (let ((model (jupyter-tramp-get-file-model filename))) + (when (and visit (jupyter-api-binary-content-p model)) + (set-buffer-multibyte nil)) + (let ((pos (point))) + (jupyter-api-insert-model-content model replace beg end) + (and visit (funcall do-visit)) + (list filename (- (point) pos))))))) + +(defun jupyter-tramp-file-local-copy (filename) + (jupyter-tramp-with-api-connection filename + (unless (file-exists-p filename) + (tramp-error + v 'file-missing + "Cannot make local copy of non-existing file `%s'" filename)) + ;; Ensure we grab a fresh model since the cached version may be out of + ;; sync with the server. + (jupyter-tramp-flush-file-properties v localname) + (let ((model (jupyter-tramp-get-file-model filename))) + (when (jupyter-api-notebook-p model) + (error "Notebooks not supported yet")) + (let ((coding-system-for-write + (if (jupyter-api-binary-content-p model) + 'no-conversion + 'utf-8))) + (tramp-run-real-handler + 'make-temp-file + (list "jupyter-tramp." nil (file-name-extension filename t) + (with-current-buffer (jupyter-api-content-buffer model) + (buffer-string)))))))) + +;;; File/directory attributes + +(defun jupyter-tramp-file-attributes-from-model (model &optional id-format) + ;; :name is nil if the corresponding file of MODEL doesn't exist, see + ;; `jupyter-tramp-get-file-model'. + (when (plist-get model :name) + (let* ((dirp (equal (plist-get model :type) "directory")) + (last-modified (plist-get model :last_modified)) + (created (plist-get model :created)) + (mtime (or (and last-modified (jupyter-decode-time last-modified)) + (current-time))) + (ctime (or (and created (jupyter-decode-time created)) + (current-time))) + ;; Sometimes the model doesn't contain a size + (size (or (plist-get model :size) 64)) + ;; FIXME: What to use for these two? + (ugid (if (eq id-format 'string) "jupyter" 100)) + (mbits (format "%sr%s%s-------" + (if dirp "d" "-") + (if (plist-get model :writable) "w" "") + (if dirp "x" "")))) + (list dirp 1 user-login-name ugid + mtime mtime ctime size mbits nil -1 -1)))) + +(defun jupyter-tramp-file-attributes (filename &optional id-format) + (jupyter-tramp-file-attributes-from-model + (jupyter-tramp-with-api-connection filename + (jupyter-tramp-get-file-model filename 'no-content)) + id-format)) + +(defun jupyter-tramp-directory-file-models (directory &optional full match) + "Return the files contained in DIRECTORY as Jupyter file models. +The returned files have the form (PATH . MODEL) where PATH is +relative to DIRECTORY unless FULL is non-nil. In that case PATH +is an absolute file name. PATH will have an ending / character if +MODEL corresponds to a directory. + +If MATCH is non-nil, it should be a regular expression. Only +return files that match it. + +If DIRECTORY does not correspond to a directory on the server, +return nil." + (when (file-directory-p directory) + (jupyter-tramp-with-api-connection directory + (let ((dir-model (jupyter-tramp-get-file-model directory))) + (cl-loop + for model across (plist-get dir-model :content) + for dirp = (equal (plist-get model :type) "directory") + for name = (concat (plist-get model :name) (and dirp "/")) + for path = (if full (expand-file-name name directory) name) + if match when (string-match-p match name) + collect (cons path model) into files end + else collect (cons path model) into files + finally return + (let ((pdir-model (jupyter-tramp-get-file-model + (file-name-directory + (directory-file-name directory))))) + (dolist (d (list (cons "../" pdir-model) + (cons "./" dir-model))) + (when (or (null match) + (string-match-p match (car d))) + (when full + (setcar d (expand-file-name (car d) directory))) + (push d files))) + files)))))) + +(defun jupyter-tramp-directory-files-and-attributes + (directory &optional full match nosort id-format) + (jupyter-tramp--barf-if-not-directory directory) + (let ((files + (cl-loop + for (file . model) + in (jupyter-tramp-directory-file-models directory full match) + for attrs = (jupyter-tramp-file-attributes-from-model model id-format) + collect (cons file attrs)))) + (if nosort files + (sort files (lambda (a b) (string-lessp (car a) (car b))))))) + +(provide 'jupyter-tramp) + +;;; jupyter-tramp.el ends here diff --git a/lisp/jupyter/jupyter-widget-client.el b/lisp/jupyter/jupyter-widget-client.el new file mode 100644 index 00000000..ec02ef21 --- /dev/null +++ b/lisp/jupyter/jupyter-widget-client.el @@ -0,0 +1,287 @@ +;;; jupyter-widget-client.el --- Widget support -*- lexical-binding: t -*- + +;; Copyright (C) 2018-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 21 May 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: + +;; Use an external browser to interact with Jupyter widgets. +;; +;; A `jupyter-kernel-client' does not come with any widget support by default, +;; the purpose of the `jupyter-widget-client' class is to provide such support. +;; This is done by opening an external browser and serving it the necessary +;; resources to display widgets using the `simple-httpd' package. Emacs then +;; acts as an intermediary for the widget comm messages sent between the +;; browser and the kernel, communicating with the kernel through `zmq' and with +;; the browser through `websocket'. +;; +;; To add widget support to a client, subclass `jupyter-widget-client'. + +;;; Code: + +(require 'simple-httpd) +(require 'websocket) +(require 'jupyter-client) + +(defvar jupyter-widgets-initialized nil + "A client local variable that is non-nil if a browser for widgets is opened.") + +(defvar jupyter-widgets-server nil + "The `websocket-server' redirecting kernel messages.") + +(defvar jupyter-widgets-port 8090 + "The port that `jupyter-widgets-server' listens on.") + +(defvar jupyter-widgets-supported-targets '("jupyter.widget") + "A list of the supported widget target names.") + +(defvar jupyter-widgets-url-format + "http://127.0.0.1:%d/jupyter/widgets?username=%s&clientId=%s&port=%d" + "Format of the URL that will be visited to display widgets.") + +(defclass jupyter-widget-client (jupyter-kernel-client) + ((widget-sock + :type (or null websocket) + :initform nil + :documentation "The `websocket' connected to the browser +displaying the widgets for this client.") + (widget-state + :type string + :initform "null" + :documentation "The JSON encode string representing the +widget state. When a browser displaying the widgets of the client +is closed, the state of the widgets is sent back to Emacs so that +the state can be recovred when a new browser is opened.") + (widget-messages + :type list + :initform nil + :documentation "A list of pending messages to send to the +widget socket.")) + :abstract t) + +;;; Websocket handlers + +(defsubst jupyter-widgets--send-deferred (client) + (cl-loop for msg in (nreverse (oref client widget-messages)) + do (websocket-send-text (oref client widget-sock) msg)) + (oset client widget-messages nil)) + +(defun jupyter-widgets-on-message (ws frame) + "When websocket, WS, receives a message FRAME, handle it. +Send the contents of the message FRAME to the kernel and register +callbacks." + (cl-assert (eq (websocket-frame-opcode frame) 'text)) + (let* ((msg (jupyter-read-plist-from-string + (websocket-frame-payload frame))) + (client (jupyter-find-client-for-session + (jupyter-message-session msg)))) + (cl-assert client) + (unless (equal ws (oref client widget-sock)) + ;; TODO: Handle multiple clients and sending widget state to new clients + (oset client widget-sock ws)) + (pcase (jupyter-message-type msg) + ("connect" + (jupyter-widgets--send-deferred client)) + (_ + ;; Any other message the browser sends is meant for the kernel so do the + ;; redirection and setup the callbacks + (let* ((msg-type (jupyter-message-type msg)) + (content (jupyter-message-content msg))) + (jupyter-run-with-client client + (jupyter-sent + (jupyter-message-subscribed + (let ((jupyter-inhibit-handlers + (if (member msg-type '("comm_info_request")) + '("comm_msg" "status" "comm_info_reply") + '("comm_msg")))) + (apply #'jupyter-request msg-type content)) + (let ((fn (apply-partially #'jupyter-widgets-send-message client))) + `(("comm_open" ,fn) + ("comm_close" ,fn) + ("comm_info_reply" ,fn) + ("comm_msg" ,fn) + ("status" ,fn))))))))))) + +(defun jupyter-widgets-on-close (ws) + "Uninitialize the client whose widget-sock is WS." + (cl-loop + for client in jupyter--clients + when (and (object-of-class-p client 'jupyter-widget-client) + (equal ws (oref client widget-sock))) + do (oset client widget-sock nil) + (jupyter-set client 'jupyter-widgets-initialized nil))) + +;;; Working with comm messages + +(defun jupyter-widgets-normalize-comm-msg (msg) + "Ensure that a comm MSG's fields are not ambiguous before encoding. +For example, for fields that are supposed to be arrays, ensure +that they will be encoded as such. In addition, add fields +required by the JupyterLab widget manager." + (prog1 msg + (when (member (jupyter-message-type msg) + '("comm_open" "comm_close" "comm_msg")) + (let ((buffers (plist-member msg :buffers))) + (if (null buffers) (plist-put msg :buffers []) + (when (eq (cadr buffers) nil) + (setcar (cdr buffers) []))) + (unless (equal (cadr buffers) []) + (setq buffers (cadr buffers)) + (while (car buffers) + (setcar buffers + (base64-encode-string + (encode-coding-string (car buffers) 'utf-8-auto t) t)) + (setq buffers (cdr buffers)))) + ;; Needed by WidgetManager + (unless (jupyter-message-metadata msg) + (plist-put msg :metadata '(:version "2.0"))))))) + +(cl-defmethod jupyter-widgets-send-message ((client jupyter-widget-client) msg) + "Send a MSG to CLIENT's `widget-sock' `websocket'." + (setq msg (jupyter-widgets-normalize-comm-msg msg)) + (let ((msg-type (jupyter-message-type msg))) + (plist-put msg :channel + (cond + ((member msg-type '("status" "comm_msg" + "comm_close" "comm_open")) + :iopub) + ((member msg-type '("comm_info_reply")) + :shell))) + (push (jupyter--encode msg) (oref client widget-messages)) + (when (websocket-openp (oref client widget-sock)) + (jupyter-widgets--send-deferred client)))) + +;;; Displaying widgets in the browser +;; NOTE: The "display_model" and "clear_display" messages below are not true +;; Jupyter messages, but are only used for communication between the browser +;; and Emacs. + +(cl-defmethod jupyter-widgets-display-model ((client jupyter-widget-client) model-id) + "Display the model with MODEL-ID for the kernel CLIENT is connected to." + ;; (jupyter-widgets-clear-display client) + (jupyter-widgets-send-message + client (list :msg_type "display_model" + :content (list :model_id model-id)))) + +(cl-defmethod jupyter-widgets-clear-display ((client jupyter-widget-client)) + "Clear the models being displayed for CLIENT." + (jupyter-widgets-send-message client (list :msg_type "clear_display"))) + +;;; `jupyter-kernel-client' methods + +(defun jupyter-widgets-start-websocket-server () + "Start the `jupyter-widgets-server' if necessary." + (unless (process-live-p jupyter-widgets-server) + (setq jupyter-widgets-server + (websocket-server + jupyter-widgets-port + :host 'local + :on-message #'jupyter-widgets-on-message + :on-close #'jupyter-widgets-on-close)))) + +(defun jupyter-widgets--initialize-client (client) + (unless (jupyter-get client 'jupyter-widgets-initialized) + (jupyter-set client 'jupyter-widgets-initialized t) + (unless (get-process "httpd") + (httpd-start)) + (browse-url + (format jupyter-widgets-url-format + httpd-port + user-login-name + (jupyter-session-id (oref client session)) + jupyter-widgets-port)))) + +(cl-defmethod jupyter-handle-comm-open ((client jupyter-widget-client) _req msg) + (jupyter-with-message-content msg (target_name) + (when (member target_name jupyter-widgets-supported-targets) + (jupyter-widgets-start-websocket-server) + (jupyter-widgets--initialize-client client) + (jupyter-widgets-send-message client msg))) + (cl-call-next-method)) + +(cl-defmethod jupyter-handle-comm-close ((client jupyter-widget-client) _req msg) + (jupyter-widgets-send-message client msg) + (cl-call-next-method)) + +(cl-defmethod jupyter-handle-comm-msg ((client jupyter-widget-client) _req msg) + (jupyter-widgets-send-message client msg) + (cl-call-next-method)) + +;;; `httpd' interface + +(defun httpd/jupyter (proc path _query &rest _args) + "Serve the javascript required for Jupyter widget support. +PROC is the httpd process and PATH is the requested resource +path. Currently no resources are accessible at any PATH other +than the root, which will serve the necessary Javascript to +load." + (let ((split-path (split-string (substring path 1) "/"))) + (if (= (length split-path) 1) + (with-httpd-buffer proc "text/javascript; charset=UTF-8" + (insert-file-contents + (expand-file-name "js/built/index.built.js" jupyter-root))) + (error "Not found")))) + +(defun httpd/jupyter/widgets/built (proc path _query &rest _args) + "Serve the resources required by the widgets in the browser. +PROC is the httpd process and PATH is the requested resource +path. Currently this will only serve a file from the js/built +directory if it has one of the extensions woff, woff2, ttf, svg, +or eot. These are used by Jupyter." + (let* ((split-path (split-string (substring path 1) "/")) + (file (car (last split-path))) + (mime (pcase (file-name-extension file) + ((or "woff" "woff2") + "application/font-woff") + ("ttf" + "application/octet-stream") + ("svg" + "image/svg+xml") + ("eot" + "application/vnd.ms-fontobject")))) + (unless mime + (error "Unsupported file type")) + (setq file (expand-file-name (concat "js/built/" file) jupyter-root)) + ;; TODO: Fix this, when loading the files through httpd, font awesome + ;; doesnt work + (when (file-exists-p file) + (error "File nonexistent (%s)" (file-name-nondirectory file))) + (with-temp-buffer + (insert-file-contents file) + (httpd-send-header proc mime 200 + :Access-Control-Allow-Origin "*")))) + +;; TODO: Since the path when we instantiate widgets is jupyter/widgets, all +;; files that are trying to be loaded locally in the javascript will be +;; referenced to this path. If we encounter a javascript file requesting to be +;; loaded we can automatically search the jupyter --paths for notebook +;; extension modules matching it. +(defun httpd/jupyter/widgets (proc &rest _args) + "Serve the HTML page to display widgets. +PROC is the httpd process." + (with-temp-buffer + (insert-file-contents (expand-file-name "widget.html" jupyter-root)) + (httpd-send-header + proc "text/html; charset=UTF-8" 200 + :Access-Control-Allow-Origin "*"))) + +(provide 'jupyter-widget-client) + +;;; jupyter-widget-client.el ends here diff --git a/lisp/jupyter/jupyter-zmq-channel-ioloop.el b/lisp/jupyter/jupyter-zmq-channel-ioloop.el new file mode 100644 index 00000000..44830f79 --- /dev/null +++ b/lisp/jupyter/jupyter-zmq-channel-ioloop.el @@ -0,0 +1,82 @@ +;;; jupyter-zmq-channel-ioloop.el --- IOLoop functions for Jupyter channels -*- lexical-binding: t -*- + +;; Copyright (C) 2018-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 08 Nov 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 `jupyter-channel-ioloop' using `jupyter-zmq-channel' to send and receive +;; messages. Whenever a message is received on a channel an event that looks +;; like the following will be sent back to the parent process +;; +;; (message CHANNEL-TYPE IDENTS . MSG) +;; +;; where CHANNEL-TYPE is the channel on which the message was received (one of +;; `jupyter-socket-types'), IDENTS are ZMQ identities, typically ignored, and +;; MSG is the message plist. + +;;; Code: + +(require 'jupyter-base) +(require 'jupyter-channel-ioloop) +(require 'jupyter-zmq-channel) + +(defclass jupyter-zmq-channel-ioloop (jupyter-channel-ioloop) + () + :documentation "A `jupyter-ioloop' configured for Jupyter channels.") + +(cl-defmethod initialize-instance ((ioloop jupyter-zmq-channel-ioloop) &optional _slots) + (cl-call-next-method) + (jupyter-ioloop-add-setup ioloop + (require 'jupyter-zmq-channel-ioloop) + (push 'jupyter-zmq-channel-ioloop--recv-messages jupyter-ioloop-post-hook) + (cl-loop + for channel in '(:shell :stdin :iopub :control) + unless (object-assoc channel :type jupyter-channel-ioloop-channels) + do (push (jupyter-zmq-channel + :session jupyter-channel-ioloop-session + :type channel) + jupyter-channel-ioloop-channels)))) + +(defun jupyter-zmq-channel-ioloop--recv-messages (events) + "Print the received messages described in EVENTS. +EVENTS is a list of socket events as returned by +`zmq-poller-wait-all'. If any of the sockets in EVENTS matches +one of the sockets in `jupyter-channel-ioloop-channels', receive a +message on the channel and print a list with the form + + (message CHANNEL-TYPE . MSG...) + +to stdout. CHANNEL-TYPE is the channel on which MSG was +received, either :shell, :stdin, :iopub, or :control. MSG is a +list as returned by `jupyter-recv'." + (let (messages) + (dolist (channel jupyter-channel-ioloop-channels) + (with-slots (type socket) channel + (when (zmq-assoc socket events) + (push (cons type (jupyter-recv channel)) messages)))) + (when messages + ;; Send messages + (mapc (lambda (msg) (prin1 (cons 'message msg))) (nreverse messages)) + (zmq-flush 'stdout)))) + +(provide 'jupyter-zmq-channel-ioloop) + +;;; jupyter-zmq-channel-ioloop.el ends here diff --git a/lisp/jupyter/jupyter-zmq-channel.el b/lisp/jupyter/jupyter-zmq-channel.el new file mode 100644 index 00000000..0c4c6f86 --- /dev/null +++ b/lisp/jupyter/jupyter-zmq-channel.el @@ -0,0 +1,252 @@ +;;; jupyter-zmq-channel.el --- A Jupyter channel implementation using ZMQ sockets -*- lexical-binding: t -*- + +;; Copyright (C) 2019-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 27 Jun 2019 + +;; 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: + +;; Implements synchronous channel types using ZMQ sockets. Each channel is +;; essentially a wrapper around a `zmq-socket' constrained to a socket type by +;; the type of the channel and with an associated `zmq-IDENTITY' obtained from +;; the `jupyter-session' that must be associated with the channel. A heartbeat +;; channel is distinct from the other channels in that it is implemented using +;; a timer which periodically pings the kernel depending on how its configured. +;; In order for communication to occur on the other channels, one of +;; `jupyter-send' or `jupyter-recv' must be called after starting the channel +;; with `jupyter-start'. + +;;; Code: + +(require 'jupyter-messages) +(require 'zmq) +(require 'jupyter-channel) +(eval-when-compile (require 'subr-x)) + +(declare-function jupyter-ioloop-poller-remove "jupyter-ioloop") +(declare-function jupyter-ioloop-poller-add "jupyter-ioloop") + +(defconst jupyter-socket-types + (list :hb zmq-REQ + :shell zmq-DEALER + :iopub zmq-SUB + :stdin zmq-DEALER + :control zmq-DEALER) + "The socket types for the various channels used by `jupyter'.") + +(cl-deftype zmq-socket () '(satisfies zmq-socket-p)) + +(defclass jupyter-zmq-channel (jupyter-channel) + ((socket + :type (or null zmq-socket) + :initform nil + :documentation "The socket used for communicating with the kernel."))) + +(defun jupyter-connect-endpoint (type endpoint &optional identity) + "Create socket with TYPE and connect to ENDPOINT. +If IDENTITY is non-nil, it will be set as the ROUTING-ID of the +socket. Return the created socket." + (let ((sock (zmq-socket (zmq-current-context) type))) + (prog1 sock + (zmq-socket-set sock zmq-LINGER 1000) + (when identity + (zmq-socket-set sock zmq-ROUTING-ID identity)) + (zmq-connect sock endpoint)))) + +(defun jupyter-connect-channel (ctype endpoint &optional identity) + "Create a socket based on a Jupyter channel type. +CTYPE is one of the symbols `:hb', `:stdin', `:shell', +`:control', or `:iopub' and represents the type of channel to +connect to ENDPOINT. If IDENTITY is non-nil, it will be set as +the ROUTING-ID of the socket. Return the created socket." + (let ((sock-type (plist-get jupyter-socket-types ctype))) + (unless sock-type + (error "Invalid channel type (%s)" ctype)) + (jupyter-connect-endpoint sock-type endpoint identity))) + +(cl-defmethod jupyter-start ((channel jupyter-zmq-channel) + &key (identity (jupyter-session-id + (oref channel session)))) + (unless (jupyter-alive-p channel) + (let ((socket (jupyter-connect-channel + (oref channel type) (oref channel endpoint) identity))) + (oset channel socket socket) + (cl-case (oref channel type) + (:iopub + (zmq-socket-set socket zmq-SUBSCRIBE "")))) + (when (and (functionp 'jupyter-ioloop-environment-p) + (jupyter-ioloop-environment-p)) + (jupyter-ioloop-poller-add (oref channel socket) zmq-POLLIN)))) + +(cl-defmethod jupyter-stop ((channel jupyter-zmq-channel)) + (when (jupyter-alive-p channel) + (when (and (functionp 'jupyter-ioloop-environment-p) + (jupyter-ioloop-environment-p)) + (jupyter-ioloop-poller-remove (oref channel socket))) + (with-slots (socket) channel + (zmq-disconnect socket (zmq-socket-get socket zmq-LAST-ENDPOINT))) + (oset channel socket nil))) + +(cl-defmethod jupyter-alive-p ((channel jupyter-zmq-channel)) + (not (null (oref channel socket)))) + +(cl-defmethod jupyter-send ((channel jupyter-zmq-channel) type message &optional msg-id) + "Send a message on a ZMQ based Jupyter channel. +CHANNEL is the channel to send MESSAGE on. TYPE is a Jupyter +message type, like :kernel-info-request. Return the message ID +of the sent message." + (cl-destructuring-bind (id . msg) + (jupyter-encode-message (oref channel session) type + :msg-id msg-id + :content message) + (prog1 id + (zmq-send-multipart (oref channel socket) msg)))) + +(cl-defmethod jupyter-recv ((channel jupyter-zmq-channel) &optional dont-wait) + "Receive a message on CHANNEL. +Return a cons cell (IDENTS . MSG) where IDENTS are the ZMQ +message identities, as a list, and MSG is the received message. + +If DONT-WAIT is non-nil, return immediately without waiting for a +message if one isn't already available." + (condition-case nil + (let ((session (oref channel session)) + (msg (zmq-recv-multipart (oref channel socket) + (and dont-wait zmq-DONTWAIT)))) + (when msg + (cl-destructuring-bind (idents . parts) + (jupyter--split-identities msg) + (cons idents (jupyter-decode-message session parts))))) + (zmq-EAGAIN nil))) + +;;; Heartbeat channel + +(defvar jupyter-hb-max-failures 3 + "Number of heartbeat failures until the kernel is considered unreachable. +A ping is sent to the kernel on a heartbeat channel and waits +until `time-to-dead' seconds to see if the kernel sent a ping +back. If the kernel doesn't send a ping back after +`jupyter-hb-max-failures', the callback associated with the +heartbeat channel is called. See `jupyter-hb-on-kernel-dead'.") + +(defclass jupyter-hb-channel (jupyter-zmq-channel) + ((type + :type keyword + :initform :hb + :documentation "The type of this channel is `:hb'.") + (time-to-dead + :type number + :initform 10 + :documentation "The time in seconds to wait for a response +from the kernel until the connection is assumed to be dead. Note +that this slot only takes effect when starting the channel.") + (dead-cb + :type function + :initform #'ignore + :documentation "A callback function that takes 0 arguments +and is called when the kernel has not responded for +\(* `jupyter-hb-max-failures' `time-to-dead'\) seconds.") + (beating + :type (or boolean symbol) + :initform t + :documentation "A flag variable indicating that the heartbeat +channel is communicating with the kernel.") + (paused + :type boolean + :initform t + :documentation "A flag variable indicating that the heartbeat +channel is paused and not communicating with the kernel. To +pause the heartbeat channel use `jupyter-hb-pause', to unpause +use `jupyter-hb-unpause'.")) + :documentation "A base class for heartbeat channels.") + +(cl-defmethod jupyter-alive-p ((channel jupyter-hb-channel)) + "Return non-nil if CHANNEL is alive." + (zmq-socket-p (oref channel socket))) + +(defun jupyter-hb--pingable-p (channel) + (and (not (oref channel paused)) + (jupyter-alive-p channel))) + +(cl-defmethod jupyter-hb-beating-p ((channel jupyter-hb-channel)) + "Return non-nil if CHANNEL is reachable." + (and (jupyter-hb--pingable-p channel) + (oref channel beating))) + +(cl-defmethod jupyter-hb-pause ((channel jupyter-hb-channel)) + "Pause checking for heartbeat events on CHANNEL." + (oset channel paused t)) + +(cl-defmethod jupyter-hb-unpause ((channel jupyter-hb-channel)) + "Un-pause checking for heatbeat events on CHANNEL." + (when (oref channel paused) + (if (jupyter-alive-p channel) + ;; Consume a pending message from the kernel if there is one. We send a + ;; ping and then schedule a timer which fires TIME-TO-DEAD seconds + ;; later to receive the ping back from the kernel and start the process + ;; all over again. If the channel is paused before TIME-TO-DEAD + ;; seconds, there may still be a ping from the kernel waiting. + (ignore-errors (zmq-recv (oref channel socket) zmq-DONTWAIT)) + (jupyter-start channel)) + (oset channel paused nil) + (jupyter-hb--send-ping channel))) + +(cl-defgeneric jupyter-hb-on-kernel-dead (channel fun) + (declare (indent 1))) + +(cl-defmethod jupyter-hb-on-kernel-dead ((channel jupyter-hb-channel) fun) + "When the kernel connected to CHANNEL dies, call FUN. +A kernel is considered dead when CHANNEL does not receive a +response after \(* `jupyter-hb-max-failures' `time-to-dead'\) +seconds has elapsed without the kernel sending a ping back." + (oset channel dead-cb fun)) + +(defun jupyter-hb--send-ping (channel &optional failed-count) + (when (jupyter-hb--pingable-p channel) + (condition-case nil + (progn + (zmq-send (oref channel socket) "ping") + (run-with-timer + (oref channel time-to-dead) nil + (lambda () + (when-let* ((sock (and (jupyter-hb--pingable-p channel) + (oref channel socket)))) + (oset channel beating + (condition-case nil + (and (zmq-recv sock zmq-DONTWAIT) t) + ((zmq-EINTR zmq-EAGAIN) nil))) + (if (oref channel beating) + (jupyter-hb--send-ping channel) + ;; Reset the socket + (jupyter-stop channel) + (jupyter-start channel) + (or failed-count (setq failed-count 0)) + (if (< failed-count jupyter-hb-max-failures) + (jupyter-hb--send-ping channel (1+ failed-count)) + (oset channel paused t) + (when (functionp (oref channel dead-cb)) + (funcall (oref channel dead-cb))))))))) + ;; FIXME: Should be a part of `jupyter-hb--pingable-p' + (zmq-ENOTSOCK + (jupyter-hb-pause channel) + (oset channel socket nil))))) + +(provide 'jupyter-zmq-channel) + +;;; jupyter-zmq-channel.el ends here diff --git a/lisp/jupyter/jupyter.el b/lisp/jupyter/jupyter.el new file mode 100644 index 00000000..50f86744 --- /dev/null +++ b/lisp/jupyter/jupyter.el @@ -0,0 +1,44 @@ +;;; jupyter.el --- Jupyter -*- lexical-binding: t -*- + +;; Copyright (C) 2018-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 11 Jan 2018 +;; Version: 1.0 +;; Package-Requires: ((emacs "26") (cl-lib "0.5") (org "9.1.6") (zmq "0.10.10") (simple-httpd "1.5.0") (websocket "1.9")) +;; URL: https://github.com/emacs-jupyter/jupyter + +;; 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: + +;; An interface for communicating with Jupyter kernels. + +;;; Code: + +(defgroup jupyter nil + "Jupyter" + :group 'processes) + +(require 'jupyter-base) +(require 'jupyter-client) +(require 'jupyter-kernelspec) +(require 'jupyter-server) +(require 'jupyter-repl) + +(provide 'jupyter) + +;;; jupyter.el ends here diff --git a/lisp/jupyter/ob-jupyter.el b/lisp/jupyter/ob-jupyter.el new file mode 100644 index 00000000..9fec577c --- /dev/null +++ b/lisp/jupyter/ob-jupyter.el @@ -0,0 +1,836 @@ +;;; ob-jupyter.el --- Jupyter integration with org-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2018-2024 Nathaniel Nicandro + +;; Author: Nathaniel Nicandro +;; Created: 21 Jan 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: + +;; Interact with a Jupyter kernel via `org-mode' src-block's. + +;;; Code: + +(defgroup ob-jupyter nil + "Jupyter integration with org-mode" + :group 'org-babel) + +(require 'jupyter-env) +(require 'jupyter-kernelspec) +(require 'jupyter-org-client) +(require 'jupyter-org-extensions) +(eval-when-compile + (require 'jupyter-repl) ; For `jupyter-with-repl-buffer' + (require 'subr-x)) + +(declare-function org-in-src-block-p "org" (&optional inside)) +(declare-function org-element-at-point "org-element") +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-babel-execute-src-block "ob-core" (&optional arg info params executor-type)) +(declare-function org-babel-variable-assignments:python "ob-python" (params)) +(declare-function org-babel-expand-body:generic "ob-core" (body params &optional var-lines)) +(declare-function org-export-derived-backend-p "ox" (backend &rest backends)) + +(declare-function jupyter-run-server-repl "jupyter-server") +(declare-function jupyter-connect-server-repl "jupyter-server") +(declare-function jupyter-kernelspecs "jupyter-server") +(declare-function jupyter-server-kernel-id-from-name "jupyter-server") +(declare-function jupyter-server-name-client-kernel "jupyter-server") +(declare-function jupyter-api-get-kernel "jupyter-rest-api") + +(declare-function jupyter-tramp-url-from-file-name "jupyter-tramp") +(declare-function jupyter-tramp-server-from-file-name "jupyter-tramp") +(declare-function jupyter-tramp-file-name-p "jupyter-tramp") + +(defcustom org-babel-jupyter-language-aliases '(("python3" "python")) + "An alist mapping kernel language names to another name. +If a kernel has a language name matching the CAR of an element of +this list, the associated name will be used for the names of the +source blocks instead. + +So if this variable has an entry like \\='(\"python3\" \"python\") +then instead of jupyter-python3 source blocks, you can use +jupyter-python source blocks for the associated kernel." + :type '(alist :key-type string :value-type string)) + +(defvaralias 'org-babel-jupyter-resource-directory + 'jupyter-org-resource-directory) + +(defvar org-babel-jupyter-session-clients (make-hash-table :test #'equal) + "A hash table mapping session names to Jupyter clients. +`org-babel-jupyter-src-block-session' returns a key into this +table for the source block at `point'.") + +(defvar org-babel-header-args:jupyter '((kernel . :any) + (async . ((yes no)))) + "Available header arguments for Jupyter src-blocks.") + +(defvar org-babel-default-header-args:jupyter '((:kernel . "python") + (:async . "no")) + "Default header arguments for Jupyter src-blocks.") + +;;; Helper functions + +(defun org-babel-jupyter--src-block-kernel-language () + (when (org-in-src-block-p) + (let ((info (org-babel-get-src-block-info))) + (save-match-data + (string-match "^jupyter-\\(.+\\)$" (car info)) + (match-string 1 (car info)))))) + +(defun org-babel-jupyter-language-p (lang) + "Return non-nil if LANG src-blocks are executed using Jupyter." + (or (string-prefix-p "jupyter-" lang) + ;; Check if the language has been overridden, see + ;; `org-babel-jupyter-override-src-block' + (advice-member-p + 'ob-jupyter (intern (concat "org-babel-execute:" lang))))) + +(defun org-babel-jupyter-session-key (params) + "Return a string that is the concatenation of the :session and :kernel PARAMS. +PARAMS is the arguments alist as returned by +`org-babel-get-src-block-info'. The returned string can then be +used to identify unique Jupyter Org babel sessions." + ;; Take into account a Lisp expression as a session name. + (let ((session (org-babel-read (alist-get :session params))) + (kernel (alist-get :kernel params))) + (unless (and session kernel + (not (equal session "none"))) + (error "Need a valid session and a kernel to form a key")) + (concat session "-" kernel))) + +(defun org-babel-jupyter-src-block-session () + "Return the session key for the current Jupyter source block. +Return nil if the current source block is not a Jupyter block or +if there is no source block at point." + (let ((info (or (and (org-in-src-block-p) + (org-babel-get-src-block-info 'light)) + (org-babel-lob-get-info)))) + (when info + (cl-destructuring-bind (lang _ params . rest) info + (when (org-babel-jupyter-language-p lang) + (org-babel-jupyter-session-key params)))))) + +;;; `ob' integration + +(defun org-babel-variable-assignments:jupyter (params &optional lang) + "Assign variables in PARAMS according to the Jupyter kernel language. +LANG is the kernel language of the source block. If LANG is nil, +get the kernel language from the current source block. + +The variables are assigned by looking for the function +`org-babel-variable-assignments:LANG'. If this function does not +exist or if LANG cannot be determined, assign variables using +`org-babel-variable-assignments:python'." + (or lang (setq lang (org-babel-jupyter--src-block-kernel-language))) + (let ((fun (when lang + (intern (format "org-babel-variable-assignments:%s" lang))))) + (if (functionp fun) (funcall fun params) + (require 'ob-python) + (org-babel-variable-assignments:python params)))) + +(cl-defgeneric org-babel-jupyter-transform-code (code _changelist) + "Transform CODE according to CHANGELIST, return the transformed CODE. +CHANGELIST is a property list containing the requested changes. The default +implementation returns CODE unchanged. + +This is useful for kernel languages to extend using the +jupyter-lang method specializer, e.g. to return new code to change +directories before evaluating CODE. + +See `org-babel-expand-body:jupyter' for possible changes that can +be in CHANGELIST." + code) + +(defun org-babel-expand-body:jupyter (body params &optional var-lines lang) + "Expand BODY according to PARAMS. + +BODY is the code to expand, PARAMS should be the header arguments +of the src block with BODY as its code, and VAR-LINES should be +the list of strings containing the variables to evaluate before +executing body. LANG is the kernel language of the source block. + +This function is similar to +`org-babel-variable-assignments:jupyter' in that it attempts to +find the kernel language of the source block if LANG is not +provided. + +BODY is expanded by calling the function +`org-babel-expand-body:LANG'. If this function doesn't exist or +if LANG cannot be determined, fall back to +`org-babel-expand-body:generic'. + +If PARAMS has a :dir parameter, the expanded code is passed to +`org-babel-jupyter-transform-code' with a changelist that +includes the :dir parameter with the directory being an absolute +path." + (or lang (setq lang (org-babel-jupyter--src-block-kernel-language))) + (let* ((expander (when lang + (intern (format "org-babel-expand-body:%s" lang)))) + (expanded (if (functionp expander) + (funcall expander body params) + (org-babel-expand-body:generic body params var-lines))) + (changelist nil)) + (when-let* ((dir (alist-get :dir params))) + (setq changelist (plist-put changelist :dir (expand-file-name dir)))) + (if changelist (org-babel-jupyter-transform-code expanded changelist) + expanded))) + +(defun org-babel-edit-prep:jupyter (info) + "Prepare the edit buffer according to INFO. +Enable `jupyter-repl-interaction-mode' in the edit buffer +associated with the session found in INFO. + +If the session is a Jupyter TRAMP file name, the +`default-directory' of the edit buffer is set to the root +directory the notebook serves. + +If `jupyter-org-auto-connect' is nil, this function does nothing +if the session has not been initiated yet." + (let* ((params (nth 2 info)) + (session (alist-get :session params)) + (client-buffer + (when (or jupyter-org-auto-connect + (org-babel-jupyter-session-initiated-p params)) + (org-babel-jupyter-initiate-session session params)))) + (when client-buffer + (jupyter-repl-associate-buffer client-buffer) + (when (jupyter-tramp-file-name-p session) + (setq default-directory (concat (file-remote-p session) "/")))))) + +(defun org-babel-jupyter--insert-variable-assignments (params) + "Insert variable assignment lines from PARAMS into the `current-buffer'. +Return non-nil if there are variable assignments, otherwise +return nil." + (let ((var-lines (org-babel-variable-assignments:jupyter params))) + (prog1 var-lines + (jupyter-repl-replace-cell-code (mapconcat #'identity var-lines "\n"))))) + +(defun org-babel-prep-session:jupyter (session params) + "Prepare a Jupyter SESSION according to PARAMS." + (with-current-buffer (org-babel-jupyter-initiate-session session params) + (goto-char (point-max)) + (and (org-babel-jupyter--insert-variable-assignments params) + (jupyter-repl-execute-cell jupyter-current-client)) + (current-buffer))) + +(defun org-babel-load-session:jupyter (session body params) + "In a Jupyter SESSION, load BODY according to PARAMS." + (save-window-excursion + (with-current-buffer (org-babel-jupyter-initiate-session session params) + (goto-char (point-max)) + (when (org-babel-jupyter--insert-variable-assignments params) + (insert "\n")) + (insert (org-babel-expand-body:jupyter (org-babel-chomp body) params)) + (current-buffer)))) + +(defvar org-babel-jupyter-resolving-reference-p nil + "Non-nil if a reference is being resolved.") + +(defun org-babel-jupyter--indicate-resolve (&rest args) + "Set `org-babel-jupyter-resolving-referece-p', apply ARGS." + (let ((org-babel-jupyter-resolving-reference-p t)) + (apply args))) + +(advice-add #'org-babel-ref-resolve :around #'org-babel-jupyter--indicate-resolve) + +;;;; Initializing session clients + +(cl-defstruct (org-babel-jupyter-session + (:constructor org-babel-jupyter-session)) + name) + +(cl-defstruct (org-babel-jupyter-remote-session + (:include org-babel-jupyter-session) + (:constructor org-babel-jupyter-remote-session)) + connect-repl-p) + +(cl-defmethod org-babel-jupyter-parse-session ((session string)) + "Return a parsed representation of SESSION." + (org-babel-jupyter-session :name session)) + +(cl-defmethod org-babel-jupyter-initiate-client ((_session org-babel-jupyter-session) kernel) + "Launch SESSION's KERNEL, return a `jupyter-org-client' connected to it. +SESSION is the :session header argument of a source block and +KERNEL is the name of the kernel to launch." + (jupyter-run-repl kernel nil nil 'jupyter-org-client)) + +(cl-defmethod org-babel-jupyter-initiate-client :around (session _kernel) + "Rename the returned client's REPL buffer to include SESSION's name. +Also set `jupyter-include-other-output' to nil for the session so +that output produced by other clients do not get handled by the +client." + (let ((client (cl-call-next-method))) + (prog1 client + (jupyter-set client 'jupyter-include-other-output nil) + ;; Append the name of SESSION to the initiated client REPL's + ;; `buffer-name'. + (jupyter-with-repl-buffer client + (let ((name (buffer-name))) + (when (string-match "^\\*\\(.+\\)\\*" name) + (rename-buffer + (concat "*" (match-string 1 name) "-" + (org-babel-jupyter-session-name session) + "*") + 'unique))))))) + +(cl-defmethod org-babel-jupyter-parse-session :extra "remote" ((session string)) + "If SESSION is a remote file name, return a `org-babel-jupyter-remote-session'. +A `org-babel-jupyter-remote-session' is also returned if SESSION +ends in \".json\", regardless of SESSION being a remote file +name, with `org-babel-jupyter-remote-session-connect-repl-p' set +to nil. The CONNECT-REPL-P slot indicates that a connection file +is read to connect to the session, as opposed to launching a +kernel." + (if jupyter-use-zmq + (let ((json-p (string-suffix-p ".json" session))) + (if (or json-p (file-remote-p session)) + (org-babel-jupyter-remote-session + :name session + :connect-repl-p json-p) + (cl-call-next-method))) + (when (file-remote-p session) + (error "ZMQ is required for remote sessions (%s)" session)) + (cl-call-next-method))) + +(cl-defmethod org-babel-jupyter-initiate-client :before ((session org-babel-jupyter-remote-session) _kernel) + "Raise an error if SESSION's name is a remote file name without a local name. +The local name is used as a unique identifier of a remote +session." + (unless (not (zerop (length (file-local-name + (org-babel-jupyter-session-name session))))) + (error "No remote session name"))) + +(cl-defmethod org-babel-jupyter-initiate-client ((session org-babel-jupyter-remote-session) kernel) + "Initiate a client connected to a remote kernel process." + (pcase-let (((cl-struct org-babel-jupyter-remote-session name connect-repl-p) session)) + (if connect-repl-p + (jupyter-connect-repl name nil nil 'jupyter-org-client) + (let ((default-directory (file-remote-p name))) + (org-babel-jupyter-aliases-from-kernelspecs) + (jupyter-run-repl kernel nil nil 'jupyter-org-client))))) + +(require 'jupyter-server) +(require 'jupyter-tramp) + +(cl-defstruct (org-babel-jupyter-server-session + (:include org-babel-jupyter-remote-session) + (:constructor org-babel-jupyter-server-session))) + +(cl-defmethod org-babel-jupyter-parse-session :extra "server" ((session string)) + "If SESSION is a Jupyter TRAMP file name return a +`org-babel-jupyter-server-session'." + (if (jupyter-tramp-file-name-p session) + (org-babel-jupyter-server-session :name session) + (cl-call-next-method))) + +(cl-defmethod org-babel-jupyter-initiate-client ((session org-babel-jupyter-server-session) kernel) + (let* ((rsession (org-babel-jupyter-session-name session)) + (server (with-parsed-tramp-file-name rsession nil + (when (member host '("127.0.0.1" "localhost")) + (setq port (tramp-file-name-port-or-default v)) + (when (jupyter-port-available-p port) + (if (y-or-n-p (format "Notebook not started on port %s. Launch one? " + port)) + ;; TODO: Specify authentication? But then + ;; how would you get the token for the + ;; login that happens in + ;; `jupyter-tramp-server-from-file-name'. + (jupyter-launch-notebook port) + (user-error "Launch a notebook on port %s first." port)))) + (jupyter-tramp-server-from-file-name rsession)))) + (unless (jupyter-server-has-kernelspec-p server kernel) + (error "No kernelspec matching \"%s\" exists at %s" + kernel (oref server url))) + ;; Language aliases may not exist for the kernels that are accessible on + ;; the server so ensure they do. + (org-babel-jupyter-aliases-from-kernelspecs + nil (jupyter-kernelspecs server)) + (let ((sname (file-local-name rsession))) + (if-let ((id (jupyter-server-kernel-id-from-name server sname))) + ;; Connecting to an existing kernel + (cl-destructuring-bind (&key name id &allow-other-keys) + (or (ignore-errors (jupyter-api-get-kernel server id)) + (error "Kernel ID, %s, no longer references a kernel at %s" + id (oref server url))) + (unless (string-match-p kernel name) + (error "\":kernel %s\" doesn't match \"%s\"" kernel name)) + (jupyter-connect-server-repl server id nil nil 'jupyter-org-client)) + ;; Start a new kernel + (let ((client (jupyter-run-server-repl + server kernel nil nil 'jupyter-org-client))) + (prog1 client + ;; TODO: If a kernel gets renamed in the future it doesn't affect + ;; any source block :session associations because the hash of the + ;; session name used here is already stored in the + ;; `org-babel-jupyter-session-clients' variable. Should that + ;; variable be updated on a kernel rename? + ;; + ;; TODO: Would we always want to do this? + (jupyter-server-name-client-kernel client sname))))))) + +(defun org-babel-jupyter-session-initiated-p (params) + "Return non-nil if the session corresponding to PARAMS is initiated." + (let ((key (org-babel-jupyter-session-key params))) + (gethash key org-babel-jupyter-session-clients))) + +(defun org-babel-jupyter-initiate-session-by-key (session params) + "Return the Jupyter REPL buffer for SESSION. +If SESSION does not have a client already, one is created based +on SESSION and PARAMS. If SESSION ends with \".json\" then +SESSION is interpreted as a kernel connection file and a new +kernel connected to SESSION is created. + +Otherwise a kernel is started based on the `:kernel' parameter in +PARAMS which should be either a valid kernel name or a prefix of +one, in which case the first kernel that matches the prefix will +be used. + +If SESSION is a remote file name, like /ssh:ec2:jl, then the +kernel starts on the remote host /ssh:ec2: with a session name of +jl. The remote host must have jupyter installed since the +\"jupyter kernel\" command will be used to start the kernel on +the host." + (let* ((key (org-babel-jupyter-session-key params)) + (client (gethash key org-babel-jupyter-session-clients))) + (unless client + (setq client (org-babel-jupyter-initiate-client + (org-babel-jupyter-parse-session session) + (alist-get :kernel params))) + (puthash key client org-babel-jupyter-session-clients) + (jupyter-with-repl-buffer client + (let ((forget-client (lambda () (remhash key org-babel-jupyter-session-clients)))) + (add-hook 'kill-buffer-hook forget-client nil t)))) + (oref client buffer))) + +(defun org-babel-jupyter-initiate-session (&optional session params) + "Initialize a Jupyter SESSION according to PARAMS." + (if (equal session "none") (error "Need a session to run") + (when session + ;; Take into account a Lisp expression as a session name. + (setq session (org-babel-read session))) + (org-babel-jupyter-initiate-session-by-key session params))) + +;;;; Helper functions + +;;;###autoload +(defun org-babel-jupyter-scratch-buffer () + "Display a scratch buffer connected to the current block's session." + (interactive) + (let (buffer) + (org-babel-do-in-edit-buffer + (setq buffer (save-window-excursion + (jupyter-repl-scratch-buffer)))) + (if buffer (pop-to-buffer buffer) + (user-error "No source block at point")))) + +(cl-defmethod jupyter-do-refresh-kernelspecs (&context (major-mode org-mode)) + (or (jupyter-org-when-in-src-block + (let* ((info (org-babel-get-src-block-info 'light)) + (params (nth 2 info)) + (session (org-babel-read (alist-get :session params)))) + (when (file-remote-p session) + (jupyter-kernelspecs session 'refresh)))) + (cl-call-next-method))) + +;;;; `org-babel-execute:jupyter' + +(defvar org-link-bracket-re) + +(defun org-babel-jupyter-cleanup-file-links () + "Delete the files of image links for the current source block result. +Do this only if the file exists in +`org-babel-jupyter-resource-directory'." + (when-let* + ((pos (org-babel-where-is-src-block-result)) + (link-re (format "^[ \t]*%s[ \t]*$" org-link-bracket-re)) + (resource-dir (expand-file-name org-babel-jupyter-resource-directory))) + (save-excursion + (goto-char pos) + (forward-line) + (let ((bound (org-babel-result-end))) + ;; This assumes that `jupyter-org-client' only emits bracketed links as + ;; images + (while (re-search-forward link-re bound t) + (when-let* + ((path (org-element-property :path (org-element-context))) + (dir (when (file-name-directory path) + (expand-file-name (file-name-directory path))))) + (when (and (equal dir resource-dir) + (file-exists-p path)) + (delete-file path)))))))) + +;; TODO: What is a better way to handle discrepancies between how `org-mode' +;; views header arguments and how `emacs-jupyter' views them? Should the +;; strategy be to always try to emulate the `org-mode' behavior? +(defun org-babel-jupyter--remove-file-param (params) + "Destructively remove the file result parameter from PARAMS. +These parameters are handled internally." + (let* ((result-params (assq :result-params params)) + (fresult (member "file" result-params)) + (fparam (assq :file params))) + (setcar fresult "") + (delq fparam params))) + +(defconst org-babel-jupyter-async-inline-results-pending-indicator "???" + "A string to disambiguate pending inline results from empty results.") + +(defun org-babel-jupyter--execute (code async-p) + (jupyter-run-with-client jupyter-current-client + (let ((dreq (jupyter-execute-request :code code))) + (jupyter-mlet* ((req (jupyter-org-maybe-queued dreq))) + (jupyter-return + `(,req + ,(cond + (async-p + (when (bound-and-true-p org-export-current-backend) + (jupyter-add-idle-sync-hook + 'org-babel-after-execute-hook req 'append)) + (if (jupyter-org-request-inline-block-p req) + org-babel-jupyter-async-inline-results-pending-indicator + ;; This returns the message ID of REQ as an indicator + ;; for the pending results. + (jupyter-org-pending-async-results req))) + (t + (jupyter-idle-sync req) + (if (jupyter-org-request-inline-block-p req) + ;; When evaluating a source block synchronously, only the + ;; :execute-result will be in `jupyter-org-request-results' since + ;; stream results and any displayed data will be placed in a separate + ;; buffer. + (let ((el (jupyter-org-result + req (car (jupyter-org-request-results req))))) + (if (stringp el) el + (org-element-property :value el))) + ;; This returns an Org formatted string of the collected + ;; results. + (jupyter-org-sync-results req)))))))))) + +(defvar org-babel-jupyter-current-src-block-params nil + "The block parameters of the most recently executed Jupyter source block.") + +(defun org-babel-execute:jupyter (body params) + "Execute BODY according to PARAMS. +BODY is the code to execute for the current Jupyter `:session' in +the PARAMS alist." + (when org-babel-current-src-block-location + (save-excursion + (goto-char org-babel-current-src-block-location) + (when (jupyter-org-request-at-point) + (user-error "Source block currently being executed")))) + (let* ((result-params (assq :result-params params)) + (async-p (jupyter-org-execute-async-p params))) + (when (member "replace" result-params) + (org-babel-jupyter-cleanup-file-links)) + (let* ((org-babel-jupyter-current-src-block-params params) + (session (alist-get :session params)) + (buf (org-babel-jupyter-initiate-session session params)) + (jupyter-current-client (buffer-local-value 'jupyter-current-client buf)) + (lang (jupyter-kernel-language jupyter-current-client)) + (vars (org-babel-variable-assignments:jupyter params lang)) + (code (progn + (when-let* ((dir (alist-get :dir params))) + ;; `default-directory' is already set according + ;; to :dir when executing a source block. Set + ;; :dir to the absolute path so that + ;; `org-babel-expand-body:jupyter' does not try + ;; to re-expand the path. See #302. + (setf (alist-get :dir params) default-directory)) + (org-babel-expand-body:jupyter body params vars lang)))) + (pcase-let ((`(,req ,maybe-result) + (org-babel-jupyter--execute code async-p))) + ;; KLUDGE: Remove the file result-parameter so that + ;; `org-babel-insert-result' doesn't attempt to handle it while + ;; async results are pending. Do the same in the synchronous + ;; case, but not if link or graphics are also result-parameters, + ;; only in Org >= 9.2, since those in combination with file mean + ;; to interpret the result as a file link, a useful meaning that + ;; doesn't interfere with Jupyter style result insertion. + ;; + ;; Do this after sending the request since + ;; `jupyter-generate-request' still needs access to the :file + ;; parameter. + (when (and (member "file" result-params) + (or async-p + (not (or (member "link" result-params) + (member "graphics" result-params))))) + (org-babel-jupyter--remove-file-param params)) + (prog1 maybe-result + ;; KLUDGE: Add the "raw" result parameter for non-inline + ;; synchronous results because an Org formatted string is + ;; already returned in that case and + ;; `org-babel-insert-result' should not process it. + (unless (or async-p + (jupyter-org-request-inline-block-p req)) + (nconc (alist-get :result-params params) (list "raw")))))))) + +;;; Overriding source block languages, language aliases + +(defvar org-babel-jupyter--babel-ops + '(execute expand-body prep-session edit-prep + variable-assignments load-session + initiate)) + +(defvar org-babel-jupyter--babel-vars + '(header-args default-header-args)) + +(defun org-babel-jupyter--babel-op-symbol (op lang) + (if (eq op 'initiate) + (intern (format "org-babel-%s-initiate-session" lang)) + (intern (format (format "org-babel-%s:%s" op lang))))) + +(defun org-babel-jupyter--babel-var-symbol (var lang) + (intern (format "org-babel-%s:%s" var lang))) + +(defun org-babel-jupyter--babel-map (alias-action + var-action) + "Loop over Org babel function and variable symbols. +ALIAS-ACTION and VAR-ACTION are functions of one argument. + +When ALIAS-ACTION is called, the argument will be a symbol that +represents an Org Babel operation that can be defined by a +language extension to Org Babel, e.g. \\='execute. + +Similarly VAR-ACTION is called with a symbol representing an Org +Babel variable that can be defined for a language, +e.g. \\='header-args." + (declare (indent 0)) + (dolist (op org-babel-jupyter--babel-ops) + (funcall alias-action op)) + (dolist (var org-babel-jupyter--babel-vars) + (funcall var-action var))) + +(defun org-babel-jupyter-override-src-block (lang) + "Override the built-in `org-babel' functions for LANG. +This overrides functions like `org-babel-execute:LANG' and +`org-babel-LANG-initiate-session' to use the machinery of +jupyter-LANG source blocks. + +Also, set `org-babel-header-args:LANG' to the value of +`org-babel-header-args:jupyter-LANG', if the latter exists. If +`org-babel-header-args:LANG' had a value, save it as a symbol +property of `org-babel-header-args:LANG' for restoring it later. +Do the same for `org-babel-default-header-args:LANG'." + (org-babel-jupyter--babel-map + (lambda (op) + ;; Only override operations that are not related to a particular + ;; language. + (unless (memq op '(variable-assignments expand-body)) + (let ((lang-op + (org-babel-jupyter--babel-op-symbol + op lang)) + (jupyter-lang-op + (org-babel-jupyter--babel-op-symbol + op (format "jupyter-%s" lang)))) + ;; If a language doesn't have a function assigned, set one so it can + ;; be overridden + (unless (fboundp lang-op) + (fset lang-op #'ignore)) + (advice-add lang-op :override jupyter-lang-op + '((name . ob-jupyter)))))) + (lambda (var) + (let ((lang-var + (org-babel-jupyter--babel-var-symbol + var lang)) + (jupyter-lang-var + (org-babel-jupyter--babel-var-symbol + var (format "jupyter-%s" lang)))) + (when (boundp jupyter-lang-var) + (when (boundp lang-var) + (put lang-var 'jupyter-restore-value (symbol-value lang-var))) + (set lang-var (copy-tree (symbol-value jupyter-lang-var)))))))) + +(defun org-babel-jupyter-restore-src-block (lang) + "Restore the overridden `org-babel' functions for LANG. +This undoes everything that +`org-babel-jupyter-override-src-block' did." + (org-babel-jupyter--babel-map + (lambda (op) + ;; Only override operations that are not related to a particular + ;; language. + (unless (memq op '(variable-assignments expand-body)) + (let ((lang-op + (org-babel-jupyter--babel-op-symbol + op lang)) + (jupyter-lang-op + (org-babel-jupyter--babel-op-symbol + op (format "jupyter-%s" lang)))) + (advice-remove lang-op jupyter-lang-op) + ;; The function didn't have a definition, so + ;; ensure that we restore that fact. + (when (eq (symbol-function lang-op) #'ignore) + (fmakunbound lang-op))))) + (lambda (var) + (let ((lang-var + (org-babel-jupyter--babel-var-symbol + var lang))) + (when (boundp lang-var) + (set lang-var (get lang-var 'jupyter-restore-value))))))) + +(defun org-babel-jupyter-make-language-alias (kernel lang) + "Similar to `org-babel-make-language-alias' but for Jupyter src-blocks. +KERNEL should be the name of the default kernel to use for kernel +LANG, the language of the kernel. + +The Org Babel functions `org-babel-FN:jupyter-LANG', where FN is +one of execute, expand-body, prep-session, edit-prep, +variable-assignments, or load-session, are aliased to +`org-babel-FN:jupyter'. Similarly, +`org-babel-jupyter-LANG-initiate-session' is aliased to +`org-babel-jupyter-initiate-session'. + +If not already defined, the variable +`org-babel-default-header-args:jupyter-LANG' is set to the same +value as `org-babel-header-args:jupyter', which see. The +variable `org-babel-default-header-args:jupyter-LANG' is also set +to + + \((:async . \"no\") + \(:kernel . KERNEL)) + +if that variable does not already have a value. + +If LANG has an association in `org-babel-tangle-lang-exts', +associate the same value with jupyter-LANG, if needed. +Similarly, associate the same value for LANG in +`org-src-lang-modes'." + (org-babel-jupyter--babel-map + (lambda (op) + (defalias (org-babel-jupyter--babel-op-symbol + op (format "jupyter-%s" lang)) + (org-babel-jupyter--babel-op-symbol + op "jupyter"))) + (lambda (var) + (let ((jupyter-var + (org-babel-jupyter--babel-var-symbol + var "jupyter")) + (jupyter-lang-var + (org-babel-jupyter--babel-var-symbol + var (format "jupyter-%s" lang)))) + (unless (boundp jupyter-lang-var) + (set jupyter-lang-var (copy-tree (symbol-value jupyter-var))) + (cond + ((eq var 'default-header-args) + ;; Needed since the default kernel is not language + ;; specific and it needs to be. + (setf (alist-get :kernel (symbol-value jupyter-lang-var)) kernel) + (put jupyter-lang-var 'variable-documentation + (format + "Default header arguments for Jupyter %s src-blocks" + lang))) + (t + (put jupyter-lang-var 'variable-documentation + (get jupyter-var 'variable-documentation)))))))) + (when (assoc lang org-babel-tangle-lang-exts) + (add-to-list 'org-babel-tangle-lang-exts + (cons (concat "jupyter-" lang) + (cdr (assoc lang org-babel-tangle-lang-exts))))) + (add-to-list 'org-src-lang-modes + (cons (concat "jupyter-" lang) + (or (cdr (assoc lang org-src-lang-modes)) + (intern (downcase (replace-regexp-in-string + "[0-9]*" "" lang))))))) + +(defun org-babel-jupyter-aliases-from-kernelspecs (&optional refresh specs) + "Make language aliases based on the available kernelspecs. +For all kernel SPECS, make a language alias for the kernel +language if one does not already exist. The alias is created with +`org-babel-jupyter-make-language-alias'. + +SPECS defaults to those associated with the `default-directory'. +Optional argument REFRESH has the same meaning as in +`jupyter-kernelspecs'. + +Note, spaces in the kernel language name are converted into +dashes in the language alias, e.g. + + Wolfram Language -> jupyter-Wolfram-Language + +For convenience, after creating a language alias for a kernel +language LANG, set the :kernel default header argument if not +present in `org-babel-default-header-args:jupyter-LANG', see +`org-babel-header-args:jupyter'. This allows users to set that +variable in their configurations without having to also set the +:kernel header argument since it is common for only one per +language to exist on someone's system." + (cl-loop + for spec in (or specs + (with-demoted-errors "Error retrieving kernelspecs: %S" + (jupyter-kernelspecs default-directory refresh))) + for kernel = (jupyter-kernelspec-name spec) + for lang = (let ((lang (jupyter-canonicalize-language-string + (plist-get (jupyter-kernelspec-plist spec) :language)))) + (or (cadr (assoc lang org-babel-jupyter-language-aliases)) + lang)) + unless (member lang languages) collect lang into languages and + do (org-babel-jupyter-make-language-alias kernel lang) + ;; KLUDGE: The :kernel header argument is always set, even when we aren't + ;; the ones who originally set the defaults. This is here for convenience + ;; since usually a user does not set :kernel directly. + (let ((var (intern (concat "org-babel-default-header-args:jupyter-" lang)))) + (unless (alist-get :kernel (symbol-value var)) + (setf (alist-get :kernel (symbol-value var)) kernel))))) + +;;; `ox' integration + +(defvar org-latex-minted-langs) + +(defun org-babel-jupyter-setup-export (backend) + "Ensure that Jupyter src-blocks are integrated with BACKEND. +Currently this makes sure that Jupyter src-block languages are +mapped to their appropriate minted language in +`org-latex-minted-langs' if BACKEND is latex." + (cond + ((org-export-derived-backend-p backend 'latex) + (cl-loop + for spec in (jupyter-kernelspecs default-directory) + for lang = (plist-get (jupyter-kernelspec-plist spec) :language) + do (cl-pushnew (list (intern (concat "jupyter-" lang)) lang) + org-latex-minted-langs :test #'equal))))) + +(defun org-babel-jupyter-strip-ansi-escapes (_backend) + "Remove ANSI escapes from Jupyter src-block results in the current buffer." + (org-babel-map-src-blocks nil + (when (org-babel-jupyter-language-p lang) + (when-let* ((pos (org-babel-where-is-src-block-result)) + (ansi-color-apply-face-function + (lambda (beg end face) + ;; Could be useful for export backends + (when face + (put-text-property beg end 'face face))))) + (goto-char pos) + (ansi-color-apply-on-region (point) (org-babel-result-end)))))) + +;;; Hook into `org' + +;; Defer generation of the aliases until Org is enabled in a buffer to +;; avoid generating them at top-level when loading ob-jupyter. Some +;; users, e.g. those who use conda environments, may not have a +;; jupyter command available at load time. +(defun org-babel-jupyter-make-local-aliases () + (let ((default-directory user-emacs-directory)) + (org-babel-jupyter-aliases-from-kernelspecs))) +(add-hook 'org-mode-hook #'org-babel-jupyter-make-local-aliases 10) + +(add-hook 'org-export-before-processing-functions #'org-babel-jupyter-setup-export) +(add-hook 'org-export-before-parsing-functions #'org-babel-jupyter-strip-ansi-escapes) + +(provide 'ob-jupyter) + +;;; ob-jupyter.el ends here diff --git a/lisp/jupyter/widget.html b/lisp/jupyter/widget.html new file mode 100644 index 00000000..d47ee69a --- /dev/null +++ b/lisp/jupyter/widget.html @@ -0,0 +1,33 @@ + + + +Jupyter Client + + + + + + + + diff --git a/lisp/ox-ipynb.el b/lisp/ox-ipynb.el new file mode 100644 index 00000000..88710803 --- /dev/null +++ b/lisp/ox-ipynb.el @@ -0,0 +1,1108 @@ +;;; ox-ipynb.el --- Convert an org-file to an ipynb. -*- lexical-binding: t; -*- + +;; Copyright(C) 2017 John Kitchin + +;; Author: John Kitchin +;; URL: https://github.com/jkitchin/ox-ipynb/ox-ipynb.el +;; Version: 0.1 +;; Keywords: org-mode +;; Package-Requires: ((emacs "25") (org "8.2") (s "1.10.0")) + +;; This file is not currently part of GNU Emacs. + +;; 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 2, 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 this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; The export language is determined by the first cell. If the first cell is not +;; the notebook language, e.g. because you use a shell block for some reason, +;; you can specify the language with a keyword like this: +;; +;; #+OX-IPYNB-LANGUAGE: jupyter-python +;; +;; It is possible to set metadata at the notebook level using +;; #+ox-ipynb-keyword-metadata: key1 key2 +;; This will use store key:value pairs in +;; the notebook metadata section, in an org section. +;; +;; It is also possible to set cell metadata on src-block cells. You use an +;; attribute like #+ATTR_IPYNB: :key1 val1 :key2 val2 to set the cell metadata. +;; You can also do this on paragraphs. Only one attr_ipynb line is supported, so +;; all metadata needs to go in that line. +;; +;; You can force a new cell to be created with the org-directive #+ipynb-newcell +;; +;; This exporter supports ipython and R Juypter notebooks. Other languages could +;; be supported, but you need to add a kernelspec to `ox-ipynb-kernelspecs' and +;; the language info to `ox-ipynb-language-infos'. +;; +;; The org-file is parsed into a list of cells. Each cell is either a markdown +;; cell or a code cell (with results). Headlines are parsed to their own cells +;; to enable collapsible headings to work nicely. +;; +;; You can export an org-file to a buffer, file or file and open. +;; +;; `ox-ipynb' supports the following features for making notebooks that don't +;; include all the org-source. You can label regions of a code cell with ### +;; BEGIN SOLUTION...### END SOLUTION, and if you export with +;; `ox-ipynb-export-to-participant-notebook' those regions will be stripped out +;; in the notebook. You can also label a region as hidden with ### BEGIN +;; HIDDEN...### END HIDDEN. +;; +;; Finally any cell with +;; #+attr_ipynb: :remove t +;; on it will be removed in the export with `ox-ipynb-export-to-participant-notebook'. +;; +;; You can export a notebook with all the results stripped out with +;; `ox-ipynb-export-to-ipynb-no-results-file-and-open'. + + + +;;; Code: +(require 'cl-lib) +(require 'ox-md) +(require 'ox-org) +(require 's) +(require 'json) +(require 'dash) + +(unless (string-match "^9\\.[2-9][\\.0-9]*" (org-version)) + (warn "org 9.2+ is required for `ox-ipynb'. Earlier versions do not currently work.")) + +(defcustom ox-ipynb-preprocess-hook '() + "Hook variable to apply to a copy of the buffer before exporting." + :group 'ox-ipynb) + + +(defvar ox-ipynb-kernelspecs '((ipython . (kernelspec . ((display_name . "Python 3") + (language . "python") + (name . "python3")))) + (R . (kernelspec . ((display_name . "R") + (language . "R") + (name . "ir")))) + (julia . (kernelspec . ((display_name . "Julia 0.6.0") + (language . "julia") + (name . "julia-0.6")))) + (jupyter-julia . (kernelspec . ((display_name . "Julia 0.6.0") + (language . "julia") + (name . "julia-0.6")))) + (jupyter-python . (kernelspec . ((display_name . "Python 3") + (language . "python") + (name . "python3"))))) + "Kernelspec metadata for different kernels.") + + +(defvar ox-ipynb-language-infos + '((ipython . (language_info . ((codemirror_mode . ((name . ipython) + (version . 3))) + (file_extension . ".py") + (mimetype . "text/x-python") + (name . "python") + (nbconvert_exporter . "python") + (pygments_lexer . "ipython3") + (version . "3.5.2")))) + + (jupyter-python . (language_info . ((codemirror_mode . ((name . ipython) + (version . 3))) + (file_extension . ".py") + (mimetype . "text/x-python") + (name . "python") + (nbconvert_exporter . "python") + (pygments_lexer . "ipython3") + (version . "3.5.2")))) + + (jupyter-julia . (language_info . ((codemirror_mode . "julia") + (file_extension . ".jl") + (mimetype . "text/x-julia") + (name . "julia") + (pygments_lexer . "julia") + (version . "0.6.0")))) + (julia . (language_info . ((codemirror_mode . "julia") + (file_extension . ".jl") + (mimetype . "text/x-julia") + (name . "julia") + (pygments_lexer . "julia") + (version . "0.6.0")))) + + (R . (language_info . ((codemirror_mode . "r") + (file_extension . ".r") + (mimetype . "text/x-r-source") + (name . "R") + (pygments_lexer . "r") + (version . "3.3.2"))))) + "These get injected into notebook metadata. +They are reverse-engineered from existing notebooks.") + + +(defun ox-ipynb-insert-slide (type) + "Insert the attribute line for a slide TYPE." + (interactive (list (completing-read "Type: " '(slide subslide fragment notes skip)))) + (goto-char (line-beginning-position)) + (insert (format "#+attr_ipynb: (slideshow . ((slide_type . %s)))" type)) + (when (not (looking-at "$")) (insert "\n"))) + + +(defun ox-ipynb-export-code-cell (src-result) + "Return a code cell for the org-element in the car of SRC-RESULT. +The cdr of SRC-RESULT is the end position of the results." + (let* ((src-block (car src-result)) + (results-end (cdr src-result)) + (results (org-no-properties (car results-end))) + (output-cells '()) + img-path img-data + (start 0) + end + (src-metadata (or (when-let (smd (plist-get (cadr src-block) :attr_ipynb)) + (read (format "(%s)" (s-join " " smd)))) + (make-hash-table))) + block-start block-end + html + latex + md) + + ;; Handle inline images first + (while (string-match "\\[\\[file:\\(.*?\\)\\]\\]" (or results "") start) + (setq start (match-end 0)) + (setq img-path (match-string 1 results) + img-data (base64-encode-string + (encode-coding-string + (if (file-exists-p img-path) + (with-temp-buffer + (insert-file-contents img-path) + (buffer-string)) + "") + 'binary) + t)) + + (setq output-cells + (append output-cells + `(((data . ((image/png . ,img-data) + ("text/plain" . ""))) + (metadata . ,(make-hash-table)) + (output_type . "display_data")))))) + ;; now remove the inline images and put the results in. + (setq results (s-trim (replace-regexp-in-string "\\[\\[file:\\(.*?\\)\\]\\]" "" + (or results "")))) + + ;; Check for HTML cells. I think there can only be one I don't know what the + ;; problem is, but I can't get the match-end functions to work correctly + ;; here. Its like the match-data is not getting updated. + (when (string-match "#\\+BEGIN_EXPORT HTML" (or results "")) + (setq block-start (s-index-of "#+BEGIN_EXPORT HTML" results) + start (+ block-start (length "#+BEGIN_EXPORT HTML\n"))) + + ;; Now, get the end of the block. + (setq end (s-index-of "#+END_EXPORT" results) + block-end (+ end (length "#+END_EXPORT"))) + + (setq html (substring results start end)) + + ;; remove the old output. + (setq results (concat (substring results 0 block-start) + (substring results block-end))) + (message "html: %s\nresults: %s" html results) + (setq output-cells (append + output-cells `((data . ((text/html . ,html) + ("text/plain" . "HTML object"))) + (metadata . ,(make-hash-table)) + (output_type . "display_data"))))) + + ;; Handle latex cells + (when (string-match "#\\+BEGIN_EXPORT latex" (or results "")) + (setq block-start (s-index-of "#+BEGIN_EXPORT latex" results) + start (+ block-start (length "#+BEGIN_EXPORT latex\n"))) + + ;; Now, get the end of the block. + (setq end (s-index-of "#+END_EXPORT" results) + block-end (+ end (length "#+END_EXPORT"))) + + (setq latex (substring results start end)) + + ;; remove the old output. + (setq results (concat (substring results 0 block-start) + (substring results block-end))) + + (setq output-cells (append + output-cells + `((data . ((text/latex . ,latex) + ("text/plain" . "Latex object"))) + (metadata . ,(make-hash-table)) + (output_type . "display_data"))))) + + ;; output cells + (unless (string= "" results) + (setq output-cells (append `(((name . "stdout") + (output_type . "stream") + (text . ,results))) + output-cells))) + + + `((cell_type . "code") + (execution_count . 1) + ;; the hashtable trick converts to {} in json. jupyter can't take a null here. + (metadata . ,src-metadata) + (outputs . ,(if (null output-cells) + ;; (vector) json-encodes to [], not null which + ;; jupyter does not like. + (vector) + (vconcat output-cells))) + (source . ,(vconcat + (list (s-trim (car (org-export-unravel-code src-block))))))))) + + +(defun ox-ipynb-filter-latex-fragment (text _ _) + "Export org latex fragments in TEXT for ipynb markdown. +Latex fragments come from org as \(fragment\) for inline math or +\[fragment\] for displayed math. Convert to $fragment$ +or $$fragment$$ for ipynb." + ;; \\[frag\\] or \\(frag\\) are also accepted by ipynb markdown (need double backslash) + (setq text (replace-regexp-in-string + "\\\\\\[" "$$" + (replace-regexp-in-string "\\\\\\]" "$$" text))) + (replace-regexp-in-string "\\\\(\\|\\\\)" "$" text)) + + +(defun ox-ipynb-filter-link (text _ _) + "Make a link in TEXT into markdown. +For some reason I was getting angle brackets in them I wanted to remove. +This only fixes file links with no description I think. + +[2019-08-11 Sun] added a small additional condition to not change +text starting with %s") + (code . "%s") + (italic . "%s") + (strike-through . "%s") + (underline . "%s") + (verbatim . "%s"))) ; we overwrite the underline + + ;; In here we temporarily define many export functions to fine-tune the markdown we get. + (md (cl-letf (((symbol-function 'org-md-headline) + (lambda (HEADLINE CONTENTS INFO) + "changed to get the right number of # for the heading level." + (concat + (cl-loop for i to (org-element-property :level HEADLINE) + concat "#") + " " + (org-export-string-as + (org-element-property :raw-value HEADLINE) + 'md t '(:with-toc nil :with-tags nil))))) + ((symbol-function 'org-export-get-relative-level) + (lambda (headline info) + "changed to get the level number of a headline. We need the absolute level." + (org-element-property :level headline))) + ;; Tables are kind of special. I want a markdown rendering, not html. + ((symbol-function 'org-html-table-cell) + (lambda (table-cell contents info) + (s-concat (org-trim (or contents "")) "|"))) + ((symbol-function 'org-html-table-row) 'ox-ipynb--export-table-row) + ((symbol-function 'org-html-table) + (lambda (_ contents info) + "We need to adapt the contents to remove leading and trailing rule lines." + + ;; There are leading and trailing \n. strip off for the next step. + (setq contents (string-trim contents)) + + (let ((lines (split-string contents "\n"))) + (when (string-prefix-p "|-" (nth 0 lines)) + (setq lines (cdr lines))) + + (when (string-prefix-p "|-" (car (last lines))) + (setq lines (butlast lines))) + + ;; Now add back the blank lines + (setq contents (string-join (append '("") lines '("")) "\n"))) + + ;; finally, it looks like there are double line returns we + ;; replace here. + (replace-regexp-in-string "\n\n" "\n" (or contents ""))))) + (org-export-string-as + s + 'md t '(:with-toc nil :with-tags nil)))) + (pos 0) + (attachments '()) + metadata) + + ;; we need to do some work to make images inlined for portability. + (while (setq pos (string-match "(attachment:\\(.*\\))" md (+ 1 pos))) + (push (list (match-string 1 md) + (list "image/png" (cdr (assoc (match-string 1 md) ox-ipynb-images)))) + attachments)) + + ;; metadata handling, work on the original string since the attr line is + ;; gone from the export + (when (string-match "#\\+attr_ipynb: *\\(.*\\)" s) + (setq metadata (read (format "(%s)" (match-string 1 s))))) + + ;; check headline metadata + (when (string-match ":metadata: *\\(.*\\)" s) + (setq metadata (read (format "(%s)" (match-string 1 s))))) + + (if (not (string= "" (s-trim md))) + (if attachments + `((attachments . ,attachments) + (cell_type . "markdown") + (metadata . ,(or metadata (make-hash-table))) + (source . ,(vconcat + (list md)))) + `((cell_type . "markdown") + (metadata . ,(or metadata (make-hash-table))) + (source . ,(vconcat + (list md))))) + nil))) + + +(defun ox-ipynb--export-table-row (table-row contents info) + "Custom function to create a markdown string from a TABLE-ROW. +Note, this works a row at a time in a table, and does not store +information about how many horizontal rules there are. In simple +markdown, which we use here, you can only have one rule in the +header. If you wanted a fancier table, you should export it as +html I think. That is not currently supported. +" + (let (ncolumns + (contents (org-no-properties contents))) + (cond + ((eq (org-element-property :type table-row) 'standard) + ;; for a regular row, it seems the opening | is not included in contents + (concat "| " contents)) + + ;; A rule in org looks like |---+---| we count the number of columns + ;; assuming it looks like this + ((eq (org-element-property :type table-row) 'rule) + (setq contents (buffer-substring (org-element-property :begin table-row) + (org-element-property :end table-row))) + (setq ncolumns (+ (s-count-matches "+" contents) 1)) + (if (= 1 ncolumns) + "|---|" + (concat "|---" (cl-loop for i to (- ncolumns 2) concat "|---") "|")))))) + + +(defun ox-ipynb-export-keyword-cell () + "Make a markdown cell containing org-file keywords and values." + (let* ((all-keywords (org-element-map (org-element-parse-buffer) + 'keyword + (lambda (key) + (cons (org-element-property :key key) + (org-element-property :value key))))) + (ipynb-keywords (cdr (assoc "OX-IPYNB-KEYWORD-METADATA" all-keywords))) + (include-keywords (mapcar 'upcase (split-string (or ipynb-keywords "")))) + (keywords (cl-loop for key in include-keywords + if (assoc key all-keywords) + collect (cons key (or (cdr (assoc key all-keywords)) ""))))) + + (setq keywords + (cl-loop for (key . value) in keywords + collect + (format "- %s: %s\n" + key + (replace-regexp-in-string + "<\\|>" "" + (or value ""))))) + (when keywords + `((cell_type . "markdown") + (metadata . ,(make-hash-table)) + (source . ,(vconcat keywords)))))) + + +(defun ox-ipynb-get-language () + "Get the language for the exporter. +If you set OX-IPYNB-LANGUAGE it will be used, otherwise we assume +the first code-block contains the language you want. If none of +those exist, default to ipython." + (intern (or + (cdr (assoc "OX-IPYNB-LANGUAGE" (org-element-map (org-element-parse-buffer) + 'keyword + (lambda (key) + (cons (org-element-property :key key) + (org-element-property :value key)))))) + (org-element-map (org-element-parse-buffer) + 'src-block + (lambda (src) + (unless (string= "none" + (cdr (assq :exports + (org-babel-parse-header-arguments + (org-element-property :parameters src))))) + (org-element-property :language src))) + nil t) + "ipython"))) + + +(defun ox-ipynb-split-text (s) + "Given a string S, split it into substrings. +Each heading is its own string. Also, split on #+ipynb-newcell and #+attr_ipynb. +Empty strings are eliminated." + (let* ((s1 (s-slice-at org-heading-regexp s)) + ;; split headers out + (s2 (cl-loop for string in s1 + append + (if (string-match org-heading-regexp string) + (let ((si (split-string string "\n")) + heading content) + ;; The first one is definitely the heading. We may also + ;; need properties. + (setq heading (pop si)) + (when (and si (s-matches? ":PROPERTIES:" (car si))) + (setq heading (concat "\n" heading (pop si) "\n")) + (while (not (s-matches? ":END:" (car si))) + (setq heading (concat heading (pop si) "\n"))) + (setq heading (concat heading (pop si) "\n"))) + (list heading + (mapconcat 'identity si "\n"))) + (list string)))) + (s3 (cl-loop for string in s2 + append + (split-string string "#\\+ipynb-newcell"))) + ;; check for paragraph metadata and split on that, but keep the attribute. + (s4 (cl-loop for string in s3 + append + ;; Note I specifically leave off the b: in this pattern so I + ;; can use it in the next section + (split-string string "^#\\+attr_ipyn"))) + (s5 (cl-loop for string in s4 collect + (if (string-prefix-p "b: " string t) + (concat "#+attr_ipyn" string) + string)))) + + s5)) + + +(defun ox-ipynb-export-to-buffer-data () + ;; This is a hack to remove empty Results. I think this is a bug in org-mode, + ;; that it exports empty results to have a nil in them without a \n, which + ;; causes this exporter to fail to find them. + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "#\\+RESULTS:\s+ +:RESULTS: +nil:END:" nil t) + (replace-match ""))) + + ;; this is a temporary hack to fix a bug in org-mode that puts a nil at the + ;; end of exported dynamic blocks. <2017-05-19 Fri> + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\\(#\\+BEGIN:.*\\)nil" nil t) + (replace-match "\\1"))) + + ;; expand any include files + (org-export-expand-include-keyword) + + ;; preprocess some org-elements that need to be exported to strings prior to + ;; the rest. This is not complete. Do these in reverse so the buffer positions + ;; don't get changed in the parse tree. + ;; ** footnotes + (mapc (lambda (elm) + (cl--set-buffer-substring (org-element-property :begin elm) + (org-element-property :end elm) + (format "[%s]" + (org-element-property :label elm) + (org-element-property :label elm)))) + (reverse (org-element-map (org-element-parse-buffer) 'footnote-reference 'identity))) + + (mapc (lambda (elm) + (cl--set-buffer-substring (org-element-property :begin elm) + (org-element-property :end elm) + (format "

[%s] %s" + (org-element-property :label elm) + (org-element-property :label elm) + (buffer-substring (org-element-property :contents-begin elm) + (org-element-property :contents-end elm))))) + (reverse (org-element-map (org-element-parse-buffer) 'footnote-definition 'identity))) + + ;; ** quote blocks + (mapc (lambda (elm) + (cl--set-buffer-substring (org-element-property :begin elm) + (org-element-property :end elm) + (org-md-quote-block elm + (buffer-substring + b (org-element-property :contents-begin elm) + (org-element-property :contents-end elm)) + nil))) + (reverse (org-element-map (org-element-parse-buffer) 'quote-block 'identity))) + + (mapc (lambda (elm) + (cl--set-buffer-substring (org-element-property :begin elm) + (org-element-property :end elm) + (org-md-export-block elm + (buffer-substring + (org-element-property :contents-begin elm) + (org-element-property :contents-end elm)) + nil))) + (reverse (org-element-map (org-element-parse-buffer) 'dynamic-block 'identity))) + + + + ;; Now we parse the buffer. + (let* ((cells '()) + (ox-ipynb-language (ox-ipynb-get-language)) + (metadata `(metadata . ((org . ,(let* ((all-keywords (org-element-map (org-element-parse-buffer) + 'keyword + (lambda (key) + (cons (org-element-property :key key) + (org-element-property :value key))))) + (ipynb-keywords (cdr (assoc "OX-IPYNB-KEYWORD-METADATA" all-keywords))) + (include-keywords (mapcar 'upcase (split-string (or ipynb-keywords "")))) + (keywords (cl-loop for key in include-keywords + collect (assoc key all-keywords)))) + keywords)) + ,(cdr (assoc ox-ipynb-language ox-ipynb-kernelspecs)) + ,(cdr (assoc ox-ipynb-language ox-ipynb-language-infos))))) + (ipynb (ox-ipynb-notebook-filename)) + src-blocks + src-results + current-src + result + result-end + end + data) + + ;; Do we need a title cell? + (let* ((keywords (org-element-map (org-element-parse-buffer) + 'keyword + (lambda (key) + (cons (org-element-property :key key) + (org-element-property :value key))))) + (title (cdr (assoc "TITLE" keywords))) + (author (cdr (assoc "AUTHOR" keywords))) + (date (cdr (assoc "DATE" keywords))) + title-string + cell) + (when title + (setq title_string (format "%s\n%s\n\n" title (make-string (length title) ?=))) + (when author + (setq title_string (format "%s**Author:** %s\n\n" title_string author))) + (when date + (setq title_string (format "%s**Date:** %s\n\n" title_string date))) + + (push `((cell_type . "markdown") + (metadata . ,(make-hash-table)) + (source . ,title_string)) + cells))) + + ;; Next keyword cells + (let ((kws (ox-ipynb-export-keyword-cell))) + (when kws (push kws cells))) + + (setq src-blocks (org-element-map (org-element-parse-buffer) 'src-block + (lambda (src) + (when (string= (symbol-name ox-ipynb-language) + (org-element-property :language src)) + src)))) + + ;; Get a list of (src . results). These are only source blocks and + ;; corresponding results. We assume that before, between and after src + ;; blocks there are markdown cells. + (setq src-results + (cl-loop for src in src-blocks + with result=nil + do + (setq result + (save-excursion + (goto-char (org-element-property :begin src)) + (let ((location (org-babel-where-is-src-block-result nil nil)) + start end + result-content) + (when location + (save-excursion + (goto-char location) + (when (looking-at + (concat org-babel-result-regexp ".*$")) + (setq start (1- (match-beginning 0)) + end (progn (forward-line 1) (org-babel-result-end)) + result-content (buffer-substring-no-properties + start end)) + ;; clean up the results a little. This gets rid + ;; of the RESULTS markers for output and drawers + (cl-loop for pat in '("#\\+RESULTS:" + "^: " "^:RESULTS:\\|^:END:") + do + (setq result-content (replace-regexp-in-string + pat + "" + result-content))) + ;; the results and the end of the results. + ;; we use the end later to move point. + (cons (s-trim result-content) end))))))) + collect + (cons src result))) + + (setq current-source (pop src-results)) + + ;; First block before a src is markdown, unless it happens to be empty. + (if (car current-source) + (unless (string= "" (s-trim + (buffer-substring-no-properties + (point-min) + (org-element-property :begin (car current-source))))) + (let ((text (buffer-substring-no-properties + (point-min) + (org-element-property :begin (car current-source))))) + (cl-loop for s in (ox-ipynb-split-text text) + unless (string= "" (s-trim s)) + do + (when-let ((md (ox-ipynb-export-markdown-cell s))) + (push md cells))))) + ;; this is a special case where there are no source blocks, and the whole + ;; document is a markdown cell. + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + (cl-loop for s in (ox-ipynb-split-text text) + unless (string= "" (s-trim s)) + do + (when-let ((md (ox-ipynb-export-markdown-cell s))) + (push md cells))))) + + (while current-source + ;; add the src cell + (push (ox-ipynb-export-code-cell current-source) cells) + (setq result-end (cdr current-source) + result (car result-end) + result-end (cdr result-end)) + + (setq end (max + (or result-end 0) + (org-element-property :end (car current-source)))) + + (setq current-source (pop src-results)) + + (if current-source + (when (not (string= "" (s-trim (buffer-substring + end + (org-element-property + :begin + (car current-source)))))) + (let ((text (buffer-substring-no-properties + end (org-element-property :begin + (car current-source))))) + (cl-loop for s in (ox-ipynb-split-text text) + unless (string= "" s) + do + (when-let ((md (ox-ipynb-export-markdown-cell (s-trim s)))) + (push md cells))))) + ;; on last block so add rest of document + (let ((text (buffer-substring-no-properties end (point-max)))) + (cl-loop for s in (ox-ipynb-split-text text) + unless (string= "" s) + do + (when-let ((md (ox-ipynb-export-markdown-cell (s-trim s)))) + (push md cells)))))) + + (setq data (append + `((cells . ,(reverse cells))) + (list metadata) + '((nbformat . 4) + (nbformat_minor . 0)))) + + data)) + + + +(defun ox-ipynb-notebook-filename () + "Get filename for export." + (or (and (boundp 'export-file-name) export-file-name) + ;; subtree + (org-entry-get (point) "EXPORT_FILE_NAME") + ;; file level + (org-element-map (org-element-parse-buffer 'element) 'keyword + (lambda (k) + (when (string= "EXPORT_FILE_NAME" (org-element-property :key k)) + (org-element-property :value k))) + nil t) + ;; last case + (concat (file-name-base + (or (buffer-file-name) + "Untitled")) ".ipynb"))) + + +(defun ox-ipynb-preprocess-ignore () + "Process the ignore headlines similar to + `org-export-ignore-headlines'." + (goto-char (point-min)) + (while (re-search-forward org-heading-regexp nil 'mv) + (when (-contains? (org-get-tags) "ignore") + (save-restriction + (org-narrow-to-subtree) + ;; first remove headline and properties. + (beginning-of-line) + (cl--set-buffer-substring (point) + (progn (org-end-of-meta-data) + (point)) + "") + ;; now, promote any remaining headlines in this section + (while (re-search-forward org-heading-regexp nil 'mv) + (org-promote)))))) + + +(add-hook 'ox-ipynb-preprocess-hook 'ox-ipynb-preprocess-ignore) + + +(defun ox-ipynb-preprocess-babel-calls () + "Process babel calls to remove them. +They don't work well in the export." + (goto-char (point-min)) + (cl-loop for bc in (reverse (org-element-map (org-element-parse-buffer) 'babel-call 'identity)) + do + (delete-region (org-element-property :begin bc) + (org-element-property :end bc)))) + +(add-hook 'ox-ipynb-preprocess-hook 'ox-ipynb-preprocess-babel-calls) + +(defun ox-ipynb-export-to-buffer () + "Export the current buffer to ipynb format in a buffer. +Only ipython source blocks are exported as code cells. Everything +else is exported as a markdown cell. The output is in *ox-ipynb*." + (interactive) + (org-export-with-buffer-copy + ;; First, let's delete any headings in :exclude-tags + (let ((exclude-tags (or (plist-get (org-export--get-inbuffer-options) :exclude-tags) + org-export-exclude-tags))) + (cl-loop for hl in + (reverse + (org-element-map (org-element-parse-buffer) 'headline + (lambda (hl) + (when (-intersection (org-get-tags + (org-element-property :begin hl) t) + exclude-tags) + hl)))) + do + (cl--set-buffer-substring (org-element-property :begin hl) + (org-element-property :end hl) + ""))) + + ;; Now delete anything not in select_tags, but only if there is some headline + ;; with one of the tags. + (let* ((select-tags (or (plist-get (org-export--get-inbuffer-options) :select-tags) + org-export-select-tags)) + (found nil) + (hls (reverse + (org-element-map (org-element-parse-buffer) 'headline + (lambda (hl) + (when (-intersection (org-get-tags + (org-element-property :begin hl)) + select-tags) + (setq found t)) + (unless (-intersection (org-get-tags + (org-element-property :begin hl) t) + select-tags) + hl)))))) + (when found + (cl-loop for hl in hls + do + (cl--set-buffer-substring (org-element-property :begin hl) + (org-element-property :end hl) + "")))) + + ;; Now we should remove any src blocks with :exports none in them + (cl-loop for src in + (reverse + (org-element-map (org-element-parse-buffer) + 'src-block + (lambda (src) + (when (string= "none" + (cdr (assq :exports + (org-babel-parse-header-arguments + (org-element-property :parameters src))))) + src)))) + do + (goto-char (org-element-property :begin src)) + (org-babel-remove-result) + (cl--set-buffer-substring (org-element-property :begin src) + (org-element-property :end src) + "")) + + ;; And finally run any additional hooks + (cl-loop for func in ox-ipynb-preprocess-hook do (funcall func)) + + ;; Now get the data and put the json into a buffer + (let ((data (ox-ipynb-export-to-buffer-data)) + (ipynb (ox-ipynb-notebook-filename))) + (with-current-buffer (get-buffer-create "*ox-ipynb*") + (erase-buffer) + (insert (json-encode data))) + + (switch-to-buffer "*ox-ipynb*") + (setq-local export-file-name ipynb) + (get-buffer "*ox-ipynb*")))) + + +(defun ox-ipynb-nbopen (fname) + "Open FNAME in jupyter notebook." + (interactive (list (read-file-name "Notebook: "))) + (shell-command (format "nbopen \"%s\" &" fname))) + + +(defun ox-ipynb-remove-solution () + "Delete all SOLUTION regions. +This is usually run as a function in `ox-ipynb-preprocess-hook'." + (goto-char (point-max)) + (while (re-search-backward "^### BEGIN SOLUTION\\(.\\|\n\\)*?### END SOLUTION" nil t) + (cl--set-buffer-substring (match-beginning 0) (match-end 0) ""))) + + +(defun ox-ipynb-remove-hidden () + "Delete all HIDDEN regions. +This is usually run as a function in `ox-ipynb-preprocess-hook'." + (goto-char (point-max)) + (while (re-search-backward "^### BEGIN HIDDEN\\(.\\|\n\\)*?### END HIDDEN" nil t) + (cl--set-buffer-substring (match-beginning 0) (match-end 0) ""))) + +(defun ox-ipynb-remove-remove () + "Delete all cells with remove in the metadata. +This is not specific +This is usually run as a function in `ox-ipynb-preprocess-hook'." + (org-babel-map-src-blocks nil + (let* ((src (org-element-context)) + (ipynb-attr (org-element-property :attr_ipynb src)) + remove) + (when (and ipynb-attr) + (setq remove (cdr (assoc 'remove (cadr (read (concat "(" (car ipynb-attr) ")")))))) + (when remove + (cl--set-buffer-substring (org-element-property :begin src) (org-element-property :end src) "")))))) + + +;; * export menu +(defun ox-ipynb-export-to-ipynb-buffer (&optional async subtreep visible-only + body-only info) + "Export the current buffer to an ipynb in a new buffer. +Optional argument ASYNC to asynchronously export. +Optional argument SUBTREEP to export current subtree. +Optional argument VISIBLE-ONLY to only export visible content. +Optional argument BODY-ONLY export only the body. +Optional argument INFO is a plist of options." + (let ((ipynb (ox-ipynb-notebook-filename)) + (content (buffer-string)) + buf) + ;; (org-org-export-as-org async subtreep visible-only body-only info) + ;; (with-current-buffer "*Org ORG Export*" + (with-temp-buffer + (insert content) + (org-mode) + (setq-local export-file-name ipynb) + + ;; Reminder to self. This is not a regular kind of exporter. We have to + ;; build up the json document that represents a notebook, so some things + ;; don't work like a regular exporter that has access to the whole data + ;; structure for resolving links. We have to handle org-ref separately. At + ;; this point, they are no longer org-ref links, and have been converted + ;; to custom-id links. They don't render because they are turned to md as + ;; isolated strings. + (let ((links (cl-loop for link in (org-element-map + (org-element-parse-buffer) 'link 'identity) + if (string= "custom-id" (org-element-property :type link)) + collect link))) + (cl-loop for link in (reverse links) + do + (cl--set-buffer-substring (org-element-property :begin link) + (org-element-property :end link) + (format "[%s]" (org-element-property :path link))))) + ;; The bibliography also leaves something to be desired. It gets turned + ;; into an org-bibtex set of headings. Here we convert these to something + ;; just slightly more palatable. + (let ((bib-entries (cl-loop for hl in (org-element-map + (org-element-parse-buffer) 'headline 'identity) + if (org-element-property :=KEY= hl) + collect hl))) + (cl-loop for hl in (reverse bib-entries) + do + (cl--set-buffer-substring (org-element-property :begin hl) + (org-element-property :end hl) + (s-format "[${=KEY=}] ${AUTHOR}. ${TITLE}. https://dx.doi.org/${DOI}\n\n" + (lambda (arg &optional extra) + (let ((entry (org-element-property (intern-soft (concat ":"arg)) hl))) + (substring + entry + (if (s-starts-with? "{" entry) 1 0) + (if (s-ends-with? "}" entry) -1 nil))))))))) + + (setq buf (ox-ipynb-export-to-buffer)) + (with-current-buffer buf + (setq-local export-file-name ipynb)) + ;; (prog1 + ;; buf + ;; (kill-buffer "*Org ORG Export*")) + buf)) + + +(defun ox-ipynb-export-to-ipynb-file (&optional async subtreep visible-only body-only info) + "Export current buffer to a file. +Optional argument ASYNC to asynchronously export. +Optional argument SUBTREEP to export current subtree. +Optional argument VISIBLE-ONLY to only export visible content. +Optional argument BODY-ONLY export only the body. +Optional argument INFO is a plist of options." + (with-current-buffer (ox-ipynb-export-to-ipynb-buffer async subtreep visible-only body-only info) + (let* ((efn export-file-name) + (buf (find-file-noselect efn) )) + (write-file efn) + (with-current-buffer buf + (setq-local export-file-name efn)) + (kill-buffer buf) + efn))) + + +(defun ox-ipynb-export-to-ipynb-file-and-open (&optional async subtreep visible-only body-only info) + "Export current buffer to a file and open it. +Optional argument ASYNC to asynchronously export. +Optional argument SUBTREEP to export current subtree. +Optional argument VISIBLE-ONLY to only export visible content. +Optional argument BODY-ONLY export only the body. +Optional argument INFO is a plist of options." + (let* ((async-shell-command-buffer 'confirm-kill-buffer) + (fname (expand-file-name + (ox-ipynb-export-to-ipynb-file async subtreep visible-only body-only info)))) + ;; close the .ipynb buffer. + (kill-buffer (find-file-noselect fname)) + (async-shell-command + (format "jupyter notebook \"%s\"" fname)))) + + +(defun ox-ipynb-export-to-ipynb-slides-and-open (&optional async subtreep visible-only body-only info) + "Export current buffer to a slide show and open it. +Optional argument ASYNC to asynchronously export. +Optional argument SUBTREEP to export current subtree. +Optional argument VISIBLE-ONLY to only export visible content. +Optional argument BODY-ONLY export only the body. +Optional argument INFO is a plist of options." + (let* ((async-shell-command-buffer 'confirm-kill-buffer) + (fname (expand-file-name + (ox-ipynb-export-to-ipynb-file async subtreep visible-only body-only info)))) + ;; close the .ipynb buffer. + (kill-buffer (find-file-noselect fname)) + (async-shell-command + (format "jupyter nbconvert \"%s\" --to slides --post serve" fname)))) + + +(defun ox-ipynb-export-to-ipynb-no-results-file-and-open (&optional async subtreep visible-only body-only info) + "Export current buffer to a file and open it. Strip results first. +Optional argument ASYNC to asynchronously export. +Optional argument SUBTREEP to export current subtree. +Optional argument VISIBLE-ONLY to only export visible content. +Optional argument BODY-ONLY export only the body. +Optional argument INFO is a plist of options." + (let ((ox-ipynb-preprocess-hook '((lambda () + (org-babel-map-src-blocks nil + (org-babel-remove-result)))))) + (ox-ipynb-export-to-ipynb-file-and-open))) + + +(defun ox-ipynb-export-org-file-to-ipynb-file (file) + "Export FILE with `ox-ipynb-export-to-ipynb-file'. +Works interactively: M-x ox-ipynb-export-org-file-to-ipynb-file RET +Works non-interactively: (ox-ipynb-export-org-file-to-ipynb-file \"test.org\") +Works in Dired+ by marking some *.org files and pressing \"@\" ox-ipynb-export-org-file-to-ipynb-file RET +Based on the `org-babel-tangle-file' function that is to be +found in the ob-tangle.el file." + (interactive "fOrg file to export as ipynb: ") + (let ((visited-p (find-buffer-visiting (expand-file-name file))) + to-be-removed) + (prog1 + (save-window-excursion + (find-file file) + (setq to-be-removed (current-buffer)) + (ox-ipynb-export-to-ipynb-file) ) + (unless visited-p + (kill-buffer to-be-removed))))) + + +(defun ox-ipynb-export-to-participant-notebook (&optional async subtreep visible-only body-only info) + "Export current buffer to a participant file and open it. +Removes SOLUTION and HIDDEN regions. +Optional argument ASYNC to asynchronously export. +Optional argument SUBTREEP to export current subtree. +Optional argument VISIBLE-ONLY to only export visible content. +Optional argument BODY-ONLY export only the body. +Optional argument INFO is a plist of options." + (let ((ox-ipynb-preprocess-hook (append ox-ipynb-preprocess-hook '(ox-ipynb-remove-hidden + ox-ipynb-remove-solution + ox-ipynb-remove-remove)))) + (ox-ipynb-export-to-ipynb-file-and-open))) + + +(org-export-define-derived-backend 'jupyter-notebook 'org + :menu-entry + '(?n "Export to jupyter notebook" + ((?b "to buffer" ox-ipynb-export-to-ipynb-buffer) + (?n "to notebook" ox-ipynb-export-to-ipynb-file) + (?o "to notebook and open" ox-ipynb-export-to-ipynb-file-and-open) + (?p "to participant nb & open" ox-ipynb-export-to-participant-notebook) + (?r "to nb (no results) and open" ox-ipynb-export-to-ipynb-no-results-file-and-open) + (?s "to slides and open" ox-ipynb-export-to-ipynb-slides-and-open)))) + + +(defun ox-ipynb-publish-to-notebook (plist filename pub-dir) + "Publish an org-file to a Jupyter notebook." + (with-current-buffer (find-file-noselect filename) + (let ((output (ox-ipynb-export-to-ipynb-file))) + (org-publish-attachment plist (expand-file-name output) pub-dir) + output))) + +(provide 'ox-ipynb) + +;;; ox-ipynb.el ends here diff --git a/lisp/request/request-pkg.el b/lisp/request/request-pkg.el new file mode 100644 index 00000000..de7133d3 --- /dev/null +++ b/lisp/request/request-pkg.el @@ -0,0 +1,12 @@ +(define-package "request" "20230127.417" "Compatible layer for URL request" + '((emacs "24.4")) + :commit "01e338c335c07e4407239619e57361944a82cb8a" :authors + '(("Takafumi Arakaki ")) + :maintainers + '(("Takafumi Arakaki ")) + :maintainer + '("Takafumi Arakaki ") + :url "https://github.com/tkf/emacs-request") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/lisp/request/request.el b/lisp/request/request.el new file mode 100644 index 00000000..e70884c1 --- /dev/null +++ b/lisp/request/request.el @@ -0,0 +1,1234 @@ +;;; request.el --- Compatible layer for URL request -*- lexical-binding: t; -*- + +;; Copyright (C) 2012 Takafumi Arakaki +;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012 +;; Free Software Foundation, Inc. + +;; Author: Takafumi Arakaki +;; URL: https://github.com/tkf/emacs-request +;; Package-Requires: ((emacs "24.4")) +;; Version: 0.3.3 + +;; This file is NOT part of GNU Emacs. + +;; request.el 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 of the License, or +;; (at your option) any later version. + +;; request.el 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 request.el. +;; If not, see . + +;;; Commentary: + +;; Uses ``curl`` as its backend or Emacs's native ``url.el`` library if +;; ``curl`` is not found. +;; +;; The default encoding for requests is ``utf-8``. Please explicitly specify +;; ``:encoding 'binary`` for binary data. + +;;; Code: + +(eval-when-compile + (defvar url-http-method) + (defvar url-http-response-status)) + +(require 'cl-lib) +(require 'url) +(require 'mail-utils) +(require 'auth-source) +(require 'mailheader) + +(defgroup request nil + "Compatible layer for URL request in Emacs." + :group 'comm + :prefix "request-") + +(defconst request-version "0.3.3") + +(defcustom request-storage-directory + (concat (file-name-as-directory user-emacs-directory) "request") + "Directory to store data related to request.el." + :type 'directory) + +(defcustom request-curl "curl" + "Executable for curl command." + :type 'string) + +(defcustom request-curl-options nil + "List of curl command options. + +List of strings that will be passed to every curl invocation. +You can pass extra options here, like setting the proxy." + :type '(repeat string)) + +(defcustom request-backend (if (executable-find request-curl) + 'curl + 'url-retrieve) + "Backend to be used for HTTP request. +Automatically set to `curl' if curl command is found." + :type '(choice (const :tag "cURL backend" curl) + (const :tag "url-retrieve backend" url-retrieve))) + +(defcustom request-timeout nil + "Default request timeout in second. +nil means no timeout." + :type '(choice (integer :tag "Request timeout seconds") + (boolean :tag "No timeout" nil))) + +(make-obsolete-variable 'request-temp-prefix nil "0.3.3") + +(defcustom request-log-level -1 + "Logging level for request. +One of `error'/`warn'/`info'/`verbose'/`debug'/`trace'/`blather'. +-1 means no logging." + :type '(choice (integer :tag "No logging" -1) + (const :tag "Level error" error) + (const :tag "Level warn" warn) + (const :tag "Level info" info) + (const :tag "Level Verbose" verbose) + (const :tag "Level DEBUG" debug) + (const :tag "Level TRACE" trace) + (const :tag "Level BLATHER" blather))) + +(defcustom request-message-level 'warn + "Logging level for request. +See `request-log-level'." + :type '(choice (integer :tag "No logging" -1) + (const :tag "Level error" error) + (const :tag "Level warn" warn) + (const :tag "Level info" info) + (const :tag "Level Verbose" verbose) + (const :tag "Level DEBUG" debug) + (const :tag "Level TRACE" trace) + (const :tag "Level BLATHER" blather))) + +(defmacro request--document-function (function docstring) + "Document FUNCTION with DOCSTRING. Use this for defstruct accessor etc." + (declare (indent defun) + (doc-string 2)) + `(put ',function 'function-documentation ,docstring)) + +(defconst request--log-level-def + '(;; debugging + (blather . 60) (trace . 50) (debug . 40) + ;; information + (verbose . 30) (info . 20) + ;; errors + (warn . 10) (error . 0)) + "Named logging levels.") + +(defvar request-log-buffer-name " *request-log*") + +(defmacro request-log (level fmt &rest args) + "Main logging function at warning LEVEL in FMT with ARGS." + (declare (indent 1)) + `(cl-flet ((log-level-as-int + (level) + (if (integerp level) + level + (or (cdr (assq level request--log-level-def)) 0)))) + (let ((level (log-level-as-int ,level)) + (log-level (log-level-as-int request-log-level)) + (msg-level (log-level-as-int request-message-level))) + (when (<= level (max log-level msg-level)) + (let ((msg (format "[%s] %s" ,level (format ,fmt ,@args)))) + (when (<= level log-level) + (with-current-buffer (get-buffer-create request-log-buffer-name) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (insert msg "\n")))) + (when (<= level msg-level) + (message "%s" msg))))))) + +(defconst request--url-unreserved-chars + '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z + ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z + ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 + ?- ?_ ?. ?~) + "`url-unreserved-chars' copied from Emacs 24.3 release candidate. +This is used for making `request--urlencode-alist' RFC 3986 compliant +for older Emacs versions.") + +(defun request--urlencode-alist (alist) + "Hexify ALIST fields according to RFC3986." + (let ((url-unreserved-chars request--url-unreserved-chars)) + (cl-loop for sep = "" then "&" + for (k . v) in alist + concat sep + concat (url-hexify-string (format "%s" k)) + concat "=" + concat (url-hexify-string (format "%s" v))))) + + +(defun request--parse-response-at-point () + "Parse the first header line such as \"HTTP/1.1 200 OK\"." + (when (re-search-forward "\\=[ \t\n]*HTTP/\\([0-9\\.]+\\) +\\([0-9]+\\)" nil t) + (list :version (match-string 1) + :code (string-to-number (match-string 2))))) + +(defun request--goto-next-body (&optional noerror) + "Scan forward to next blank line allowing NOERROR if missing." + (re-search-forward "^\r\n" nil noerror)) + +(cl-defstruct request-response + "A structure holding all relevant information of a request." + status-code history data error-thrown symbol-status url + done-p settings + ;; internal variables + -buffer -raw-header -timer -backend) + +(defmacro request--document-response (function docstring) + "Append to FUNCTION's DOCSTRING some more canned verbiage." + (declare (indent defun) (doc-string 2)) + `(request--document-function ,function ,(concat docstring " + +.. This is an accessor for `request-response' object. + +\(fn RESPONSE)"))) + +(request--document-response request-response-status-code + "Integer HTTP response code (e.g., 200).") + +(request--document-response request-response-history + "Redirection history (a list of response object). +The first element is the oldest redirection. + +You can use restricted portion of functions for the response +objects in the history slot. It also depends on backend. Here +is the table showing what functions you can use for the response +objects in the history slot. + +==================================== ============== ============== +Slots Backends +------------------------------------ ----------------------------- +\\ curl url-retrieve +==================================== ============== ============== +request-response-url yes yes +request-response-header yes no +other functions no no +==================================== ============== ==============") + +(request--document-response request-response-data + "Response parsed by the given parser.") + +(request--document-response request-response-error-thrown + "Error thrown during request. +It takes the form of ``(ERROR-SYMBOL . DATA)``, which can be +re-raised (`signal'ed) by ``(signal ERROR-SYMBOL DATA)``.") + +(request--document-response request-response-symbol-status + "A symbol representing the status of request (not HTTP response code). +One of success/error/timeout/abort/parse-error.") + +(request--document-response request-response-url + "Final URL location of response.") + +(request--document-response request-response-done-p + "Return t when the request is finished or aborted.") + +(request--document-response request-response-settings + "Keyword arguments passed to `request' function. +Some arguments such as HEADERS is changed to the one actually +passed to the backend. Also, it has additional keywords such +as URL which is the requested URL.") + +;;;###autoload +(defun request-response-header (response field-name) + "Fetch the values of RESPONSE header field named FIELD-NAME. + +It returns comma separated values when the header has multiple +field with the same name, as :RFC:`2616` specifies. + +Examples:: + + (request-response-header response + \"content-type\") ; => \"text/html; charset=utf-8\" + (request-response-header response + \"unknown-field\") ; => nil" + (let ((raw-header (request-response--raw-header response))) + (when raw-header + (with-temp-buffer + (erase-buffer) + (insert raw-header) + ;; ALL=t to fetch all fields with the same name to get comma + ;; separated value [#rfc2616-sec4]_. + (mail-fetch-field field-name nil t))))) +;; .. [#rfc2616-sec4] RFC2616 says this is the right thing to do +;; (see https://tools.ietf.org/html/rfc2616.html#section-4.2). +;; Python's requests module does this too. + +;;;###autoload +(defun request-response-headers (response) + "Return RESPONSE headers as an alist. +I would have chosen a function name that wasn't so suggestive that +`headers` is a member of the `request-response` struct, but +as there's already precedent with `request-response-header', I +hew to consistency." + (let ((raw-header (request-response--raw-header response))) + (when raw-header + (with-temp-buffer + (save-excursion (insert raw-header)) + (when (save-excursion (request--parse-response-at-point)) + (forward-line)) + (mail-header-extract-no-properties))))) + +(defconst request--backend-alist + '((url-retrieve + . ((request . request--url-retrieve) + (request-sync . request--url-retrieve-sync) + (terminate-process . delete-process) + (get-cookies . request--url-retrieve-get-cookies))) + (curl + . ((request . request--curl) + (request-sync . request--curl-sync) + (terminate-process . interrupt-process) + (get-cookies . request--curl-get-cookies)))) + "Map backend and method name to actual method (symbol). + +It's alist of alist, of the following form:: + + ((BACKEND . ((METHOD . FUNCTION) ...)) ...) + +It would be nicer if I can use EIEIO. But as CEDET is included +in Emacs by 23.2, using EIEIO means abandon older Emacs versions. +It is probably necessary if I need to support more backends. But +let's stick to manual dispatch for now.") +;; See: (view-emacs-news "23.2") + +(defun request--choose-backend (method) + "Return `fucall'able object for METHOD of current `request-backend'." + (assoc-default + method + (or (assoc-default request-backend request--backend-alist) + (error "%S is not valid `request-backend'" request-backend)))) + + +(defun request-cookie-string (host &optional localpart secure) + "Lookup HOST LOCALPART SECURE in cookie jar as`document.cookie` string. +Example:: + + (request-cookie-string \"127.0.0.1\" \"/\") ; => \"key=value; key2=value2\"" + (mapconcat (lambda (nv) (concat (car nv) "=" (cdr nv))) + (request-cookie-alist host localpart secure) + "; ")) + +(defun request-cookie-alist (host &optional localpart secure) + "Lookup HOST LOCALPART SECURE in cookie jar as alist. + +Example:: + + (request-cookie-alist \"127.0.0.1\" \"/\") ; => ((\"key\" . \"value\") ...)" + (funcall (request--choose-backend 'get-cookies) host localpart secure)) + +;;;###autoload +(cl-defun request (url &rest settings + &key + (params nil) + (data nil) + (headers nil) + (encoding 'utf-8) + (error nil) + (sync nil) + (response (make-request-response)) + &allow-other-keys) + "Main entry requesting URL with property list SETTINGS as follow. + +==================== ======================================================== +Keyword argument Explanation +==================== ======================================================== +TYPE (string) type of request to make: POST/GET/PUT/DELETE +PARAMS (alist) set \"?key=val\" part in URL +DATA (string/alist) data to be sent to the server +FILES (alist) files to be sent to the server (see below) +PARSER (symbol) a function that reads current buffer and return data +HEADERS (alist) additional headers to send with the request +ENCODING (symbol) encoding for request body (utf-8 by default) +SUCCESS (function) called on success +ERROR (function) called on error +COMPLETE (function) called on both success and error +TIMEOUT (number) timeout in second +STATUS-CODE (alist) map status code (int) to callback +SYNC (bool) If non-nil, wait until request is done. Default is nil. +==================== ======================================================== + + +* Callback functions + +Callback functions STATUS, ERROR, COMPLETE and `cdr\\='s in element of +the alist STATUS-CODE take same keyword arguments listed below. For +forward compatibility, these functions must ignore unused keyword +arguments (i.e., it\\='s better to use `&allow-other-keys\\=' [#]_).:: + + (CALLBACK ; SUCCESS/ERROR/COMPLETE/STATUS-CODE + :data data ; whatever PARSER function returns, or nil + :error-thrown error-thrown ; (ERROR-SYMBOL . DATA), or nil + :symbol-status symbol-status ; success/error/timeout/abort/parse-error + :response response ; request-response object + ...) + +.. [#] `&allow-other-keys\\=' is a special \"markers\" available in macros + in the CL library for function definition such as `cl-defun\\=' and + `cl-function\\='. Without this marker, you need to specify all arguments + to be passed. This becomes problem when request.el adds new arguments + when calling callback functions. If you use `&allow-other-keys\\=' + (or manually ignore other arguments), your code is free from this + problem. See info node `(cl) Argument Lists\\=' for more information. + +Arguments data, error-thrown, symbol-status can be accessed by +`request-response-data\\=', `request-response-error-thrown\\=', +`request-response-symbol-status\\=' accessors, i.e.:: + + (request-response-data RESPONSE) ; same as data + +Response object holds other information which can be accessed by +the following accessors: +`request-response-status-code\\=', +`request-response-url\\=' and +`request-response-settings\\=' + +* STATUS-CODE callback + +STATUS-CODE is an alist of the following format:: + + ((N-1 . CALLBACK-1) + (N-2 . CALLBACK-2) + ...) + +Here, N-1, N-2,... are integer status codes such as 200. + + +* FILES + +FILES is an alist of the following format:: + + ((NAME-1 . FILE-1) + (NAME-2 . FILE-2) + ...) + +where FILE-N is a list of the form:: + + (FILENAME &key PATH BUFFER STRING MIME-TYPE) + +FILE-N can also be a string (path to the file) or a buffer object. +In that case, FILENAME is set to the file name or buffer name. + +Example FILES argument:: + + `((\"passwd\" . \"/etc/passwd\") ; filename = passwd + (\"scratch\" . ,(get-buffer \"*scratch*\")) ; filename = *scratch* + (\"passwd2\" . (\"password.txt\" :file \"/etc/passwd\")) + (\"scratch2\" . (\"scratch.txt\" :buffer ,(get-buffer \"*scratch*\"))) + (\"data\" . (\"data.csv\" :data \"1,2,3\\n4,5,6\\n\"))) + +.. note:: FILES is implemented only for curl backend for now. + As furl.el_ supports multipart POST, it should be possible to + support FILES in pure elisp by making furl.el_ another backend. + Contributions are welcome. + + .. _furl.el: https://code.google.com/p/furl-el/ + + +* PARSER function + +PARSER function takes no argument and it is executed in the +buffer with HTTP response body. The current position in the HTTP +response buffer is at the beginning of the buffer. As the HTTP +header is stripped off, the cursor is actually at the beginning +of the response body. So, for example, you can pass `json-read\\=' +to parse JSON object in the buffer. To fetch whole response as a +string, pass `buffer-string\\='. + +When using `json-read\\=', it is useful to know that the returned +type can be modified by `json-object-type\\=', `json-array-type\\=', +`json-key-type\\=', `json-false\\=' and `json-null\\='. See docstring of +each function for what it does. For example, to convert JSON +objects to plist instead of alist, wrap `json-read\\=' by `lambda\\=' +like this.:: + + (request + \"https://...\" + :parser (lambda () + (let ((json-object-type \\='plist)) + (json-read))) + ...) + +This is analogous to the `dataType\\=' argument of jQuery.ajax_. +Only this function can access to the process buffer, which +is killed immediately after the execution of this function. + +* SYNC + +Synchronous request is functional, but *please* don\\='t use it +other than testing or debugging. Emacs users have better things +to do rather than waiting for HTTP request. If you want a better +way to write callback chains, use `request-deferred\\='. + +If you can\\='t avoid using it (e.g., you are inside of some hook +which must return some value), make sure to set TIMEOUT to +relatively small value. + +Due to limitation of `url-retrieve-synchronously\\=', response slots +`request-response-error-thrown\\=', `request-response-history\\=' and +`request-response-url\\=' are unknown (always nil) when using +synchronous request with `url-retrieve\\=' backend. + +* Note + +API of `request\\=' is somewhat mixture of jQuery.ajax_ (Javascript) +and requests.request_ (Python). + +.. _jQuery.ajax: https://api.jquery.com/jQuery.ajax/ +.. _requests.request: https://docs.python-requests.org" + (declare (indent defun)) + ;; FIXME: support CACHE argument (if possible) + ;; (unless cache + ;; (setq url (request--url-no-cache url))) + (unless error + (setq error (cl-function + (lambda (&rest args &key symbol-status &allow-other-keys) + (request-log 'error + "request-default-error-callback: %s %s" + url symbol-status)))) + (setq settings (plist-put settings :error error))) + (when (and (consp data) + (not (assoc-string "Content-Type" headers t))) + (setq data (request--urlencode-alist data)) + (setq settings (plist-put settings :data data))) + (when params + (cl-assert (listp params) nil "PARAMS must be an alist. Given: %S" params) + (setq url (concat url (if (string-match-p "\\?" url) "&" "?") + (request--urlencode-alist params)))) + (setq settings (plist-put settings :url url)) + (setq settings (plist-put settings :response response)) + (setq settings (plist-put settings :encoding encoding)) + (setf (request-response-settings response) settings) + (setf (request-response-url response) url) + (setf (request-response--backend response) request-backend) + ;; Call `request--url-retrieve'(`-sync') or `request--curl'(`-sync'). + (apply (if sync + (request--choose-backend 'request-sync) + (request--choose-backend 'request)) + url settings) + response) + +(defun request--clean-header (response) + "Strip off carriage return in the header of RESPONSE." + (let* ((buffer (request-response--buffer response)) + (backend (request-response--backend response)) + ;; FIXME: a workaround when `url-http-clean-headers' fails... + (sep-regexp (if (eq backend 'url-retrieve) "^\r?$" "^\r$"))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (goto-char (point-min)) + (when (and (re-search-forward sep-regexp nil t) + (not (equal (match-string 0) ""))) + (request-log 'trace "request--clean-header: cleaning\n%s" + (buffer-substring (save-excursion + (forward-line -1) + (line-beginning-position)) + (save-excursion + (forward-line 1) + (line-end-position)))) + (while (re-search-backward "\r$" (point-min) t) + (replace-match ""))))))) + +(defun request--cut-header (response) + "Move the header to the raw-header slot of RESPONSE object." + (let ((buffer (request-response--buffer response))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (goto-char (point-min)) + (when (re-search-forward "^$" nil t) + (setf (request-response--raw-header response) + (buffer-substring (point-min) (point))) + (request-log 'trace "request--cut-header: cutting\n%s" + (buffer-substring (point-min) (min (1+ (point)) (point-max)))) + (delete-region (point-min) (min (1+ (point)) (point-max)))))))) + +;;;###autoload +(defun request-untrampify-filename (file) + "Return FILE as the local file name." + (or (file-remote-p file 'localname) file)) + +(defun request--parse-data (response encoding parser) + "In RESPONSE buffer, decode via ENCODING, then send to PARSER." + (let ((buffer (request-response--buffer response))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (request-log 'trace "request--parse-data: %s" (buffer-string)) + (unless (eq (request-response-status-code response) 204) + (recode-region (point-min) (point-max) encoding 'no-conversion) + (goto-char (point-min)) + (setf (request-response-data response) + (if parser (funcall parser) (buffer-string)))))))) + +(defsubst request-url-file-p (url) + "Return non-nil if URL looks like a file URL." + (let ((scheme (and (stringp url) (url-type (url-generic-parse-url url))))) + (and (stringp scheme) + (not (string-match-p "^http" scheme))))) + +(cl-defun request--callback (buffer + &key + parser success error complete + status-code response + encoding + &allow-other-keys) + "Parse BUFFER according to PARSER. +Delegate to callbacks SUCCESS, ERROR, and COMPLETE the STATUS-CODE of +RESPONSE via ENCODING." + (when (buffer-live-p buffer) + ;; questionable whether BUFFER should override RESPONSE. + (setf (request-response--buffer response) buffer)) + (request-log 'debug "request--callback: UNPARSED\n%s" + (when (buffer-live-p (request-response--buffer response)) + (with-current-buffer (request-response--buffer response) + (buffer-string)))) + (cl-symbol-macrolet ((timer (request-response--timer response))) + (when timer + (cancel-timer timer) + (setq timer nil))) + (cl-symbol-macrolet + ((error-thrown (request-response-error-thrown response)) + (symbol-status (request-response-symbol-status response)) + (data (request-response-data response)) + (done-p (request-response-done-p response))) + (let* ((response-url (request-response-url response)) + (curl-file-p (and (eq (request-response--backend response) 'curl) + (request-url-file-p response-url)))) + (unless curl-file-p + (request--clean-header response) + (request--cut-header response))) + + ;; Parse response even if `error-thrown' is set, e.g., timeout + (condition-case err + (request--parse-data response encoding parser) + (error (unless error-thrown (setq error-thrown err)) + (unless symbol-status (setq symbol-status 'parse-error)))) + (kill-buffer (request-response--buffer response)) + + ;; Ensuring `symbol-status' and `error-thrown' are consistent + ;; is why we should get rid of `symbol-status' + ;; (but downstream apps might ill-advisedly rely on it). + (if error-thrown + (progn + (request-log 'error "request--callback: %s" + (error-message-string error-thrown)) + (unless symbol-status (setq symbol-status 'error))) + (unless symbol-status (setq symbol-status 'success)) + (request-log 'debug "request--callback: PARSED\n%s" data)) + + (let ((args (list :data data + :symbol-status symbol-status + :error-thrown error-thrown + :response response))) + (let* ((success-p (eq symbol-status 'success)) + (cb (if success-p success error)) + (name (if success-p "success" "error"))) + (when cb + (request-log 'debug "request--callback: executing %s" name) + (apply cb args))) + (let ((cb (cdr (assq (request-response-status-code response) + status-code)))) + (when cb + (request-log 'debug "request--callback: executing status-code") + (apply cb args))) + (when complete + (request-log 'debug "request--callback: executing complete") + (apply complete args))) + + (setq done-p t))) + +(cl-defun request-response--timeout-callback (response) + "If RESPONSE times out, ensure `request--callback' gets called." + (setf (request-response-symbol-status response) 'timeout) + (setf (request-response-error-thrown response) '(error . ("Timeout"))) + (let* ((buffer (request-response--buffer response)) + (proc (and (buffer-live-p buffer) (get-buffer-process buffer)))) + (if proc + ;; This implicitly calls `request--callback'! + (funcall (request--choose-backend 'terminate-process) proc) + (cl-symbol-macrolet ((done-p (request-response-done-p response))) + (unless done-p + (when (buffer-live-p buffer) + (cl-destructuring-bind (&key code &allow-other-keys) + (with-current-buffer buffer + (goto-char (point-min)) + (request--parse-response-at-point)) + (setf (request-response-status-code response) code))) + (apply #'request--callback + buffer + (request-response-settings response)) + (setq done-p t)))))) + +;;;###autoload +(defun request-abort (response) + "Abort request for RESPONSE (the object returned by `request'). +Note that this function invoke ERROR and COMPLETE callbacks. +Callbacks may not be called immediately but called later when +associated process is exited." + (cl-symbol-macrolet ((buffer (request-response--buffer response)) + (symbol-status (request-response-symbol-status response)) + (done-p (request-response-done-p response))) + (let ((process (get-buffer-process buffer))) + (unless symbol-status ; should I use done-p here? + (setq symbol-status 'abort) + (setq done-p t) + (when (process-live-p process) + (funcall (request--choose-backend 'terminate-process) process)))))) + + +(cl-defun request--url-retrieve-preprocess-settings + (&rest settings &key type data files headers &allow-other-keys) + "Augment SETTINGS with properties TYPE DATA FILES HEADERS." + (when files + (error "`url-retrieve' backend does not support FILES")) + (when (and (equal type "POST") + data + (not (assoc-string "Content-Type" headers t))) + (push '("Content-Type" . "application/x-www-form-urlencoded") headers) + (setq settings (plist-put settings :headers headers))) + settings) + +(cl-defun request--url-retrieve (url &rest settings + &key type data timeout response + &allow-other-keys + &aux headers) + "Internal workhorse querying URL via curl. +SETTINGS is a property list with keys (some optional) such as GET or POST TYPE, +DATA for posting fields, TIMEOUT in seconds, RESPONSE a mandatory struct. +HEADERS needs to be assigned after SETTINGS is preprocessed." + (setq settings (apply #'request--url-retrieve-preprocess-settings settings)) + (setq headers (plist-get settings :headers)) + (let* ((url-request-extra-headers headers) + (url-request-method type) + (url-request-data data) + (buffer (url-retrieve url #'request--url-retrieve-callback + (nconc (list :response response) settings) t)) + (proc (get-buffer-process buffer))) + (request--install-timeout timeout response) + (setf (request-response--buffer response) buffer) + (process-put proc :request-response response) + (set-process-query-on-exit-flag proc nil))) + +(cl-defun request--url-retrieve-callback (status &rest settings + &key response url + &allow-other-keys) + "Ensure `request--callback' gets called for STATUS. +SETTINGS should include RESPONSE and URL properties which +inform any necessary redirect or history recording logic." + (when (featurep 'url-http) + (setf (request-response-status-code response) url-http-response-status)) + (let ((redirect (plist-get status :redirect))) + (when redirect + (setf (request-response-url response) redirect))) + ;; Construct history slot + (cl-loop for v in + (cl-loop with first = t + with l = nil + for (k v) on status by 'cddr + when (eq k :redirect) + if first + do (setq first nil) + else + do (push v l) + finally do (cons url l)) + do (let ((r (make-request-response :-backend 'url-retrieve))) + (setf (request-response-url r) v) + (push r (request-response-history response)))) + (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response)) + (status-error (plist-get status :error))) + (when status-error + (request-log 'warn "request--url-retrieve-callback: %s" status-error) + (unless error-thrown + (setq error-thrown status-error)))) + (apply #'request--callback (current-buffer) settings)) + +(cl-defun request--url-retrieve-sync (url &rest settings + &key type data timeout response + &allow-other-keys + &aux headers) + "Internal synchronous retrieve of URL. +SETTINGS include typical TYPE DATA TIMEOUT RESPONSE properties. +HEADERS needs to be assigned after SETTINGS is preprocessed." + (setq settings (apply #'request--url-retrieve-preprocess-settings settings)) + (setq headers (plist-get settings :headers)) + (let* ((url-request-extra-headers headers) + (url-request-method type) + (url-request-data data) + (buffer (if timeout + (with-timeout + (timeout + (setf (request-response-symbol-status response) + 'timeout) + (setf (request-response-done-p response) t) + nil) + (url-retrieve-synchronously url t)) + (url-retrieve-synchronously url t)))) + (setf (request-response--buffer response) buffer) + ;; It seems there is no way to get redirects and URL here... + (when buffer + ;; Fetch HTTP response code + (with-current-buffer buffer + (goto-char (point-min)) + (cl-destructuring-bind (&key code &allow-other-keys) + (request--parse-response-at-point) + (setf (request-response-status-code response) code))) + ;; Parse response body, etc. + (apply #'request--callback buffer settings))) + response) + +(defun request--url-retrieve-get-cookies (host localpart secure) + "Retrieve cookies corresponding to HOST LOCALPART SECURE." + (mapcar + (lambda (c) (cons (url-cookie-name c) (url-cookie-value c))) + (url-cookie-retrieve host localpart secure))) + +(defvar request--curl-cookie-jar nil + "Override what the function `request--curl-cookie-jar' returns. +Currently it is used only for testing.") + +(defun request--curl-cookie-jar () + "Cookie storage for curl backend." + (or request--curl-cookie-jar + (expand-file-name "curl-cookie-jar" request-storage-directory))) + +(defvar request--curl-capabilities-cache + (make-hash-table :test 'eq :weakness 'key) + "Used to avoid invoking curl more than once for version info. By skeeto/elfeed.") + +(defun request--curl-capabilities () + "Return capabilities plist for curl. By skeeto/elfeed. +:version -- cURL's version string +:compression -- non-nil if --compressed is supported." + (let ((cache-value (gethash request-curl request--curl-capabilities-cache))) + (if cache-value + cache-value + (with-temp-buffer + (call-process request-curl nil t nil "--version") + (let ((version + (progn + (goto-char (point-min)) + (when (re-search-forward "[.0-9]+" nil t) + (match-string 0)))) + (compression + (progn + (goto-char (point-min)) + (not (null (re-search-forward "libz\\>" nil t)))))) + (setf (gethash request-curl request--curl-capabilities-cache) + `(:version ,version :compression ,compression))))))) + +(defconst request--curl-write-out-template + (if (eq system-type 'windows-nt) + "\\n(:num-redirects %{num_redirects} :url-effective %{url_effective})" + "\\n(:num-redirects %{num_redirects} :url-effective \"%{url_effective}\")")) + +(defun request--curl-stdin-config (&rest args) + "Split ARGS such that we \"Only write one option per physical line\". +Fragile. Some escaping will be necessary for special characters +in user `request-curl-options'." + (let (result) + (dolist (arg args (mapconcat #'identity (reverse (cons "" result)) "\n")) + (if (or (not result) + (string-prefix-p "-" arg)) + (push arg result) + (setcar result (format "%s %s" (car result) + (if (cl-search " " arg) + (format "\"%s\"" + (replace-regexp-in-string + "\"" + (regexp-quote "\\\"") arg)) + arg))))))) + +(defun request--curl-command () + "Stub for test-request.el to override." + (list request-curl "--config" "-")) + +(cl-defun request--curl-command-args + (url &key type data headers files unix-socket auth + &allow-other-keys + &aux (cookie-jar (convert-standard-filename + (expand-file-name (request--curl-cookie-jar))))) + "Internal command cobbler for curl to URL. +TYPE, DATA, HEADERS, FILES, UNIX-SOCKET, AUTH are as described in `request'. +COOKIE-JAR is the file location for the netscape cookie jar, usually +in the request subdirectory of `user-emacs-directory'. + +BUG: Simultaneous requests are a known cause of cookie-jar corruption." + (append + (list "--silent" "--location" + "--cookie" cookie-jar "--cookie-jar" cookie-jar) + (when auth + (let* ((host (url-host (url-generic-parse-url url))) + (auth-source-creation-prompts `((user . ,(format "%s user: " host)) + (secret . "Password for %u: "))) + (cred (car (auth-source-search + :host host :require '(:user :secret) :create t :max 1)))) + (split-string (format "--%s --user %s:%s" + auth + (plist-get cred :user) + (let ((secret (plist-get cred :secret))) + (if (functionp secret) + (funcall secret) + secret)))))) + (unless (request-url-file-p url) + (list "--include" "--write-out" request--curl-write-out-template)) + request-curl-options + (when (plist-get (request--curl-capabilities) :compression) (list "--compressed")) + (when unix-socket (list "--unix-socket" unix-socket)) + (when type (if (equal "head" (downcase type)) + (list "--head") + (list "--request" type))) + (cl-loop for (k . v) in headers + collect "--header" + collect (format "%s: %s" k v)) + (list "--url" url) + (when data + (split-string "--data-binary @-")) + (cl-loop with stdin-p = data + for (name . item) in files + collect "--form" + collect + (apply #'format "%s=%s%s;filename=%s%s" + (cond ((stringp item) + (list name "@" item (file-name-nondirectory item) "")) + ((bufferp item) + (if stdin-p + (error (concat "request--curl-command-args: " + "only one buffer or data entry permitted")) + (setq stdin-p t)) + (list name "@" "-" (buffer-name item) "")) + ((listp item) + (unless (plist-get (cdr item) :file) + (if stdin-p + (error (concat "request--curl-command-args: " + "only one buffer or data entry permitted")) + (setq stdin-p t))) + (list name + (if (plist-get (cdr item) :use-contents) "<" "@") + (or (plist-get (cdr item) :file) "-") + (car item) + (if (plist-get (cdr item) :mime-type) + (format ";type=%s" (plist-get (cdr item) :mime-type)) + ""))) + (t (error (concat "request--curl-command-args: " + "%S not string, buffer, or list") + item))))))) + +(defun request--install-timeout (timeout response) + "Out-of-band trigger after TIMEOUT seconds to forestall a hung RESPONSE." + (when (numberp timeout) + (setf (request-response--timer response) + (run-at-time timeout nil + #'request-response--timeout-callback response)))) + +(defun request--curl-occlude-secret (command) + "Simple regex filter on anything looking like a secret in COMMAND." + (let ((matched + (string-match (concat (regexp-quote "--user") "\\s-*\\(\\S-+\\)") command))) + (if matched + (replace-match "elided" nil nil command 1) + command))) + +(cl-defun request--curl (url &rest settings + &key data files timeout response encoding semaphore + &allow-other-keys) + "Internal workhorse querying URL via curl. + +SETTINGS is a property list with keys (some optional) such as DATA for +posting fields, FILES containing one or more lists of the form + (NAME . FILENAME) + (NAME . BUFFER) + (NAME . (FILENAME :buffer BUFFER)) + (NAME . (FILENAME :data DATA)) + (NAME . (FILENAME :file FILE :use-contents t)) +with NAME and FILENAME defined by curl(1)'s overwrought `--form` switch format, +TIMEOUT in seconds, RESPONSE a mandatory struct, ENCODING, and SEMAPHORE, +an internal semaphore. Adding `:use-contents t` sends a text field +with the file's contents as opposed to attaching a file as described +in curl(1). + +Redirection handling strategy +----------------------------- + +curl follows redirection when --location is given. However, +all headers are printed when it is used with --include option. +Number of redirects is printed out sexp-based message using +--write-out option (see `request--curl-write-out-template'). +This number is used for removing extra headers and parse +location header from the last redirection header. + +Sexp at the end of buffer and extra headers for redirects are +removed from the buffer before it is shown to the parser function." + (ignore-errors + (make-directory (file-name-directory (request--curl-cookie-jar)) t)) + (let* (process-connection-type ;; pipe, not pty, else curl hangs + (home-directory (or (file-remote-p default-directory) "~/")) + (default-directory (expand-file-name home-directory)) + (buffer (generate-new-buffer " *request curl*")) + (file-items (mapcar #'cdr files)) + (file-buffer (or (cl-some (lambda (item) + (when (bufferp item) item)) + file-items) + (cl-some (lambda (item) + (and (listp item) + (plist-get (cdr item) :buffer))) + file-items))) + (file-data (cl-some (lambda (item) + (and (listp item) + (plist-get (cdr item) :data))) + file-items)) + (command-args (apply #'request--curl-command-args url settings)) + (stdin-config (apply #'request--curl-stdin-config command-args)) + (command (request--curl-command)) + (proc (apply #'start-process "request curl" buffer command))) + (request--install-timeout timeout response) + (request-log 'debug "request--curl: %s" + (request--curl-occlude-secret (mapconcat #'identity command-args " "))) + (setf (request-response--buffer response) buffer) + (process-put proc :request-response response) + (set-process-coding-system proc 'no-conversion 'no-conversion) + (set-process-query-on-exit-flag proc nil) + (process-send-string proc stdin-config) + (when (or data file-buffer file-data) + ;; We dynamic-let the global `buffer-file-coding-system' to `no-conversion' + ;; in case the user-configured `encoding' doesn't fly. + ;; If we do not dynamic-let the global, `select-safe-coding-system' would + ;; plunge us into an undesirable interactive dialogue. + (let* ((buffer-file-coding-system-orig + (default-value 'buffer-file-coding-system)) + (select-safe-coding-system-accept-default-p + (lambda (&rest _) t))) + (unwind-protect + (progn + (setf (default-value 'buffer-file-coding-system) 'no-conversion) + (with-temp-buffer + (setq-local buffer-file-coding-system encoding) + (insert (or data + (when file-buffer + (with-current-buffer file-buffer + (buffer-substring-no-properties (point-min) (point-max)))) + file-data)) + (process-send-region proc (point-min) (point-max)))) + (setf (default-value 'buffer-file-coding-system) + buffer-file-coding-system-orig)))) + (process-send-eof proc) + (let ((callback-2 (apply-partially #'request--curl-callback url))) + (if semaphore + (set-process-sentinel proc (lambda (&rest args) + (apply callback-2 args) + (apply semaphore args))) + (set-process-sentinel proc callback-2))))) + +(defun request--curl-read-and-delete-tail-info () + "Read a sexp at the end of buffer and remove it and preceding character. +This function moves the point at the end of buffer by side effect. +See also `request--curl-write-out-template'." + (let (forward-sexp-function) + (goto-char (point-max)) + (forward-sexp -1) + (let ((beg (1- (point)))) + (prog1 + (read (current-buffer)) + (delete-region beg (point-max)))))) + +(defconst request--cookie-reserved-re + (mapconcat + (lambda (x) (concat "\\(^" x "\\'\\)")) + '("comment" "commenturl" "discard" "domain" "max-age" "path" "port" + "secure" "version" "expires") + "\\|") + "Uninterested keys in cookie. +See \"set-cookie-av\" in https://www.ietf.org/rfc/rfc2965.txt") + +(defun request--consume-100-continue () + "Remove \"HTTP/* 100 Continue\" header at the point." + (cl-destructuring-bind (&key code &allow-other-keys) + (save-excursion (request--parse-response-at-point)) + (when (equal code 100) + (request-log 'debug "request--consume-100-continue: consuming\n%s" + (buffer-substring (point) + (save-excursion + (request--goto-next-body t) + (point)))) + (delete-region (point) (progn (request--goto-next-body) (point))) + ;; FIXME: Does this make sense? Is it possible to have multiple 100? + (request--consume-100-continue)))) + +(defun request--consume-200-connection-established () + "Remove \"HTTP/* 200 Connection established\" header at the point." + (when (looking-at-p "HTTP/1\\.[0-1] 200 Connect") + (delete-region (point) (progn (request--goto-next-body) (point))))) + +(defun request--curl-preprocess (&optional url) + "Pre-process current buffer before showing it to user. +Curl switches need to be adjusted if URL is a file://." + (let (history) + (cl-destructuring-bind (&key num-redirects url-effective) + (if (request-url-file-p url) + `(:num-redirects 0 :url-effective ,url) + (request--curl-read-and-delete-tail-info)) + (goto-char (point-min)) + (request--consume-100-continue) + (request--consume-200-connection-established) + (when (> num-redirects 0) + (cl-loop with case-fold-search = t + repeat num-redirects + ;; Do not store code=100 headers: + do (request--consume-100-continue) + do (let ((response (make-request-response + :-buffer (current-buffer) + :-backend 'curl))) + (request--clean-header response) + (request--cut-header response) + (push response history)))) + + (goto-char (point-min)) + (nconc (list :num-redirects num-redirects :url-effective url-effective + :history (nreverse history)) + (request--parse-response-at-point))))) + +(defun request--curl-absolutify-redirects (start-url redirects) + "Convert relative paths in REDIRECTS to absolute URLs. +START-URL is the URL requested." + (cl-loop for prev-url = start-url then url + for url in redirects + unless (string-match url-nonrelative-link url) + do (setq url (url-expand-file-name url prev-url)) + collect url)) + +(defun request--curl-absolutify-location-history (start-url history) + "Convert relative paths in HISTORY to absolute URLs. +START-URL is the URL requested." + (when history + (setf (request-response-url (car history)) start-url)) + (cl-loop for url in (request--curl-absolutify-redirects + start-url + (mapcar (lambda (response) + (or (request-response-header response "location") + (request-response-url response))) + history)) + for response in (cdr history) + do (setf (request-response-url response) url))) + +(defun request--curl-callback (url proc event) + "Ensure `request--callback' gets called after curl to URL finishes. +See info entries on sentinels regarding PROC and EVENT." + (let* ((response (process-get proc :request-response)) + ;; questionable whether (process-buffer proc) + ;; should override RESPONSE's -buffer member. + (buffer (or (process-buffer proc) + (request-response--buffer response))) + (settings (request-response-settings response))) + (request-log 'debug "request--curl-callback: event %s" event) + (request-log 'trace "request--curl-callback: raw-bytes=\n%s" + (when (buffer-live-p buffer) + (with-current-buffer buffer (buffer-string)))) + (cond + ((and (memq (process-status proc) '(exit signal)) + (/= (process-exit-status proc) 0)) + (setf (request-response-error-thrown response) (cons 'error event)) + (apply #'request--callback buffer settings)) + ((cl-search "finished" event) + (cl-destructuring-bind (&key code history error url-effective &allow-other-keys) + (condition-case err + (with-current-buffer buffer + (request--curl-preprocess url)) + ((debug error) + (list :error err))) + (request--curl-absolutify-location-history (plist-get settings :url) + history) + (setf (request-response-status-code response) code) + (setf (request-response-url response) url-effective) + (setf (request-response-history response) history) + (setf (request-response-error-thrown response) + (or error (and (numberp code) (>= code 400) `(error . (http ,code))))) + (apply #'request--callback buffer settings)))))) + +(cl-defun request--curl-sync (url &rest settings &key response &allow-other-keys) + "Internal synchronous curl call to URL with SETTINGS bespeaking RESPONSE." + (let (finished) + (prog1 (apply #'request--curl url + :semaphore (lambda (&rest _) (setq finished t)) + settings) + (cl-loop with buf = (request-response--buffer response) + with interval = 0.05 + with timeout = 5 + with maxiter = (truncate (/ timeout interval)) + with iter = 0 + until (or (>= iter maxiter) finished) + do (accept-process-output nil interval) + for proc = (get-buffer-process buf) + if (or (not proc) (not (process-live-p proc))) + ;; only run the clock if lollygagging + ;; (before or after process lifetime) + do (cl-incf iter) + end + finally (when (>= iter maxiter) + (let ((m "request--curl-sync: semaphore never called")) + (princ (format "%s %S %s\n" + m + buf + (buffer-live-p buf)) + #'external-debugging-output) + (request-log 'error m))))))) + +(defun request--curl-get-cookies (host localpart secure) + "Return entry for HOST LOCALPART SECURE in cookie jar." + (request--netscape-get-cookies (request--curl-cookie-jar) + host localpart secure)) + +(defun request--netscape-cookie-parse () + "Parse Netscape/Mozilla cookie format." + (goto-char (point-min)) + (let ((tsv-re (concat "^\\(#HttpOnly_\\)?" + (cl-loop repeat 6 concat "\\([^\t\n]+\\)\t") + "\\(.*\\)")) + cookies) + (while (not (eobp)) + ;; HttpOnly cookie starts with '#' but its line is not comment line(#60) + (cond ((and (looking-at-p "^#") (not (looking-at-p "^#HttpOnly_"))) t) + ((looking-at-p "^$") t) + ((looking-at tsv-re) + (let ((cookie (cl-loop for i from 1 to 8 collect (match-string i)))) + (push cookie cookies)))) + (forward-line 1)) + (setq cookies (nreverse cookies)) + (cl-loop for (http-only domain flag path secure expiration name value) in cookies + collect (list domain + (equal flag "TRUE") + path + (equal secure "TRUE") + (null (not http-only)) + (string-to-number expiration) + name + value)))) + +(defun request--netscape-filter-cookies (cookies host localpart secure) + "Filter COOKIES for entries containing HOST LOCALPART SECURE." + (cl-loop for (domain _flag path secure-1 _http-only _expiration name value) in cookies + when (and (equal domain host) + (equal path localpart) + (or secure (not secure-1))) + collect (cons name value))) + +(defun request--netscape-get-cookies (filename host localpart secure) + "Get cookies from FILENAME corresponding to HOST LOCALPART SECURE." + (when (file-readable-p filename) + (with-temp-buffer + (erase-buffer) + (insert-file-contents filename) + (request--netscape-filter-cookies (request--netscape-cookie-parse) + host localpart secure)))) + +(provide 'request) + +;;; request.el ends here diff --git a/lisp/zmq/.ipynb_checkpoints/Untitled-checkpoint.ipynb b/lisp/zmq/.ipynb_checkpoints/Untitled-checkpoint.ipynb new file mode 100644 index 00000000..363fcab7 --- /dev/null +++ b/lisp/zmq/.ipynb_checkpoints/Untitled-checkpoint.ipynb @@ -0,0 +1,6 @@ +{ + "cells": [], + "metadata": {}, + "nbformat": 4, + "nbformat_minor": 5 +} diff --git a/lisp/zmq/Makefile b/lisp/zmq/Makefile new file mode 100644 index 00000000..e034ceb0 --- /dev/null +++ b/lisp/zmq/Makefile @@ -0,0 +1,93 @@ +ROOT = . +SHELL = bash +EMACS ?= emacs +EFILES := zmq.el +# CPPFLAGS = -DEZMQ_DEBUG=0 +ELCFILES = $(EFILES:.el=.elc) + +export ZMQ_GIT_REPO ?= https://github.com/zeromq/libzmq +# The version of ZMQ to build +export ZMQ_VERSION ?= 4.3.1 +# Directory in which the emacs-zmq module will be written +EZMQ_LIBDIR ?= $(CURDIR) +# NOTE: The ZMQ_LIBS and ZMQ_CFLAGS can be set before configuring the project +# to point to the ZMQ to build with. + +MODULE_EXT := $(shell $(EMACS) -Q --batch --eval "(princ (and (boundp 'module-file-suffix) module-file-suffix))") +ifeq ($(MODULE_EXT), nil) + $(error No module support in $(EMACS)) +endif +EZMQ_MODULE := emacs-zmq$(MODULE_EXT) + +.PHONY: all +all: $(EZMQ_LIBDIR)/$(EZMQ_MODULE) compile + +.PHONY: configure +configure: src/configure + cd src && ./configure CPPFLAGS="$(CPPFLAGS)" \ + --prefix=$(CURDIR) \ + --enable-shared=emacs-zmq --enable-static=zeromq \ + --without-docs --enable-drafts=yes --enable-libunwind=no \ + --disable-curve-keygen --disable-perf --disable-eventfd + +$(EZMQ_LIBDIR)/$(EZMQ_MODULE): src/Makefile + $(MAKE) -C src + mkdir -p $(EZMQ_LIBDIR) + cp src/.libs/$(EZMQ_MODULE) $(EZMQ_LIBDIR)/$(EZMQ_MODULE) + +src/Makefile: src/configure + $(MAKE) configure + +# Needed for static Windows builds of libzmq, see libzmq/INSTALL +ifeq ($(MODULE_EXT),.dll) +CPPFLAGS += -DZMQ_STATIC +endif + +src/configure: src/configure.ac src/Makefile.am + cd src && autoreconf -i + +.PHONY: test +test: + $(EMACS) -nw -Q -batch -L . -l ert -l zmq-tests.el \ + --eval "(ert-run-tests-batch-and-exit)" + +.PHONY: clean +clean: + $(MAKE) -C src clean + $(RM) emacs-zmq.* $(ELCFILES) + +.PHONY: clean-zmq-build +clean-zmq-build: + $(RM) -r src/libzmq-build + $(MAKE) -C src clean-libzmq + +.PHONY: compile +compile: $(ELCFILES) + +$(ELCFILES): %.elc: %.el + $(EMACS) --batch -Q -L . -f batch-byte-compile $< + +ifneq (,$(filter products,$(MAKECMDGOALS))) + ifeq (,$(shell which $(CC))) + $(error "Compiler $(CC) not found.") + endif + PRODUCT := emacs-zmq-$(shell $(CC) -dumpmachine) + ifneq ($(shell command -v shasum),) + SHA256SUM := shasum -a 256 + else + SHA256SUM := sha256sum + endif +endif + +.PHONY: products +products: products/$(PRODUCT).tar.gz.sha256 + +products/$(PRODUCT).tar.gz: $(EZMQ_LIBDIR)/$(EZMQ_MODULE) + mkdir -p products/$(PRODUCT) + cp $(EZMQ_LIBDIR)/*$(EZMQ_MODULE) products/$(PRODUCT) + cd products && \ + tar -czf $(CURDIR)/products/$(PRODUCT).tar.gz $(PRODUCT) + +products/$(PRODUCT).tar.gz.sha256: products/$(PRODUCT).tar.gz + cd products && \ + $(SHA256SUM) $(PRODUCT).tar.gz > $(PRODUCT).tar.gz.sha256 diff --git a/lisp/zmq/emacs-zmq.so b/lisp/zmq/emacs-zmq.so new file mode 100755 index 0000000000000000000000000000000000000000..40ddee68d70ffb3d8fc738fbc7ab3ad3e31812e9 GIT binary patch literal 230672 zcmeEvdstLe_y1ABkhH-Hwal6d6-!JkQY#At^o$NV3K(Vu2*V|TL6}i2O$;!n38TBc z-RN$2-|Fo(-%8X{D=V^_-QMi#nU_i{E6a@EXYIYuIeQL_mCttkGnwP*R~fH2ZmpWl@m7_GUf0BOygf(q ztB%(bMZ#Mx@Ky^v{kl`Ipu3&E^s5zbhrqL569k@qr8el3{gt=) zP}*||yts+HBi8FJZLB$vPX5o%XviuS_kp-d3fuR^>`mUc8oHZyrzF6^#H z8}ZTyU;6YEWx4*bfRoiy{ltHNwdsNW1snUHzUb3n$I`tkUp@U_gx7#?2EN1}nZRA% zXHR?i;_?&v3>q5KdXqicewtlLtyc!c^;CK$#H7~ui)uS1>ao$T1^4#8uh+(YIVZQ@ z(-OV&)GrbXdiKoAOdZ-7Tc4OZ>fUQy^-<0BC->^n(BtTXnhM)iL%5>s#vk)hFDi#GIN+ywE3;UzAC>l1Wd&*NJZyzSHoXfp0dx zx%kp&7QPqaI~(6Q_+E_frT7-$TZnHFzQy>K;9H8X{3%1BTmUM?wF=j2eCLa@7uN;& zE)-?D)Zu$MzE@BIpC$aFEX8%1_)YR{6u+0_dNsa&e6PVbfNwLt^l8EOdVFuh_ZEC_ z!H3-6)>Hxlj6U zDSGawPwsqjWMJ`^nWJ`$UgONzJ$`rVv7_&Qbb9==6ZY838h_ePTdSc(%uRNZ8UfZn=n-<=) z#a4gTwr8imvCuuzb5zr>xBlaw59aP$blHtXmmg8}*6+BsOjs8ft6nko+-+-LDcg9* zV1MtEZ{PHR=Q`J#g|}Wl_{Gm3IL6t~(|`Zq2gaT|^`Dx2_t9Xaf*yC%HfyZ81jKlQtL(!jc4^N9!UNPeobzb)%4#P zz`73-?%BHM$e&(Xx#X+^^Phbp`|{!a&cEyBEBD@Z%Lgq3mcCvx%Cq9g$9g~2Im9)0 z{2y_rJm=9~__{n$D0y>M*)(O0J&zuVDTvz&Ut6wPuCTFwPWu~9qy%j zPoBKwtC5$CZAregS9y7#g?sN9JGb=N6EENDQ_lQm$I^bQ)Mfrf{#8fZ5#9HR=E2`Q z{6opWtIk>f!n?np<^Jl++A^eCGJr>$6gSeXYTh@>J(>FR0&5 z7~z{Z{M@;3Eqeakxx*g3?7hkEJBHl6=h=X(|L^yvuP%G#i^qP|OnLqZ2X*c-F!V1D zV<&Hfp+7%N{WW3W7lx5fN*F%N!tgmdj2wE0p;H$|&beXeJQ}9mAz|vT4?}-w7th9EgHfH-DIEZ8U4P>o;kd{RlrYUa_+0NS98D{s7If3fZksjsOr7vLm7Uu;V6cE+E!u6jw7W;tZ-0kZ94_iVE!tJeIA9vu zqtA;%Zmx@XS=aAE0dJ#)3O+hKL$tfr((aRxC-rO3*S!9({Gu!q{H%F_187}ApKl>p zlACIgPrcx?y_DA*#xKe&VJEF0azM7=e}$kk+Ct|w0Z+BSY28ZtZL{c|?1kW?h2GH} z_PGrIQome6{EAKdpx5v zP^q`jxlzb%wT1rxlm9@a)lz?<=oj zS>Q!No-LPf0$T;0uLZnq76(wgNS_t>l6>04I32>EigKD5FEJMWGlhHxS@`cG?9*kb zKTODBhXp=d&{<*Ozf;&%`zFrFV8LgJu!r^q9DYFX`GD|O<1F;I>vG8B75^pZ)Chg8 zwX{1_@SkU)^RCcKfzXR?=aio!xs85{(?3S%6Gife<1F%7CE8tWY4;H^-U~!hx4bng`dBg zlTk_qpQ&QyzgY13k{G{hE&Q}V4#dx%U7WxcQ9m7Ys9!rR^|uOsGz&kk3Odzab2@t5 zwN2R73JaazK!@682~MC0u`0_%zg)u3bvic*I&~I0cM3aM^D=LDEWapgab@&HlI|e^ ze^kg}jfKu7qQ9C2{x3nl+Cu*!!M}YDC%jdsk1N@~-D3ayAy<-Tt3__V2)nJnoD$LVp$HL-LG! zfmfuQE`7!eIgHNdWk0_tUkmzsUg7{#AJ`0_Tg?!2^{EybaB1fOGsKOb%3N6F7Gt@Kpo*Ln+Uy!rV`z9T0qzt~;lE-kP1 zx@&T>(knbw?wrE86>fg7`#bqXb%psQYkJ7J{>)V*FD9iSafT)_AH)^Sz6z-T8$zrM^mcl~8>oQUZl(*I1woJ6y-DYQn$C(Q#8+0-Q^A> z8tx7dAa1C;+zWYHC|1{a>PVVycMaEeXoKvw6^F~nLa4%BxB$iyihh}=yvhnIF0X|Q ztK3Ch`rxaYTh25X(&sRhyQ|7HWMM%VMF>ffl$$HI$Xk~W^RzNaU<`!H?%=g$K5wyS zVV8~(4iwZaN;hCnl^26WnXv$pfL@q>VK=q;9v_BJNq$XXRjC+MWaVrCQ7_2S$u9Fl z?6%TVW120E5W{RMJ8`CUEOoQdf6xjCy=mbgOdArHVQR20hq>3C(dgWFXJq=lZq%>eBFTqot=sXW z<1zJxLnJ+ixyKA5%spl~VeZwEYwZ3Ww^4UpHC$vq`9W`C6`4&nT(P%AnbFmHXSnD4 zbT?0aU!N<4xf2MMPA=2hWVNTF!d;VJZH1#*8a7>T@G;#LuFJ6tCC-|qr$xS+1@8Q6 z-`tAwqApFdd-L3jste1z_|eP9rR2M-iaf<#dO~-K-QC?;;I64H_jK_iWrekDEMfku z@~~eRm|`;QZjND|gG34IGiTLmUu{`_X@zHQjk|;^uG&*=030;%UDKUT$27(G?V9N@ z3)6FR%tGeOnV9L^Ri)lCWd@Y(E_Kt)j1tiix+*L#&M)DT3M6ogc#1H?R{0DS)+*H%zS8ol{PNoT$u1|xV`X)rx11uj zit@Qo%cxqhfPtJWZrS z&HLuBDB~`#W!}-Tx?bfv^6#!S4@3T%1bQj|L+l^NRtJi5)AhGtr3B5ya@euu<^AZX zu)d<~JH8yXdnyA^rjPzyAeJ-ivqvnTTE&Ks4sR9kddoURFI)F)%vSf3&53wSbSaz*h-)ss+APz*P%;pMbk8@D(R=e)25vodRB9fft;_>z7&J zEdpL`fsYdXt+T+}Mg4jU+$rj>u)q~NZ@0w)A1&akEbu%5Z?(Yd1$?yyzIrI9zs3S@ z7x1+f_&xz|v%u}cIGwE)xGLc77WfJQ-(i8b3;0e8Tp7;kYZmxu0pDYR=Lz^e3%o_Z z6-$0&tANK?;H@KgyKxq{<6I86?vHFejl->ZLgjQ0x8}+71l*c$$s5V*kF&J9Lcp#2 zH7Y%bfX|9~{0ir-h}02-w@C2k7=-_`N`i|mWp<-gg6p|Ry0Kb<>p3ZcuaV#%5kP#_ zO7Ph_5Z5*d{vQdxRf6l!q|)tn3I3Q=e}@GBM1t>>;CfDzZfg?!7ODOo34W&p-zULI zrpBkjlykWO#Pb;v{AvjvC&9&57`r=2g5NFGw@dKN5DZ#f$a7}{Gli+(K_*@CTPl5*|xFQnpG$v+9@E8d$9+_cx<0SYhss11d zF1DoDUAqK-T&kZa!NsF7?Cxj@-YnH0C&7y)c&Y?{NP?>pTx>nDyDkZ??|ssZJPE!` zqEjHjX^%z!lu7U#bs(~fThXnUa@SPHTiUijr_@X-={sstY= z!PiOfR0;l`1Xm?^g#>p=@cSiro&*#pck3khBU1f( z3GS5ODIKXFOc9a3GR~Mc@lh_1TT=_ zuSoDR3I2uzua@A;C3u|#_et=234WCXUm?NuXT0ckiv+(}s=rEtS4;3#30^P3S4(iQ zh0gA-k>E3>`fDZlgA%+=f=`g(TP1j=1aFt%PfPF}68u96zEgtVE5Vg&ZnsAO#((jf zF%rC|R6kCF>(7qR?LiW}msH;_!J{O2q6CkY;G-q@Z4!K(1Q#hYb~jamQy=t?D#2rP zAg(S6-baGxN$?9Lc!30umEdI({74C2Ey4Rr@Hz?pwgj)2;Qb`{3JHFc1aFbxHVM8; zf|p3}RtX*_!BR#`0)~4nQz+v2@*U;f)A14aT5Gr5`2&ZKT(3)CHP4aJW+z% zCHQCwezF7~C&5pV;HeV)R0*z1@B|6&lHeO8c%B3wD!~gR_`4FkOoDHf;MEd*m;|qr z;KL<&y#!B`;438f2npUI!B3Omt0cHbg11WW(9G1Xg2^^NdVF?_Tz+nj-mcU^N9G1Xg z3H<*ifgf!r{-!p36Qc&Am*Ej3wW-b9v$I`ocqwKR>q=+Jt9a62$dH&B_Dxxs2yzJ|(_8VnY&@>Nu(lwi=s%9m4_QhvcyR<5BkrTT)SS@|+5Q;IKW zXXUw6rW9TGNtZ<3Mc&sZ6P~U_C1zO=U`<1*=&(mdcbm3l^|) zPbyQ&Ea+n8-|*yD8KugCsjU11m1(OqIGUCJM`cQx1?{Z-Ih83@7K~%%52;M4u%N=q z+o?<`u;88p)c;qhY^U;0R^CWuN_hp_S$Q3mDb*EhW96r)OewD58diRU%9Pp)wzBfQ zRHoEbu!WWXL1juo1?yS)1}anPDOkKPQe0JzKY6}Y6`ko`En{#iYb`N$~9D` z6jE?BD_=%sN*x95tUQ;>lmZIIvGPS!rqoYRVda@rrj$=`&+knCRHjrhk>pGIX$%>-Ln`4lQsN+#IC%EwcgQZd1LRz8}_l!6IX zvvMqzX^SRUz{)+TOsSZli+DpUC-ldFQ=6k{9IE5@ zdE?dfx2N|FSW;J^{qd= z$AZA?c>I+J#B}Z~v7H3z==kKH>nHpRxQg%0T(x0B?D6=i`oHq_Qv(xT#M7&t@%wi-G-V3f1bhs0tv5H*xMh3d~p7?j+m-Tf=|X-FNk#ro7s z?~<))FI5Zlat0=xf*ymx%;cXPfq|?-bz_^Y@o8Sc#MsCH@u$W^a{*BLP7NH5yUsvC zwd&7Fi0O0{sDX3U0Dh|e&1s$Q5S5!5H@nqlZ$g~9B_n}t?Pyy_)+A(uAz!Ifur)r* z(X=P_L8O5ri0GhV_4H#|?`%zNbi3iDL@u7ROVjcpBCdbxlc}lAAym(Y86>xL{FCeg z{I6d@D!BqpSa|tJ#%fv&EJwhHh=J7ngZ3MkZ`jvqYa$DTkYh1wf)_FigB_DG5W8_1 z{_oL-Hd3#h#A|jgK+vkXXfxOtQ^)(G*%1r*2hJw?tg(%z9 z-(a#O)R+SrY!Hz-1mgi^eubJEho+du26G+cq5nY}eq&sbW}#K8wn0}_G_RIS)qX`x z!0lzXW(S>M6>dsCCM}2j$dCFs#4wBt8HO0d+92S;wS0dxsWH@f6sZ1BRoLs6s04^l z(H>{g*%abn&XY^tvw@-A@)J>vECjfklUgG9)5p(W>5s}Ncl&cLTG0Em z6w*U~^1$EU=}#SNJ!wY&Ki5yczt*3he`NjH0*ZgPKl8wh-k&GY8v3&Wpuf|f)vWcT zWpRJrp9!SOKiAJN-k)DU@$dHMc1b^+p5W8?kNK<)4JCx-Xuv!njJKX;Pg|GYoTzb6SrUkC~PUHyE7KIry#0i*~0 z43heTAj6C>VzeyQ(2!wZJ#+@~&5|ZfZ?asVc<%*5fTtoyeF^y`bqk#sr6?Vri+Bg~ zrgjncdTt842pw*Q&08H_=jRR7W;t3cPajf(VpBxVi>Zb9|=|tFKkV; z_iTh=SEC;D#Af{A0mlf2;#tQmld1PIsXM+*xo}ce)6d?htiXa8N5Gqaf0kgX`az@d zkB)d}Q1HU~OyQjfR9HXsep%tHM-(`Gv7305Cq(b^j#pYBncE03{ z@8lKq5W!c6+Nc0YW8S9tnbo@6QfsEv2&Sv1Z@p1!pfV<_sgq>66g+?t7D@SoPXBLe zpgKlt_>POT$`R-d;SCB22N2Hzq{qv$oDF&22z&?PZmD~X(=nHKyv*VR!#3uj9!xvv zkQOYi@4jr8Ie|6=lc|OZ(%41xs$(jHWw$vb(CU|8S$|i zh@SYA$DwLr^`hVJO%IXhlSmH z0ZSUj-CG9+IVg$zH3pd5(4dL&?bGWudDR6lO<@w>OxvOQP5Vz=qH_r#x3hX zTN53I%!4vo%5}QxEH2vC^fJ|G*gtmZLi{_-c3m!5_m0NzBWx>Arh99Z!A}gPtb}U2 zZ-?zFI`*_-|H(WKZ`eP;*4WHCpQ)^))D)J}fk$ycV=b*HGfAlajgU?evx{-ycmw(! zT!*_XUTxT~E{Rsg*`M+{kPiiYuv&c*OGMA zw|74L@d~6qn?6Eu^{KweKfhFMYplg!pbqPizjYC8YkCLO`H21eIkIK{f1Un>1nmH% z*fE0qy@Xw6d$!FVm7rITV%4?nOyJQsvi_jH9MjsGdN6_N!+w)t&x~vT2P*YjslT<3 zdZ0G7`>x{N~UvD(*kFqtcKnXhB4;}WjUHvVx0~UstbaY|Z=VXEf!*B=)_%BBlB0rbN-_FQq za25@1s?Y|vXP)t}HBzdT`Nib6;C%cxm7% z(O>;R=ttl;GEobGs69eBMt;b;zFGDS{ei7C`WqAIFT$agxfwKrzk(!E!~QW#FUP-U*sfE10gDFrb(6SzIKp;aBT-_y-p+qT+nQSF7p(~CO8x~N z)Ydo#<0M2$O)bnYkL9YP49n(>W8+L?>$rmC)3ASvZRIV@7N`CTia5%4^=Qy#4qtuy z^ItZOoeOO=<$$C5uTQWwO~uWIUwhk{;H?=KxJX>kd2u0JG_C`tDc|Ham+66hflzhV#cg_2GODjkBK&JBA*~ADVikHxPtKuxTqQs{!H|%rdsMn|BfD zVp_6)stsZVN=PzmYpDl4F_KAsr`xV80k8fKbm^(jL6?KiL$hkrtG*>v1c1z^=~Y`3 z4Wx$sc1QwUZ|Q1hYf(9rzeL6#+NW{Nd7Ob5Nz6sT{>0w9$V72Y+D zg8NMBy1hUarXXUp7j{zjlWsXc8VOA^Vx4X}8Sg+49tR;Ay43X;xFSZoRfzs0DC=DO z?$~bFBe)33KUmtIz}p}2m)c)TwTvW)um@^?GL%Sp4{HBE(8fX958nPMhMhUzrd^o) zGwldD{0G>628(YRzR8m!nv4V$bbsXIrveL4r~f-Cvw*c4%*I!uTeKJXW@A}pYkHKX zT}+-TX7VVp|Kg%4tl_0Rr~emo86La`EwnfSSH@^t{>%IGEZXfr-#Q*Qg>l3>(W1^8VruWel2bX01|2=Jfqk>AR4Py-0V7o6(|GHlwi}GiSme3ZmHE zaj;VbD-I{cD{5eL8Xis|!LSlji@@XaqINAr%^vg+`3a~*8w5oJRW@f}zOa#S>9rKl z`)(*?$|sPIz7?05jNxNw+dD%l*c$g@8d0%t5T^|TPVg%fTR?+CfJCB@2%3ua8#v(d zHVOIeasn^0<345&DpF%{naORG%4zO*4#;RJ!s4$3L$AQ1JC z?bDBmfuyyNhjnxhXQLZ~#~Em?CpK;b`W)=hq2}gGoc^6@7n7$^<|Mb#PKcrZG&X>V zz8EPGa`Z_sL}$RRdC;CSkfieV9FqU=ja6x&uB71(i$z9b1Op5~t8n3H6gt9k{OVTl zLOz3!i_V>7peTYN4zcb}8|?5|?%R)8k2mkL^w_^KxvgotZzOAUEh@>*u36Vkcnv@*7jLimoYpO#z73f42A~~ z!_U*aXVG60XRkNdvog?iK3Yw+423`iG%u2DhJ%VeA3Ta?4>BKE;w9=nx1{?%AVCdT z{BzfMiPJ=rksHyr5Uy+Ds`c*@6c6~0R)SK%#$I6p*7MsLKNoeC-N^{ej_ z)YoaTIEm%3C{$VmE2G~22ZDV8zdN2{adx;kX^N)K;GSht&gvc^Nc zOBlo5cG;Jv$3m||YH}xt|Hv01`Jomh*g~Fo~A&qTd0Mh6P z>f`JSvJ6Pn_dM=?&1Kc`n%Mt$umF#qOnHYtmO`CjTN)p~PyI>y*Iw!m@~dV@V{0Nk zVTxi&XzgiKv?MBh$hx9_ApQa{1KBfYPtROmdXXD9sawViQkO4bi0|M| zj3wBGy#n4{-ktWu%nKD zYxUqOZ5GnIcmESPcUle?#P3VmGobt``jAhh0(n@l5}fKy2!`2mW zHt9}?B;CyaBf3#0-RY6!x9tf-zWQP{WOy8^J=BUUEJEC>g{NgF48fPqxH(H{GObizMB>V#6Qv zMMUNMut_(f{9bI*wMSA815LWAk)-?nBZi%IA~zSYanWqjjf*6|Q%$<{k)#`C(&Zb@ zmaykg{lg~l;6tSCcd1D?qVrIiNw?eZ?@;B?%cP5Q_akR#SFJMaS4oW^-6;}X+CsL5 z!G|h`<0ZQG2-02mkSPZYxQOvvZ__6H0*)36mzIvY_-}56$x6!1V8Y#L%wtfO;n^XGVfQylm znbRG4q+}XU*_t=O6!n)?kQzI#d z*X}Xon-xjAev_^Y#@$?qbQZbbdrX(rv?e~VviS$**i z#Vwz)O}vbR7`}5Pq8+hg^x^G>IF9R%Jffc_M&-~pq*j{bbGjpcsL_wpq#IFbD+b*N zE@+5(Vz=C*dsO{ecE8q#k?Fjx=)&PVZV{1 zd$may_8U367n*dTw#d;PZqfz6cvv(-S*l;IGW0eGufdHN-8W6Tu(Qa~eaNKSE0S~< znsnnMNq4$Q7mu=Zl>@??sBJ7QgAnEO*GL%|33mR}%wKLcby^Mh;B?(m~KJoLS(o2Ui;SntV^ z;+`HucA0d?MUrk`lWs)$edQWM4kIGTZ@o!3qB+;GCf$hUo;&=893nb<+-1^@=%}7y z(mgVgdW$mYB5IACH~#kuL%xVwBS&|hN%w?E(zTm(BdWI#t~TV55lMcpH|a)HzUe02 zh}zlD%MCe1GH1B&r$mx&x=HucNYd?L z(oKjY-L^(UzC$BPx89`diX`2$O}Y_X)y|u5$RVPuxqBN7x_u%kheDHXME&{@gRZ(| zGfqIlpASYT+xqcUh9qW0QW7_rbfY3kH^-nGX-Nz;D8D#9k{oYYW=J?Ll631#x)B|7 zqfNTABgyX<^@bcSj3nLrO}eupN!M-C&5b18Q%t&fk)->@QbWEG^=UVmbSFoWU#Ceo zGm>BC?q#N5EUF=I${8QhT znu1@4v@bQ@Y-MbBtsLt9(VoSIR4$1WUHm1yac-Bd9}Wo^t)JkrNlU&7=Q-sje@lNv z-{t&c`BdCNH&e8LKk|xSG2ot3_073ov%aOjSD%=41e2C=R5YLbEt5@=i-DY zwfSNkQnd_x;Dmvw47A!exh>$NyD9&?f~5MXR(lKa6J7BnE22H^WVFVP)Wn$=yE|`g zC7A=C1a>St=*&lFw~qt2T5n>EoeRNFD`5u@SPt$0@%I^V<82<)$j89M5lTNjLCtQG z4@a^!*?R!E_VsQ2!%m`n?l%58PPIL`QSGr+eQwN|{DZ@VYcD7Kb;lE<%_*Ng>GX+aM>B$c*c)8nQLrM6_|h2h$Qin;s|g zW#EKY+wQg>RNHAAf3VGt9tiS3IBg^MIGV5Qq1}cqN^O&2c;o0G?maCyw&7+jxAe^! zNWwzgbYm=WfLb3Czc?>n917RcO0D}}?$~Ia50m_DFb~11)(B?V`6BG?M`7fDA(OHp ze>&3ZVrGU(zQ>7j$T=0ZrajagI9T1wTSsSB=#ss65mgSAtbV3NH^C@vps&2+h@jMd~`Nk?Zec+(VcI@eCQbM!7CwUDBu`egNcx&I0wo9 z9o@YIP@Gy~YnqQcu!wIVw4j^hy$N@iyxECW2O#xX3l*gs--|Y{V}cu`ErpWNOB{<6 z{mdh#$k)ydEAm`a4ITXDSfsUoTi#VcfAKnwpc4S=UyAoOm zVmVX_r}-ENZG?Yrbm>FX{>$Dm`W6ycj{XNTG?16yb%t3r^tA}UVCOW!I}x$0@xS=i zspB=@zr;CXWX~P{(Q+YB=C>h_m>21&ByBt71@ABbO_ee$VP^(O=dK*L z?A>)YnE1oH#s6S635QcP&bwmm)4{dcOcQ^X)RN#ET-_EHe-(mwgFvbaD^v;p8aX9VB5uovd1Iah0;Xu?t=4!*W`;Jtb-P#N z&DQt=D%h@@j8(&g{S0si{rnw2eYxxDqD^Hk1@Bkfq@|*1oMW}<0g^FsYE0s-teuqM zHFU>}3UIpBhv;F)WHbKIIzSJn%I*!2r($G-E9fVu7kvT|m!?1dQjRz7C+Ikg-553> z(ur}wlR=_oJ@rF-(4=-dQ41u!Lm1sMxnX|yOy0Xb3cb+gn50~sls_z~2f8Q44#8jF zlc@DGsrBU4&J9bgG7Poe@Zal?A!_TdF@*Na)vTM}-WRT$Z&r8PP4?c0^+yr4`6jgz zPVMfn)YgQdcG(}`jrLEqQ%!1vIJFsJsjUn{?F6EBBvE^pOpTkztIJtWdxfPoH4L>k z4uBeDs%Tf6)E0AU|GGDv-1>*1R!`K5h}w9Q+9*z~G%U5Tp6<0UhNvOzP_zza{cIrY zY+^kJr?%vtaB>?M zhMG#$D66LRFsc3A$a;E4SZc$Q z@BE_;Oq5^V9j^0Z!w`M)H;VUIkeB=sg%y}`?;i4)Xmnr`@}4wLg5#E@x>#jLfMo7*sLZ$&UDPtmJriq4GN zl35=IjbJiffnqDJEe(J4z$=rmxVNpuo9L8`=1DzN{{v-ki)naMTXV{M^f0Sv=alBC zuWW?MXLo0_GvSCV|C^46&-OX}%>}6L*s!}-=Y@G`&9e}c=e7j0>YV|0Lk;*=Oz}q@ z0Jh?2Ui?;^qd6_6V=($7&G*}lIep7P=KC!)-=|DKWXnR!S8(h(5?D|ce;XM6Zf>py zGnm<&fu-Zrz+|kXZmt7_1vczlIiETMr63Xi z`kkmF=z^diLIF4grbxsRbYkyd@?K@e7+HuhcCZ+O4x^>l12zJY8qRHDZFEC?Cd`8| z4hEdWfQa`yuG5At6Y(;OPY{j|NoN(}6L68Vjx95&o&IbO(GSJ-q00uG7EiH}A&LR? zCu>+dB0vJB$vq{O@UpW_+T-;h(Gku+N357;zMq=gdD64=hlct}bq%^{$qD$5<9FdU z#lirqj2>v*dy)#lhgk5ETMRlZsz!hr zW7$m1sFqdvnfz`DGhY1Zns-bFmdKaw?d%juf=^*E7?*3Wgmtljiqs%GIoh-tgC%_$?xi32@b)0}d98I_T06PW=D>O^~6(Ae$JbjS5Z zd`uke_z{UiI>UXF_Bwus)*sxJIg>j&uRhKHJM-}HBtKS##bkA60>*pbK z)@vX1gw`E6r`Kifog0?zG;0b3fd$_h0dAxy^mB~@<-bJOThMrl<$dt znEe$X-inxV68#++m9K68V-=x=f&pHWl)b zTq@qjn6eT`;=0SdM*kwd9gqK!Rrm^x1ya(`lmzLuObbsp`Xd$YB!@m`G{8SHIQjI z(93&E!@elr^>n-8OvL|Im~LBlkNK^dx%IA{cY5(z0JMYY?&v@t$$ zo^*3cY6*EfazgyL--obZ4B?fw1mKMWWtf`iBwXMm=M&dxmb|opO=hqR%Ji7PVFDN@ z19x3Y*znmVkfyiK)?vBHZou%OW55RU?yS%HY0oS}%rivVcb9Vuq&(-fT3_C2ytfmfkKPUDvra}x^Sk;m!nscGQ2d6Q z-q&LRJAu0B50=kVx4ev-roMD}(e4o5nGt{S&D0-i)Y0b~YrCWgI@F#kgII3L0Wlh* zMw;C8W4AF^YTyDy1$&!b z@lI6({m!}(@QFPdHuh9ksYM9Ia9U5_m(W}XX*Q6ujVT!EM-+@`D`fM@iB65%)X>&b zEo$%Btj9M^Kl}VmulNR$^Ep*5>eN2^9f{`c9S;aS`!@#RuuOfhc&g)SEdx?w`zMHX z@xEZ)1@M#hDc;EjLm^`d))?IzB6rdR!!-n@+M3RR2f$m8ZH<_GAd6kh=Cq83iJ&d@s4P;n&oyUrnN=^!jP169&bW5Nn>%-tS!1S8jcwGfS6ThsNufEI|J z$kfp9(H1Is6I7wkzzAocpqdGxfW@o-Lr2m&-(hcq!h2|YlIDkIQPcDaBy?9rW!7T{ zHXHRQm->!-F5?D^Of#r5?Z1L47b#b~MM;Fl>=jB#AwZ^-EZ?vzO3PvPgY9ZEt(D(G z!Q{L#FFkraz4O} zPcTYA){4=5$Ehs8KbH73cvQvOfOtHEcnt8NWz5*Nre{e{%U+_S!yvP0?O2g8TAwc*4d3=qVe0Tknz~_Ul{!^DRTy@S@6W%B^wbKA8dtBD}pvS60&dG0B~j-L9NjW|2RuDr6q6?ad4z~q+$oneUhSLU6nFB)!Zp9B>p4wm(R)YwvrgAJZ-G0%mYZ#c{IRoR_psSW&@ctV_PEiuQ?-g&j zu^F}TdORqQ+_~yM7S0*!fw1YNdhqE$fwFB)tuz{%Q^sCI8lW*MOdmVIWc|q=;tub# zID_vn5_F0_BZrH&rfJ-xG3qpw8!7(1ipksI$}R<8tnv;}MCBK$GQB$2 zSpVSt+ndRx8&Ok_-+1uG-j^iX+aT@9N@iaxt|9v};%eqo`!YquKY*x#NecFL4zn+P zRe|2){e0NVBl{vfqQ_4fwV8dDg|RQ7fF|Bs&F$;`3rW6R?dvT_0re#NGTY|%1w!5{ zneM)31T6ODo5EP<)1$5N6{hv*x#%s~78VU5;g+sHF}ZThVMWdDiK^?#F!nktp-;ok ziiq0~JM+CJHScS(tr$G-e9saEB>iey8D{&-yH67%C52(-Djk4pt?5&`+whWI zR}*4lMJxus(|&~DtWFUd>fBnn%Dpq0ZR}G0BM}*5SicDzIJAmfl5fbe9%CJgbw1MJ z0WrLRwORWES_;mARE_b)-&2N|NxOz^!Gp=3kcKi5UyV;vzc4y z5972S?r0x_B}rlY{ZP7^Vzhq5aUkhyl0D5qB1Z|~`7-4a%bO+ttYxt=6MZF2hTAw^ zEXngj%}7a|0cv2%_cmB=K+TRXkF)$l!x9}YQ@mJ46`@2pZbHCN$6H8%Z<@nwD7!_e#4q+N&( z3B6!4{)(@u_&fI449yfJuJOXHwo>r^F8$*BA z-UK(;Pf81I#uuB0Jv3V*TPHVXw&FF);I%#o8&O&)5JG-fNej%1$qJmGhIri3u-Tqw zTYu#~f9_4%H{U@sxi>+KD`**vr%ANnZi-TAfswU}2VjBtC08*4v|`5xQDN3$Y z*VCSk|B|(=c5~JmXCR*cF-_(ghKO3M2GV~>ywMb3$97EG_;+pB7DG23Q6+f33w_*b z1lK-fnA|%k{ijC&WZoG_T|NyR25GQq{!(eYLTND_$D1Az!NqM2WP{Kb+9TKZYYEI5 z(;vnZ@+;93F%gKdvx)DoupIOHMA8JF7L!Z>F#+&j;WjXl$cC!Vx9CTkr}&k1L=U(A|eJ~sv0=cBu37QXDPS4s1cU5qh}F? z)bjYlHL?SvbpdkXdKU3W3vCR^#3?0_vQ;H3!e?O9-;As|9HPE*wGGD#fb4KGg`4DC8 z#}hv9Qry+BKYAhb-)}4V@1m&N@VqnaVbp^)@FrX%X=J$D(C995aAtC_g}u_g^H##a zpkosVM`Y_5j4$aC=oL$eE_u9LU{axkbor@)iO|}VL294|;ycF~mi1W2||Mn~KmP4|Rcs2z6Cq)#gtqyHg%n03BI%pgrLQobnEonaZ7 z+*UtfI;LX9*0cyu4XA;EYSVVx$~*C!ZT6`RzYVl4FF>*LLNGJL1u2qaUUtqdCeB`K z$s602pN|@N-S3eoXwPFHBMA)mGlh|)g@4p^B3>59EFBAf%)Kln7T>uHH=0x8rV-tq z6iIYf>mF*hIpw>ogVyTBX>B`rt)FLk*?-GvJ?}iI>>pap`gqsDYn{w#Ej>sr z>>fYO`6{AX$YhLmuq`1TL*}g;NQT#(G81<(;P@V{nb&M-<+qbq6B!BPSa1sWnx~4F zGP0FvhM7;oV~TJG%_%2Np$JX?jm{j_5D!xOYGR>sY zn^Q^cj*55wxM+#e6ULtxV=(0r$^5@z@y3rgx zC!Gj*;$x;#n@CUqD-gXAHEsRbb`(clMiQg-4WXXLQ7h02P=|bi*~>&7h%VduU(B=c z2w$U1z@mZLgQK3qQKO#V%X=+F?G9l=rm%~6wH#nfVo=}Y{HLx_a`1CbjN{tkH>^mRE$jb0yu zO7QIF)P z@o!+dFk5voh9%|X%dPh0sNcgsiBT&C+y=(1*t?=p(7>=4k zv!jXH#H1^Ynr*TXev0G}`uf%Rtgq4SA*f@}NQgPSBDZ=!N8OgjP$#%UP{*=XC7s?P zi>aKW-pf&=PYXf)rrOf#R2g*?N3G+i@w?%l%)SO0s$>qUWQKqImi5)eQHMMef_fKY zSkmk3vU1jP)L|TTs3Qb*Fl$xP>qRodOE~K9m~zP*o*#m$vQ{N;7^2sS9QAFEnsRCg zYBOt9((7WG;UhTeYK}T#75tMark<=-NjZKQb=x;gOiMUwbY%$YLaTB%S4oC=Jx9&v zsPSV$Q17=Yr$biGERH&YqYl}H;chZKgP}^wDUe$o%uzepF!v1oI0W@54_T9>oKIxb zogJ*NA92*A`5~yURT8SCoDV_E7<3PC)cmcDZ6T-^S(Wp!%<$g-vA*s;hYXR$Fv1(wG7(AM@F`hDFL1Od z-eUY+AuZ-vb-KPn>gQD)bq9AYLyAIBA4el0ljAco>ST`kBu5>(0|U<#(Pa!((&_iI zi28EW)0L9FDHiw?_!rCmz7D;T4hQHD=wu5~~ zY>sY+SMNbjDdy1Ai~4rnamc;r>AS$}*+^w=FGW#0-q-HPB1!jq7fM? zT_!w_i}nd_W6R~l-`MsBwgNT*?eOQY1P)8!umlcE;IIS^OW?2s4ol#$1P)8!umrl3 zz^uXwpW9wkSXJfm+KW6@-oo-K`?OrAy{N3Prm)ECu0gsEpY+_Bvoh`T+>7i~(Nkhy zP*_o3Y_D)vm3qrY;SX*-Mf2RaQSB}FRIxf`g;m8B?qd5Qw-@&l%d5O+pOx<&0X+Np z6YP#@Iaz6W`B{!>_F=<_nEgBxn3ktZ2C?kv=~L~~T{({F(?-R{CYDsmkP*B$*`f99 zUXOiNnlm@ED*}fLG$p6ZZ7;aIa(+@RV?3$SQ&sNu)C{**y1iu{>X^6IURY%>tgfyo zFDhic@|M-O3ybYu$YowE$FsW^xT{bzv7&q)#OSH2au<1PN7x~QLiRqcP5pE6p);xLr_(2<>yrtBPyw-m*e3b8r)is`?bIv%!o;fYUH6217WzX?|kBSQLL6vn%oX?T=MIK*lrLPvcX3bK$ z#_m~I)wS`F=zg)@rI7ZGwqj#RjG41Cr{!eZ3u{V!l@Nv&1w;a-q;#7c;*;>7eYb*VS)?Fi^+nEi_2-CU@#XKdJFA^MMdZf6CN{ML4>!#xQVTGg9pfp z7?jw7^lP}#VfDJX(;$G}N=jhbkZex63!;j3xYF(Js^V%79E?2Zbt4t#sgL_?rdA>} z*H>QQg}5)m5Jea2gj`7`HJ%E4Nrh+Os908=HyozE)M*(tHjzx4X_pZnK7tw{IblRE zVm(QpJ}qbFbf-Q-%S-I#Z17Zhs*jO(n+CA~HVoNfLp5AwV$tVxgx=Ga&)! z$v!bHeJWjt@#zEhlb+_v$(@;L7cv^597J!UV$-?bWl}YW3KzAibdx#Om1ShTjC?()Gn&TOao`Zd<95jEaPSs28z3=tO`>O22nX|y@q*@xo+=5 zx4Q}h1?CCH8P;6PL--A8Lc_$JE;Z2?MvvK&tfbm9@^o+yAW~5g3&&7fSjzisn%G=u z*=~rE+?mi3DDkl@+7k01_brz8Ys);o3Ya?vt(abNCk`LUe`aK+IWuPtAITk{3y)~y z4%|L77kLi+%eKNt_;em5jKl<9xWH|nJac-kOLhwkfT~8l%iuV|S5q>|YoSh>)p_s% z1yq`otrV5${zf>O+$x&4|2mFt!Yt;2h;?!@?>dZ{m}pS{3zboSCLhqygits+5^9XO znQ7D0r@Lm8?ZWYp_0z0}x<#JqMfxnR<1yE6_=i{+in|8$x!b<53~KMh42X zD+mp@d*)sSxyIHa?h-Ss!5lR*%09`NHaVNPDx~?Qvaog@F;h}eh*8S|O*pq~HxB}e zJw+`1;Gr6-A-Ky2n+x=z8yZ@$nXFc{fbiGuEu80;g>CvG&IRw7&@SR#Hh%22V7$U@ zux-dRD>FMgZE_|B)^<0hYs{(UFfavBgPw`04pv5UG51Ini(-9M<#QLo(U@`gUzP{? zg4k~5!A8AsWq(s1dXFq}(FHP7HyH}Eg#UpOa%Q_QpHwkFo|%^;1WaBXC3aU3$kFGR z?yKs}DA{E`Z!yKIf<`FC5p3O1sNW1-Jm{_R6@{Qk>j!Ina&ht^A`~%n9YOd)G{b8{ z{D>|v-Q)1}3ax7nT3_PJtXJdlAyg@~J2FInb>fZ;QJ?722s3NaP!ZKakr)QmFVydY zb4*5sY-GD;PIqO_%$YqZR{zBZAeMd$5zVoQhpd`rHnM3?6^m`LXo3qUuj2k(Sa=d9 zy=r$2MIpmOd9drm1^fDV()%R_5)XBy5Q~jP3n}I@!^m4jHAUauAsJD4Rp z47q}93dIfKBBsf}X>x2*(x(zr3(VL>UBr|$IH>lhScXFe3fmN(*YL53FAD7oFz4V0 zcxV0<%LaET7Ex>-G#aE?P-=|4cx5$~UIuq89bp4-_0GiOepnRHQ_D`{d{M$*j88M&~9BnKWyV)VMH=a>fja%3cd zUK;iF&+298(4XBUrBBbG#>3OiN^?${J~Io_nVIQw&JNpt?zC)IX1ZgNgC0W-M=vYK zm6Senwkv1)imL!4~4{gUfvldz_xi(YllFV&x#IXfvcFC9iOnbjqI zTIEXhOaY`%&&qw5r-zaawj?+=~UH@Rf2(sJWOGEjldqEWL6b%S#Ew8ZWII=RQ=jO01>NJs@MLgx2?!=0l zO>=rSA(=&UdL5CT^c2DHz#>IQh}?B*iIwicTDlPnU?no7Sn|QVijnL#mWz7Q7jR@j z+!Ynbq_`>X?XGaM)Gz`JNR;JUkmIeiCsG`igt=%^29(5k9iji=ai>mGaJR6myr?Wz z=TU@-f2!I%MFgulV^UMy z<_d&orqoy=a`(tJAk$t{Q(lc2c2uk&ZN;>VnMAQhV^aq;?3iXG-cW+C(6e%!tC>hv zv-Xg5q0CMa50|;Z|Fq|P!b<1cONDIPMV_-n)<<%A41w9XBPTN}JJgH8Uojx;#N1Re z{fj<^p^`A(BsRPSBL{>nOmY=sYX(_NbFk|Ejuy4DzZ0BuwhS|zRD*PXX@zGl^0qZ@ zk+y}YAXili*8=_kMozL8NhSv-D2+ZUHp_#p97GR=bBR=FY#?wkaT0O1XGy}M+%GvjZdYv22JE3hc%@p( z?9w)48Mb+gJuEIMMV_Dtd{?2CubQ?l{vUhq9VbPx^$+)S&&>90n9Z={1xccdC@4sf zUD$<1mbeQdCRCDvAV~}eiXbXc45+9eq9~}SfEZ9N2Jo8jns`)xV!Glrp(1*{>b&3Y zsnfl)z2onFoX zsGu4wnob=D)6-$k6%*sSMjx8``#0K2K{v1to|H(;?v_Y2L+pi4pvj-x)r4dj@<>yb zF=dShn*ZZ4T{`F7>C>?aan3kA>shAZ9nZJ=Ud$B>UVmB%CXcr2IIhm0{92kk{^NDv z`M57vOLdy8S^Q_`ad0+k?6~oC-5E05^rnMCaCN;rt8lR@h1C$u<2fM&F&MMdlHmi&>(aQm2Mq4dXS-xEbz8&Z&VFsG#LSy8kxAm2 z=~Ix0e8cMqk>LrM1%83cD=_iJ1iHGW96Qv?swz9Zq^zckilO44Th(;K_)ez z+B`9rW5MvWvH>Qq8T3Rzk|kw*`&JCa480yppS+X#RaHq;A6UA+Oy8;@)pZIJMhZD& z^SYwi59JkTUrGei*WrAMWp|kBmk+4c?yJMDT|cNEfd*ET*FmcWRAcK5U7J+Updom? zz+|erX2{T?D$TWrk`aTk4N_Cqr^@tmKcgKF-lvrfFV{Zok8c+DlH4@Glj*3Es*1t= zbd$7D2pb{Kc|}6jp290V9n|RF+}A!kc3csHj%45!HjSb2{8SVOLg^4X^1_ zQHI45FPG0rzNTvBYHCdB1IlsTV(u=b4j6&9M}L1y|S`52Id(4j7_Ojiws4 zWJ!6yDq|yTe3$eaP=#&VlKy&mC$WasXN~Y#BfAV4jKvmFK6K*9P#R&> z4lgSoU>t3@H?R-yJF?G+ej=D5tjby z7!cPaRtCgsBM0>zP=bE$hv7~J7;h}90}L2kJC-B^{s1FP?-EHKu}5LrBZ`=ShQTAs z%)l-5;34JM7OTbKhJ7$esK+pFE?IOrlH;Ti^RBQ_xR4A7jg(8&!VS{pUHx0N)XfyPaf zq%QGEx2>TCuIcE=C^A zY)z6Ujyz@!FGE8NGEQTNeq|W{O%n41V_%d}gL-&by$LbcgDSMZvi_bmEBaL{kCPS5 zgeoxQR7JRbR(K~@&*$U7SPP4fy?73`%EP%xJATScoaw;Rm$6q%NKc+V z71R2QFR{wUVIzOaWxC8}o(#<6^wFI6<5Bb6>DD+t)s?^wR55Kv$tkiuc1m$43+p1* zAWcym&g$b$y*{% zfHS9-@BtUksndna!vvDxDGN#P$crRk7ap0BG!NKFVx}C4k>ptaRE>~wR!36O3zCxa zQnjfPEWM1Ih6mkbKlV=TikNZjlIi1&S|#!PY6>fj(iNvo6IU5s+_6U^-J3)J5az{7^SI5kY$DP9y2OglY{TH#Le7q7apCIk= zz5L;ToF}hr%aac^ae8b*rWyb_@kC+|(ueXBi9?7t7vN{2ka1pvL}D@G(jxE?=QK(r zT0_AB#G?>zZVVjpye4QX;-O6wiNlDC@%6>+Bft@#iFhZz&wVH2PQ}O{g`Sp)#8kvP z+awa3NF&~fxbzs<5b<)v1!0+K0FpUu%6W;xUNtL%as@i^LHhBp*NQ`a9yO3(&4?lzU?$ zF%+={Kfe-j&QjPB@p8ob5En0lTn_5H9Ck*$8S!ewdl7F&dfN|Uht92AF=G`%Il`|w z_`zQ?`owdV*nQ$fi=F=Q;)UU|c>DR0s(2^+%Jg{q@_2Dsya*C~;_kqVa&Y=4amwKW zRwcsC2orM?i8pvrL3$a>Tk7STma7>W-RR-Q4;C@HV2HhiN9oU*uEo^f%!sIMf)Kx{MeRAJnV zp}li+yr4@=ZiOnx7x~%LWi*!FvP#Z~PuL)-mx^j)`!N zh0!wO_sc`}IQUEbajahk>vb4q9c-USoQAaNUtD)OUQI)5D&sj7aknA^J&X$vV>QHB zhhs5^$T>Q}Z(&zIJC)NBZK1bez$a@57<2$wY(@Ot-D!x+{FSVDXbe;ZxJ)TiVC7k41%qzc4 zp+oN3$>Uk6y)fl)R{qyI*bkeaBL{QVk5otSKKn#qRHDBeK%Qrj=dXMnLmqs+Umag( zz9P(LKS#c0b#)ng5Atn1Alc7KAv+ZLdSd?kDD&0z>k%dw?r8%v=yBz8Qxm)D4NiTW zbLtH!V<*c9_$ucUaGToES7uFS4)z-IbviDQ7}DG1TgvCMA8Jkf?)zm~{(En>0TkDqr zTk%@rv&g7R5{XIvy#sctJB|&tFERH8v<5wZ5v9W9?F1_=o`!p)pBHV=yaUaBth8QU zT#1!zKk}}bo=7y&ys784IN-;T0o%t$2gC1&XScn%!O<*f_uF8Ds+ zH~(MoUx9D=3%nR*6lLOm_ZK)|xli?k%pu5JNd`Wx5r%?y=1jfM8{f%_RxEKAhv!G^ zBk6d$D9fPV@cFKMRw8i<#%1GU>Nmyq*YF$Mf^eOn&nbH!WJlrIuMg5j7WcmSPQQ5Z zMBg3hy~hIH3)w3no5A~}r@!AaXK8pz+5o)4KJdsJ$M$Lto2&V>wY2U(euL?D|DJxCiA^Rkj=#Nax==} z!}&%S&%j0C@i&Y4;arZ-(XGK7K?dwN-<|;vE6bqobpbXJSPx?Th@JLA+^uFp>Qe)J z5%3R)OCN|$*`hQ24(o63=kp-j6VL5~DJx@LrC;~qe%&iF&hwf9G1hN8^3@<;JLZG8 z%(u@L-!BLG4zP*99w3G?m)h_b9cM7AEaY5sezYHMb@S?v5oQ>a`+ieA^Y2AD2eh2U z_CSB0!~yQbt`j7eHPi{EE^7d9#wi~LOQE9}>oOlL#rl!zsCUnT4&GCT+7H*i zrRuXj*L*6mHdKH9XzOeZV_ikYncl-gC+J;;JU1iHzmYcAMOBjTjj^`}e2-(_YsfPO zYfiga*TC2}SjN6PWbESuTLDD4=44?F3SZ_a_mInQ1$9HR0BcU|!QV$d`bg)lwe$Qc zH1}zYP2l*$8vMTs;zN=5HRSz5?Nu)?M}d8Tajj3rRRIo%XDM$D%DWirVm~!7b@{*e zW_f&h$l25&rNihf31$56=l>TLI3zbN%(pbAJM!~?Fh}OcqyMEeZW;19tTd((<}=hp zxNXYkMaSf9r1UCTB(f~;-svj8vBql@=Y5kO5C8ek#1vt0%?2OuS^tm*X8-a zlvO^hG{NhGAC9;DXff8oDW-lLUiq1aXFq;;z4N1_)zFaEcDaey@^g+hfLG5Axc>N2 zv-tY{OqlxbZEx^|(wej1O|c)Z55G+wCjts392@ivWL*7!Y* z|Ecj2jic47U*onKpQLd=jYn!cUgKFBFVy%}jqlfZo5n9|{GP`D)cAKEYG&}< z<4jzt^i+*kX}m|{Uo~FDpS;HBfW~857<#$J9ksl@N>?du6&txu8jsR=p2i#67<{kB zziM3E*6=GeUZn9}jjeWCuEwJ@Uas*Tjn^D)lA#L>mackXyX$K#7n=yXDtPF;@gD$81CI;WGekzyfhus4S@r2n6fg0{5^ z6E7n_bdrHC@aBlVq)8b0?wvjPol{l7oAaiWzX}7BDSzi2BOuGp0a=o!{CDp0|mI?;5GJf>hF8eP&`eMC<>Rk#oE`dm!7* zuw=vviSV&2uyRbk2;ZE`btC=I1&GQRh1@Ne z^yk`XVa)Y&!)ZB?%ne1i2{UpP^yGKNKj+v+l_)CzLBLK)6Be6)4*8XNc*EMP>MB-v!#r ze;Z|{wQa^V`_2zQ@L<|d_igBO?}8!HsXzpxg$a3xHkb# zJ1hMn5JheW66ZCW3!>QNk%+Xh>B~U0cYnbDwDHXzM%2l@2IZ$+l)f88H+L5EOcA2g zttK)v_b`x3cNVKQFSjA0q3$t67UXsUG0N?Xil*HlH5lWb#G;p^4+Vm^@h`E`mZeWd zdaCsLM^|B65DEfIid(bDUMxfieq*w z(g$=AyEK`32BjO|AG=ooD>4}Zo&>c)Ro3ZicBZKrqI6(Krt)Avw|5<;U7a%j$Ai91)Ruw;><|*GdLx! z$V&uR$=`i|Vm5|q%O=l?u)UH0LpdV!Qd5AKil7yVf+=V(AC;8xm6PaGttmp9&YV=k zNPo~pbn05BcEA{BVL9~jTGWcrtBUCDwM?6GR%9jqOGW7ZNvNsj!(bNiS_mL&_E(vi zlDtA{MXbobK(`CS0%HNXcXY)i+GGg2e&Md!pEMzF5ff9uxq*q^Fw;^btS&|F+So)$ zyHl}d3>l^!=(44!m&(~{u|1SWtntS%EwK*l>BUy{(SD=ex&LNNf8T4^6 z=b%T2(lDUMoC6-61^WD$v(Ka3fSw$4_ImX3pf8I#dpx=k=xbxnPLJ*ddRffb?$HB4 z-w|^*d-Mp<_s5(K9(^w89WiH(M^6I%PRv>5(U*b#Bjzku`osmGLz6=>XOVIWPe$w0 zkBRdVT8G=OTqE`ipzMzLXJ!2YJmbYss0_p_z5ppBN}d&=>`AwylQa8feNQR5isj!} ziZW%jItpby8Hs_Wv)C-;C@bqMMCrGMvROt`f+C#tFvyHuMsXjqSw+c{Ts@u)%XmGM z!?MozrC5T9TCGMv=g!NBB2x9$TArkXg1EEE|`vS`qcJvf9DBGxnI`jtO9|vCQ2D>mR^=hBY%@ zHrV+AER$uvWU#q)vBGA|_oGzv7DD`oAr+bmr?BZi=g}BE7-68o$*jbYeD>7KHku6SFxEP+4aY%%_dBRDB zb-fRTWj$(V4J63CR@SG?@``EaB_6xhQ;aucy#i4e6Aa#mmQYHZLT*TfSE9-8z7RR< z2=Sj4;W*n03G4eE9@C8Lg&ok7?#CgD@l1rxQP@k=Smj7inK2NTOv+=^(YCI=->Qu$quJ~G5_C156X;$k! z$~R3#mAL{jIj)wwC&_Z{0Sp5mmRoD8ycSC7o=%rZMm;Up7ec8m$Dh6A$5`&)7Z@s~ z<^BNnvsaCWLUGQ|#BzD4#y+nan@lw}Lij-h=h7t0{avf!4hweRb;*{CAEi{PYUCAZ z@1iXE6yfQ+J6$KV-Ke%=KLVHtw%Fx)!`%wr69`UPl3hka2zCjb7_3jjWV7V$Rh6a4 z&(BL<*{_(gp9gOTg7c#a(&k(hNNsaFxv_cOw7Wa9WPDn|9U4xWKEZk;RLJp$VK+kN zAQg;500qaKN?l4rGKXv9<|i@J2CJc#;##ws--my6XL_=DrtmYd5kSE!5tY*xWvkA8{y4km@xK+sc%EP*h!Kj&aY_BVT6VkSlx`` zESNiucb9Qm1o~4xZ=)pf@t&bZ^zRN3YL8&WTd5@P!5F(?OxAWqDGJ%CP^A=MS(oOc znYnmQGrRSL{%DX2>hE_k_K(FwxT2kOvgyjg) zMdwX5Y$EG}LS(xtZdpHOG21v~ zITsyesH7O-OXBWHWGJ1zawQJXQ9X$2+o(9 zgHJV$Awy4?ga0-5Ra9fof`NZh8M&=HmuQ9AO9M@gKrcD>stDcdLM>FTJ(|hNd{^PC z1gfEqHlKK<&b4k4_AoZid0kcWacYwh$E_&sH)WeH{{{`(&A!?@1}S{JUChwxi8whD z?SW?RZbgA>9m~23A^IkW-6xZ^4kWMp==dmDL&$m=YfzUu1*#Wv8hYN0CHO1YK=q4pfPJ zSd86|PRYDPdF_u$2SsR^%o9}N7D1&4;twa~s%uMF+RFJ4+P#`~>7*679$bDxtA{m) zl{lSQEw)^Z)U60IjNL8me+J}MgxCUPI3D8C{(GeTZ-f69LfTp_m`e_64=W*!j`vM! zbe+0MgRPuX(XT65xiM!;ovb}3Lgi-QAemHdg;eenX!;N#dJ`_O6~{1-g>L!{EUE8G zsc#Fg8X?HAd$SC?_KKn54yf79GV1mKcp^gVa^%l~3Ted#D`duQrNN895);iaUIZ3b zI>kg+`6lAM`zqr_08d1SjfK8ys1Os)HC_b%Fa&3&wv4N06_D{vbhYx0i4JO&X`)#o zRnJ8Ent>*|*@z^WsJo){qD?+(r7cpvG105I(5BKvht3F^Xn%7x(bPubMX3832x6kC z$BGw$yc|JHG|hMs$lDRbMAPe-Xu9ztfLjq_r$gT?s1Os)FkS@yTL{j2Z9EqbCql+E z(PPRtCMrrY(d{Bt&qRGygeH2@h$NZlLPcq!H+>X)g~~T3It=T`jl8&?iL7EZ(YVI6 z$0w-!hX`V#aV2DNEBH6C#6%N}7lG9XK}^Q@9Op5$5_@H)k*%E!n)RYDROEVrWzOTcT1hU=uT>Rp zDVD61zg1Mk=h+0+MHR$!6tw_ohvJ9V5#qrw6QbaRUy&*yj&k)uuh|0*{R+iaM1iv$a zGebL-J0cSy!)um4GF)cP*D7kR-0M#>4di8ci^v*(!V3H5xmNsfh1mg~m15{Pt24|Y z^*TDn%>ulaWA#GFYon$2FvVI0kdr!gkU9>B%uocUpUM@1h(gBm;E~C-ix( z{b@NrXfF{SDTM@woy<1cfC~kd^}Niply{Z#;2Ui&QXZZJZZp*h<5@XsWqzZ;#@YhX zmTI-k!2KLLI>z3%v^vjg+e51lw?*q3!-ryW`yY?Sj%I^-z9}XTRCj>986o@_rb!v% zA=^McLKb)QGsQ#R0lAkfE`r2mTmK7?A0ss7R)0<|JK;}+UlE*UNp_ipDv0S8dY1ym z)yzIBakZdg7Uvx0ai{9`B>pwZ=Y{o*SDLr%%qJ&jxk_w+#D5tHaX6XTceqzkUUq3a zlo0Rh&E@626O6f#Pd=g5+$lKbQ9yh>xB#J4c2!hP*3Y>PEg~HOcR(oHjm+^QD)R=$ zc{DoaO!QaPu>|&mu1&+&ob-#ZkUczUy&Bp3aQ~YpJ>yp2MxYt2yHRVN%li?RWK%hp zmjD+7y%jw1I0S1=QF9irnK_FWHD~bq08_OhgHCi zv~BhV(!~#;tb>uEZVhvDn2A(pt)i5}gK?3O&FIap!-H{=(Yfz~$Z>80962lf8xTcK z2NLHsM(#ALIh^UjpgK?3I(knr9b7nEm6d_8TY9cdpX9B5o zcrY$9FLxD)p$-qmMHb{f24a-MgK?1?qy}T0lfa5BNq-B`#C#l#i!4k39_gtL55`4S z#9b6K+j*91R_3+@G0$nrl5ff6L61ca55`4q%N-43xx<5Tk@e}jGY7WNPZHcqtbU%Yr(z5#zU?u1H0L4OA z01T05*=(=PK|u=Okvvm?n2Mlf^8lZq&-tjNjITUN5gyG8lcqB#)zIDpI!33iWoid} z!YnL@US5k@HkZ6&^!8e2h;o))0H#!g?w^F3YI035#%m#fsM)KSnUcIhYDFyjBG3(a zW^EL}=pEZZ=6DC=a>jzkgK;_D!MGf56v@H3mPOIEv9BQQ@HQH~xA0n|t$f}sqw6wg z3^$*9n9=)lY4jW`gG!;+#kI1|EGQbOG3{ ztu|cya$n9PRQLkY-D&93sUY!@42VOk^KfrZ=bWm06ABE+&A$pEjT5Mz5$e1IV*Mol@f_u9b%#L)|E5Qm{xz$S13K7maW$F~sJ$9?G5d7n*dnZ@% z@Tslbqh95XZ$W|EplJnyRIamBZX3wW2=Rre+%kwu<+@1a-T?nK1h5l6Z*0yhUu+yfLfy5p=zWkj_2!=AFp;56GVp(m0S8 z%cW7Ah5HMFG@_+6Vi?GQWO0kVm7MsW0&)U^oCsC$K#G%EK8N1yklp7*dJ1_2UN`bi>oj+qXMn7IAFQ76z5ZsYk!Ua&0H&+P` z8w-OPxe(NTkxF!cgnNq;ViKzq3$vV|_dylf%M3jqhJbfi!FP>88dXAZ`=a|`gj+w3JnAv(>0!o|?4R{yIOL|+TgX{2424T+Jn@ifv z+?{(Un)Gf=j+wdVh0tx`#s#!c-nkesBclr!AbkvPw54wJgPbFvjy=bUexA=1hK-Vu zh@)s|$L>hsS0PoF|g4ht%_hwE9u{p}e1H3mg9ntnE9}n=} z49~6ZjOu$c_k-9I)%Rvz1hF^D#{;}K^BIVJQGIXbcMu1xJU$-ay_x-Ju)~uOE%tkt|>jD}4=;BEyb0nWb+0XF1$pEMQ0178^1OH-jlP zVb2>>8YchbIfY}L@m`0MW)Y@mBo*bG!g7A`MCdO@gauemW6-hw_{UJ27niF%9ypyn zoGw(0Yc;EhzKL?^Q?;n&Tta|Np??{GVwQ6QfhX~gAt^_Wc|35|5oboapTQ|dr2u-VDL_m`&~n0H3d&O$29=cY6%GqdD~gb&Gbhzh9%l>a z)U{0QfU}u}<F*TcyK)5o8cjbC?5~--b@H-tBJlh zLu0s2^t~AxJ;%z^_hzV}rFlHy)z?xU4=CcjDU@5e~`S&ZE7BZZPa zh`UED8e(6iU&VBqN&f>fct1w?XXAE<_hTfzk?C}k9!i-ElfIbgOp`7_WAJ{A$nU0n z+@!m+{A`nMK=~Y#=9f9*{TPw|lJa>beJs=YCY?{20+YUzc?%_-`6MjS3GbWeV@M|F z?5E;=6OVoqG*;M_do=fk&%@g$9?hBR#W81|NB;!+(wH;bqxn2?b8$n9qDwU~dCEn4C+O8+M17od|u^3PNt9~Fr6;*6SCCr&0V z6{K&=8$4E=?`cHMdm5*w!pm9yukz}}48Qy`Yqw9wPoT-nTQU2|Wp7z0@b#7qyxww% zEb6p6^RXFkl>7-!D=U6IJLx;IPWueaCW2D2knkj*!-LXsK91u}6;`2=;$jKGbJwG! zpQMp;nbtfyFjSUE}GPq0nbA;s|1y(bJ zqj*m92uE-4ywH&d&D0y%$p~3j19zZ7Hi~|c4bRiSAAt~gSnF~rD)%!gY~vXN4+QR0 z%BNkdNPDH&=WS7v?Qa%AUbZ?T)hfb1D>ou2h{fT&kn4TDK=)=SuBaJW`W0I>lut**W-O4??8y0ujR3xeA=&HPj|kG ztU`k$uPVW@;3us#rpxXh%9qyXo&-<&n6=r-r9*s{nF!VW%&YFlM^oSpRALW8mvI-2 zwL%~FChuF&Um{2oK9MG5=D?>AG9dM7;9u!|@$eM*5kD^fNtIwpbO2Iz`A<{)_ z#ldbZWN2L0wlul6k$1F`w81|_%G=oU`l`_{Dxw8gML(d0@3XRF6wzHdv~V>2kgoZD z8ww0YMJf@bHUA~8nFMkI>vu_#<|<@MVg0*Qgafmc`yPsYm8H(R+*tG@->~dbQTu8O z3S5u!`7T9TCuTX3tPLRVMUa}jE;ZQ=@^1)7-2tgLHlr|J5yz8|E8;U?`w`?^!JFbb z36TFrh-}a*&}=a%uV4Ad+bTjAZ)ZemT|DxGqP&6d(xY*4B}IN$J_j9Mb|_f*P1F?h zy(!8^M`m|W{`I~rO9JAKP=sFTo~eXfQMtt^WCyLXTo=o}^ey=*S|^s=A(m{Ci_sJz zjfW?9h$Xv&>_QfI)^}90m~%i@BZzUI7vu8FESDq5Ch1OLJp*zpS=?;@n>g~jAm2jB zx(KDrrmeX+xJw-QpWuIv5V=52(g;0sA!KZGzQUcUd^6}grcGgw+$mB)M~=LkB(lR3 zk-by3S@xeQ@s^-+y)=re8qfW6%TbTV#Co%h*^cunS3 zeE|MGgve}d66YKnAVcfTg-2Ygd}F;W+7w!EpGYNHPaJT6k_6i&9`73u!+Ex=CB~sv z4ce%Y@|3oUcp7dkjkotwW3}gf;}ztq@zyq{z(ExADS}+YYrBw@28j@YSZbY^r7g%} z1i5bS6SMRI*^?};ny#0V4r4%$LdY6{Qud%wvDE!ysrlf~L2&123ynoS*ZR>SUrURU zEFw3t>@>}g5Lmn=|0v~g3g>%FSCp|>8qL)eeEu*I2F!VQcSAg8u{8P~ROEI9Y4l=g z^m8D$lXW99Egr~XJ^}eYg4kiH*dZU~WFUwgmWds@f$W5k)rHoCxHNjD800kYM<8S` z)MmZ_TstXpoANl#{J`+>o`Jhg*iF~W(VjoOF=K7;-qk^P7l+K-nv28w$G*mOI2g26P z3f0#0Wwvl5N?d>-R$L%fdv-n*9^_XDQr|12 zzBy=-ix9pVQdbJAGsqHztmeqFlNdW;jx=E)$N>oMDOyiH4Y;Q!HzD%kOj9K`;WNnA zZ$|!CNg{P%4ir`{55rDog^N}0I=_)Wu#ub|OqNETj`FJ!q(xJu`m;e!Ly#6-lFOOv ztss{oWaXpGn^1zZXu7m$EBH?!xJzalC47=`Z&$)x$;T_j7HviLI#o8)(GecP?pAcGKp#+~StlWuc?pQW=`3zHq+UBlrsLdTK&3&N|H%tU+?s#eL0gxXd z$XGQ&u9ROuevgplqRbg6L7F>Jn#-4x3J~1FnMRjs;X2jK7T$&&^;_ufQ4v1QSw$bg z4{KOwOW9YO;^2oD7ipbqq|PTnTPFmm;K*F&sRlU&L7H)zG-D#j^C;B}1{@_*rE5X* zou;fm@SxKJg@(C;eMU}4Xu2ExI}qGzRnKQeE7CHl8D}F$ie~gt5k7iaMT_viid9-e z$HV6|6QLQOdCjPjW;_9H4k^f}yk3$H5h5qT8 zy%MakAjeSrD~R)zAn}G?;whJbe@t+`r}uWAdXfpj&>$$I2ysdKs9g} zbZ07I#-Km+THp}c2ra8~@v>v`RlGz%_NdkR9OZE&jT}^qb5&-zDS>BX-Mh7(^6b)M z6E40`j#+m<04ekCdro^^ZoN3fgmSuZp{L8p2?)zu81cS$ zv79>1zG>X-o2Hq4Q$*Z1O*8wZX=dLv&Fq_|nSIkVvu_$pI^~${hUY;G1h`k4BWbf& z8s<$cmUPN7&Fq!NxIe0=9Nk@zab&s`<2I(Aa?JHkId(%2Mc6}n$T7lQ%#qF3gY8DR zi8(r#=N)q*H=&%f(s_utDAEDx^O|vSzc|7j%(3aeAl*K~4b1V)IK%H0;r``C>Bk}6 zErRR7nj-1a2zM`M=5hzHGQ!QvdAac`R&Agj<%6=01eHI0q zJrV9!?#Si2t-X;CP>1K!nQLE!dzHJg$0L2fiVXvRlZ@qPUw8oiWpJx9ybIj$D3DS1 z0GEs$zCbVA;*OBgXJMlG+^S3qk77aP(KX=6Hz-=^vRj#Mb}KWuTNx%OC9=~@i7dei zKZO7CU6093o^XtEx1U`pfEC_HL3XFo+*lMDcB{!O)#E=a{5z%D$+g8gMqy(xr6x3< zL02J%X&{}z;iYaoGu*`!rY|HFB{__yb3GBBcQhh0R)qP+bd)C?8EW(5f|1=ync)ad zzp2Hwnmd?#BWglVszt5vhXmLZx|IPaW`z$EXbC1mQjRpUTN&nIN6ARPGdLx!Fki)% zij4IEmhW5v&>_!~<9%TsdXxg_pr!yZ6^&tqCwnN5EE-f&#$BGI2)~CgN}8UWRKxJ2 zpk2CjEmJ#y#~h<9hfZFLTH#MYyY%*2rb9U^%wvvHP5OTlYN}ZXrhHju08z8^3Xf8f z7fG#%6&?<{fSZTWhw^zr6yA-0(M_FbsRn~__Xwqjf&*@7bx#b=nUP%lV~Q_kWb#W4 zvc$f4OQB&UbH;N?-%*732@vc*aI@p*8>qw!AlNtazQfqg!7YxTGz<;`P4b~O3h_vy zK(l6%y$Zc)pinQ% zenwdbgIeBEAPutyRw>Y!&lPTE;Fz<`*YcY}CuvUiB+Jg9CnmFo2rtQI$0{&cg#&7O zD$Knr)FS4*;Hw#~&|R9-MQbin-ZtSSskv5xcT=mmS>Z#Tnzwy54=KdA0;Ox9<^|<( z_ot3Kf22T96%MrK8--6ZaLoCaug1RGlFvn+njx0mM0wW+)pSu{U1~Mu3P0zm`O{Z3 zTA{ZLgvqu&U0M9;nL3SGtU!!|Mtu)ht#E4tUrKH1*Y_Ut{#$?@SlLU>87xmkfzR5;)P_bGh3fn!dYujXlmCV6VmH*YJCM;+_*%{L0HPp#&6 zg?D;tM)+#-<{P8EZJ^MJmVJz}z6ok6S0Do$iYdCLMq%!wip|FOS}s)RWCLM|)}F5{ z?hw~$%W4I98asuSO$smev`qK4>{4ir=5*Ux_J_)QDyZhL0{c>{314gM!p&1@%rak1 zV}+vFg9H@ngLhPv)k0WF{a>ZPDMmIpY@Vs`=?0EDxBFVADRi-F>229JDr-Sd%Y6#m zms-mfg`fAd-0N%kyF%PgWn0iOpDF9>pqAeiNXHInijK)#U@X?gz%l1hUrQ^6x)~^h zw)9XIzqznZ_tz-E^Ux`@j8*tXPs`K3mdh2oM{~Nxmc3GW{6WS#YBnkGerh$(D*U6T z=5=4qKNN~)n+m$6mi@KzS_m(x|HBK7QBG0e!1Z6C@aYDQIbZl{Iw&;RKu&rhVcC6^ zd0kM?nF`#WTF=D_|IO3$ldtC*h2Akx2(7tOS=`{SW3(*_aGO6x-@K@BI|Ij@7{Aq( zANvD^dT35}o@M`}yc*#p87=cVlWTfvHBA*>>Zxh$t2sfTbp~?Mt&n98R3?9ru}*Ww zD)3=yJu?(O;^{fw*K>nHF-)%YvRS9BR>DeZ&9e%W8QI_v@S4JB8aU=u_*ySu28Cu2o=jYArV_{Hmwr7hlUm3jH6|g5l-`WpSggjzfQ> zK!XM;yXG5(k2i44iJahFp!Q;8o^k{6e$zx*X9+9GVqFxtGPRa+g>Un;vx)5cfxxI($uJ7ULl#)FNrItVMNF`p|iz{m!@`LM#= zMMF_IKkREsTVhPc4K!-O<5RJ+mIt+*tiYqGwG2@B@1B-QU&}cPnQtPj;j`duWgQ7> zS)l-T#!#bRTh=Pv$-psZoUi3ch58zZ6VAQL;?_+aC;Li)D^hFux5Br2TITp#vX>f* zJ)}9^GRtnSycdFM$`trCwVGiH|KX{*$yYN$q1;Bs3@#?N^OV;?cuD<#y8;7LIB@wt zsPI?=$D9XzHP0(F+fy^zviB)(MNrKT3T#fTCbZ00=2cJ4OTL*E!@Y|l6S9~>t6#CLr)7`Si zE6*wpsF|xk3jylQ1ePh>-M}&DBVWyWg$8R*w})jvr@RS4HSa61FtwU56<%xLnDf1_ z<`0Fo7$}5=^ai(B@_AiYNnLZC0^bpOligfdp;iG0=&C@m0QDT8zrsBX9CKRvTFz2vuz^C@81&Rfz*Z-F)+{3^zC*iAEqR6Tz}uDppsHP0(>U1~LNDtxb}Chx?MX}kCE1Y(WcK<-64nOf5_g+KH(b@Mf?SLjDiQ&==Tr|gVl1FrDC z0v!aX=L%mcTw!1wEb}$}q0pHIie#d(uwH|EjP+&)H65qG&8ao@R`^j*({f+a2!&oW zkW)IKH74rH+#l3)odUn7)^nS}4NKG?w)=V>R;Z(aq(!-yt1G*|u#^1ZV+F<=`Jg|1 zukh8LrUSmF$Qom$Ri36Ie(Q+cT-lEWHFZ^BZ)#2b75>`Olyj8ld1onPca-Lek3-We zWj7IaQk#}3(A~%f+jNh@BMcmKN_|aR6}s5d4IRv>5A*ksO1wKu!DeGQiqCY%M7QYybANweU3OcDr zkc(y+Vb17#OEKeND$GG~7Uu%!Z<=T-g@| zHJzov4XHIvQh2?mX`ioYzCzD>nryrbh&jEo-wkTos=(pYnqE>k`vmEB9QAACdBleb zwKb58dl(}QE4#O_lRP5pK4ZPJjeO7}nkjslr>UE-sk1^$4dj$oVkECp<^w@J;}m!~ zwVs&@f8yyG=T9JRROqmQII+7=Sy`O}zOX}qV+E+^3$H8O-@q|vlCR}6g+?1F)YYuyojB|$B( zE3iDZmi-EE^t3$SYxzl`=Tu82eh~HnW3l&xTG}XZB(;_k70x|Ld;f7?%Rq%%8;FO> z$11Cru#$Rzjsj;I*5tZF&gvR_ozyFo4c6*!z)%eM+=chlYvpX81I&V$B0tqjD6?WW4= zA*`g{KT(0vMmE^{6$;Pvv}F2P&QNHPYQYFILs@HsT9zoVGqskx6#mfDQs8TOLZR<9 zr;EnCrabrLK=*&4Ksy2Ib^p%__c3tHY3r-Wc*vM+q~>(7Lfu+4 z^wgZ>tGQ62XAKm>GUyG;dN-(LodSnbYk5N9?C#qCWxkeI6gtX4avq|SPYsTD z-K4zq9sv*7sKC(z)boI66fQS#%(==}^Oi!RG$)pq?0+fmlAs!Ald;P3)N1k--sq`W z;;T7Yq2~<5?c+YmdOxV;3WrMHfzZAMbwcw8Vqq5cowPZYOEVe7PmL>}C_q06WYdKz_L#hSi%&E$X z^$K+V`3kfbpkDV+SGcc%W6pEFmg^N7X`m4HLGM-8l%SSp6j+*C%c}}M=xKSy*Yb%% z&#IRGmi?Qu-VJKWf5ceqaB3|_DV%+Z_WnD*mXj4~WgzZ@4OdnVVI}qcMGA~IvccZJ zLgAU7mIJ<)6$&jN z$2_jAcY<18Rp6)8T0T@bUaH++1}(#hAdR-x}Sr;9DUr%%P@tWRxP;uU#P6N zgIeY*@MCH%D;3V_quoEs*Yco3Ee&M5ZSmto%Ihw?r2hXyRq`t2Gw*{U}tJIeHH%DQ!~$3bGky`duood>}kq#`vx4~Mg`glP|pGG zRJf0UW6rIm|G-7g(vlnJOG`fprRB>Zy6#SM!uY zHyDWPCI3*?x}cV?71)(p%YPK!?`aw1uQBCrF*ZA-S}@D(psZL$zybOy&|ZLg4p6Od zUjyTWlHZmK6dGxu5T4AgQPz~8mOB+#np(?7g&*{^M7xDd6YRe!^sH*Z-RuKpy&Kf> zlLCiRYjL)kGPC<>_c!*nG*Rd%1KBa0yYHgBp2AD&{y_?yp~8XgKTF|Ro|?|Sn&}GN zpgG-Pmc3Yc>w;?5E3hlInym`&_tf|4+Yu_P_O^9wi%oC zHE_&1!`ISAq0=-cZFY+CrUuoVrogh)Y9=WBkf&z0uV#)y&uLCP!rHeg@BN^fM-@1d zTFvtc=T@o*%=6W}t59nLg-UVkT3Nk>mE-_vPa30~X=H;_fQAZR>S?*&*HWU;4XOp# ze?Mid3u-w>fnBM!Oi_5hr{#8E%L0Xd(46>%Tl;S1r4I-=z>^9bEkHd7*sXB6fn&~n zzMB0CjnbU%X*kxQyi0;=vbP(XEl;hcg~A&>H9LGYCo1&3r)DIMbtrFNP|XAdeo3w7 zQibzQRR?&_SF=Q+wg$4@5jfVNyxzh~@_^?RI9r7SL%^E~U*@U#+E??1LQ6a~qj0W6 zdG`m^G$BeKlRiM_0{~W&=F4!*3IM37^7tm3b;T!1v&~)&jq?FJix$sG0Imn zNTD+g#PzxH%9b~6 zm&qXP|1udgMNxm}9>DQ^NZBhIQ#5A2Z7`B92E zzkV;;w%IS>w3n~niwB%W%;bh`MrG69l28x?G1mx>O7ym48*=LznL$(D|-Wo16F((p$;vtM}wWE z_-B4aj9up3MI*3xoAmX84`lzIguN+_jZ%~9Z zojIw7&JO@`=+w1L?SOPJqb!GBUW-~zYtT9L_F86$a+cGJSy)ZFe-g?zSk7t8$7>;g zsM%*SGbMS2)QVWn&7h0DUlB{Y;}eh#hrnhF@ta`{$07rNMXcczaQG`?4gFscJGv-s zZ7dHLbeLarm3D98!^mkh=C6pQt;?V>+{XMBv9$YhS?3%pP98T?r${J8P2(@{r!GOhrfi7!F$=<7f?h&cy6dL`)NW6lAOz6bQ6n6uBLH-erJ zbM|^Pe{~GM3bx0i`Kx2A@MY5;&0ihEuYzs&X#VQh{V`{=M}G+#zY?}V>CCZcD}JOI z`&;;i(=@mREg6!2Y{f4XODhV6{z1ODdgjky#af#m@A{7HmB=T9iq!$j>{i+vq2Ix7 zYGqykqr{4hWD#!jMv~%I<`80yY+;@3W0K+=!gAikzoU2(Fzw0END4@;SVxq+gmq|Y z7fu7f5R!izCFB3Y-kX3)Rb1`k_xA03`_A-iJ^L^W%&@P+A|S%Bxv~g?f`Th5vLr4D z0|+W0NHmEtjK*jT0X1q81vN1m_mG%GToU*FbB%jqqL^qjM*r`7>eTJq!=QFz{?GUP zp0A(hc2}Kq>eQ)Ir%o-ms`_qx7x6EuQgGfB`Fs)x)1spgwf`c<|9UcF7o84a(kHn^ zc<*JYk3Jon4-n4lZ~pQ;G|PxU@2jE?T0dmBzTL zI>?;A;g8>34I>)_oxJh-v*cnW8zJpV$zye}MsvBKjOmO)Cw&H!wk!stDeuHiw2 zDUDOutbpl4WUfv3+Adq;^cZDH*EkCdlGk;Y{z<{ZFy3}N`s1pI7Ab*1+x zmLA6OyK9VXX`a$97xlG`cl`Yn%RfjvL$TO-Pis%zzw+mPZdVzF-{WB!rf_h%2xUZ6-er}Y9VUuAgR)_Ux_HrNl}#!F4g**A@w&5 z5)HtUxh?_kU!v7BQ>tec;4|<@CC(DiLPY10{8o_v19C`>&6XNl3HS;;{_!d+-TPZc zR+zLJap_XUni{)C1!SF+A$w{Qb>jab2Je%F7bZ3J-U4G&5v}!c3L6x2q+(d_&}SdC z1;yYWP*w`kHk2FIz$g^SDsIz^(Ef_2#^6yE@2yhVD)yjEsp7d(#p_Y}v+xuit8{-g zvg}&LtCS#K#bXu5D((ix$TeQYXR1J^il?E9_mC>y{!3HEQ(g1xZhEu~t+q1>8rW(t zfkgbn1!=XzrPhCj=rwpMc<=t6J_mYith{=EPoItTaUdVWlldVS3;@5>eF%)IAm!VD z{|QfO85;6v(~uGUJ0AbW?I6I1)%k)cLt?e-_z!FsutP0>pzt$6|ANBV?N=ciYWhrk z%m1x4e4tpy37tV7hCirK@FYa|;k9^D3;Rkf6xL&mg{N@Hc0oI>!Wa$hK5Z}Hq zk5#;_1pes+FJ*T8zo|~?N46QUw9|x|@TX^*kfr&pO1%`$s90;zRMB}*PfamvVEkQ1 zkTaqxT3(JSI+Fx_NzfJI*5i>Xs*@_(3(+BXDn3D_)Y~d5|LO@V5n~k{3FM)8GMubE z2sfL08I)b5idq3*f+xlQitH*?v=-4b@c4&m*;qyEkc=v46)jdc3w5c&Sw&x0I0sj^ zL~vV0mn*hi72TyJwpBC)<&`SxE5fuv5dINH;gd>N13XyZ3eDUqN-6tYtEg2|vWlil zYCEoxDk_bYW}!i&`8%a|C|s(j`dw(OSgPoTJ53dR!~CH0Kc)i8F9kuV{LO~f_VYCr zV;L=*02;6DmNgZtQ1_)ZCVI!3{>Lqwk3YC5WJ1W`zo0BRQv66I1QQgKiD83Y+Z}K~ z|57rJGrKY=>SL)<#?{up`=wf1j#2lFh@8SM3ZJ1c)7dSBSfdmp1s!k+L_P&H14kiH z>Qvnh(@RRh?fP090C|uN#ro$E$O_x`KY)#o6|0IRe7JFskrI#yQ3e}8}gIPTs*%et~ z_3&TlYzE5e;RLiaWa+%4Bg$XE=kPOoUsU+%C{^N#8mgkmtR6O-)x#pQdWfG19&l#$ zu*j?)7Mazf41|5MG?(B4(LwRiq01Jqs|xkM?3n z$iVTZ60r(je6nfL+GP>bpKtLrp)6j-{2H-bqo7S?v5tQw5iAPr%OFVR_;(WV7QXnz zQWTj*O#cbunULmZ@T7G7_lcm810w{<66XM!Ak6VuUcVGUVL&T246Y&xk&eHo#hx5t zCA0xZ$6r7Ovq-`?jX5Tve;VRtH0mr+E1(U)0`j4iXR(fdE#hUg_AD?#I>-MFzC}!$ ze++BHd>+6uwuN>WRr|+GOiH$pEQ#aSBi_?4VuqJ4M6}i}V%E+>zFfqtwTqaw(IV!E z+VJv%?}0kSMa=Mus$mE_HC%BCf0*8Ya9G1d%<$?Al@6!OOu`>|%wbRdn@M<01)E64e@VX;8{#!x6os_%hxb)E2`zcU*i;dE9)4_twMC<_o$?OijPFtG?uG?N>B+B zbt-;?uCwrIvqrU)RQz&$mbU9}!22E<4}FUm!kmhaQRc$!u7I!1g0}%z_-nI#c%KC) zCIFh)!mnn0Ib9o|f}N7|1=8>f@6aIdUiRh1Ttr5)Dcip;g2Q5UiSjf&pn6m$NA+rKQccU4VGXu(YUmA z2?)BdD&E5A=0!ZC+26VS+-9~d{Lt5$<&<%2XgFdhrpH5XzU2yQu;VWM9d=!0p1!-C53l#JS+SRwbThs8N;cLEcDm z$54L-1)Gbfkp*_#K`bzDR^*=qCU4N>)Y=jxgs8G)_iKf-HkN{Q-49TX_vUJ$Mn{>w zi!>$7?7ezQ_855XAm5crNxt_fU-0R@PT^GW9}QgofiC^M7{b~A3@FNdTlBGA_0bUJ zxgUn+lIPo^jS!dwo<7ehrQGFsnev0xNd`_G*YNMLU=B3+aW|a|&6g~O<=@k30|5QO zsR_>kqVRh&ELB*i+UPB5P)tZL@s!1_j{9ha?JUtYGdWyo=n{ShJfv_Z(B|7_!sfBl zFg;c&=u4cwC8&mO$a~Uj_;R0-B_?l?^Q;7BLV|958xPWovr zE8j9^wb<^aBpO61JBMvu z*f-3Bh)3d)+St~Q`a2)dv+>m5fefw}_1%W(&+sJYDL=OP=S}|ZL??Mo4E(-|8;*C< zcPLyMW2XQP=u%2G_+cYXg=u!E!W&Ces!O|3s+W-0lXyyK@Rtswz1MYt#_)Ko)lDMR z(TL8(6aG&5P1aIAgED$t*SwQR z!Z*b3&)^B}QGSi!g3Rch3g1we#+|xqlrg@Qsp?k0*UIe$$CBzu70Ks==nlYBT0 zwT*ZBtxyEqWcor4OS_pe3)Sr|cFX=?vP+|@=f~ajvog(g zaWCev4E#@GwlBcg7Z0M6eu(Hrc=~toq2VRPoEm#=@2n1&Dl<-9__-3S>Yqfq6;Qmwd)4Nf%SwY|97>35Q1_@}e!`iBe)(S;1uXxj&J%AdeLnoV8Lmc7Vz z*#@SGb6wPf&3VADfLOGb3^nUGJ2+zT?+hnj%M1lVDJ3T?S>hZ~M+Nq5#Ow`E>BC5R zM7IebpMvOqc#Hy%QU$JEQ~xG><|8qO0d)2Ih(t~&zDpjt0jTZ2 z#}__(n;#hXyPz$-4~a)sHUk(mInF1Ike&m>Q8IC82B;UF};q^WXvl=w3 z@OUR8X}!!4+YtR0p5*+Nhwt!lF_e+M>)wqE1Y6=Q#i#6 zRICvKGh%g8n26OQE7r5B)mbXm8&<3a5$itW|2r#IgNXGUqEAz-S2Zccy3%Ct7k$h- z#gp$Sijv(CldN!u$>yP$WL*>{l8wwtHoBd{)>Ns&x`<@&K!iVA$-0PSUN<;5O1582 zVWW{u6n31GoE}ryAquC$zM}920y7F*tuPU5N>;45@5`-6{zrybS630M8ZwmQ5$ozI zV)aF|C!XX7nv@EA#ENyilT5_KdMhSYXN7+f6Kil>ti!WnEx0#VtgTk8MiHw8`H!?> zHHugVAv%R(ovKMG)X-uq{ z3jb|Ptc3~_v7)gdUgfFxn57C^QLAEg7qPBG{?}Nsx{Fx9LiA3G)l-vFtUZuS6!wWI zY_Osz*%X5kg-urYF#%mts=AqVT`Rr22=#M5^y+rMiDduG#<4O4U=O`Uu&-Z>8!f zQWbZ{}bxKBAXM#cQMoQK}0yDW!T}vk#APlA9Gyu}Z)W(u!EOD7>4%j93pSOq6v) zR;)S|*NXL!6|1+1wLkLT+ltj&#F~TXEQ-}#lTxhnO!hd-oNQJwrMfaE)kKBg5|ipk zg^5&mWTo=jIn?=B>=481BT}7+>=#<8`iN9(5Ivnz6~`QEHzZ>fwqPElU`jR0fJIkB zZB7C+y4qi1BGo-vsb*MOZHOORsrrgk7a;rdtyFzQs;dyaoKhX3NvW$_RI1TVa=wBo z)k86<)+${8mV=TOen(*<)gxJ{7Hi|QHTYdDuZXVtiBz{B`=48>`iWHcBYF>|TBS)T z)xk(6?%|)}9yTb7l5v5^+SV3@uNIim*NqAj$)3wfwnZhjk`2V1TO{i*l06R*p0Sek z7s=j5^leJ^6HQ9V-qh^FQ=R0`6;82Su(M+QLE%*bGh)50FcIsutXNCc&swqWwqgws zv64Mdy?CT04iK?w5Us$IJX4cWEc2fnv$#NUu7WAm#WAU_Q24bmscu%7NcBM^Ro_n% z7^-sc%28=^6-TB0kYz6`$)F0Zrj9{$FFfhtJB$&^QcsIUC|2?SjZl~#U}#k|SK%WC zCMr5?jl!aJ2XOwTj?>85na%Y%=TVcF?SR}(oWoRo4XEjmG~ORnY17N zBOvC3;y66c5o9+)$+97ElMk0th3yIuFT-;r*;;x_bre}v&QdO;Q&L3ynL)JLf|+Ys z6q(@_R$_tn;Osgqv*P|l^X|Mm%#H8P@2#~IKwa&T^VoRoOcfPpDL&rZjC zhSsMJb5ADHL>^EW#)Z$4d2iu&HL;g-!Fx9uFUTT{k#}_UdO+~V;pohZ0b#yQ!;1p z{CUn>?%fD=Iu6u-a+e@j)QPJXf0l5G(}PLhc4bF#Z4=U)_Zfp;0J!m?#F3WcBL+^6 zk0yj;PjGompk>1S@dUZoIz5>5iG)XHHG1raFJH$02&H@j$9_J7fIiXChMOUjQ_Y{ak=Ztxprfv7f6EY4rKV9LIicMx>9g$9^6|WU$XS z<~a8A7eq$-%bDgBiH!I8#vI3f>Y>Gn{&IZd*w0w}O!xW59LIhRLu9tE$9^cmT%T{u zaqMRWFbjK{V?P%myx7-cKi460ntungxiE7NB5QrVF~_kVo=7;?*JD30H)o@-$A0=C za*2N_OK@#we?%_x_1MoMM1Jh+v7dE_+~7~eH;(;m!p|)}-x=+w+0s$Ww8M#(h3hVYGfav@kH`I4@H zwKEcd1mCGAt^{>Lq8ku$lEh-s%k0hw_B{qPz3#!6(@Wl%_cCwHhwzPgl1O1kMH+TY z?j-pty_QuP2d*Ra7<{pM1>qzwMzEGOtnq6R6dG2vNi4GQ%Sqmj?^@P+mTkgh_%whb z32WY9rC{>KZ3E_IoGBs?!w4}gBgRUIO-_x#2np@QkZgejPI4b27UPRgHZ9t?yfIH6 zY4J3nEMCPtgV#vGF{ z$yeRAH0mtSxR~TQ02YuBtvri$l9wZ1OKZ;p6QpyJx8Yj^q4~$KEQ6DL48U5pg?1QK z`%We%C0j_A#7SllA8Oy2r!GAj(FXg*ykQ;^@QrzcePiAby)mD_V?W;pwXes1_*&5E z$>mKP``LhS*pqJ|aO{UlFLP>`36A|RhrRj6JatV4n_r=x@F7(p{|q{{wV#Cf&OEhs zu!QxrkAzPJ@6>f&B>XzmpSrGxgg<23>rC3t65d1L55QHYZtx|1UkStI5Ptb zshxl=bA6UI>H;xXP`i zTz!|PAu5Uv8J9zpoa@L4}{|b@Y@ub%$VeM&9|K7(-CfBDHUI5~0JmI!C z5yOX?bkgU8bO+|F!FpMvZIJSo20T<2D?kS)D17QvG$1Z=&59fbH)JYiB< zejQVrpvFd;P~{K;^PgnfKUN2raN#`^-q`qUXRrBA(kYstgn-sS0=}i?OS~jrs|8NK zgSl_vPMHC0QtFZr*piQxtZF!j?kTpDL_A#K2GC zD=3LbDx2}cU#K7r-I47u>SsGB_aB8=V$B+-u`d*IgfXetj9?#{ADGmhz==s6;Yv?% z6ts019xm(h`I!G>f#Jk@w18+ zs|ji~#^(N{5bsh2IR0>k=%6Q{o$aEl{YU-)n9nQinL;S0F zq;Qp{a91I|1yA}w6mAs!a9>PKt6loMUjckOQ5>H41xm_YV;tDiKs<>jXi;(5$<~92 zt^%eI9vClo-I!NJPK$N++^B%d4BQz3`BSXNI=6uJ_&RvMgeNr_TBSP2e=mTOrVHeH#QV10Gi%SvwKr^NGxzhvc4Ki{-RHY6cR*Gg&n1vnL^5MOv z@Fc_pZGpG1E|NG!A1Dfrs!6cM6?$zrAy$&m{B32TIXc0gwe~2+97(cE3v5!RCz<@H z(V~Giqt(vYCL{XBaGqu%O{?4au#pc~+1p<>ntd-akt(dkRIrcyKrEyN%F5uWpoM%O z2GWA)V1ix-gAXQ>&FP4qgr}Gd;zQ{l??Uuug18v+&oq}SUPbg-Jn1IX%s0!86(z-r zs`}#fHJbto~Slrf^czL~msI6M4}mB`BIl$brRm(NRqXu)EiI*}o5E0=M+%rdnBz@U@ZuQhtSsr* z4QUc)7GU915my@G0&lFf&tQ$BI86JMpy{h25zdBs7bx;^%>?Br+MLbg&n6S`?H?-G z(Ra--$&$6IkmjyZTGBb)UV>RXP1~9NqS5w=2=n7^3To5@pKc(*Y^eNTJYs@R4<%?N zqNfr>6MT9wE%G`tKgrSMi2-Bplgm^kXA| z8Hy+EBry^PrkF#k*JT_w9q?&*f(u?25gm@f-;YYjK5Q_?HR-m^S>p?@P+D>6b<