daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

change python config, add jupyter and ein

Browse Source
This commit is contained in:
Daniel Weschke
2024-05-05 20:36:39 +02:00
parent b18d02d8d5
commit 8b80ceda39
168 changed files with 177127 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
lisp/anaphora/anaphora-pkg.el Normal file
View File

@@ -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:

474
lisp/anaphora/anaphora.el Normal file
View File

@@ -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 <walker@pobox.com>
;; 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

14
lisp/code-cells/code-cells-pkg.el Normal file
View File

@@ -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:

442
lisp/code-cells/code-cells.el Normal file
View File

@@ -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 <arstoffel@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
;;; 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

14
lisp/deferred/deferred-pkg.el Normal file
View File

@@ -0,0 +1,14 @@
(define-package "deferred" "20170901.1330" "Simple asynchronous functions for emacs lisp"
'((emacs "24.4"))
:commit "2239671d94b38d92e9b28d4e12fd79814cfb9c16" :authors
'(("SAKURAI Masashi <m.sakurai at kiwanami.net>"))
:maintainers
'(("SAKURAI Masashi <m.sakurai at kiwanami.net>"))
:maintainer
'("SAKURAI Masashi <m.sakurai at kiwanami.net>")
:keywords
'("deferred" "async")
:url "https://github.com/kiwanami/emacs-deferred")
;; Local Variables:
;; no-byte-compile: t
;; End:

971
lisp/deferred/deferred.el Normal file
View File

@@ -0,0 +1,971 @@
;;; deferred.el --- Simple asynchronous functions for emacs lisp -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 SAKURAI Masashi
;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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<KEY . VALUE>" )
(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<LIST>" )
(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<KEY . VALUE>" )
(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<LIST>" )
(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

1109
lisp/ein/ein-cell.el Normal file
View File

File diff suppressed because it is too large Load Diff

331
lisp/ein/ein-classes.el Normal file
View File

@@ -0,0 +1,331 @@
;;; ein-classes.el --- Classes and structures. -*- lexical-binding:t -*-
;; Copyright (C) 2017 John M. Miller
;; Author: John M Miller <millejoh at mac dot com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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/<KERNEL-ID>
ws-url ; ws://<URL>[:<PORT>]
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-mode-map>\\[ein:notebook-restart-session-command-km]")
(status_reconnecting.Kernel . "Kernel reconnecting...")
(status_reconnected.Kernel . "Kernel reconnected")
(status_disconnected.Kernel . "Kernel requires reconnect \\<ein:notebook-mode-map>\\[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

34
lisp/ein/ein-completer.el Normal file
View File

@@ -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 <aka.tkf at gmail.com> / John Miller <millejoh at mac.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

353
lisp/ein/ein-contents-api.el Normal file
View File

@@ -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 <aka.tkf at gmail.com>
;; John M. Miller <millejoh at mac.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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)

174
lisp/ein/ein-core.el Normal file
View File

@@ -0,0 +1,174 @@
;;; ein-core.el --- EIN core -*- lexical-binding:t -*-
;; Copyright (C) 2012 Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

230
lisp/ein/ein-dev.el Normal file
View File

@@ -0,0 +1,230 @@
;;; ein-dev.el --- Development tools -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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"
"<!-- Ensure no information sensitive to your institution below!!! -->\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

63
lisp/ein/ein-events.el Normal file
View File

@@ -0,0 +1,63 @@
;;; ein-events.el --- Event module -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

63
lisp/ein/ein-file.el Normal file
View File

@@ -0,0 +1,63 @@
;;; ein-file.el --- Editing files downloaded from jupyter -*- lexical-binding:t -*-
;; Copyright (C) 2017- John M. Miller
;; Authors: Takafumi Arakaki <aka.tkf at gmail.com>
;; John M. Miller <millejoh at mac.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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)

729
lisp/ein/ein-gat.el Normal file
View File

@@ -0,0 +1,729 @@
;;; ein-gat.el --- hooks to gat -*- lexical-binding: t; -*-
;; Copyright (C) 2019 The Authors
;; Authors: dickmao <github id: 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 <http://www.gnu.org/licenses/>.
;;; 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 - <<EOF
from notebook.auth import passwd
print(passwd('%s', 'sha1'))
EOF
" ein:gat-python-command raw-password)))
(ein:gat-shell-command gat-hash-password-python)))
(defun ein:gat-crib-password ()
(let* ((gat-crib-password-python
(format "%s - <<EOF
from traitlets.config.application import Application
from traitlets import Unicode
class NotebookApp(Application):
password = Unicode(u'', config=True,)
app = NotebookApp()
app.load_config_file('jupyter_notebook_config.py', '~/.jupyter')
print(app.password)
EOF
" ein:gat-python-command))
(config-dir
(elt (assoc-default
'config
(ein:json-read-from-string (ein:gat-shell-command "jupyter --paths --json")))
0))
(config-json (expand-file-name "jupyter_notebook_config.json" config-dir))
(config-py (expand-file-name "jupyter_notebook_config.py" config-dir))
result)
(when (file-exists-p config-py)
(setq result
(awhen (ein:gat-shell-command gat-crib-password-python)
(unless (zerop (length it)) it))))
(unless (stringp result)
(when (file-exists-p config-json)
(-let* (((&alist 'NotebookApp (&alist 'password))
(json-read-file config-json)))
(setq result password))))
result))
(defun ein:gat-kaggle-env (var json-key)
(when-let ((val (or (getenv var)
(let ((json (expand-file-name "kaggle.json" "~/.kaggle")))
(when (file-exists-p json)
(assoc-default json-key (json-read-file json)))))))
(format "--env %s=%s" var val)))
(defun ein:gat--run (remote-p batch-p refresh)
(unless with-editor-emacsclient-executable
(error "Could not determine emacsclient"))
(ein:gat-install-gat
(-if-let* ((ipynb-name
(if (string= major-mode "ein:ipynb-mode")
(file-name-nondirectory (buffer-file-name))
(awhen (aand (ein:get-notebook) (ein:$notebook-notebook-name it)) it)))
(callback
(if (string= major-mode "ein:ipynb-mode")
(apply-partially (lambda (buffer*
_notebook _created
&rest _args)
(when (buffer-live-p buffer*)
(kill-buffer-if-not-modified buffer*)))
(current-buffer))
#'ignore))
(default-directory (ein:gat-where-am-i))
(password (if (or batch-p (not remote-p))
""
(or (ein:gat-crib-password)
(let ((new-password
(read-passwd "Enter new password for remote server [none]: " t)))
(if (zerop (length new-password))
new-password
(let ((hashed (ein:gat-hash-password new-password)))
(if (cl-search ":" hashed)
hashed
(prog1 nil
(ein:log 'error "ein:gat--run: %s %s"
"Could not hash" new-password)))))))))
(gat-chain-args `("gat" nil
"--project" ,(ein:gat-project)
"--region" ,(ein:gat-region)
"--zone" ,(ein:gat-zone)))
(common-options (append '("--bespoke")
'("--user" "root")
'("--env" "GRANT_SUDO=1")
(awhen (ein:gat-kaggle-env "KAGGLE_USERNAME" 'username)
(split-string it))
(awhen (ein:gat-kaggle-env "KAGGLE_KEY" 'key)
(split-string it))
(awhen (ein:gat-kaggle-env "KAGGLE_NULL" 'null)
(split-string it))))
(gat-chain-run (if remote-p
(append '("run-remote")
common-options
`("--vendor" ,ein:gat-vendor)
`("--machine" ,(ein:gat-elicit-machine))
`(,@(when (string= (ein:gat-elicit-preemptible) "y")
(list "--spot")))
`(,@(awhen (ein:gat-elicit-disksizegb)
(list "--disksizegb"
(number-to-string it))))
`(,@(when (string= ein:gat-vendor "aws")
(list "--keyname"
(ein:gat-elicit-keyname))))
`(,@(-when-let* ((gce-p (string= ein:gat-vendor "gce"))
(gpus (ein:gat-elicit-gpus))
(nonzero (not (zerop gpus))))
(list "--gpus"
(number-to-string gpus)
"--gpu"
(ein:gat-elicit-gpu-type)))))
(append '("run-local") common-options)))
(now (truncate (float-time)))
(gat-log-exec (append gat-chain-args
(list "log" "--after" (format "%s" now)
"--vendor" ein:gat-vendor
"--until" "is running at:"
"--nextunit" "shutdown.service")))
(command (cond (batch-p
(format "start.sh jupyter nbconvert --ExecutePreprocessor.timeout=21600 --to notebook --execute %s" ipynb-name))
((zerop (length password))
(format "start-notebook.sh --NotebookApp.token=''"))
(t
(format "start-notebook.sh --NotebookApp.password='%s'" password))))
(last-known-buffer (current-buffer)))
(progn
(unless (or (file-directory-p
(concat (file-name-as-directory default-directory) ".gat"))
(member ".gat" (split-string default-directory "/")))
(let* ((command (format "gat --project %s --region %s --zone %s create"
(ein:gat-project) (ein:gat-region) (ein:gat-zone)))
(retcode (shell-command command)))
(unless (zerop retcode)
(error "ein:gat-where-am-i: \"%s\" exited with %d" command retcode))))
(cl-destructuring-bind (pre-docker . post-docker) (ein:gat-dockerfiles-state)
(if (or refresh (null pre-docker))
(if (fboundp 'magit-with-editor)
(magit-with-editor
(let* ((dockerfile (format "Dockerfile.%s" (file-name-sans-extension ipynb-name)))
(base-image (ein:gat-elicit-base-image))
(_ (with-temp-file dockerfile
(insert (format "FROM %s\nCOPY --chown=jovyan:users ./%s .\n"
base-image ipynb-name))))
(my-editor (when (and (boundp 'server-name)
(server-running-p server-name))
`("-s" ,server-name))))
(ein:gat-chain
last-known-buffer
(apply-partially
#'ein:gat-chain
last-known-buffer
(when remote-p
(apply-partially
#'ein:gat-chain
last-known-buffer
(unless batch-p
(apply-partially #'ein:gat-jupyter-login ipynb-name default-directory callback))
gat-log-exec))
(append gat-chain-args gat-chain-run (list "--dockerfile" dockerfile "--command" command)))
`(,with-editor-emacsclient-executable nil ,@my-editor ,dockerfile))))
(error "ein:gat--run: magit not installed"))
(if (special-variable-p 'magit-process-popup-time)
(let ((magit-process-popup-time 0))
(ein:gat-chain
last-known-buffer
(when remote-p
(apply-partially
#'ein:gat-chain
last-known-buffer
(unless batch-p
(apply-partially #'ein:gat-jupyter-login ipynb-name default-directory callback))
gat-log-exec))
(append gat-chain-args gat-chain-run (list "--dockerfile" pre-docker "--command" command))))
(error "ein:gat--run: magit not installed")))))
(message "ein:gat--run: aborting"))))
(defun ein:gat-elicit-base-image ()
"Using a defcustom as HIST is suspect but pithy."
(ein:completing-read
"FROM image: " ein:gat-base-images nil 'confirm
nil 'ein:gat-base-images (car ein:gat-base-images)))
(defun ein:gat-elicit-preemptible ()
(interactive)
(let ((kind (cl-case (intern ein:gat-vendor)
(gce "Preemptible")
(otherwise "Spot")))
(default (or (car ein:gat-preemptible-history) "n")))
(ein:completing-read
(format "%s [%s]: " kind default)
(split-string "y n")
nil t nil
'ein:gat-preemptible-history default)))
(defun ein:gat-elicit-keyname ()
(interactive)
(ein:completing-read
(format "Keyname%s: " (aif (car ein:gat-keyname-history)
(format " [%s]" it) ""))
nil nil nil nil
'ein:gat-keyname-history (car ein:gat-keyname-history)))
(defun ein:gat-elicit-machine ()
(interactive)
(let ((machine ""))
(while (zerop (length machine))
(setq machine (ein:completing-read
(format "Machine Type%s: " (aif (car ein:gat-machine-history)
(format " [%s]" it) ""))
(append (seq-uniq ein:gat-machine-history)
(seq-remove (lambda (x) (member x ein:gat-machine-history))
(cl-copy-list (ein:gat-machine-types))))
nil t nil 'ein:gat-machine-history
(car ein:gat-machine-history))))
machine))
(defun ein:gat-elicit-gpu-type ()
(interactive)
(let ((types ein:gat-gpu-types))
(ein:completing-read
(format "GPU%s: " (aif (car ein:gat-gpu-type-history)
(format " [%s]" it) ""))
(append (seq-uniq ein:gat-gpu-type-history)
(seq-remove (lambda (x) (member x ein:gat-gpu-type-history))
(cl-copy-list types)))
nil t nil 'ein:gat-gpu-type-history
(car (or ein:gat-gpu-type-history types)))))
(defun ein:gat-elicit-gpus ()
(interactive)
(cl-loop for answer =
(string-to-number
(ein:completing-read
(format "Number GPUs%s: "
(format " [%s]" (or (car ein:gat-gpus-history) "0")))
'("0") nil nil nil
'ein:gat-gpus-history (car ein:gat-gpus-history)))
until (>= 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.<notebook> 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)

126
lisp/ein/ein-ipdb.el Normal file
View File

@@ -0,0 +1,126 @@
;;; ein-ipdb.el --- Support ipython debugger (ipdb) -*- lexical-binding:t -*-
;; Copyright (C) 2015 - John Miller
;; Author: John Miller <millejoh at mac.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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.
\\<ein:ipdb-mode-map>")
(provide 'ein-ipdb)

81
lisp/ein/ein-ipynb-mode.el Normal file
View File

@@ -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 <aka.tkf at gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

435
lisp/ein/ein-jupyter.el Normal file
View File

@@ -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 <millejoh at mac.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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)

612
lisp/ein/ein-kernel.el Normal file
View File

@@ -0,0 +1,612 @@
;;; ein-kernel.el --- Communicate with IPython notebook server -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

56
lisp/ein/ein-kernelinfo.el Normal file
View File

@@ -0,0 +1,56 @@
;;; ein-kernelinfo.el --- Kernel info module -*- lexical-binding:t -*-
;; Copyright (C) 2012 Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

55
lisp/ein/ein-kill-ring.el Normal file
View File

@@ -0,0 +1,55 @@
;;; ein-kill-ring.el --- Kill-ring for cells -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

116
lisp/ein/ein-log.el Normal file
View File

@@ -0,0 +1,116 @@
;;; ein-log.el --- Logging module for ein.el -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

8082
lisp/ein/ein-markdown-mode.el Normal file
View File

File diff suppressed because it is too large Load Diff

65
lisp/ein/ein-node.el Normal file
View File

@@ -0,0 +1,65 @@
;;; ein-node.el --- Structure to hold data in ewoc node -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-node.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-node.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-node.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ewoc)
(require 'ein-core)
(cl-defstruct ein:$node
path ; list of path
data ; actual data
class ; list
)
(defun ein:node-new (path data &optional class &rest args)
(apply #'make-ein:$node :path path :data data :class class args))
(defun ein:node-add-class (node &rest classes)
(mapc (lambda (c) (cl-pushnew c (ein:$node-class node))) classes))
(defun ein:node-remove-class (node &rest classes)
(let ((node-class (ein:$node-class node)))
(mapc (lambda (c) (setq node-class (delq c node-class))) classes)
(setf (ein:$node-class node) node-class)))
(defun ein:node-has-class (node class)
(memq class (ein:$node-class node)))
(defun ein:node-filter (ewoc-node-list &rest args)
(cl-loop for (key . class) in (ein:plist-iter args)
do (setq ewoc-node-list
(cl-loop for ewoc-node in ewoc-node-list
for node = (ewoc-data ewoc-node)
when (cl-case key
(:is (ein:node-has-class node class))
(:not (not (ein:node-has-class node class)))
(t (error "%s is not supported" key)))
collect ewoc-node)))
ewoc-node-list)
(provide 'ein-node)
;;; ein-node.el ends here

1011
lisp/ein/ein-notebook.el Normal file
View File

File diff suppressed because it is too large Load Diff

826
lisp/ein/ein-notebooklist.el Normal file
View File

@@ -0,0 +1,826 @@
;;; ein-notebooklist.el --- Notebook list buffer -*- lexical-binding:t -*-
;; Copyright (C) 2018- John M. Miller
;; Authors: Takafumi Arakaki <aka.tkf at gmail.com>
;; John M. Miller <millejoh at mac.com>
;; This file is NOT part of GNU Emacs.
;; ein-notebooklist.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-notebooklist.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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'widget)
(require 'cus-edit)
(require 'ein-core)
(require 'ein-contents-api)
(require 'deferred)
(require 'dash)
(require 'ido)
(declare-function ein:jupyter-crib-token "ein-jupyter")
(declare-function ein:jupyter-get-default-kernel "ein-jupyter")
(declare-function ein:jupyter-crib-running-servers "ein-jupyter")
(declare-function ein:file-open "ein-file")
(autoload 'ein:get-notebook "ein-notebook")
(defcustom ein:notebooklist-login-timeout (truncate (* 6.3 1000))
"Timeout in milliseconds for logging into server"
:group 'ein
:type 'integer)
(make-obsolete-variable 'ein:notebooklist-first-open-hook nil "0.17.0")
(cl-defstruct ein:$notebooklist
"Hold notebooklist variables.
`ein:$notebooklist-url-or-port'
URL or port of IPython server.
`ein:$notebooklist-path'
The path for the notebooklist.
`ein:$notebooklist-data'
JSON data sent from the server.
`ein:$notebooklist-api-version'
Major version of the IPython notebook server we are talking to."
url-or-port
path
data
api-version)
(define-obsolete-variable-alias 'ein:notebooklist 'ein:%notebooklist% "0.1.2")
(ein:deflocal ein:%notebooklist% nil
"Buffer local variable to store an instance of `ein:$notebooklist'.")
(ein:deflocal ein:%notebooklist-new-kernel% nil
"Buffer local variable to store kernel type for newly created notebooks.")
(defcustom ein:notebooklist-sort-field :name
"The notebook list sort field."
:type '(choice (const :tag "Name" :name)
(const :tag "Last modified" :last_modified))
:group 'ein)
(defcustom ein:notebooklist-sort-order :ascending
"The notebook list sort order."
:type '(choice (const :tag "Ascending" :ascending)
(const :tag "Descending" :descending))
:group 'ein)
(defvar ein:notebooklist-buffer-name-template "*ein:notebooklist %s*")
(defvar ein:notebooklist-map (make-hash-table :test 'equal)
"Data store for `ein:notebooklist-list'.
Mapping from URL-OR-PORT to an instance of `ein:$notebooklist'.")
(defun ein:notebooklist-keys ()
"Get a list of registered server urls."
(hash-table-keys ein:notebooklist-map))
(defun ein:notebooklist-list ()
"Get a list of opened `ein:$notebooklist'."
(hash-table-values ein:notebooklist-map))
(defun ein:notebooklist-list-remove (url-or-port)
(remhash url-or-port ein:notebooklist-map))
(defun ein:notebooklist-list-add (nblist)
"Register notebook list instance NBLIST for global lookup.
This function adds NBLIST to `ein:notebooklist-map'."
(puthash (ein:$notebooklist-url-or-port nblist)
nblist
ein:notebooklist-map))
(defun ein:notebooklist-list-get (url-or-port)
"Get an instance of `ein:$notebooklist' by URL-OR-PORT as a key."
(gethash url-or-port ein:notebooklist-map))
(defsubst ein:notebooklist-url (url-or-port &rest paths)
(apply #'ein:url url-or-port "api/contents" paths))
(defun ein:notebooklist-sentinel (url-or-port process event)
"Remove URL-OR-PORT from ein:notebooklist-map when PROCESS dies"
(when (not (string= "open" (substring event 0 4)))
(ein:log 'info "Process %s %s %s"
(car (process-command process))
(replace-regexp-in-string "\n$" "" event)
url-or-port)
(ein:notebooklist-list-remove url-or-port)))
(defun ein:notebooklist-get-buffer (url-or-port)
(get-buffer-create
(format ein:notebooklist-buffer-name-template url-or-port)))
(defun ein:notebooklist-token-or-password (url-or-port)
"Return token or password for URL-OR-PORT.
Jupyter requires one or the other but not both.
Return empty string token if all authentication disabled.
Return nil if unclear what, if any, authentication applies."
(cl-multiple-value-bind (password-p token) (ein:jupyter-crib-token url-or-port)
(cond ((eq password-p t) (read-passwd (format "Password for %s: " url-or-port)))
((and (stringp token) (eq password-p :json-false)) token)
(t nil))))
(defun ein:notebooklist-ask-url-or-port ()
(let* ((default (ein:url (aif (ein:get-notebook)
(ein:$notebook-url-or-port it)
(aif ein:%notebooklist%
(ein:$notebooklist-url-or-port it)))))
(url-or-port-list
(-distinct (mapcar #'ein:url
(append (when default (list default))
(if (stringp ein:urls)
(list ein:urls)
ein:urls)
(mapcar
(lambda (json)
(cl-destructuring-bind (&key url &allow-other-keys)
json
(ein:url url)))
(ein:jupyter-crib-running-servers))))))
(url-or-port (let (ido-report-no-match ido-use-faces)
(ein:completing-read "URL or port: "
url-or-port-list
nil nil nil nil
(car-safe url-or-port-list)))))
(ein:url url-or-port)))
(defsubst ein:notebooklist-canonical-url-or-port (url-host username)
"Canonicalize.
For the record,
https://hub.data8x.berkeley.edu
needs to look like
https://hub.data8x.berkeley.edu/user/1dcdab3c2f59736806b85af865a1a28d"
(ein:url url-host "user" username))
(cl-defun ein:notebooklist-open* (url-or-port &optional path resync callback errback hub-p
&aux (canonical-p (not hub-p)) tokens-key)
"Workhorse of `ein:login'.
A notebooklist can be opened from any PATH within the server root hierarchy.
PATH is empty at the root. RESYNC, when non-nil, requeries the contents-api
version and kernelspecs.
Full jupyterhub url is https://hub.data8x.berkeley.edu/user/1dcdab3c2f59736806b85af865a1a28d/?token=c421c6863ddb4e7ea5a311c31c948cd0
URL-HOST is hub.data8x.berkeley.edu
USERNAME is 1dcdab3c2f59736806b85af865a1a28d
TOKEN is c421c6863ddb4e7ea5a311c31c948cd0
CALLBACK takes two arguments, the resulting buffer and URL-OR-PORT.
ERRBACK takes one argument, the resulting buffer."
(setq path (or path ""))
(if (and (not resync) (ein:notebooklist-list-get url-or-port))
(ein:content-query-contents
url-or-port path
(apply-partially #'ein:notebooklist-open--finish url-or-port callback)
errback)
(when hub-p
(let* ((parsed-url (url-generic-parse-url url-or-port))
(url-host (url-host parsed-url))
(cookies (ein:query-get-cookies url-host "/user/"))
(previous-users
(mapcar
(lambda (entry)
(file-name-nondirectory (directory-file-name (plist-get entry :path))))
cookies))
(pq (url-path-and-query parsed-url))
(path0 (car pq))
(query (cdr pq))
(_ (setf canonical-p
(and (stringp path0)
(string-match "user/\\([a-z0-9]+\\)" path0))))
(username (if canonical-p
(match-string-no-properties 1 path0)
(read-no-blanks-input "User: " (car previous-users))))
(_ (setf url-or-port
(ein:notebooklist-canonical-url-or-port url-host username)))
(_ (setf tokens-key
(ein:query-divine-authorization-tokens-key url-or-port)))
(token
(if (and (stringp query)
(string-match "token=\\([a-z0-9]+\\)" query))
(prog1
(match-string-no-properties 1 query)
(cl-assert canonical-p))
(when canonical-p
(read-no-blanks-input "Token: ")))))
(when token
(setf (gethash tokens-key ein:query-authorization-tokens) token))))
(if (not canonical-p)
;; Retread to get _xsrf for canonical url
(progn
(ein:notebooklist-list-remove url-or-port)
(ein:notebooklist-login--iteration url-or-port callback errback nil -1 nil))
(when tokens-key
(let ((belay-tokens
(lambda (&rest _args)
(remhash tokens-key ein:query-authorization-tokens))))
(add-function :before (var errback) belay-tokens)
(add-function :before (var callback) belay-tokens)))
(ein:query-notebook-api-version
url-or-port
(lambda ()
(ein:query-kernelspecs
url-or-port
(lambda ()
(deferred:$
(deferred:next
(lambda ()
(ein:content-query-hierarchy url-or-port))))
(ein:content-query-contents
url-or-port path
(apply-partially #'ein:notebooklist-open--finish url-or-port callback)
errback))))))))
(make-obsolete-variable 'ein:notebooklist-keepalive-refresh-time nil "0.17.0")
(make-obsolete-variable 'ein:enable-keepalive nil "0.17.0")
(defcustom ein:notebooklist-date-format "%F"
"The format spec for date in notebooklist mode.
See `ein:format-time-string'."
:type '(or string function)
:group 'ein)
(defun ein:notebooklist-open--finish (url-or-port callback content)
"Called via `ein:notebooklist-open*'."
(ein:log 'verbose "Opening notebooklist at %s"
(ein:url url-or-port (ein:$content-path content)))
(with-current-buffer (ein:notebooklist-get-buffer url-or-port)
(ein:notebooklist-mode)
(let ((restore-point (aand (widget-at)
(awhen (widget-value it)
(and (stringp it) it))
(string-match-p "Open\\|Stop\\|Delete" it)
(point))))
(awhen ein:%notebooklist%
(ein:notebooklist-list-remove (ein:$notebooklist-url-or-port it)))
(setq ein:%notebooklist%
(make-ein:$notebooklist :url-or-port url-or-port
:path (ein:$content-path content)
:data (ein:$content-raw-content content)
:api-version (ein:$content-notebook-api-version content)))
(ein:notebooklist-list-add ein:%notebooklist%)
(let ((inhibit-read-only t))
(erase-buffer))
(when callback
(funcall callback (current-buffer) url-or-port))
(ein:content-query-sessions url-or-port (apply-partially #'ein:notebooklist-render
url-or-port
restore-point))
(current-buffer))))
(cl-defun ein:notebooklist-open-error (url-or-port path
&key error-thrown &allow-other-keys)
(ein:log 'error
"ein:notebooklist-open-error %s: ERROR %s DATA %s" (concat (file-name-as-directory url-or-port) path) (car error-thrown) (cdr error-thrown)))
;;;###autoload
(defun ein:notebooklist-reload (&optional nblist resync callback)
"Reload current Notebook list."
(interactive)
(setq nblist (or nblist ein:%notebooklist%))
(ein:notebooklist-open* (ein:$notebooklist-url-or-port nblist)
(ein:$notebooklist-path nblist) resync callback))
;;;###autoload
(defun ein:notebooklist-new-notebook (url-or-port kernelspec &optional callback no-pop retry explicit-path)
(interactive (list (ein:notebooklist-ask-url-or-port)
(ein:completing-read
"Select kernel: "
(ein:list-available-kernels
(ein:$notebooklist-url-or-port ein:%notebooklist%))
nil t nil nil "default" nil)))
(let* ((notebooklist (ein:notebooklist-list-get url-or-port))
(path (or explicit-path (ein:$notebooklist-path notebooklist)))
(url (ein:notebooklist-url url-or-port path)))
(ein:query-singleton-ajax
url
:type "POST"
:data (ein:json-encode '((type . "notebook")))
:headers (list (cons "Content-Type" "application/json"))
:parser #'ein:json-read
:error (apply-partially #'ein:notebooklist-new-notebook-error
url-or-port kernelspec callback no-pop retry explicit-path)
:success (apply-partially #'ein:notebooklist-new-notebook-success
url-or-port kernelspec
path
callback no-pop))))
(cl-defun ein:notebooklist-new-notebook-success (url-or-port
kernelspec
path
callback
no-pop
&key data
&allow-other-keys)
(let ((nbpath (plist-get data :path)))
(ein:notebook-open url-or-port nbpath kernelspec callback nil no-pop)
(ein:notebooklist-open* url-or-port path)))
(cl-defun ein:notebooklist-new-notebook-error
(url-or-port kernelspec callback no-pop retry explicit-path
&key symbol-status error-thrown &allow-other-keys)
(let ((notice (format "ein:notebooklist-new-notebook-error: %s %s"
symbol-status error-thrown)))
(if retry
(ein:log 'error notice)
(ein:log 'info notice)
(sleep-for 0 1500)
(ein:notebooklist-new-notebook url-or-port kernelspec callback no-pop t explicit-path))))
;;;###autoload
(defun ein:notebooklist-new-notebook-with-name
(url-or-port kernelspec name &optional callback no-pop)
"Upon notebook-open, rename the notebook, then funcall CALLBACK."
(interactive
(let ((url-or-port (ein:get-url-or-port)))
(unless url-or-port
(error "ein:notebooklist-new-notebook-with-name: no server context"))
(let ((kernelspec (ein:completing-read
"Select kernel: "
(ein:list-available-kernels url-or-port)
nil t nil nil "default" nil))
(name (read-from-minibuffer
(format "Notebook name (at %s): " url-or-port))))
(list url-or-port kernelspec name))))
(unless callback
(setq callback #'ignore))
(add-function :before (var callback)
(apply-partially
(lambda (name* notebook _created)
(with-current-buffer (ein:notebook-buffer notebook)
(ein:notebook-rename-command name*)))
name))
(ein:notebooklist-new-notebook url-or-port kernelspec callback no-pop))
(defun ein:notebooklist-delete-notebook (_notebooklist url-or-port path &optional callback)
"CALLBACK with no arguments, e.g., semaphore"
(setq callback (or callback #'ignore))
(dolist (buf (seq-filter (lambda (b)
(with-current-buffer b
(aif (ein:get-notebook)
(string= path (ein:$notebook-notebook-path it)))))
(buffer-list)))
(cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _args) nil)))
(kill-buffer buf)))
(if (ein:notebook-opened-notebooks (lambda (nb)
(string= path
(ein:$notebook-notebook-path nb))))
(ein:log 'error "ein:notebooklist-delete-notebook: cannot close %s" path)
(let ((delete-nb
(apply-partially
(lambda (url* settings* _kernel)
(apply #'ein:query-singleton-ajax url* settings*))
(ein:notebooklist-url url-or-port path)
(list :type "DELETE"
:complete (apply-partially
#'ein:notebooklist-delete-notebook--complete
(ein:url url-or-port path) callback)))))
(ein:message-whir
"Ending session" (var delete-nb)
(ein:kernel-delete-session delete-nb
:url-or-port url-or-port
:path path)))))
(cl-defun ein:notebooklist-delete-notebook--complete
(_url callback
&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:notebooklist-delete-notebook--complete %s" resp-string)
(when callback (funcall callback)))
(defun generate-breadcrumbs (path)
"Given notebooklist path, generate alist of breadcrumps of form (name . path)."
(let* ((paths (split-string path "/" t))
(current-path "/")
(pairs (list (cons "Home" ""))))
(dolist (p paths pairs)
(setf current-path (concat current-path "/" p)
pairs (append pairs (list (cons p current-path)))))))
(cl-defun ein:nblist--sort-group (group by-param order)
(sort group #'(lambda (x y)
(cond ((eq order :ascending)
(string-lessp (plist-get x by-param)
(plist-get y by-param)))
((eq order :descending)
(string-greaterp (plist-get x by-param)
(plist-get y by-param)))))))
(defun ein:notebooklist--order-data (nblist-data sort-param sort-order)
"Try to sanely sort the notebooklist data for the current path."
(let* ((groups (-group-by (lambda (x) (plist-get x :type)) nblist-data))
(dirs (ein:nblist--sort-group (cdr (assoc "directory" groups))
sort-param
sort-order))
(nbs (ein:nblist--sort-group (cdr (assoc "notebook" groups))
sort-param
sort-order))
(files (ein:nblist--sort-group
(-flatten-n 1 (-map #'cdr (-group-by
#'(lambda (x) (car (last (split-string (plist-get x :name) "\\."))))
(cdr (assoc "file" groups)))))
sort-param
sort-order)))
(-concat dirs nbs files)))
(defun render-header (url-or-port &rest _args)
(with-current-buffer (ein:notebooklist-get-buffer url-or-port)
(widget-insert
(format "Contents API %s (%s)\n\n"
(ein:need-notebook-api-version url-or-port)
url-or-port))
(let ((breadcrumbs (generate-breadcrumbs
(ein:$notebooklist-path ein:%notebooklist%))))
(dolist (p breadcrumbs)
(let ((url-or-port url-or-port)
(name (car p))
(path (cdr p)))
(widget-insert " | ")
(widget-create
'link
:notify (lambda (&rest _ignore)
(ein:notebooklist-open* url-or-port path nil
(lambda (buffer _url-or-port)
(pop-to-buffer buffer))))
name)))
(widget-insert " |\n\n"))
(let* ((url-or-port url-or-port)
(kernels (ein:list-available-kernels url-or-port)))
(widget-create
'link
:notify (lambda (&rest _ignore) (ein:notebooklist-new-notebook
url-or-port
ein:%notebooklist-new-kernel%))
"New Notebook")
(widget-insert " ")
(widget-create
'link
:notify (lambda (&rest _ignore) (ein:notebooklist-reload nil t))
"Resync")
(widget-insert " ")
(widget-create
'link
:notify (lambda (&rest _ignore)
(browse-url (ein:url url-or-port)))
"Open In Browser")
(widget-insert "\n\nCreate New Notebooks Using Kernel:\n")
(let ((radio-widget
(widget-create
'radio-button-choice
:notify (lambda (widget &rest _args)
(let ((update (ein:get-kernelspec url-or-port
(widget-value widget))))
(unless (equal ein:%notebooklist-new-kernel% update)
(when ein:%notebooklist-new-kernel%
(message "New notebooks started with %s kernel"
(ein:$kernelspec-display-name update)))
(setq ein:%notebooklist-new-kernel% update)))))))
(if kernels
(let ((initial (ein:jupyter-get-default-kernel kernels)))
(dolist (k kernels)
(let ((child (widget-radio-add-item
radio-widget
(list 'item
:value (car k)
:format (format "%s\n" (cdr k))))))
(when (string= initial (car k))
(widget-apply-action (widget-get child :button)))))
(widget-insert "\n"))
(widget-insert "\n No kernels found\n"))))))
(defun ein:format-nbitem-data (name last-modified)
(let ((dt (date-to-time last-modified)))
(format "%-40s%+20s" name
(ein:format-time-string ein:notebooklist-date-format dt))))
(defun render-directory (url-or-port sessions)
;; SESSIONS is a hashtable of path to (session-id . kernel-id) pairs
(with-current-buffer (ein:notebooklist-get-buffer url-or-port)
(cl-loop with reloader = (apply-partially (lambda (nblist _kernel)
(ein:notebooklist-reload nblist))
ein:%notebooklist%)
for note in (ein:notebooklist--order-data
(ein:$notebooklist-data ein:%notebooklist%)
ein:notebooklist-sort-field
ein:notebooklist-sort-order)
for name = (plist-get note :name)
for path = (plist-get note :path)
for last-modified = (plist-get note :last_modified)
for type = (plist-get note :type)
do (ein:notebook-get-opened-notebook url-or-port path)
if (string= type "directory")
do (progn (widget-create
'link
:notify (let ((url-or-port url-or-port)
(name name))
(lambda (&rest _ignore)
;; each directory creates a whole new notebooklist
(ein:notebooklist-open* url-or-port
(concat (file-name-as-directory
(ein:$notebooklist-path ein:%notebooklist%))
name)
nil
(lambda (buffer _url-or-port) (pop-to-buffer buffer)))))
"Dir")
(widget-insert " : " name)
(widget-insert "\n"))
end
if (string= type "file")
do (progn (widget-create
'link
:notify (apply-partially
(lambda (url-or-port* path* &rest _args)
(ein:file-open url-or-port* path*))
url-or-port path)
"Open")
(widget-insert " ")
(widget-insert " : " (ein:format-nbitem-data name last-modified))
(widget-insert "\n"))
end
if (string= type "notebook")
do (progn (widget-create
'link
:notify (apply-partially
(lambda (url-or-port* path* &rest _args)
(ein:notebook-open url-or-port* path*))
url-or-port path)
"Open")
(widget-insert " ")
(if (gethash path sessions)
(widget-create
'link
:notify
(apply-partially
(cl-function
(lambda (url-or-port*
path*
&rest _ignore
&aux (callback (lambda (_kernel) t)))
(ein:message-whir
"Ending session" (var callback)
(ein:kernel-delete-session callback
:url-or-port url-or-port*
:path path*))))
url-or-port path)
"Stop")
(widget-insert "[----]"))
(widget-insert " ")
(widget-create
'link
:notify (apply-partially
(lambda (notebooklist* url-or-port* path* callback*
&rest _args)
(when (or noninteractive
(y-or-n-p (format "Delete notebook %s?" path*)))
(ein:notebooklist-delete-notebook
notebooklist* url-or-port* path*
(apply-partially callback* nil))))
ein:%notebooklist% url-or-port path reloader)
"Delete")
(widget-insert " : " (ein:format-nbitem-data name last-modified))
(widget-insert "\n"))
end)))
(defun ein:notebooklist-render (url-or-port restore-point sessions)
(with-current-buffer (ein:notebooklist-get-buffer url-or-port)
(if (not (ein:$notebooklist-path ein:%notebooklist%))
(ein:log 'error "ein:notebooklist-render: cannot render null")
(render-header url-or-port sessions)
(render-directory url-or-port sessions)
(widget-setup)
(awhen (get-buffer-window (current-buffer))
(set-window-point it (or restore-point (point-min)))))))
;;;###autoload
(defun ein:notebooklist-list-paths (&optional content-type)
"Return all files of CONTENT-TYPE for all sessions"
(apply #'append
(cl-loop for nblist in (ein:notebooklist-list)
for url-or-port = (ein:$notebooklist-url-or-port nblist)
collect
(cl-loop for content in (ein:content-need-hierarchy url-or-port)
when (or (null content-type)
(string= (ein:$content-type content) content-type))
collect (ein:url url-or-port (ein:$content-path content))))))
(defun ein:notebooklist-parse-nbpath (nbpath)
"Return `(,url-or-port ,path) from URL-OR-PORT/PATH"
(cl-loop for url-or-port in (ein:notebooklist-keys)
if (cl-search url-or-port nbpath :end2 (length url-or-port))
return (list (substring nbpath 0 (length url-or-port))
(substring nbpath (1+ (length url-or-port))))
end
finally (ein:display-warning
(format "%s not among: %s" nbpath (ein:notebooklist-keys))
:error)))
(defsubst ein:notebooklist-ask-path (&optional content-type)
(ein:completing-read (format "Open %s: " content-type)
(ein:notebooklist-list-paths content-type)
nil t))
;;;###autoload
(defun ein:notebooklist-load (&optional url-or-port)
"Load notebook list but do not pop-up the notebook list buffer.
For example, if you want to load notebook list when Emacs starts,
add this in the Emacs initialization file:
(add-to-hook \\='after-init-hook \\='ein:notebooklist-load)
or even this (if you want fast Emacs start-up):
;; load notebook list if Emacs is idle for 3 sec after start-up
(run-with-idle-timer 3 nil #\\='ein:notebooklist-load)"
(ein:notebooklist-open* url-or-port))
;;; Login
(defun ein:notebooklist-login--iteration (url-or-port callback errback token iteration response-status)
(ein:log 'debug "Login attempt #%d in response to %s from %s."
iteration response-status url-or-port)
(setq callback (or callback #'ignore))
(setq errback (or errback #'ignore))
(let* ((reset-p (not response-status))
(request-curl-options (if reset-p
(cons "--junk-session-cookies" request-curl-options)
request-curl-options))
(parsed-url (url-generic-parse-url (file-name-as-directory url-or-port)))
(host (url-host parsed-url))
(query (cdr (url-path-and-query parsed-url))))
(when reset-p
(remhash host ein:query-xsrf-cache))
(ein:query-singleton-ajax
(ein:url url-or-port (if query "" "login"))
;; do not use :type "POST" here (see git history)
:timeout ein:notebooklist-login-timeout
:data (when (and token (not query)) (concat "password=" (url-hexify-string token)))
:parser #'ein:notebooklist-login--parser
:complete (apply-partially #'ein:notebooklist-login--complete url-or-port)
:error (apply-partially #'ein:notebooklist-login--error url-or-port token
callback errback iteration)
:success (apply-partially #'ein:notebooklist-login--success url-or-port callback
errback token iteration))))
;;;###autoload
(defun ein:notebooklist-open (url-or-port callback)
"This is now an alias for `ein:notebooklist-login'."
(interactive `(,(ein:notebooklist-ask-url-or-port)
,(lambda (buffer _url-or-port) (pop-to-buffer buffer))))
(ein:notebooklist-login url-or-port callback))
(make-obsolete 'ein:notebooklist-open 'ein:notebooklist-login "0.14.2")
;;;###autoload
(defalias 'ein:login 'ein:notebooklist-login)
;;;###autoload
(defun ein:notebooklist-login (url-or-port callback &optional cookie-name cookie-content token)
"Deal with security before main entry of ein:notebooklist-open*.
CALLBACK takes two arguments, the buffer created by
ein:notebooklist-open--success and the url-or-port argument of
ein:notebooklist-open*."
(interactive `(,(ein:notebooklist-ask-url-or-port)
,(lambda (buffer _url-or-port) (pop-to-buffer buffer))
,(when current-prefix-arg
(read-no-blanks-input "Cookie name: "))
,(when current-prefix-arg
(read-no-blanks-input "Cookie content: "))
nil))
(when cookie-name
(let* ((parsed-url (url-generic-parse-url (file-name-as-directory url-or-port)))
(domain (url-host parsed-url))
(securep (string-match "^wss://" url-or-port))
(line (mapconcat #'identity (list domain "FALSE" (car (url-path-and-query parsed-url)) (if securep "TRUE" "FALSE") "0" cookie-name (concat cookie-content "\n")) "\t")))
(write-region line nil (request--curl-cookie-jar) 'append)))
(let ((token (or token (ein:notebooklist-token-or-password url-or-port))))
(cond ((null token) ;; don't know
(ein:notebooklist-login--iteration url-or-port callback nil nil -1 nil))
((string= token "") ;; all authentication disabled
(ein:log 'verbose "Skipping login %s" url-or-port)
(ein:notebooklist-open* url-or-port nil nil callback nil))
(t
(ein:notebooklist-login--iteration url-or-port callback nil token 0 nil)))))
(defun ein:notebooklist-login--parser ()
(save-excursion
(goto-char (point-min))
(when (re-search-forward "<input type=.?password" nil t)
(list :reprompt t))))
(defun ein:notebooklist-login--success-1 (url-or-port callback errback &optional hub-p)
(ein:log 'info "Login to %s complete." url-or-port)
(ein:notebooklist-open* url-or-port nil nil callback errback hub-p))
(defun ein:notebooklist-login--error-1 (url-or-port error-thrown response errback)
(ein:log 'error "Login to %s failed, error-thrown %s, raw-header %s"
url-or-port
(subst-char-in-string ?\n ?\ (format "%s" error-thrown))
(request-response--raw-header response))
(funcall errback))
(cl-defun ein:notebooklist-login--complete
(_url-or-port
&key data response
&allow-other-keys &aux
(resp-string (format "STATUS: %s DATA: %s"
(request-response-status-code response) data)))
(ein:log 'debug "ein:notebooklist-login--complete %s" resp-string))
(cl-defun ein:notebooklist-login--success
(url-or-port callback errback token 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 (plist-get data :reprompt)
(cond ((>= iteration 0)
(ein:notebooklist-login--error-1 url-or-port error-thrown response errback))
(hub-p (ein:notebooklist-open* url-or-port nil nil callback errback t))
(t (setq token (read-passwd (format "Password for %s: " url-or-port)))
(ein:notebooklist-login--iteration url-or-port callback errback token
(1+ iteration) response-status)))
(ein:notebooklist-login--success-1 url-or-port callback errback hub-p)))
(cl-defun ein:notebooklist-login--error
(url-or-port token 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")))
(cond (hub-p
(if (< iteration 0)
(ein:notebooklist-login--iteration url-or-port callback errback
token (1+ iteration) response-status)
(if (and (eq response-status 405)) ;; no javascript is okay
(ein:notebooklist-login--success-1 url-or-port callback errback hub-p)
(ein:notebooklist-login--error-1 url-or-port error-thrown response errback))))
((and response-status (< iteration 0))
(setq token (read-passwd (format "Password for %s: " url-or-port)))
(ein:notebooklist-login--iteration url-or-port callback errback token (1+ iteration) response-status))
((and (eq response-status 403) (< iteration 1))
(ein:notebooklist-login--iteration url-or-port callback errback token (1+ iteration) response-status))
(t (ein:notebooklist-login--error-1 url-or-port error-thrown response errback))))
(defun ein:get-url-or-port--notebooklist ()
(when (ein:$notebooklist-p ein:%notebooklist%)
(ein:$notebooklist-url-or-port ein:%notebooklist%)))
(defun ein:notebooklist-prev-item () (interactive) (move-beginning-of-line 0))
(defun ein:notebooklist-next-item () (interactive) (move-beginning-of-line 2))
(defvar ein:notebooklist-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap widget-keymap
special-mode-map))
(define-key map "\C-c\C-r" 'ein:notebooklist-reload)
(define-key map "\C-c\C-f" 'ein:file-open)
(define-key map "\C-c\C-o" 'ein:notebook-open)
(define-key map "p" 'ein:notebooklist-prev-item)
(define-key map "n" 'ein:notebooklist-next-item)
map)
"Keymap for ein:notebooklist-mode.")
(easy-menu-define ein:notebooklist-menu ein:notebooklist-mode-map
"EIN Notebook List Mode Menu"
`("EIN Notebook List"
,@(ein:generate-menu
'(("Reload" ein:notebooklist-reload)
("New Notebook" ein:notebooklist-new-notebook)
("New Notebook (with name)"
ein:notebooklist-new-notebook-with-name)))))
(define-derived-mode ein:notebooklist-mode special-mode "ein:notebooklist"
"IPython notebook list mode.
Commands:
\\{ein:notebooklist-mode-map}"
(set (make-local-variable 'revert-buffer-function)
(lambda (&rest _args) (ein:notebooklist-reload))))
(provide 'ein-notebooklist)
;;; ein-notebooklist.el ends here

180
lisp/ein/ein-notification.el Normal file
View File

@@ -0,0 +1,180 @@
;;; ein-notification.el --- Notification widget for Notebook -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-notification.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-notification.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-notification.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'ein-core)
(require 'ein-classes)
(require 'ein-events)
(declare-function ein:get-notebook "ein:notebook")
(declare-function ein:notebook-opened-buffer-names "ein:notebook")
(declare-function ein:list-available-kernels "ein:notebook")
(declare-function ein:notebook-switch-kernel "ein:notebook")
(define-obsolete-variable-alias 'ein:@notification 'ein:%notification% "0.1.2")
(ein:deflocal ein:%notification% nil
"Buffer local variable to hold an instance of `ein:notification'.")
(defvar ein:header-line-format '(:eval (ein:header-line)))
(defvar ein:header-line-switch-kernel-map (make-sparse-keymap))
(cl-defmethod ein:notification-status-set ((ns ein:notification-status) status)
(let* ((message (cdr (assoc status (slot-value ns 's2m)))))
(setf (slot-value ns 'status) status)
(setf (slot-value ns 'message) (substitute-command-keys message))
(force-mode-line-update t)))
(cl-defmethod ein:notification-bind-events ((notification ein:notification) events)
"Bind a callback to events of the event handler EVENTS which
just set the status (= event-type):
(ein:notification-status-set NS EVENT-TYPE)
where NS is `:kernel' or `:notebook' slot of NOTIFICATION."
(cl-loop for ns in (list (slot-value notification 'kernel)
(slot-value notification 'notebook))
for statuses = (mapcar #'car (slot-value ns 's2m))
do (cl-loop for st in statuses
do (ein:events-on events
st ; = event-type
#'ein:notification--callback
(cons ns st))))
(ein:events-on events
'notebook_saved.Notebook
#'ein:notification--fadeout-callback
(list (slot-value notification 'notebook)
"Notebook is saved"
'notebook_saved.Notebook
nil))
(ein:events-on events
'execution_count.Kernel
#'ein:notification--set-execution-count
notification))
(defun ein:notification--callback (packed _data)
(let ((ns (car packed))
(status (cdr packed)))
(ein:notification-status-set ns status)))
(defun ein:notification--set-execution-count (notification count)
(setf (oref notification :execution-count) count))
(defun ein:notification--fadeout-callback (packed _data)
;; FIXME: I can simplify this.
;; Do not pass around message, for exmaple.
(cl-destructuring-bind (ns message status &rest) packed
(setf (oref ns :status) status)
(setf (oref ns :message) message)
(apply #'run-at-time
1 nil
(lambda (ns _message status next)
(when (equal (slot-value ns 'status) status)
(ein:notification-status-set ns next)
;; (ein:with-live-buffer (slot-value ns :buffer)
;; (force-mode-line-update))
))
packed)))
(defun ein:notification-setup (buffer events &rest tab-slots)
"Setup a new notification widget in the BUFFER.
This function saves the new notification widget instance in the
local variable of the BUFFER.
Rest of the arguments are for TABs in `header-line'.
GET-LIST : function
Return a list of worksheets.
GET-CURRENT : function
Return the current worksheet.
GET-NAME : function
Return a name of the worksheet given as its argument.
\(fn buffer events &key get-list get-current)"
(with-current-buffer buffer
(setq ein:%notification%
(make-instance 'ein:notification
:buffer buffer))
(setq header-line-format ein:header-line-format)
(ein:notification-bind-events ein:%notification% events)
(setf (oref ein:%notification% :tab)
(apply #'make-instance 'ein:notification-tab tab-slots))
ein:%notification%))
(defface ein:notification-tab-normal
'((t :inherit (header-line) :underline t :height 0.8))
"Face for headline selected tab."
:group 'ein)
(define-key ein:header-line-switch-kernel-map
[header-line mouse-1] 'ein:header-line-switch-kernel)
(defmacro ein:with-destructuring-bind-key-event (key-event &rest body)
(declare (debug (form &rest form))
(indent 1))
;; See: (info "(elisp) Click Events")
`(cl-destructuring-bind
(event-type
(window pos-or-area (x . y) timestamp
object text-pos (col . row)
image (dx . dy) (width . height)))
,key-event
,@body))
(defun ein:header-line-switch-kernel (_key-event)
(interactive "e")
(let* ((notebook (or (ein:get-notebook)
(ein:completing-read
"Select notebook: "
(ein:notebook-opened-buffer-names))))
(kernel-name (ein:completing-read
"Select kernel: "
(ein:list-available-kernels (ein:$notebook-url-or-port notebook)))))
(ein:notebook-switch-kernel notebook kernel-name)))
(defun ein:header-line ()
(format
"IP[%s]: %s"
(slot-value ein:%notification% 'execution-count)
(ein:join-str
" | "
(cl-remove-if-not
#'identity
(list (slot-value (slot-value ein:%notification% 'notebook) 'message)
(slot-value (slot-value ein:%notification% 'kernel) 'message)
(propertize (aif (aand (ein:get-notebook) (ein:$notebook-kernelspec it))
(format "|%s|" (ein:$kernelspec-name it))
"|unknown: please click and select a kernel|")
'keymap ein:header-line-switch-kernel-map
'help-echo "Click (mouse-1) to change the running kernel."
'mouse-face 'highlight
'face 'ein:notification-tab-normal))))))
(provide 'ein-notification)
;;; ein-notification.el ends here

187
lisp/ein/ein-output-area.el Normal file
View File

@@ -0,0 +1,187 @@
;;; ein-output-area.el --- Output area module
;; Copyright (C) 2012 Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-output-area.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-output-area.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-output-area.el.
;; If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'xml)
(require 'shr)
(require 'ein-core)
(defvar ein:output-area-case-types '(:image/svg+xml :image/png :image/jpeg :text/plain :text/html :application/latex :application/tex :application/javascript)
"Prefer :text/plain.
Unless it's a single line \"<IPython.core.display.HTML object>\" or
\"TemporalData[TimeSeries, <<1>>]\" in which case prefer :text/html.")
(defcustom ein:output-area-inlined-images nil
"Turn on to insert images into buffer. Default spawns external viewer."
:type 'boolean
:group 'ein)
(defcustom ein:output-area-inlined-image-properties '(:foreground "black" :background "white")
"Additional properties for inlined images.
This is passed to `create-image' for some supported image types,
such as SVG ones whose foregrounds are taken from the current
frame by default and may appear unreadable."
:type '(plist :value-type color)
:group 'ein)
(defcustom ein:shr-env
'((shr-table-horizontal-line ?-)
(shr-table-vertical-line ?|)
(shr-table-corner ?+))
"Variables let-bound while calling `shr-insert-document'.
To use default shr setting:
(setq ein:shr-env nil)
Draw boundaries for table (default):
(setq ein:shr-env
\\='((shr-table-horizontal-line ?-)
(shr-table-vertical-line ?|)
(shr-table-corner ?+)))
"
:type '(sexp)
:group 'ein)
;;; XML/HTML utils
(defun ein:xml-parse-html-string (html-string)
"Parse HTML-STRING and return a dom object which
can be handled by the xml module."
(with-temp-buffer
(insert html-string)
(when (fboundp 'libxml-parse-html-region)
(cl-loop with result
repeat 3
do (setq result
(libxml-parse-html-region (point-min) (point-max)))
until result
finally return result))))
(defalias 'ein:xml-node-p 'listp)
(defun ein:xml-tree-apply (dom operation)
"Apply OPERATION on nodes in DOM. Apply the same OPERATION on
the next level children when it returns `nil'."
(cl-loop for child in (xml-node-children dom)
if (and (not (funcall operation child))
(ein:xml-node-p child))
do (ein:xml-tree-apply child operation)))
(defun ein:xml-replace-attributes (dom tag attr replace-p replacer)
"Replace value of ATTR of TAG in DOM using REPLACER
when REPLACE-P returns non-`nil'."
(ein:xml-tree-apply
dom
(lambda (node)
(ein:and-let* (((ein:xml-node-p node))
((eq (xml-node-name node) tag))
(attr-cell (assoc attr (xml-node-attributes node)))
(val (cdr attr-cell))
((funcall replace-p val)))
(setcdr attr-cell (funcall replacer val))
t))))
(defun ein:output-area-get-html-renderer ()
(if (fboundp 'libxml-parse-xml-region)
#'ein:insert-html-shr
#'ein:insert-read-only))
(defun ein:shr-insert-document (dom)
"`shr-insert-document' with EIN setting."
(eval `(let ,ein:shr-env (shr-insert-document dom))))
(defun ein:insert-html-shr (html-string)
"Render HTML-STRING using `shr-insert-document'.
Usage::
(ein:insert-html-shr \"<b>HTML</b> string\")
"
(let ((dom (ein:xml-parse-html-string html-string))
(start (point))
end
(buffer-undo-list t))
(ein:insert-html--fix-urls dom)
(ein:shr-insert-document dom)
(setq end (point))
(put-text-property start end 'read-only t)
(put-text-property start end 'front-sticky t)))
(defun ein:insert-html--fix-urls (dom &optional url-or-port)
"Destructively prepend notebook server URL to local URLs in DOM."
(ein:and-let* ((url-or-port (or url-or-port (ein:get-url-or-port)))
(replace-p (lambda (val) (string-match-p "^/?files/" val)))
(replacer (lambda (val) (ein:url url-or-port val))))
(ein:xml-replace-attributes dom 'a 'href replace-p replacer)
(ein:xml-replace-attributes dom 'img 'src replace-p replacer)))
(defun ein:output-area-type (mime-type)
"Investigate why :image/svg+xml to :svg and :text/plain to :text"
(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 ":")))))
(intern (concat ":"
(cond ((string= minor "plain") "text")
(t (cl-subseq minor 0 (cl-search "+" minor))))))))
(defun ein:output-area-convert-mime-types (json data)
(let ((known-mimes (cl-remove-if-not
#'identity
(mapcar (lambda (x) (intern-soft (concat ":" x)))
(mailcap-mime-types)))))
(mapc (lambda (x)
(-when-let* ((mime-val (plist-get data x))
(minor-kw (ein:output-area-type x)))
(setq json (plist-put json minor-kw mime-val))))
known-mimes)
json))
(defmacro ein:output-area-case-type (json &rest case-body)
`(let* ((types (cl-copy-list ein:output-area-case-types))
(heuristic-p (and (memq :text/plain types)
(memq :text/html types)))
(,json (or (plist-get ,json :data) ,json))
(plain (plist-get ,json :text/plain))
(html (plist-get ,json :text/html)))
(when (and heuristic-p
(stringp plain) (< (length plain) 60)
(stringp html) (> (length html) 300))
(delq :text/plain types))
(seq-some (lambda (type)
(when-let ((value (plist-get ,json type)))
,@case-body
t))
types)))
(provide 'ein-output-area)
;;; ein-output-area.el ends here

98
lisp/ein/ein-pager.el Normal file
View File

@@ -0,0 +1,98 @@
;;; ein-pager.el --- Pager module -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-pager.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-pager.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-pager.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ansi-color)
(require 'ein-core)
(require 'ein-events)
(require 'view)
;; FIXME: Make a class with `:get-notebook-name' slot like `ein:worksheet'
(declare-function ess-help-underline "ess-help")
(defun ein:pager-new (name events)
;; currently pager = name.
(ein:pager-bind-events name events)
name)
(defun ein:pager-bind-events (pager events)
"Bind events related to PAGER to the event handler EVENTS."
(ein:events-on events
'open_with_text.Pager
#'ein:pager--open-with-text
pager))
(defun ein:pager--open-with-text (pager data)
(let ((text (plist-get data :text)))
(unless (equal (ein:trim text) "")
(ein:pager-clear pager)
(ein:pager-expand pager)
(ein:pager-append-text pager text))))
(defun ein:pager-clear (pager)
(ein:with-read-only-buffer (get-buffer-create pager)
(erase-buffer)))
(defun ein:pager-expand (pager)
(pop-to-buffer (get-buffer-create pager))
(goto-char (point-min)))
(defun ein:pager-append-text (pager text)
(ein:with-read-only-buffer (get-buffer-create pager)
(insert (ansi-color-apply text))
(if (featurep 'ess-help)
(ess-help-underline))
(unless (eql 'ein:pager-mode major-mode)
(ein:pager-mode))))
;; FIXME: this should be automatically called when opening pager.
(defun ein:pager-goto-docstring-bset-loc ()
"Goto the best location of the documentation."
(interactive)
(goto-char (point-min))
(search-forward-regexp "^Docstring:")
(beginning-of-line 0)
(recenter 0))
(defvar ein:pager-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-b" 'ein:pager-goto-docstring-bset-loc)
map)
"Keymap for ein:pager-mode.")
(define-derived-mode ein:pager-mode view-mode "ein:pager"
"IPython notebook pager mode.
Commands:
\\{ein:pager-mode-map}"
(setq-local view-no-disable-on-exit t)
(font-lock-mode))
(provide 'ein-pager)
;;; ein-pager.el ends here

15
lisp/ein/ein-pkg.el Normal file
View File

@@ -0,0 +1,15 @@
(define-package "ein" "20230827.325" "jupyter notebook client"
'((emacs "26.1")
(websocket "1.12")
(anaphora "1.0.4")
(request "0.3.3")
(deferred "0.5")
(polymode "0.2.2")
(dash "2.13.0")
(with-editor "0pre"))
:commit "ac92eb92eac35a9542485969487e43f5318825a1" :keywords
'("jupyter" "literate programming" "reproducible research")
:url "https://github.com/dickmao/emacs-ipython-notebook")
;; Local Variables:
;; no-byte-compile: t
;; End:

215
lisp/ein/ein-process.el Normal file
View File

@@ -0,0 +1,215 @@
;;; ein-process.el --- Notebook list buffer -*- lexical-binding:t -*-
;; Copyright (C) 2018- John M. Miller
;; Authors: Takafumi Arakaki <aka.tkf at gmail.com>
;; John M. Miller <millejoh at mac.com>
;; This file is NOT part of GNU Emacs.
;; ein-process.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-process.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-process.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ein-jupyter)
(defcustom ein:process-jupyter-regexp "\\(jupyter\\|ipython\\)\\(-\\|\\s-+\\)note"
"Regexp by which we recognize notebook servers."
:type 'string
:group 'ein)
(defcustom ein:process-lsof "lsof"
"Executable for lsof command."
:type 'string
:group 'ein)
(defun ein:process-divine-dir (pid args &optional error-buffer)
"Returns notebook-dir or cwd of PID. Supply ERROR-BUFFER to capture stderr"
(if (string-match "\\bnotebook-dir\\(=\\|\\s-+\\)\\(\\S-+\\)" args)
(directory-file-name (match-string 2 args))
(if (executable-find ein:process-lsof)
(ein:trim-right
(with-output-to-string
(shell-command (format "%s -p %d -a -d cwd -Fn | grep ^n | tail -c +2"
ein:process-lsof pid)
standard-output error-buffer))))))
(defun ein:process-divine-port (pid args &optional error-buffer)
"Returns port on which PID is listening or 0 if none.
Supply ERROR-BUFFER to capture stderr."
(if (string-match "\\bport\\(=\\|\\s-+\\)\\(\\S-+\\)" args)
(string-to-number (match-string 2 args))
(if (executable-find ein:process-lsof)
(string-to-number
(ein:trim-right
(with-output-to-string
(shell-command (format "%s -p %d -a -iTCP -sTCP:LISTEN -Fn | grep ^n | sed \"s/[^0-9]//g\""
ein:process-lsof pid)
standard-output error-buffer)))))))
(defun ein:process-divine-ip (_pid args)
"Returns notebook-ip of PID"
(if (string-match "\\bip\\(=\\|\\s-+\\)\\(\\S-+\\)" args)
(match-string 2 args)
ein:url-localhost))
(defcustom ein:process-jupyter-regexp "\\(jupyter\\|ipython\\)\\(-\\|\\s-+\\)note"
"Regexp by which we recognize notebook servers."
:type 'string
:group 'ein)
(defcustom ein:process-lsof "lsof"
"Executable for lsof command."
:type 'string
:group 'ein)
(cl-defstruct ein:$process
"Hold process variables.
`ein:$process-pid' : integer
PID.
`ein:$process-url': string
URL
`ein:$process-dir' : string
Arg of --notebook-dir or 'readlink -e /proc/<pid>/cwd'."
pid
url
dir
)
(ein:deflocal ein:%processes% (make-hash-table :test #'equal)
"Process table of `ein:$process' keyed on dir.")
(defun ein:process-processes ()
(hash-table-values ein:%processes%))
(defun ein:process-alive-p (proc)
(process-attributes (ein:$process-pid proc)))
(defun ein:process-suitable-notebook-dir (filename)
"Return the uppermost parent dir of DIR that contains ipynb files."
(let ((fn (expand-file-name filename)))
(cl-loop with directory = (directory-file-name
(if (file-regular-p fn)
(file-name-directory (directory-file-name fn))
fn))
with suitable = directory
until (string= (file-name-nondirectory directory) "")
do (if (directory-files directory nil "\\.ipynb$")
(setq suitable directory))
(setq directory (directory-file-name (file-name-directory directory)))
finally return suitable)))
(defun ein:process-refresh-processes ()
"Use `jupyter notebook list --json` to populate ein:%processes%"
(clrhash ein:%processes%)
(cl-loop for line in (condition-case err
(apply #'process-lines
ein:jupyter-server-command
(append (split-string (or ein:jupyter-server-use-subcommand ""))
'("list" "--json")))
;; often there is no local jupyter installation
(error (ein:log 'info "ein:process-refresh-processes: %s" err) nil))
do (cl-destructuring-bind
(&key pid url notebook_dir &allow-other-keys)
(ein:json-read-from-string line)
(puthash (directory-file-name notebook_dir)
(make-ein:$process :pid pid
:url (ein:url url)
:dir (directory-file-name notebook_dir))
ein:%processes%))))
(defun ein:process-dir-match (filename)
"Return ein:process whose directory is prefix of FILENAME."
(cl-loop for dir in (hash-table-keys ein:%processes%)
when (cl-search dir filename)
return (gethash dir ein:%processes%)))
(defun ein:process-url-match (url-or-port)
"Return ein:process whose url matches URL-OR-PORT."
(cl-loop with parsed-url-or-port = (url-generic-parse-url url-or-port)
for proc in (ein:process-processes)
for parsed-url-proc = (url-generic-parse-url (ein:process-url-or-port proc))
when (and (string= (url-host parsed-url-or-port) (url-host parsed-url-proc))
(= (url-port parsed-url-or-port) (url-port parsed-url-proc)))
return proc))
(defsubst ein:process-url-or-port (proc)
"Naively construct url-or-port from ein:process PROC's port and ip fields"
(ein:$process-url proc))
(defsubst ein:process-path (proc filename)
"Construct path by eliding PROC's dir from filename."
(cl-subseq filename (length (file-name-as-directory (ein:$process-dir proc)))))
(defun ein:process-open-notebook* (filename callback)
"Open FILENAME as a notebook and start a notebook server if necessary.
CALLBACK with arity 2 (passed into `ein:notebook-open--callback')."
(ein:process-refresh-processes)
(let* ((proc (ein:process-dir-match filename)))
(if proc
(let* ((url-or-port (ein:process-url-or-port proc))
(path (ein:process-path proc filename))
(callback2 (apply-partially (lambda (path* callback* _buffer url-or-port)
(ein:notebook-open
url-or-port path* nil callback*))
path callback)))
(if (ein:notebooklist-list-get url-or-port)
(ein:notebook-open url-or-port path nil callback)
(ein:notebooklist-login url-or-port callback2)))
(let* ((nbdir (read-directory-name "Notebook directory: "
(ein:process-suitable-notebook-dir filename)))
(path
(concat (if ein:jupyter-use-containers
(file-name-as-directory (file-name-base ein:jupyter-docker-mount-point))
"")
(cl-subseq (expand-file-name filename)
(length (file-name-as-directory (expand-file-name nbdir))))))
(callback2 (apply-partially (lambda (path* callback* buffer url-or-port)
(pop-to-buffer buffer)
(ein:notebook-open url-or-port
path* nil callback*))
path callback)))
(ein:jupyter-server-start (executable-find ein:jupyter-server-command)
nbdir nil callback2)))))
(defun ein:process-open-notebook (&optional filename buffer-callback)
"When FILENAME is unspecified the variable `buffer-file-name'
is used instead. BUFFER-CALLBACK is called after notebook opened."
(interactive)
(unless filename (setq filename buffer-file-name))
(cl-assert filename nil "Not visiting a file")
(let ((callback2 (apply-partially (lambda (buffer buffer-callback* _notebook _created
&rest _args)
(when (buffer-live-p buffer)
(funcall buffer-callback* buffer)))
(current-buffer) (or buffer-callback #'ignore))))
(ein:process-open-notebook* (expand-file-name filename) callback2)))
(defun ein:process-find-file-callback ()
"A callback function for `find-file-hook' to open notebook."
(interactive)
(-when-let* ((filename buffer-file-name)
(match-p (string-match-p "\\.ipynb$" filename)))
(ein:process-open-notebook filename #'kill-buffer-if-not-modified)))
(provide 'ein-process)
;;; ein-process.el ends here

160
lisp/ein/ein-python-send.el Normal file
View File

@@ -0,0 +1,160 @@
;;; ein-python-send.el --- Ad hoc sending of code fragments to kernel -*- lexical-binding: t -*-
;; Copyright (C) 2012- The Authors
;; This file is NOT part of GNU Emacs.
;; ein-python-send.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-python-send.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-python-send.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; python parsing code by authors of elpy (Schaefer et al)
;;; Code:
(autoload 'ein:get-notebook "ein-notebook")
(defvar ein:python-send-map)
(defun ein:python-send--prepare (&optional reset)
(cl-assert (boundp 'ein:python-send-map) nil
"ein:python-send--prepare: %s not called"
"ein:python-send--init")
(unless (and (buffer-live-p (current-buffer))
(eq major-mode 'python-mode))
(error "ein:python-send--prepare: %s is not a python buffer" (buffer-name)))
(when (or (not (ein:get-notebook)) reset)
(aif (ein:notebook-opened-notebooks)
(let ((choice
(ein:completing-read
"Notebook: "
(mapcar (lambda (nb) (ein:$notebook-notebook-name nb)) it))))
(setq ein:%notebook% (seq-find
(lambda (nb)
(string= choice (ein:$notebook-notebook-name nb)))
it)))
(error "ein:python-send--prepare: No open notebooks"))))
(defun ein:python-send-region-or-buffer (&optional reset)
"Based on `elpy-shell--send-region-or-buffer-internal' by Schaefer et al."
(interactive "P")
(ein:python-send--prepare reset)
(if (use-region-p)
(let ((region (python-shell-buffer-substring
(region-beginning) (region-end))))
(when (string-match "\t" region)
(message "Region contained tabs, this might cause weird errors"))
;; python-shell-buffer-substring (intentionally?) does not accurately
;; respect (region-beginning); it always start on the first character
;; of the respective line even if that's before the region beginning
;; Here we post-process the output to remove the characters before
;; (region-beginning) and the start of the line. The end of the region
;; is handled correctly and needs no special treatment.
(let* ((bounds (save-excursion
(goto-char (region-beginning))
(bounds-of-thing-at-point 'line)))
(used-part (string-trim
(buffer-substring-no-properties
(car bounds)
(min (cdr bounds) (region-end)))))
(relevant-part (string-trim
(buffer-substring-no-properties
(max (car bounds) (region-beginning))
(min (cdr bounds) (region-end))))))
(setq region
;; replace just first match
(replace-regexp-in-string
(concat "\\(" (regexp-quote used-part) "\\)\\(?:.*\n?\\)*\\'")
relevant-part
region t t 1))
(ein:shared-output-eval-string (ein:get-kernel) region)))
(ein:shared-output-eval-string (ein:get-kernel) (buffer-string)))
(if (use-region-p)
(progn
(goto-char (region-end))
(deactivate-mark))
(goto-char (point-max))))
(defun ein:python-send-statement (&optional reset)
"Based on `elpy-shell-send-statement' by Schaefer et al."
(interactive "P")
(ein:python-send--prepare reset)
(python-nav-beginning-of-statement)
(unless (looking-at "[[:space:]]*$")
(let ((beg (save-excursion (beginning-of-line) (point)))
(end (progn (ein:python-send--nav-end-of-statement) (point))))
(unless (eq beg end)
(ein:shared-output-eval-string (ein:get-kernel)
(buffer-substring beg end))))))
(defun ein:python-send--nav-end-of-statement ()
"Based on `elpy-shell--nav-end-of-statement' by Schaefer et al."
(let ((continue t)
p)
(while (and (not (eq p (point))) continue)
;; is there another block at same indentation level?
(setq p (point))
(ein:python-send--nav-forward-block)
(if (eq p (point))
(progn
;; nope, go to the end of the block and done
(python-nav-end-of-block)
(setq continue nil))
(unless (eq 0 (string-match-p "\\s-*el\\(?:se:\\|if[^\w]\\)"
(thing-at-point 'line)))
(forward-line -1)
(while (and (or (eq (string-match-p "\\s-*$" (thing-at-point 'line)) 0)
(python-info-current-line-comment-p))
(not (eq (point) (point-min))))
(forward-line -1))
(setq continue nil)))))
(end-of-line))
(defun ein:python-send--nav-forward-block ()
"Based on `elpy-shell--nav-forward-block' by Schaefer et al.
Move to the next line indented like point. This will skip over lines and
statements with different indentation levels."
(interactive "^")
(let ((indent (current-column))
(start (point))
(cur nil))
(when (/= (% indent python-indent-offset)
0)
(setq indent (* (1+ (/ indent python-indent-offset))
python-indent-offset)))
(python-nav-forward-statement)
(while (and (< indent (current-indentation))
(not (eobp)))
(when (equal (point) cur)
(error "Statement does not finish"))
(setq cur (point))
(python-nav-forward-statement))
(when (< (current-indentation)
indent)
(goto-char start))))
(defun ein:python-send--init ()
(unless (boundp 'ein:python-send-map)
(require 'python)
(setq ein:python-send-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "e") 'ein:python-send-statement)
(define-key map (kbd "r") 'ein:python-send-region-or-buffer)
map))
(define-key python-mode-map (kbd "C-c C-/") ein:python-send-map)))
(provide 'ein-python-send)
;;; ein-python-send.el ends here

56
lisp/ein/ein-pytools.el Normal file
View File

@@ -0,0 +1,56 @@
;;; ein-pytools.el --- Python tools build on top of kernel -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-pytools.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-pytools.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-pytools.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ein-kernel)
(defun ein:pytools-jump-to-source-command (&optional other-window)
"Jump to the source code of the object at point.
When the prefix argument ``C-u`` is given, open the source code
in the other window. You can explicitly specify the object by
selecting it."
(interactive "P")
(cl-letf (((symbol-function 'xref--prompt-p) #'ignore))
(if other-window
(call-interactively #'xref-find-definitions-other-window)
(call-interactively #'xref-find-definitions))))
(defun ein:pytools-jump-back-command (&optional _other-window)
"Go back to the point where `ein:pytools-jump-to-source-command'
is executed last time. When the prefix argument ``C-u`` is
given, open the last point in the other window."
(interactive "P")
(call-interactively (if (fboundp 'xref-go-back)
#'xref-go-back
(symbol-function 'xref-pop-marker-stack))))
(define-obsolete-function-alias
'ein:pytools-eval-string-internal
'ein:shared-output-eval-string "0.1.2")
(provide 'ein-pytools)
;;; ein-pytools.el ends here

223
lisp/ein/ein-query.el Normal file
View File

@@ -0,0 +1,223 @@
;;; ein-query.el --- jQuery like interface on top of curl -*- lexical-binding: t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-query.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-query.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-query.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'request)
(require 'url)
(require 'ein-core)
(require 'ein-log)
(defcustom ein:query-timeout 10000
"Default query timeout for HTTP access in millisecond."
:type '(choice (integer :tag "Timeout [ms]" 1000)
(const :tag "No timeout" nil))
:group 'ein)
(defvar ein:query-xsrf-cache (make-hash-table :test 'equal)
"Remember the last xsrf token by host.
This is a hack in case we catch cookie jar in transition.
The proper fix is to sempahore between competing curl processes.")
(defvar ein:query-authorization-tokens (make-hash-table :test 'equal)
"Jupyterhub authorization token by (host . username).")
(defun ein:query-get-cookies (host path-prefix)
"Return (:path :expire :name :value) for HOST, matching PATH-PREFIX."
(when-let ((filename (request--curl-cookie-jar)))
(with-temp-buffer
(insert-file-contents filename)
(cl-loop for (domain _flag path _secure _http-only expire name value)
in (request--netscape-cookie-parse)
when (and (string= domain host)
(cl-search path-prefix path))
collect `(:path ,path :expire ,expire :name ,name :value ,value)))))
(defun ein:query-prepare-header (url settings &optional securep)
"Ensure that REST calls to the jupyter server have the correct _xsrf argument."
(let* ((host (url-host (url-generic-parse-url url)))
(paths* (let* ((warning-minimum-level :emergency)
(warning-minimum-log-level :emergency)
(root-url (car (ein:notebooklist-parse-nbpath url))))
(if root-url
(let ((root-path (url-filename (url-generic-parse-url root-url))))
(unless (zerop (length root-path))
(list (file-name-as-directory root-path))))
(let* ((url* url)
(parsed-url* (url-generic-parse-url url*))
paths*)
(while (not (zerop (length (url-filename parsed-url*))))
(push (file-name-as-directory (url-filename parsed-url*)) paths*)
(setq url* (file-name-directory (directory-file-name url*))
parsed-url* (url-generic-parse-url url*)))
paths*))))
(paths (progn (cl-pushnew "/" paths* :test #'equal) (reverse paths*)))
(cookies (cl-some (lambda (path)
(request-cookie-alist host path securep))
paths))
(xsrf (or (cdr (assoc-string "_xsrf" cookies))
(gethash host ein:query-xsrf-cache)))
(key (ein:query-divine-authorization-tokens-key url))
(token (aand key
(gethash key ein:query-authorization-tokens)
(cons "Authorization" (format "token %s" it)))))
(setq settings (plist-put settings :headers
(append (plist-get settings :headers)
(list (cons "User-Agent" "Mozilla/5.0")))))
(when token
(setq settings (plist-put settings :headers
(append (plist-get settings :headers)
(list token)))))
(when xsrf
(setq settings (plist-put settings :headers
(append (plist-get settings :headers)
(list (cons "X-XSRFTOKEN" xsrf)))))
(setf (gethash host ein:query-xsrf-cache) xsrf))
(setq settings (plist-put settings :encoding 'binary))
settings))
(defun ein:query-divine-authorization-tokens-key (url)
"Infer semblance of jupyterhub root.
From https://hub.data8x.berkeley.edu/hub/user/806b3e7/notebooks/Untitled.ipynb,
get (\"hub.data8x.berkeley.edu\" . \"806b3e7\")"
(-when-let* ((parsed-url (url-generic-parse-url url))
(url-host (url-host parsed-url))
(slash-path (car (url-path-and-query parsed-url)))
(components (split-string slash-path "/" t)))
(awhen (member "user" components)
(cons url-host (cl-second it)))))
(cl-defun ein:query-singleton-ajax (url &rest settings
&key (timeout ein:query-timeout)
&allow-other-keys)
(if (executable-find request-curl)
(let ((request-backend 'curl))
(when timeout
(setq settings (plist-put settings :timeout (/ timeout 1000.0))))
(unless (plist-member settings :sync)
(setq settings (plist-put settings :sync ein:force-sync)))
(apply #'request (url-encode-url url) (ein:query-prepare-header url settings)))
(ein:display-warning
(format "The %s program was not found, aborting" request-curl)
:error)))
(defun ein:query-kernelspecs (url-or-port callback &optional iteration)
"Send for kernelspecs of URL-OR-PORT with CALLBACK arity 0 (just a semaphore)"
(setq iteration (or iteration 0))
(ein:query-singleton-ajax
(ein:url url-or-port "api/kernelspecs")
:type "GET"
:parser #'ein:json-read
:complete (apply-partially #'ein:query-kernelspecs--complete url-or-port)
:success (apply-partially #'ein:query-kernelspecs--success url-or-port callback)
:error (apply-partially #'ein:query-kernelspecs--error url-or-port callback iteration)))
(defun ein:normalize-kernelspec-language (name)
"Normalize the kernelspec language string"
(if (stringp name)
(replace-regexp-in-string "[ ]" "-" name)
name))
(cl-defun ein:query-kernelspecs--success (url-or-port callback
&key data _symbol-status _response
&allow-other-keys)
(let ((ks (list :default (plist-get data :default)))
(specs (ein:plist-iter (plist-get data :kernelspecs))))
(setf (gethash url-or-port *ein:kernelspecs*)
(ein:flatten (dolist (spec specs ks)
(let ((name (car spec))
(info (cdr spec)))
(push (list name (make-ein:$kernelspec :name (plist-get info :name)
:display-name (plist-get (plist-get info :spec)
:display_name)
:resources (plist-get info :resources)
:language (ein:normalize-kernelspec-language
(plist-get (plist-get info :spec)
:language))
:spec (plist-get info :spec)))
ks))))))
(when callback (funcall callback)))
(cl-defun ein:query-kernelspecs--error
(url-or-port callback 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 (eq response-status 405))
(ein:query-kernelspecs--success url-or-port callback :data data)
(ein:log 'verbose "Retry kernelspecs #%s in response to %s"
iteration response-status)
(ein:query-kernelspecs url-or-port callback (1+ iteration)))
(ein:log 'error
"ein:query-kernelspecs--error %s: ERROR %s DATA %s"
url-or-port (car error-thrown) (cdr error-thrown))
(when callback (funcall callback))))
(cl-defun ein:query-kernelspecs--complete (_url-or-port &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-kernelspecs--complete %s" resp-string))
(defun ein:query-notebook-api-version (url-or-port callback)
"Get notebook version of URL-OR-PORT with CALLBACK arity 0 (a semaphore)."
(ein:query-singleton-ajax
(ein:url url-or-port "api/spec.yaml")
;; the melpa yaml package was taking too long, unfortunately
:parser (lambda ()
(if (re-search-forward "api\\s-+version: \\(\\S-+\\)"
nil t)
;; emacs-25.3 doesn't have the right string-trim
(string-remove-prefix
"\"" (string-remove-suffix
"\"" (match-string-no-properties 1)))
""))
:complete (apply-partially #'ein:query-notebook-api-version--complete
url-or-port callback)))
(cl-defun ein:query-notebook-api-version--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))
(hub-p (request-response-header response "x-jupyterhub-version")))
(ein:log 'debug "ein:query-notebook-api-version--complete %s" resp-string)
(if (not (zerop (string-to-number data)))
(setf (gethash url-or-port *ein:notebook-api-version*) data)
(if hub-p
(let ((key (ein:query-divine-authorization-tokens-key url-or-port)))
(remhash key ein:query-authorization-tokens)
(ein:display-warning
(format "Server for user %s requires start, aborting"
(or (cdr key) "unknown"))
:error)
(setq callback nil))
(ein:log 'warn "notebook api version currently unknowable")))
(when callback (funcall callback)))
(provide 'ein-query)
;;; ein-query.el ends here

50
lisp/ein/ein-scratchsheet.el Normal file
View File

@@ -0,0 +1,50 @@
;;; ein-scratchsheet.el --- Worksheet without needs for saving -*- lexical-binding:t -*-
;; Copyright (C) 2012 Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-scratchsheet.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-scratchsheet.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-scratchsheet.el.
;; If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ein-worksheet)
(defclass ein:scratchsheet (ein:worksheet)
((data :initarg :data :initform nil))
:documentation "Worksheet without needs for saving.")
(defun ein:scratchsheet-new (nbformat notebook-path kernel events &rest args)
(apply #'make-instance 'ein:scratchsheet
:nbformat nbformat
:notebook-path notebook-path
:kernel kernel
:events events
args))
(cl-defmethod ein:worksheet--buffer-name ((ws ein:scratchsheet))
(format "*ein:scratch %s/%s*"
(ein:worksheet-url-or-port ws)
(ein:worksheet-notebook-path ws)))
(provide 'ein-scratchsheet)
;;; ein-scratchsheet.el ends here

230
lisp/ein/ein-shared-output.el Normal file
View File

@@ -0,0 +1,230 @@
;; -*- lexical-binding: t -*-
;;; ein-shared-output.el --- Output buffer for ob-ein and ein-python-send
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-shared-output.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-shared-output.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-shared-output.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; When executing code from outside of notebook, some place for output
;; is needed. This module buffer containing one special cell for that
;; purpose.
;;; Code:
(require 'eieio)
(defclass ein:shared-output-cell (ein:codecell)
((cell-type :initarg :cell-type :initform "shared-output")
;; (element-names :initform (:prompt :output :footer))
(callback :initarg :callback :initform #'ignore :type function)
(clear :initarg :clear :initform #'ignore :type function)
(results-inserted :initarg :results-inserted :initform nil :type boolean))
"A singleton cell to show output from non-notebook buffers.")
(defclass ein:shared-output ()
((cell :initarg :cell :type ein:shared-output-cell)
(events :initarg :events :type ein:events)
(ewoc :initarg :ewoc :type ewoc)))
(defvar *ein:shared-output* nil
"Hold an instance of `ein:shared-output'.")
(defconst ein:shared-output-buffer-name "*ein:shared-output*")
(cl-defmethod ein:cell-insert-prompt ((cell ein:shared-output-cell))
"Insert prompt of the CELL in the buffer.
Called from ewoc pretty printer via `ein:cell-pp'."
;; Newline is inserted in `ein:cell-insert-input'.
(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-execute ((cell ein:shared-output-cell) kernel code
&rest args)
(unless (plist-get args :silent)
(setq args (plist-put args :silent nil)))
(setf (slot-value cell 'kernel) kernel)
(apply #'ein:cell-execute-internal cell kernel code args))
(cl-defmethod ein:cell-append-display-data ((_cell ein:shared-output-cell) _json)
"Do not display the plot in the shared output context.")
(cl-defmethod ein:cell--handle-output ((cell ein:shared-output-cell)
msg-type _content _metadata)
(ein:log 'debug
"ein:cell--handle-output (cell ein:shared-output-cell): %s" msg-type)
(cl-call-next-method)
(awhen (ein:oref-safe cell 'callback)
(when (funcall it cell)
(setf (slot-value cell 'results-inserted) t))))
(cl-defmethod ein:cell--handle-execute-reply ((cell ein:shared-output-cell)
content _metadata)
(ein:log 'debug
"ein:cell--handle-execute-reply (cell ein:shared-output-cell): %s"
content)
(cl-call-next-method)
(awhen (ein:oref-safe cell 'callback)
(when (funcall it cell)
(setf (slot-value cell 'results-inserted) t)))
(unless (slot-value cell 'results-inserted)
(awhen (ein:oref-safe cell 'clear)
(funcall it)))
;; clear the way for waiting block in `ob-ein--execute-async'
;; but only after 2 seconds to allow for handle-output stragglers
;; TODO avoid this hack
(run-at-time 2 nil (lambda ()
(ein:log 'debug "Clearing callback shared output cell")
(setf (slot-value cell 'callback) #'ignore)
(setf (slot-value cell 'clear) #'ignore)
(setf (slot-value cell 'results-inserted) nil))))
(defun ein:shared-output-create-buffer ()
"Get or create the shared output buffer."
(get-buffer-create ein:shared-output-buffer-name))
(defun ein:shared-output-buffer ()
"Get the buffer associated with `*ein:shared-output*'."
(ewoc-buffer (slot-value *ein:shared-output* 'ewoc)))
(defun ein:shared-output-buffer-p (&optional buffer)
"Return non-`nil' when BUFFER (or current buffer) is shared-output buffer."
(eq (or buffer (current-buffer)) (ein:shared-output-buffer)))
(defun ein:shared-output-healthy-p ()
(and (ein:shared-output-p *ein:shared-output*)
(buffer-live-p (ein:shared-output-buffer))))
(defun ein:shared-output-get-or-create ()
(if (ein:shared-output-healthy-p)
*ein:shared-output*
(with-current-buffer (ein:shared-output-create-buffer)
;; FIXME: This is a duplication of `ein:worksheet-render'.
(let* ((inhibit-read-only t)
;; Apply read-only text property to newlines by
;; setting nonsep flag to `ein:ewoc-create'
(ewoc (let ((buffer-undo-list t))
(ein:ewoc-create 'ein:worksheet-pp
(ein:propertize-read-only "\n")
nil t)))
(events (ein:events-new))
(cell (ein:shared-output-cell :ewoc ewoc
:events events)))
(erase-buffer)
(ein:shared-output-bind-events events)
(setq *ein:shared-output*
(ein:shared-output :ewoc ewoc :cell cell
:events events))
(ein:cell-enter-last cell))
(setq buffer-read-only t)
(ein:shared-output-mode)
*ein:shared-output*)))
(defun ein:shared-output-bind-events (events)
"Add dummy event handlers."
(ein:events-on events 'set_dirty.Worksheet #'ignore)
(ein:events-on events 'maybe_reset_undo.Worksheet #'ignore))
(defun ein:shared-output-get-cell ()
"Get the singleton shared output cell.
Create a cell if the buffer has none."
(slot-value (ein:shared-output-get-or-create) 'cell))
;;;###autoload
(defun ein:shared-output-pop-to-buffer ()
"Open shared output buffer."
(interactive)
(ein:shared-output-get-or-create)
(pop-to-buffer (ein:shared-output-create-buffer)))
(cl-defmethod ein:shared-output-show-code-cell ((cell ein:codecell))
"Show code CELL in shared-output buffer."
(let ((new (ein:cell-convert cell "shared-output")))
;; Make sure `*ein:shared-output*' is initialized:
(ein:shared-output-get-or-create)
(with-current-buffer (ein:shared-output-create-buffer)
(let ((inhibit-read-only t)
(ein:cell-max-num-outputs nil))
(setf (slot-value new 'ewoc) (slot-value *ein:shared-output* 'ewoc))
(setf (slot-value new 'events) (slot-value *ein:shared-output* 'events))
(erase-buffer) ; because there are only one cell anyway
(setf (slot-value *ein:shared-output* 'cell) new)
(ein:cell-enter-last new)
(pop-to-buffer (current-buffer))))))
;;;###autoload
(defun ein:shared-output-show-code-cell-at-point ()
"Show code cell at point in shared-output buffer.
It is useful when the output of the cell at point is truncated.
See also `ein:cell-max-num-outputs'."
(interactive)
(let ((cell (ein:get-cell-at-point)))
(if (ein:codecell-p cell)
(ein:shared-output-show-code-cell cell)
(error "No code cell at point."))))
;;;###autoload
(defun ein:shared-output-eval-string (kernel code &rest args)
"Entry to `ein:cell-execute-internal' from the shared output cell."
(unless kernel (setq kernel (ein:get-kernel-or-error)))
(let ((cell (ein:shared-output-get-cell)))
(ein:kernel-when-ready
kernel
(lambda (ready-kernel)
(apply #'ein:cell-execute cell ready-kernel (ein:trim-indent code) args)))))
;;; Generic getter
(defun ein:get-url-or-port--shared-output ()
(ein:aand (ein:get-kernel--shared-output) (ein:kernel-url-or-port it)))
;; (defun ein:get-notebook--shared-output ())
(defun ein:get-kernel--shared-output ()
(let ((cell (ein:get-cell-at-point--shared-output)))
(when (and (eieio-object-p cell) (slot-boundp cell :kernel))
(slot-value cell 'kernel))))
(defun ein:get-cell-at-point--shared-output ()
(when (and (ein:shared-output-p *ein:shared-output*)
(ein:shared-output-buffer-p))
(slot-value *ein:shared-output* 'cell)))
(defun ein:get-traceback-data--shared-output ()
(ein:aand (ein:get-cell-at-point--shared-output) (ein:cell-get-tb-data it)))
(defvar ein:shared-output-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-x" 'ein:tb-show)
(define-key map "\M-." 'ein:pytools-jump-to-source-command)
(define-key map (kbd "C-c C-.") 'ein:pytools-jump-to-source-command)
map)
"The map for ein:shared-output-mode-map.")
(define-derived-mode ein:shared-output-mode special-mode "ein:so"
"Shared output mode."
(font-lock-mode))
(add-hook 'ein:shared-output-mode-hook 'ein:truncate-lines-on)
(provide 'ein-shared-output)
;;; ein-shared-output.el ends here

193
lisp/ein/ein-traceback.el Normal file
View File

@@ -0,0 +1,193 @@
;;; ein-traceback.el --- Traceback module -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-traceback.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-traceback.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-traceback.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'ewoc)
(require 'ansi-color)
(require 'ein-core)
(require 'ein-shared-output)
(declare-function ein:get-notebook "ein-notebook")
(declare-function ein:notebook-buffer "ein-notebook")
(defclass ein:traceback ()
((tb-data :initarg :tb-data :type list)
(notebook :initarg :source-notebook ;; :type ein:$notebook
:accessor ein:traceback-notebook)
(buffer-name :initarg :buffer-name :type string)
(buffer :initarg :buffer :type buffer)
(ewoc :initarg :ewoc :type ewoc)))
(ein:deflocal ein:%traceback% nil
"Buffer local variable to store an instance of `ein:traceback'.")
(defvar ein:tb-buffer-name-template "*ein:tb %s/%s*")
(defun ein:tb-new (buffer-name notebook)
(make-instance 'ein:traceback
:buffer-name buffer-name
:source-notebook notebook))
(cl-defmethod ein:tb-get-buffer ((traceback ein:traceback))
(unless (and (slot-boundp traceback :buffer)
(buffer-live-p (slot-value traceback 'buffer)))
(let ((buf (get-buffer-create (slot-value traceback 'buffer-name))))
(setf (slot-value traceback 'buffer) buf)))
(slot-value traceback 'buffer))
(defun ein:tb-pp (ewoc-data)
(insert (ansi-color-apply ewoc-data)))
(cl-defmethod ein:tb-render ((traceback ein:traceback) tb-data)
(with-current-buffer (ein:tb-get-buffer traceback)
(setq ein:%traceback% traceback)
(setq buffer-read-only t)
(let ((inhibit-read-only t)
(ewoc (ein:ewoc-create #'ein:tb-pp)))
(erase-buffer)
(setf (slot-value traceback 'ewoc) ewoc)
(setf (slot-value traceback 'tb-data) tb-data)
(mapc (lambda (data) (ewoc-enter-last ewoc data)) tb-data))
(ein:traceback-mode)))
(cl-defmethod ein:tb-popup ((traceback ein:traceback) tb-data)
(ein:tb-render traceback tb-data)
(pop-to-buffer (ein:tb-get-buffer traceback)))
;;;###autoload
(defun ein:tb-show ()
"Show full traceback in traceback viewer."
(interactive)
(unless
(ein:and-let* ((tb-data (ein:get-traceback-data))
(url-or-port (or (ein:get-url-or-port)
(ein:get-url-or-port--shared-output)))
(kernel (or (ein:get-kernel)
(ein:get-kernel--shared-output)))
(kr-id (ein:kernel-id kernel))
(tb-name (format ein:tb-buffer-name-template
url-or-port kr-id)))
(ein:tb-popup (ein:tb-new tb-name (ein:get-notebook)) tb-data)
t)
(error "No traceback is available.")))
(cl-defmethod ein:tb-range-of-node-at-point ((traceback ein:traceback))
(let* ((ewoc (slot-value traceback 'ewoc))
(ewoc-node (ewoc-locate ewoc))
(beg (ewoc-location ewoc-node))
(end (ein:aand (ewoc-next ewoc ewoc-node) (ewoc-location it))))
(list beg end)))
(cl-defmethod ein:tb-file-path-at-point ((traceback ein:traceback))
(cl-destructuring-bind (beg end)
(ein:tb-range-of-node-at-point traceback)
(let* ((file-tail
(next-single-property-change beg 'font-lock-face nil end))
(file (when file-tail
(buffer-substring-no-properties beg file-tail))))
(if (string-match "\\.pyc$" file)
(concat (file-name-sans-extension file) ".py")
file))))
(cl-defmethod ein:tb-file-lineno-at-point ((traceback ein:traceback))
(cl-destructuring-bind (beg end)
(ein:tb-range-of-node-at-point traceback)
(when (save-excursion
(goto-char beg)
(search-forward-regexp "^[-]+> \\([0-9]+\\)" end t))
(string-to-number (match-string 1)))))
(cl-defmethod ein:tb-jump-to-source-at-point ((traceback ein:traceback)
&optional select)
(let ((file (ein:tb-file-path-at-point traceback))
(lineno (ein:tb-file-lineno-at-point traceback)))
(if (string-match "<ipython-input-\\([0-9]+\\)-.*" file)
(let* ((cellnum (string-to-number (match-string 1 file)))
(nb (slot-value traceback 'notebook))
(ws (cl-first (ein:$notebook-worksheets nb)))
(cells (ein:worksheet-get-cells ws))
(it (cl-find cellnum cells :key #'(lambda (x)
(if (same-class-p x 'ein:codecell)
(slot-value x 'input-prompt-number))))))
(if it
(progn
(pop-to-buffer (ein:notebook-buffer nb))
(ein:cell-goto-line it lineno))))
(let ((url-or-port (ein:$notebook-url-or-port (ein:traceback-notebook traceback))))
(cond
((numberp url-or-port) (ein:tb-jtsap--local file lineno select))
((string-match "localhost" url-or-port) (ein:tb-jtsap--local file lineno select))
((string-match "127.0.0.1" url-or-port) (ein:tb-jtsap--local file lineno select))
(t (ein:tb-jtsap--remote url-or-port file lineno select)))))))
(defun ein:tb-jtsap--local (file lineno select)
(cl-assert (file-exists-p file) nil "File %s does not exist." file)
(let ((buf (find-file-noselect file))
(scroll (lambda ()
(goto-char (point-min))
(forward-line (1- lineno)))))
(if select
(progn (pop-to-buffer buf)
(funcall scroll))
(with-selected-window (display-buffer buf)
(funcall scroll)))))
(defun ein:tb-jtsap--remote (uri path lineno select)
(let* ((uri (url-generic-parse-url uri))
(host-path (concat "/" (url-host uri)
":" path)))
(ein:tb-jtsap--local host-path lineno select)))
(defun ein:tb-jump-to-source-at-point-command (&optional select)
(interactive "P")
(ein:tb-jump-to-source-at-point ein:%traceback% select))
(defun ein:tb-prev-item ()
(interactive)
(ewoc-goto-prev (slot-value ein:%traceback% 'ewoc) 1))
(defun ein:tb-next-item ()
(interactive)
(ewoc-goto-next (slot-value ein:%traceback% 'ewoc) 1))
(defvar ein:traceback-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'ein:tb-jump-to-source-at-point-command)
(define-key map "p" 'ein:tb-prev-item)
(define-key map "n" 'ein:tb-next-item)
map)
"Keymap for ein:traceback-mode.")
(define-derived-mode ein:traceback-mode special-mode "ein:tb"
(font-lock-mode))
(add-hook 'ein:traceback-mode-hook 'ein:truncate-lines-on)
(provide 'ein-traceback)
;;; ein-traceback.el ends here

721
lisp/ein/ein-utils.el Normal file
View File

@@ -0,0 +1,721 @@
;;; ein-utils.el --- Utility module -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-utils.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-utils.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-utils.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'cc-mode)
(require 'json)
(require 'dash)
(require 'url)
(require 'deferred)
(make-obsolete-variable 'ein:enable-gc-adjust nil "0.17.0")
;;; Macros and core functions/variables
(defmacro ein:with-undo-disabled (&rest body)
"Temporarily disable undo recording while executing `body`
while maintaining the undo list for the current buffer."
`(let ((buffer-undo-list t))
,@body))
(defmacro ein:aand (test &rest rest)
"Anaphoric AND. Adapted from `e2wm:aand'."
(declare (debug (form &rest form)))
`(let ((it ,test))
(if it ,(if rest (macroexpand-all `(ein:aand ,@rest)) 'it))))
(defmacro ein:and-let* (bindings &rest form)
"Gauche's `and-let*'."
(declare (debug ((&rest &or symbolp (form) (gate symbolp &optional form))
body))
;; See: (info "(elisp) Specification List")
(indent 1))
(if (null bindings)
`(progn ,@form)
(let* ((head (car bindings))
(tail (cdr bindings))
(rest (macroexpand-all `(ein:and-let* ,tail ,@form))))
(cond
((symbolp head) `(if ,head ,rest))
((= (length head) 1) `(if ,(car head) ,rest))
(t `(let (,head) (if ,(car head) ,rest)))))))
(defvar ein:local-variables '()
"Modified by `ein:deflocal'")
(defmacro ein:deflocal (name &optional initvalue docstring)
"Define permanent buffer local variable named NAME.
INITVALUE and DOCSTRING are passed to `defvar'."
(declare (indent defun)
(doc-string 3))
`(progn
(defvar ,name ,initvalue ,docstring)
(make-variable-buffer-local ',name)
(put ',name 'permanent-local t)
(setq ein:local-variables (append ein:local-variables '(,name)))))
(defmacro ein:with-read-only-buffer (buffer &rest body)
(declare (indent 1))
`(with-current-buffer ,buffer
(setq buffer-read-only t)
(save-excursion
(let ((inhibit-read-only t))
,@body))))
(defmacro ein:with-live-buffer (buffer &rest body)
"Execute BODY in BUFFER if BUFFER is alive."
(declare (indent 1) (debug t))
`(when (buffer-live-p ,buffer)
(with-current-buffer ,buffer
,@body)))
(defmacro ein:with-possibly-killed-buffer (buffer &rest body)
"Execute BODY in BUFFER if BUFFER is live.
Execute BODY if BUFFER is not live anyway."
(declare (indent 1) (debug t))
`(if (buffer-live-p ,buffer)
(with-current-buffer ,buffer
,@body)
,@body))
(defvar ein:dotty-syntax-table
(let ((table (make-syntax-table c-mode-syntax-table)))
(modify-syntax-entry ?. "w" table)
(modify-syntax-entry ?_ "w" table)
(modify-syntax-entry ?% "w" table)
table)
"Adapted from `python-dotty-syntax-table'.")
(defun ein:beginning-of-object (&optional code-syntax-table)
"Move to the beginning of the dotty.word.at.point.
User may specify a custom syntax table. If one is not supplied
`ein:dotty-syntax-table' will be assumed."
(with-syntax-table (or code-syntax-table ein:dotty-syntax-table)
(while (re-search-backward "\\(\\sw\\|\\s_\\|\\s\\.\\|\\s\\\\|[%@|]\\)\\="
(when (> (point) 2000) (- (point) 2000))
t))
(re-search-forward "\\=#[-+.<|]" nil t)
(when (and (looking-at "@"))
(forward-char))))
(defun ein:end-of-object (&optional code-syntax-table)
"Move to the end of the dotty.word.at.point. User may specify a
custom syntax table. If one is not supplied
`ein:dotty-syntax-table' will be assumed."
(with-syntax-table (or code-syntax-table ein:dotty-syntax-table)
(re-search-forward "\\=\\(\\sw\\|\\s_\\|\\s\\.\\|#:\\|[%|]\\)*")))
(defun ein:object-start-pos ()
"Return the starting position of the symbol under point.
The result is unspecified if there isn't a symbol under the point."
(save-excursion (ein:beginning-of-object) (point)))
(defun ein:object-end-pos ()
(save-excursion (ein:end-of-object) (point)))
(defun ein:object-prefix-at-point ()
"Like `ein:object-at-point', but only return substring up to point.
For example, given pd.Series, if the cursor is at the S then
pd.S will be returned."
(ein:and-let* ((obj (ein:object-at-point))
(delta (- (point) (ein:object-start-pos))))
(substring obj 0 delta)))
(defun ein:object-at-point ()
"Return dotty.words.at.point.
When region is active, text in region is returned after trimmed
white spaces, newlines and dots. When object is not found at the
point, return the object just before previous opening
parenthesis.
For auto popup tooltip (or something like eldoc), probably it is
better to return function (any word before left parenthesis). I
should write another function or add option to this function when
the auto popup tooltip is implemented."
(if (region-active-p)
(ein:trim (buffer-substring (region-beginning) (region-end))
"\\s-\\|\n\\|\\.")
(save-excursion
(with-syntax-table ein:dotty-syntax-table
(aif (thing-at-point 'symbol)
it
(unless (looking-at "(")
(search-backward "(" (line-beginning-position) t))
(thing-at-point 'symbol))))))
(defun ein:function-at-point ()
"Similar to `ein:object-at-point', but instead will looking for the function
at point, i.e. any word before then \"(\", if it is present."
(save-excursion
(unless (looking-at "(")
(search-backward "(" (line-beginning-position) t))
(ein:object-at-point)))
(defun ein:object-at-point-or-error ()
(or (ein:object-at-point) (error "No object found at the point")))
(defun ein:flatten (tree)
"Traverses the tree in order, collecting non-null leaves into a list."
(let (list)
(cl-labels ((traverse (subtree)
(when subtree
(if (consp subtree)
(progn
(traverse (car subtree))
(traverse (cdr subtree)))
(push subtree list)))))
(traverse tree))
(nreverse list)))
(defvar ein:url-localhost "127.0.0.1")
(defsubst ein:glom-paths (&rest paths)
(cl-loop with result = ""
for p in paths
if (not (zerop (length p)))
do (setq result (concat result (ein:trim-left (directory-file-name p) "/") "/"))
end
finally return (directory-file-name result)))
(defun ein:url (url-or-port &rest paths)
(when url-or-port
(when (or (integerp url-or-port)
(and (stringp url-or-port) (string-match "^[0-9]+$" url-or-port)))
(setq url-or-port (format "http://localhost:%s" url-or-port)))
(setq url-or-port (string-trim url-or-port))
(cl-flet ((localhost-p (host) (or (string= host "localhost")
(string= host ein:url-localhost)
(string= host ""))))
(let ((parsed-url (url-generic-parse-url url-or-port)))
(unless (url-host parsed-url)
(setq url-or-port (format "%s://%s" (if (localhost-p url-or-port)
"http" "https")
url-or-port))
(setq parsed-url (url-generic-parse-url url-or-port)))
(when (localhost-p (url-host parsed-url))
(setf (url-host parsed-url) ein:url-localhost))
(directory-file-name (concat (file-name-as-directory (url-recreate-url parsed-url))
(apply #'ein:glom-paths paths)))))))
(defun ein:url-no-cache (url)
"Imitate `cache=false' of `jQuery.ajax'.
See: http://api.jquery.com/jQuery.ajax/"
(concat url (format-time-string "?_=%s")))
(defun ein:html-get-data-in-body-tag (key)
"Very ad-hoc parser to get data in body tag."
(ignore-errors
(save-excursion
(goto-char (point-min))
(search-forward "<body")
(search-forward-regexp (format "%s=\\([^[:space:]\n]+\\)" key))
(match-string 1))))
(defmacro ein:with-json-setting (&rest body)
`(let ((json-object-type 'plist)
(json-array-type 'list))
,@body))
(defsubst ein:json-read ()
"Read json from `url-retrieve'-ed buffer.
* `json-object-type' is `plist'. This is mainly for readability.
* `json-array-type' is `list'. Notebook data is edited locally thus
data type must be edit-friendly. `vector' type is not."
(goto-char (point-max))
(backward-sexp)
(if (fboundp 'json-parse-buffer)
(json-parse-buffer :object-type 'plist :array-type 'array :null-object json-null :false-object json-false)
(ein:with-json-setting (json-read))))
(defsubst ein:json-read-from-string (string)
(if (fboundp 'json-parse-string)
(json-parse-string string :object-type 'plist :array-type 'array :null-object json-null :false-object json-false)
(ein:with-json-setting (json-read-from-string string))))
(defsubst ein:json-insert (obj)
(if (fboundp 'json-insert)
(json-insert obj :null-object json-null :false-object json-false)
(insert (json-encode obj))))
(defsubst ein:json-encode (obj)
(if (fboundp 'json-serialize)
(json-serialize obj :null-object json-null :false-object json-false)
(json-encode obj)))
(defsubst ein:json-any-to-bool (obj)
(if (and obj (not (eq obj json-false))) t json-false))
(defun ein:ewoc-create (pretty-printer &optional header footer nosep)
"Do nothing wrapper of `ewoc-create' to provide better error message."
(condition-case nil
(ewoc-create pretty-printer header footer nosep)
((debug wrong-number-of-arguments)
(ein:display-warning "Incompatible EWOC version.
The version of ewoc.el you are using is too old for EIN.
Please install the newer version.
See also: https://github.com/tkf/emacs-ipython-notebook/issues/49")
(error "Incompatible EWOC version."))))
(defun ein:propertize-read-only (string &rest properties)
(apply #'propertize string 'read-only t 'front-sticky t properties))
(defvar ein:truncate-long-cell-output) ; defined in ein-cell - but cannot require it because of circularity
(defun ein:insert-read-only (string &rest properties)
(let ((buffer-undo-list t)
(start (point)))
(insert (apply #'ein:propertize-read-only
(ein:maybe-truncate-string-lines string ein:truncate-long-cell-output)
properties))
(comint-carriage-motion start (point))))
(defun ein:maybe-truncate-string-lines (string nlines)
"Truncate multi-line `string' to NLINES."
(if nlines
(let ((lines (split-string string "[\n]")))
(if (> (length lines) nlines)
(ein:join-str "\n" (append (butlast lines (- (length lines) nlines))
(list "...")))
string))
string))
(defun ein:trim (string &optional regexp)
(ein:trim-left (ein:trim-right string regexp) regexp))
(defun ein:trim-left (string &optional regexp)
(unless regexp (setq regexp "\\s-\\|\n"))
(ein:trim-regexp string (format "^\\(%s\\)+" regexp)))
(defun ein:trim-right (string &optional regexp)
(unless regexp (setq regexp "\\s-\\|\n"))
(ein:trim-regexp string (format "\\(%s\\)+$" regexp)))
(defun ein:trim-regexp (string regexp)
(if (string-match regexp string)
(replace-match "" t t string)
string))
(defun ein:trim-indent (string)
"Strip uniform amount of indentation from lines in STRING."
(let* ((lines (split-string string "\n"))
(indent
(let ((lens
(cl-loop for line in lines
for stripped = (ein:trim-left line)
unless (equal stripped "")
collect (- (length line) (length stripped)))))
(if lens (apply #'min lens) 0)))
(trimmed
(cl-loop for line in lines
if (> (length line) indent)
collect (ein:trim-right (substring line indent))
else
collect line)))
(ein:join-str "\n" trimmed)))
(defun ein:join-str (sep strings)
(mapconcat 'identity strings sep))
(defun ein:join-path (paths)
(mapconcat 'file-name-as-directory paths ""))
(defun ein:string-fill-paragraph (string &optional justify)
(with-temp-buffer
(erase-buffer)
(insert string)
(goto-char (point-min))
(fill-paragraph justify)
(buffer-string)))
(cl-defmacro ein:case-equal (str &rest clauses)
"Similar to `case' but comparison is done by `equal'.
Adapted from twittering-mode.el's `case-string'."
(declare (indent 1))
`(cond
,@(mapcar
(lambda (clause)
(let ((keylist (car clause))
(body (cdr clause)))
`(,(if (listp keylist)
`(or ,@(mapcar (lambda (key) `(equal ,str ,key))
keylist))
't)
,@body)))
clauses)))
;;; Text manipulation on buffer
(defun ein:find-leftmost-column (beg end)
"Return the leftmost column in region BEG to END."
(save-excursion
(let (mincol)
(goto-char beg)
(while (< (point) end)
(back-to-indentation)
(unless (= (point) (line-end-position))
(setq mincol (if mincol
(min mincol (current-column))
(current-column))))
(unless (= (forward-line 1) 0)
(cl-return-from ein:find-leftmost-column mincol)))
mincol)))
;;; Misc
(defun ein:completing-read (&rest args)
(cond (noninteractive (if (consp (cl-second args))
(car (cl-second args))
(cl-second args)))
(t (apply completing-read-function args))))
(defun ein:plist-iter (plist)
"Return list of (key . value) in PLIST."
;; FIXME: this is not needed. See: `ein:plist-exclude'.
(cl-loop for p in plist
for i from 0
for key-p = (= (% i 2) 0)
with key = nil
if key-p do (setq key p)
else collect `(,key . ,p)))
(defun ein:plist-exclude (plist keys)
"Exclude entries specified by KEYS in PLIST.
Example:
(ein:plist-exclude \\='(:a 1 :b 2 :c 3 :d 4) \\='(:b :c))"
(cl-loop for (k v) on plist by 'cddr
unless (memq k keys)
nconc (list k v)))
(defun ein:clip-list (list first last)
"Return elements in region of the LIST specified by FIRST and LAST element.
Example:
(ein:clip-list \\='(1 2 3 4 5 6) 2 4) ;=> (2 3 4)"
(cl-loop for elem in list
with clipped
with in-region-p = nil
when (eq elem first)
do (setq in-region-p t)
when in-region-p
do (push elem clipped)
when (eq elem last)
return (reverse clipped)))
(cl-defun ein:list-insert-after (list pivot new &key (test #'eq))
"Insert NEW after PIVOT in LIST destructively.
Note: do not rely on that `ein:list-insert-after' change LIST in place.
Elements are compared using the function TEST (default: `eq')."
(cl-loop for rest on list
when (funcall test (car rest) pivot)
return (progn (push new (cdr rest)) list)
finally do (error "PIVOT %S is not in LIST %S" pivot list)))
(cl-defun ein:list-insert-before (list pivot new &key (test #'eq))
"Insert NEW before PIVOT in LIST destructively.
Note: do not rely on that `ein:list-insert-before' change LIST in place.
Elements are compared using the function TEST (default: `eq')."
(if (and list (funcall test (car list) pivot))
(cons new list)
(cl-loop for rest on list
when (funcall test (cadr rest) pivot)
return (progn (push new (cdr rest)) list)
finally do (error "PIVOT %S is not in LIST %S" pivot list))))
(cl-defun ein:list-move-left (list elem &key (test #'eq))
"Move ELEM in LIST left. TEST is used to compare elements"
(cl-macrolet ((== (a b) `(funcall test ,a ,b)))
(cond
((== (car list) elem)
(append (cdr list) (list (car list))))
(t
(cl-loop for rest on list
when (== (cadr rest) elem)
return (let ((prev (car rest)))
(setf (car rest) elem)
(setf (cadr rest) prev)
list)
finally do (error "ELEM %S is not in LIST %S" elem list))))))
(cl-defun ein:list-move-right (list elem &key (test #'eq))
"Move ELEM in LIST right. TEST is used to compare elements"
(cl-loop with first = t
for rest on list
when (funcall test (car rest) elem)
return (if (cdr rest)
(let ((next (cadr rest)))
(setf (car rest) next)
(setf (cadr rest) elem)
list)
(if first
list
(setcdr rest-1 nil)
(cons elem list)))
finally do (error "ELEM %S is not in LIST %S" elem list)
for rest-1 = rest
do (setq first nil)))
(defun ein:get-value (obj)
"Get value from obj if it is a variable or function."
(cond
((not (symbolp obj)) obj)
((boundp obj) (symbol-value obj))
((fboundp obj) (funcall obj))))
(defun ein:choose-setting (symbol value &optional single-p)
"Choose setting in stored in SYMBOL based on VALUE.
The value of SYMBOL can be string, alist or function.
SINGLE-P is a function which takes one argument. It must
return t when the value of SYMBOL can be used as a setting.
SINGLE-P is `stringp' by default."
(let ((setting (symbol-value symbol)))
(cond
((funcall (or single-p 'stringp) setting) setting)
((functionp setting) (funcall setting value))
((listp setting)
(ein:get-value (or (assoc-default value setting)
(assoc-default 'default setting))))
(t (error "Unsupported type of `%s': %s" symbol (type-of setting))))))
(defmacro ein:setf-default (place val)
"Set VAL to PLACE using `setf' if the value of PLACE is `nil'."
`(unless ,place
(setf ,place ,val)))
(defun ein:funcall-packed (func-arg &rest args)
"Call \"packed\" function.
FUNC-ARG is a `cons' of the form: (FUNC ARG).
FUNC is called as (apply FUNC ARG ARGS)."
(apply (car func-arg) (cdr func-arg) args))
(defun ein:eval-if-bound (symbol)
(and (boundp symbol) (symbol-value symbol)))
(defun ein:remove-by-index (list indices)
"Remove elements from LIST if its index is in INDICES.
NOTE: This function creates new list."
(cl-loop for l in list
for i from 0
when (not (memq i indices))
collect l))
(defun ein:ask-choice-char (prompt choices)
"Show PROMPT and read one of acceptable key specified as CHOICES."
(let ((char-list (cl-loop for i from 0 below (length choices)
collect (elt choices i)))
(answer 'recenter))
(while
(let ((key
(let ((cursor-in-echo-area t))
(read-key (propertize (if (eq answer 'recenter)
prompt
(concat "Please choose answer from"
(format " %s. " choices)
prompt))
'face 'minibuffer-prompt)))))
(setq answer (lookup-key query-replace-map (vector key) t))
(cond
((memq key char-list) (setq answer key) nil)
((eq answer 'recenter) (recenter) t)
((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
(t t)))
(ding)
(discard-input))
answer))
(defun ein:truncate-lines-on ()
"Set `truncate-lines' on (set it to `t')."
(setq truncate-lines t))
(defun ein:wait-until (predicate &optional predargs timeout-seconds)
"Wait until PREDICATE function returns non-`nil'.
PREDARGS is argument list for the PREDICATE function.
Make TIMEOUT-SECONDS larger \(default 5) to wait longer before timeout."
(ein:log 'debug "WAIT-UNTIL start")
(unless timeout-seconds (setq timeout-seconds 5))
(unless (cl-loop repeat (/ timeout-seconds 0.05)
when (apply predicate predargs)
return t
;; borrowed from `deferred:sync!':
do (sit-for 0.05)
do (sleep-for 0.05))
(warn "Timeout"))
(ein:log 'debug "WAIT-UNTIL end"))
(defun ein:format-time-string (format time)
"Apply format to time.
If `format' is a string, call `format-time-string',
otherwise it should be a function, which is called on `time'."
(cl-etypecase format
(string (format-time-string format time))
(function (funcall format time))))
;;; Emacs utilities
(defmacro ein:message-whir (mesg callback &rest body)
"Display MESG with a modest animation until ASYNC-CALL completes."
`(let* (done-p
(done-callback (lambda (&rest _args) (setf done-p t)))
(errback (lambda (&rest _args) (setf done-p 'error))))
(ignore errback) ; make errback ignorable
;; again, how can done-callback remove itself after running?
(add-function :before ,callback done-callback)
(unless noninteractive
(ein:message-whir-subr ,mesg (lambda () done-p)))
,@body))
(defun ein:message-whir-subr (mesg doneback)
"Display MESG with a modest animation until done-p returns t.
DONEBACK returns t or \\='error when calling process is done, and nil if not done."
(let* ((mesg mesg)
(doneback doneback)
(count -1))
(message "%s%s" mesg (make-string (1+ (% (cl-incf count) 3)) ?.))
;; https://github.com/kiwanami/emacs-deferred/issues/28
;; "complicated timings of macro expansion lexical-let, deferred:lambda"
;; using deferred:loop instead
(deferred:$
(deferred:loop (cl-loop for i from 1 below 60 by 1 collect i)
(lambda ()
(deferred:$
(deferred:next
(lambda ()
(aif (funcall doneback) it
(message "%s%s" mesg (make-string (1+ (% (cl-incf count) 3)) ?.))
(sleep-for 0 365)))))))
(deferred:nextc it
(lambda (status)
(message "%s... %s" mesg
(if (or (null status) (eq status 'error)) "failed" "done")))))))
(defun ein:display-warning (message &optional level)
"Simple wrapper around `display-warning'.
LEVEL must be one of :emergency, :error or :warning (default).
This must be used only for notifying user.
Use `ein:log' for debugging and logging."
;; FIXME: Probably set BUFFER-NAME per notebook?
;; FIXME: Call `ein:log' here (but do not display in minibuffer).
(display-warning 'ein message level))
(defvar ein:display-warning-once--db
(make-hash-table :test 'equal))
(defun ein:display-warning-once (message &optional level)
"Call `ein:display-warning' once for same MESSAGE and LEVEL."
(let ((key (list message level)))
(unless (gethash key ein:display-warning-once--db)
(ein:display-warning message level)
(puthash key t ein:display-warning-once--db))))
(defvar help-xref-following) ; defined in help-mode
(defun ein:get-docstring (function)
"Return docstring of FUNCTION."
(with-temp-buffer
(erase-buffer)
(let ((standard-output (current-buffer))
(help-xref-following t)
(major-mode 'help-mode)) ; avoid error in Emacs 24
(describe-function-1 function))
(buffer-string)))
(defun ein:generate-menu (list-name-callback)
(mapcar (lambda (name-callback)
(cl-destructuring-bind (name callback &rest args) name-callback
`[,name
,(let ((km (intern-soft (concat (symbol-name callback) "-km"))))
(if (commandp km) km callback))
:help ,(ein:get-docstring callback) ,@args]))
list-name-callback))
;;; Git utilities
(defun ein:call-process (command &optional args)
"Call COMMAND with ARGS and return its stdout as string or
`nil' if COMMAND fails. It also checks if COMMAND executable
exists or not."
(with-temp-buffer
(erase-buffer)
(and (executable-find command)
(= (apply #'call-process command nil t nil args) 0)
(buffer-string))))
(defun ein:git-root-p (&optional dir)
"Return `t' when DIR is root of git repository."
(file-directory-p (expand-file-name ".git" (or dir default-directory))))
(defun ein:git-dirty-p ()
"Return `t' if the current directory is in git repository and it is dirty."
(not (equal (ein:call-process
"git" '("--no-pager" "status" "--porcelain"))
"")))
(defun ein:git-revision ()
"Return abbreviated git revision if the current directory is in
git repository."
(ein:call-process "git" '("--no-pager" "log" "-n1" "--format=format:%h")))
(defun ein:git-revision-dirty ()
"Return `ein:git-revision' + \"-dirty\" suffix if the current
directory is in a dirty git repository."
(ein:aand (ein:git-revision)
(concat it (if (ein:git-dirty-p) "-dirty" ""))))
;;; utils.js compatible
(defun ein:utils-uuid ()
"Return string with random (version 4) UUID.
Adapted from org-mode's `org-id-uuid'."
(let ((rnd (md5 (format "%s%s%s%s%s%s%s"
(random t)
(current-time)
(user-uid)
(emacs-pid)
(user-full-name)
user-mail-address
(recent-keys)))))
(format "%s-%s-4%s-%s%s-%s"
(substring rnd 0 8)
(substring rnd 8 12)
(substring rnd 13 16)
(format "%x"
(logior
#b10000000
(logand
#b10111111
(string-to-number
(substring rnd 16 18) 16))))
(substring rnd 18 20)
(substring rnd 20 32))))
(provide 'ein-utils)
;;; ein-utils.el ends here

119
lisp/ein/ein-websocket.el Normal file
View File

@@ -0,0 +1,119 @@
;;; ein-websocket.el --- Wrapper of websocket.el -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-websocket.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-websocket.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-websocket.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'websocket)
(require 'ein-core)
(require 'ein-classes)
(require 'url-cookie)
(require 'request)
(defun ein:websocket-store-cookie (c host-port url-filename securep)
(url-cookie-store (car c) (cdr c) nil host-port url-filename securep))
(defun ein:maybe-get-jhconn-user (url)
(let ((paths (cl-rest (split-string (url-filename (url-generic-parse-url url)) "/"))))
(when (string= (cl-first paths) "user")
(list (format "/%s/%s/" (cl-first paths) (cl-second paths))))))
(defun ein:websocket--prepare-cookies (url)
"Websocket gets its cookies using the url-cookie API, so we need
to transcribe any cookies stored in `request-cookie-alist' during
earlier calls to `request' (request.el)."
(let* ((parsed-url (url-generic-parse-url url))
(host-port (format "%s:%s" (url-host parsed-url) (url-port parsed-url)))
(base-url (file-name-as-directory (url-filename parsed-url)))
(securep (string-match "^wss://" url))
(read-cookies-func (lambda (path)
(request-cookie-alist
(url-host parsed-url) path securep)))
(cookies (cl-loop
repeat 4
for cand = (cl-mapcan read-cookies-func
`("/"
"/hub/"
,base-url
,@(ein:maybe-get-jhconn-user url)))
until (cl-some (lambda (x) (string= "_xsrf" (car x))) cand)
do (ein:log 'info
"ein:websocket--prepare-cookies: no _xsrf among %s, retrying."
cand)
do (sleep-for 0 300)
finally return cand)))
(dolist (c cookies)
(ein:websocket-store-cookie
c host-port (car (url-path-and-query parsed-url)) securep))))
(defun ein:websocket (url kernel on-message on-close on-open)
(ein:websocket--prepare-cookies (ein:$kernel-ws-url kernel))
(let* ((ws (websocket-open url
:on-open on-open
:on-message on-message
:on-close on-close
:on-error (lambda (ws action err)
(ein:log 'info "WS action [%s] %s (%s)"
err action (websocket-url ws)))))
(websocket (make-ein:$websocket :ws ws :kernel kernel :closed-by-client nil)))
(setf (websocket-client-data ws) websocket)
websocket))
(defun ein:websocket-open-p (websocket)
(eql (websocket-ready-state (ein:$websocket-ws websocket)) 'open))
(defun ein:websocket-send (websocket text)
;; (ein:log 'info "WS: Sent message %s" text)
(condition-case-unless-debug err
(websocket-send-text (ein:$websocket-ws websocket) text)
(error (message "Error %s on sending websocket message %s." err text))))
(defun ein:websocket-close (websocket)
(setf (ein:$websocket-closed-by-client websocket) t)
(websocket-close (ein:$websocket-ws websocket)))
(defun ein:websocket-send-shell-channel (kernel msg)
(cond ((= (ein:$kernel-api-version kernel) 2)
(ein:websocket-send
(ein:$kernel-shell-channel kernel)
(ein:json-encode msg)))
((>= (ein:$kernel-api-version kernel) 3)
(ein:websocket-send
(ein:$kernel-websocket kernel)
(ein:json-encode (plist-put msg :channel "shell"))))))
(defun ein:websocket-send-stdin-channel (kernel msg)
(cond ((= (ein:$kernel-api-version kernel) 2)
(ein:log 'warn "Stdin messages only supported with IPython 3."))
((>= (ein:$kernel-api-version kernel) 3)
(ein:websocket-send
(ein:$kernel-websocket kernel)
(ein:json-encode (plist-put msg :channel "stdin"))))))
(provide 'ein-websocket)
;;; ein-websocket.el ends here

1161
lisp/ein/ein-worksheet.el Normal file
View File

File diff suppressed because it is too large Load Diff

52
lisp/ein/ein.el Normal file
View File

@@ -0,0 +1,52 @@
;;; ein.el --- jupyter notebook client -*- lexical-binding:t -*-
;; Copyright (C) 2012-2019 The Authors of the Emacs IPython Notebook (EIN)
;; Authors: dickmao <github id: dickmao>
;; John Miller <millejoh at millejoh.com>
;; Takafumi Arakaki <aka.tkf at gmail.com>
;; Version: 0.17.1pre
;; Package-Requires: ((emacs "26.1") (websocket "1.12") (anaphora "1.0.4") (request "0.3.3") (deferred "0.5") (polymode "0.2.2") (dash "2.13.0") (with-editor "0pre"))
;; URL: https://github.com/dickmao/emacs-ipython-notebook
;; Keywords: jupyter, literate programming, reproducible research
;; This file is NOT part of GNU Emacs.
;; ein.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.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.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Emacs IPython Notebook (EIN), despite its name, is a jupyter client for all
;; languages. It does not work under non-WSL Windows environments.
;;
;; As of 2023, EIN has been sunset for a number of years having been
;; unable to keep up with jupyter's web-first ecosystem. Even during
;; its heyday EIN never fully reconciled emac's monolithic buffer
;; architecture to the notebook's by-cell discretization, leaving
;; gaping functional holes like crippled undo.
;;
;; Certainly in 2012 when jupyter was much smaller, an emacs client
;; made perfect sense. With many years of hindsight, it's now clear
;; the json-driven, git-averse notebook format is anathema to emacs's
;; plain text ethos.
;;; Code:
(when (boundp 'mouse-buffer-menu-mode-groups)
(add-to-list 'mouse-buffer-menu-mode-groups
'("^ein:" . "ein")))
(provide 'ein)
;;; ein.el ends here

458
lisp/ein/ob-ein.el Normal file
View File

@@ -0,0 +1,458 @@
;; -*- lexical-binding: t -*-
;;; ob-ein.el --- org-babel functions for template evaluation
;; Copyright (C) John M. Miller
;; Author: John M. Miller <millejoh at mac.com>
;;
;;; License:
;; This file is NOT part of GNU Emacs.
;; ob-ein.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.
;; ob-ein.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 ob-ein.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Support executing org-babel source blocks using EIN worksheets.
;;; Credits:
;; Uses code from https://github.com/gregsexton/ob-ipython (MIT License)
;;; Code:
(require 'ob)
(require 'ein-utils)
(require 'ein-cell)
(require 'anaphora)
(autoload 'org-element-property "org-element")
(autoload 'org-element-context "org-element")
(autoload 'org-element-type "org-element")
(autoload 'org-id-new "org-id")
(autoload 'org-redisplay-inline-images "org" nil t)
(autoload 'ein:notebooklist-new-notebook-with-name "ein-notebooklist")
(autoload 'ein:notebooklist-canonical-url-or-port "ein-notebooklist")
(autoload 'ein:notebooklist-login "ein-notebooklist" nil t)
(autoload 'ein:notebook-get-opened-notebook "ein-notebook")
(autoload 'ein:notebook-url "ein-notebook")
(autoload 'ein:notebook-open "ein-notebook")
(autoload 'ein:notebook-close "ein-notebook")
(autoload 'ein:process-url-or-port "ein-process")
(autoload 'ein:process-url-match "ein-process")
(autoload 'ein:process-refresh-processes "ein-process")
(autoload 'ein:jupyter-my-url-or-port "ein-jupyter")
(autoload 'ein:jupyter-server-start "ein-jupyter" nil t)
(autoload 'ein:shared-output-get-cell "ein-shared-output")
(autoload 'ein:shared-output-eval-string "ein-shared-output")
(autoload 'ein:kernel-live-p "ein-kernel")
(autoload 'ein:query-singleton-ajax "ein-query")
(autoload 'ein:output-area-case-type "ein-output-area")
(autoload 'ein:log "ein-log")
(defvar *ob-ein-sentinel* "[....]"
"Placeholder string replaced after async cell execution")
(defcustom ob-ein-timeout-seconds 600
"Maximum seconds to wait for block to finish (for synchronous operations)."
:type 'integer
:group 'ein)
(defcustom ob-ein-languages
'(("ein" . python)
("ein-python" . python)
("ein-R" . R)
("ein-r" . R)
("ein-julia" . julia))
"ob-ein has knowledge of these (ein-LANG . LANG-MODE) pairs."
:type '(repeat (cons string symbol))
:group 'ein)
(defcustom ob-ein-anonymous-path "ob-%s.ipynb"
"Applies when session header doesn't specify ipynb.
Prosecute all interactions for a given language in this throwaway
notebook (substitute %s with language)."
:type '(string)
:group 'ein)
(defun ob-ein-anonymous-p (path)
"Return t if PATH looks like ob-ein-anonymous-path. Fragile"
(string-match (replace-regexp-in-string "%s" ".+"
(replace-regexp-in-string "\\." "\\\\." ob-ein-anonymous-path))
path))
(defcustom ob-ein-inline-image-directory "ein-images"
"Store ob-ein images here."
:group 'ein
:type 'directory)
(defcustom ob-ein-default-header-args:ein nil
"No documentation."
:group 'ein
:type '(repeat string))
(defun ob-ein--inline-image-info (value)
(let* ((f (md5 value))
(d ob-ein-inline-image-directory)
(tf (concat d "/ob-ein-" f ".png")))
(unless (file-directory-p d)
(make-directory d 'parents))
tf))
(defun ob-ein--write-base64-image (img-string file)
(with-temp-file file
(let ((buffer-read-only nil)
(buffer-file-coding-system 'binary)
(require-final-newline nil)
(file-precious-flag t))
(insert img-string)
(base64-decode-region (point-min) (point-max)))))
(defun ob-ein--proxy-images (json explicit-file)
(let (result
(ein:output-area-case-types '(:image/svg+xml :image/png :image/jpeg :text/plain :application/latex :application/tex :application/javascript)))
(ein:output-area-case-type
json
(cl-case type
((:image/svg+xml :image/png :image/jpeg)
(let ((file (or explicit-file (ob-ein--inline-image-info value))))
(ob-ein--write-base64-image value file)
(setq result (format "[[file:%s]]" file))))
(otherwise
(setq result value))))
result))
(defun ob-ein--process-outputs (result-type cell params)
(let* ((session (aand (cdr (assoc :session params))
(unless (string= "none" it)
(format "%s" it))))
(render (let ((stdout-p
(lambda (out)
(and (equal "stream" (plist-get out :output_type))
(equal "stdout" (plist-get out :name))))))
(if (eq result-type 'output)
(lambda (out)
(if (funcall stdout-p out)
(plist-get out :text)
(when session ;; should aways be true under ob-ein
(concat (ob-ein--proxy-images
out (cdr (assoc :image params)))
"\n"))))
(lambda (out)
(and (not (funcall stdout-p out))
(concat (ob-ein--proxy-images
out (cdr (assoc :image params)))
"\n"))))))
(outputs (cl-loop for out in (ein:oref-safe cell 'outputs)
collect (funcall render out))))
(when outputs
(ansi-color-apply (ein:join-str "" outputs)))))
(defun ob-ein--get-name-create (src-block-info)
"Get the name of a src block or add a uuid as the name."
(if-let ((name (cl-fifth src-block-info)))
name
(save-excursion
(let ((el (org-element-context))
(id (org-id-new 'none)))
(goto-char (org-element-property :begin el))
(back-to-indentation)
(split-line)
(insert (format "#+NAME: %s" id))
id))))
(defun ob-ein--babelize-lang (lang-name lang-mode)
"Stand-up LANG-NAME as a babelized language with LANG-MODE syntax table.
Based on ob-ipython--configure-kernel."
(add-to-list 'org-src-lang-modes `(,lang-name . ,lang-mode))
(defvaralias (intern (concat "org-babel-default-header-args:" lang-name))
'ob-ein-default-header-args:ein)
(fset (intern (concat "org-babel-execute:" lang-name))
`(lambda (body params)
"Should get rid of accommodating org-babel-variable-assignments.
We don't test it, and finding a module named ob-LANG-MODE won't work generally,
e.g., ob-c++ is not ob-C.el."
(require (quote ,(intern (format "ob-%s" lang-mode))) nil t)
;; hack because ob-ein loads independently of ein
(custom-set-variables '(python-indent-guess-indent-offset-verbose nil))
(let ((parser
(quote
,(intern (format "org-babel-variable-assignments:%s" lang-mode)))))
(ob-ein--execute-body
(if (fboundp parser)
(org-babel-expand-body:generic
body params (funcall (symbol-function parser) params))
body)
params)))))
(defun ob-ein--execute-body (body params)
(let* ((buffer (current-buffer))
(result-type (cdr (assq :result-type params)))
(result-params (cdr (assq :result-params params)))
(session (or (aand (cdr (assoc :session params))
(unless (string= "none" it)
(format "%s" it)))
ein:url-localhost))
(lang (nth 0 (org-babel-get-src-block-info)))
(kernelspec (or (cdr (assoc :kernelspec params))
(aif (cdr (assoc lang org-src-lang-modes))
(cons 'language (format "%s" it))
(error "ob-ein--execute-body: %s not among %s"
lang (mapcar #'car org-src-lang-modes)))))
(name (ob-ein--get-name-create (org-babel-get-src-block-info)))
(callback (lambda (notebook)
(ob-ein--execute-async
buffer
body
(ein:$notebook-kernel notebook)
params
result-type
result-params
name))))
(save-excursion
(cl-assert (not (stringp (org-babel-goto-named-src-block name))))
(org-babel-insert-result *ob-ein-sentinel* result-params))
(ob-ein--initiate-session session kernelspec callback)
(if (ein:eval-if-bound 'org-current-export-file)
(save-excursion
(cl-loop with interval = 2000
with pending = t
repeat (/ (* ob-ein-timeout-seconds 1000) interval)
do (progn
(org-babel-goto-named-result name)
(forward-line 1)
(setq pending (re-search-forward
(regexp-quote *ob-ein-sentinel*)
(org-babel-result-end) t)))
until (not pending)
do (sleep-for 0 interval)
finally return
(if pending
(prog1 ""
(ein:log 'error "ob-ein--execute-body: %s timed out" name))
(ob-ein--process-outputs result-type
(ein:shared-output-get-cell)
params))))
(org-babel-remove-result)
*ob-ein-sentinel*)))
(defun ob-ein--execute-async-callback (buffer params result-type result-params name)
"Return callback of 1-arity (the shared output cell) to update org buffer when
`ein:shared-output-eval-string' completes.
The callback returns t if results containt RESULT-TYPE outputs, nil otherwise."
(apply-partially
(lambda (buffer* params* result-type* result-params* name* cell)
(when-let ((raw (aif (ein:oref-safe cell 'traceback)
(ansi-color-apply (ein:join-str "\n" it))
(ob-ein--process-outputs result-type* cell params*))))
(prog1 t
(let ((result
(let ((tmp-file (org-babel-temp-file "ein-")))
(with-temp-file tmp-file (insert raw))
(org-babel-result-cond result-params*
raw (org-babel-import-elisp-from-file tmp-file '(16)))))
(info (org-babel-get-src-block-info 'light)))
(ein:log 'debug "ob-ein--execute-async-callback %s \"%s\" %s"
name* result buffer*)
(save-excursion
(save-restriction
(with-current-buffer buffer*
(unless (stringp (org-babel-goto-named-src-block name*)) ;; stringp=error
(when (version-list-< (version-to-list (org-release)) '(9))
(when info ;; kill #+RESULTS: (no-name)
(setf (nth 4 info) nil)
(org-babel-remove-result info))
(org-babel-remove-result)) ;; kill #+RESULTS: name
(org-babel-insert-result
result
(cdr (assoc :result-params
(cl-third (org-babel-get-src-block-info)))))
(org-redisplay-inline-images)))))))))
buffer params result-type result-params name))
(defun ob-ein--execute-async-clear (buffer result-params name)
"Return function of 0-arity to clear *ob-ein-sentinel*."
(apply-partially
(lambda (buffer* result-params* name*)
(let ((info (org-babel-get-src-block-info 'light)))
(save-excursion
(save-restriction
(with-current-buffer buffer*
(unless (stringp (org-babel-goto-named-src-block name*)) ;; stringp=error
(when info ;; kill #+RESULTS: (no-name)
(setf (nth 4 info) nil)
(org-babel-remove-result info))
(org-babel-remove-result) ;; kill #+RESULTS: name
(org-babel-insert-result "" result-params*)
(org-redisplay-inline-images)))))))
buffer result-params name))
(defun ob-ein--execute-async (buffer body kernel params result-type result-params name)
"As `ein:shared-output-get-cell' is a singleton, ob-ein can only execute blocks
one at a time. Further, we do not order the queued up blocks!"
(deferred:$
(deferred:next
(deferred:lambda ()
(let ((cell (ein:shared-output-get-cell)))
(if (eq (slot-value cell 'callback) #'ignore)
(let ((callback (ob-ein--execute-async-callback
buffer params result-type
result-params name))
(clear (ob-ein--execute-async-clear buffer result-params name)))
(setf (slot-value cell 'callback) callback)
(setf (slot-value cell 'clear) clear))
;; still pending previous callback
(deferred:nextc (deferred:wait 1200) self)))))
(deferred:nextc it
(lambda (_x)
(ein:shared-output-eval-string kernel body)))))
(defun ob-ein--parse-session (session)
(let* ((url-or-port (ein:jupyter-my-url-or-port))
(tokens (split-string session "/"))
(parsed-url (url-generic-parse-url session))
(url-host (url-host parsed-url)))
(cond ((null url-host)
(let* ((candidate (apply #'ein:url (car tokens) (cdr tokens)))
(parsed-candidate (url-generic-parse-url candidate))
(missing (url-scheme-get-property
(url-type parsed-candidate)
'default-port)))
(if (and url-or-port
(= (url-port parsed-candidate) missing))
(apply #'ein:url url-or-port (cdr tokens))
candidate)))
(t (ein:url session)))))
(defun ob-ein--initiate-session (session kernelspec callback)
"Retrieve notebook of SESSION path and KERNELSPEC.
Start jupyter instance if necessary.
Install CALLBACK (i.e., cell execution) upon notebook retrieval."
(let* ((nbpath (ob-ein--parse-session session))
(info (org-babel-get-src-block-info))
(anonymous-path (format ob-ein-anonymous-path (nth 0 info)))
(parsed-url (url-generic-parse-url nbpath))
(slash-path (car (url-path-and-query parsed-url)))
(_ (awhen (cdr (url-path-and-query parsed-url))
(error "Cannot handle :session `%s`" it)))
(ipynb-p (file-name-extension (file-name-nondirectory slash-path)))
(path (if ipynb-p
(file-name-nondirectory slash-path)
anonymous-path))
(url-or-port (directory-file-name
(if ipynb-p
(cl-subseq nbpath 0 (- (length path)))
nbpath)))
(notebook (ein:notebook-get-opened-notebook url-or-port path))
(callback-nbopen (lambda (nb _created)
(cl-loop repeat 50
for live-p = (ein:kernel-live-p (ein:$notebook-kernel nb))
until live-p
do (sleep-for 0 300)
finally
do (if (not live-p)
(ein:log 'error
"Kernel for %s failed to launch"
(ein:$notebook-notebook-name nb))
(funcall callback nb)))))
(errback-nbopen (lambda (url-or-port status-code)
(if (eq status-code 404)
(ein:notebooklist-new-notebook-with-name
url-or-port kernelspec path callback-nbopen t))))
(callback-login (lambda (_buffer url-or-port)
(ein:notebook-open url-or-port path kernelspec
callback-nbopen errback-nbopen t))))
(cond ((and notebook
(string= path anonymous-path)
(stringp kernelspec)
(not (equal (ein:$kernelspec-name (ein:$notebook-kernelspec notebook))
kernelspec)))
(ein:log 'debug "ob-ein--initiate-session: switching %s from %s to %s"
path (ein:$kernelspec-name (ein:$notebook-kernelspec notebook))
kernelspec)
(cl-letf (((symbol-function 'y-or-n-p) #'ignore))
(ein:notebook-close notebook))
(ein:query-singleton-ajax (ein:notebook-url notebook)
:type "DELETE")
(cl-loop repeat 8
with fullpath = (concat (file-name-as-directory nbpath) path)
for extant = (file-exists-p fullpath)
until (not extant)
do (sleep-for 0 500)
finally do (if extant
(ein:display-warning
(format "cannot delete path=%s nbpath=%s"
fullpath nbpath))
(ob-ein--initiate-session session kernelspec callback))))
(notebook (funcall callback notebook))
((string= (url-host parsed-url) ein:url-localhost)
(ein:process-refresh-processes)
(aif (ein:process-url-match nbpath)
(ein:notebooklist-login (ein:process-url-or-port it) callback-login)
(ein:jupyter-server-start
(executable-find (or (ein:eval-if-bound 'ein:jupyter-server-command)
"jupyter"))
(read-directory-name "Notebook directory: " default-directory)
nil
callback-login
(let* ((port (url-port parsed-url))
(avoid (url-scheme-get-property (url-type parsed-url) 'default-port)))
(cond ((= port avoid) nil)
(t (url-port parsed-url)))))))
(t (ein:notebooklist-login url-or-port callback-login)))))
(cl-loop for (lang . mode) in ob-ein-languages
do (ob-ein--babelize-lang lang mode))
(defun ob-ein-kernel-interrupt ()
"Interrupt kernel associated with session."
(interactive)
(org-babel-when-in-src-block
(-if-let* ((info (org-babel-get-src-block-info))
(pparams (cl-callf org-babel-process-params (nth 2 info)))
(params (nth 2 info))
(session (or (aand (cdr (assoc :session params))
(unless (string= "none" it)
(format "%s" it)))
ein:url-localhost))
(nbpath (ob-ein--parse-session session))
(anonymous-path (format ob-ein-anonymous-path (nth 0 info)))
(parsed-url (url-generic-parse-url nbpath))
(slash-path (car (url-path-and-query parsed-url)))
(path (if (string= slash-path "") anonymous-path
(substring slash-path 1)))
(url-or-port (if (string= slash-path "")
nbpath
(substring nbpath 0 (- (length slash-path)))))
(notebook (ein:notebook-get-opened-notebook url-or-port path))
(kernel (ein:$notebook-kernel notebook)))
(ein:kernel-interrupt kernel)
(ein:log 'info "ob-ein-kernel-interrupt: nothing to interrupt"))))
(define-key org-babel-map "\C-k" 'ob-ein-kernel-interrupt)
;;;###autoload
(when (featurep 'org)
(let* ((orig (get 'org-babel-load-languages 'custom-type))
(orig-cdr (cdr orig))
(choices (plist-get orig-cdr :key-type)))
(push '(const :tag "Ein" ein) (nthcdr 1 choices))
(put 'org-babel-load-languages 'custom-type
(cons (car orig) (plist-put orig-cdr :key-type choices)))))
(provide 'ob-ein)

496
lisp/ein/poly-ein.el Normal file
View File

@@ -0,0 +1,496 @@
;;; poly-ein.el --- polymode for EIN -*- lexical-binding:t -*-
;; Copyright (C) 2019- The Authors
;; This file is NOT part of GNU Emacs.
;; poly-ein.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.
;; poly-ein.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 poly-ein.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'polymode)
(require 'ein-cell)
(require 'jit-lock)
(require 'quail)
(require 'display-line-numbers nil t)
(require 'undo-tree nil t)
(declare-function ein:get-notebook "ein-notebook")
(declare-function ein:notebook-mode "ein-notebook")
(declare-function polymode-inhibit-during-initialization "polymode-core")
(defmacro poly-ein--remove-hook (label functions)
"Remove any hooks saying LABEL from FUNCTIONS"
`(mapc (lambda (x) (when (and (symbolp x) (cl-search ,label (symbol-name x)))
(remove-hook (quote ,functions) x t)))
,functions))
(defun poly-ein--narrow-to-inner (modifier f &rest args)
(if (or pm-initialization-in-progress (not poly-ein-mode))
(apply f args)
(save-restriction
(widen)
(let ((range (pm-innermost-range
(or (if (numberp (car args))
(max (funcall modifier (car args)) (point-min)))
(point)))))
(narrow-to-region (car range) (cdr range))
(apply f args)))))
(defun poly-ein--decorate-functions ()
"Affect global definitions of ppss and jit-lock rather intrusively."
(mapc (lambda (fun)
(dolist (adv (list 'poly-lock-no-jit-lock-in-polymode-buffers
'polymode-inhibit-during-initialization))
(when (advice-member-p adv fun)
;; must set log level at toplevel to show following
(ein:log 'debug "poly-ein--decorate-functions: removing %s from %s"
adv fun)
(advice-remove fun adv))))
(list 'jit-lock-mode
'font-lock-fontify-region
'font-lock-fontify-buffer
'font-lock-ensure))
;; https://github.com/millejoh/emacs-ipython-notebook/issues/537
;; alternatively, filter-args on ad-should-compile but then we'd have to
;; match on function name
(custom-set-default 'ad-default-compilation-action 'never)
(add-function
:before-until (symbol-function 'pm-select-buffer)
(lambda (span &optional visibly)
(prog1 poly-ein-mode
(when poly-ein-mode
(let ((src-buf (current-buffer))
(dest-buf (pm-span-buffer span)))
(unless (eq src-buf dest-buf)
(poly-ein-set-buffer src-buf dest-buf visibly)))))))
(fmakunbound 'poly-lock-mode)
(defalias 'poly-lock-mode (symbol-function (default-value 'font-lock-function)))
(defun poly-ein--syntax-propertize (pos)
(prog1 poly-ein-mode
(when (and poly-ein-mode (< syntax-propertize--done pos))
(save-excursion
;; pared down from default `syntax-propertize'
(with-silent-modifications
(let ((parse-sexp-lookup-properties t)
(start (point-min)) ;; i've narrowed in the :around
(end (point-max))
(span (pm-innermost-span pos)))
(setq syntax-propertize--done end)
(when (eq 'body (nth 0 span))
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
;; avoid recursion if syntax-propertize-function calls me (syntax-propertize)
(when syntax-propertize-function
(let ((syntax-propertize--done most-positive-fixnum))
(funcall syntax-propertize-function start end))))))))))
(add-function
:before-until (symbol-function 'syntax-propertize)
#'poly-ein--syntax-propertize)
(add-function
:around (symbol-function 'syntax-propertize)
(apply-partially #'poly-ein--narrow-to-inner #'identity))
(add-function
:around (symbol-function 'syntax-ppss)
(apply-partially #'poly-ein--narrow-to-inner #'identity))
(add-function
:around (symbol-function 'pm--mode-setup)
(lambda (f &rest args)
;; global-font-lock-mode will call an after-change-mode-hook
;; that calls font-lock-initial-fontify, which fontifies the entire buffer!
(cl-letf (((symbol-function 'global-font-lock-mode-enable-in-buffers) #'ignore))
(when-let (b (or (cl-second args) (current-buffer)))
(with-current-buffer b
(unless (eq font-lock-support-mode 'jit-lock-mode)
(ein:log 'info "pm--mode-setup: deactivating %s in %s"
font-lock-support-mode (buffer-name))
(setq-local font-lock-support-mode 'jit-lock-mode))))
(apply f args))))
(add-function
:around (symbol-function 'pm--common-setup)
(lambda (f &rest args)
"somewhere between pm--mode-setup and pm--common-setup is a
kill-all-local-variables that douses any early attempt at
overriding font-lock-support-mode."
(when-let (b (or (cl-second args) (current-buffer)))
(with-current-buffer b
(unless (eq font-lock-support-mode 'jit-lock-mode)
(ein:log 'info "pm--common-setup: deactivating %s in %s"
font-lock-support-mode (buffer-name))
(setq-local font-lock-support-mode 'jit-lock-mode))))
(apply f args)))
(add-function
:around (symbol-function 'jit-lock-mode)
(lambda (f &rest args)
;; Override jit-lock.el.gz deliberately skipping indirect buffers
(cl-letf (((symbol-function 'buffer-base-buffer) #'ignore)) (apply f args))))
;; :before-until before :filter-args (reversed order when executed)
(add-function :before-until (symbol-function 'jit-lock-refontify)
#'poly-ein--unrelated-span)
(add-function :before-until (symbol-function 'jit-lock-fontify-now)
#'poly-ein--unrelated-span)
(add-function :filter-args (symbol-function 'jit-lock-refontify)
#'poly-ein--span-start-end)
(add-function :filter-args (symbol-function 'jit-lock-fontify-now)
#'poly-ein--span-start-end)
(add-function :filter-args (symbol-function 'font-lock-flush)
#'poly-ein--span-start-end)
(add-function :filter-args (symbol-function 'jit-lock-after-change)
#'poly-ein--span-start-end)
(add-function :before-until
(symbol-function 'pm--synchronize-points)
(lambda (&rest _args) poly-ein-mode))
(let ((dont-lookup-props
(lambda (f &rest args)
(let ((parse-sexp-lookup-properties (if poly-ein-mode
nil
parse-sexp-lookup-properties)))
(apply f args)))))
(add-function :around (symbol-function 'scan-lists) dont-lookup-props)
(add-function :around (symbol-function 'scan-sexps) dont-lookup-props))
(advice-add 'other-buffer
:filter-args
(lambda (args)
"Avoid switching to indirect buffers."
(if poly-ein-mode
(cons (or (buffer-base-buffer (car args)) (car args))
(cdr args))
args)))
(let* ((unadorned (symbol-function 'isearch-done))
(after-isearch-done
(lambda (&rest _args)
"Clear `isearch-mode' for all base and indirect buffers."
(-when-let* ((poly-ein-mode-p poly-ein-mode)
(notebook (ein:get-notebook))
(buffers (cl-remove-if (apply-partially #'string= (buffer-name))
(ein:notebook-buffer-list notebook))))
;; could just call unadorned, but what if `isearch-done' calls itself?
(cl-letf (((symbol-function 'isearch-done) unadorned))
(mapc (lambda (b) (with-current-buffer b (isearch-done))) buffers))))))
(add-function :after (symbol-function 'isearch-done) after-isearch-done)))
(defmacro poly-ein-base (&rest body)
"Copy the undo accounting to the base buffer and run BODY in it.
This is a bottleneck as we do this on every `pm-get-span'."
`(let ((base-buffer (pm-base-buffer))
(derived-buffer (current-buffer))
(pm-allow-post-command-hook nil)
(quail (aand (overlayp quail-overlay)
(overlay-start quail-overlay)
(list it (overlay-end quail-overlay))))
(quail-conv (aand (overlayp quail-conv-overlay)
(overlay-start quail-conv-overlay)
(list it (overlay-end quail-conv-overlay)))))
(poly-ein-set-buffer derived-buffer base-buffer)
(unwind-protect
(cl-letf (((symbol-function 'poly-ein--copy-state) #'ignore))
,@body)
(save-current-buffer
(with-current-buffer derived-buffer
(poly-ein-set-buffer base-buffer derived-buffer)
(when quail
(apply #'move-overlay quail-overlay quail))
(when quail-conv
(apply #'move-overlay quail-conv-overlay quail-conv)))))))
(defclass pm-inner-overlay-chunkmode (pm-inner-auto-chunkmode)
()
"Inner chunkmode delimited by cell overlays.")
(cl-defmethod pm-get-span ((cm pm-inner-overlay-chunkmode) &optional pos)
"Return a list of the form (TYPE POS-START POS-END RESULT-CM).
TYPE can be \\='body, nil."
(poly-ein-base
(setq pos (or pos (point)))
(when-let ((result-cm cm)
(span `(nil ,(point-min) ,(point-min)))
(cell (ein:worksheet-get-current-cell :pos pos :noerror t)))
;; Change :mode if necessary
(-when-let* ((nb (ein:get-notebook))
(lang
(condition-case err
(ein:$kernelspec-language
(ein:$notebook-kernelspec nb))
(error (message "%s: defaulting language to python"
(error-message-string err))
"python")))
(what (cond ((ein:codecell-p cell) lang)
((ein:markdowncell-p cell) "ein:markdown")
(t "fundamental")))
(mode (pm-get-mode-symbol-from-name what))
(f (not (equal mode (ein:oref-safe cm 'mode)))))
(when (eq mode 'poly-fallback-mode)
(let ((warning (format (concat "pm-get-span: Add (%s . [mode-prefix]) to "
"polymode-mode-name-aliases")
what)))
(when (or (not (get-buffer "*Warnings*"))
(not (with-current-buffer "*Warnings*"
(save-excursion
(goto-char (point-min))
(re-search-forward (regexp-quote warning) nil t)))))
(ein:display-warning warning))))
(setq result-cm
(cl-loop for ocm in (eieio-oref pm/polymode '-auto-innermodes)
when (equal mode (ein:oref-safe ocm 'mode))
return ocm
finally return (let ((new-mode (clone cm :mode mode)))
(object-add-to-list pm/polymode '-auto-innermodes
new-mode)
new-mode))))
;; Span is a zebra pattern of "body" (within input cell) and "nil"
;; (outside input cell). Decide boundaries of span and return it.
(let ((rel (poly-ein--relative-to-input pos cell)))
(cond ((zerop rel)
(setq span `(body
,(ein:cell-input-pos-min cell)
,(1+ (ein:cell-input-pos-max cell)))))
((< rel 0)
(setq span `(nil
,(or (ein:aand (ein:cell-prev cell)
(1+ (ein:cell-input-pos-max it)))
(point-min))
,(ein:cell-input-pos-min cell))))
(t
(setq span `(nil
,(1+ (ein:cell-input-pos-max cell))
,(or (ein:aand (ein:cell-next cell)
(ein:cell-input-pos-min it))
(point-max)))))))
(append span (list result-cm)))))
(defun poly-ein-fontify-buffer (buffer)
"Called from `ein:notebook--worksheet-render'"
(with-current-buffer buffer
(save-excursion
(pm-map-over-spans
(lambda (span)
(with-current-buffer (pm-span-buffer span)
(cl-assert (eq font-lock-function 'poly-lock-mode))
(ignore-errors (jit-lock-function (nth 1 span)))))))))
(defun poly-ein--relative-to-input (pos cell)
"Return -1 if POS before input, 1 if after input, 0 if within"
(let* ((input-pos-min (ein:cell-input-pos-min cell))
(input-pos-max (ein:cell-input-pos-max cell)))
(cond ((< pos input-pos-min) -1)
((> pos input-pos-max) 1)
(t 0))))
(defvar jit-lock-start)
(defvar jit-lock-end)
(defun poly-ein--hem-jit-lock (start _end _old-len)
(when (and poly-ein-mode (not pm-initialization-in-progress))
(let ((range (pm-innermost-range (or start (point)))))
(setq jit-lock-start (max jit-lock-start (car range)))
(setq jit-lock-end (min jit-lock-end (cdr range))))))
(defun poly-ein-initialize (type)
(poly-ein--remove-hook "polymode" after-change-functions)
(poly-ein--remove-hook "polymode" syntax-propertize-extend-region-functions)
(add-hook 'jit-lock-after-change-extend-region-functions #'poly-ein--hem-jit-lock t t)
(setq jit-lock-contextually nil) ; else recenter font-lock-fontify-keywords-region
(setq jit-lock-context-unfontify-pos nil)
(when (ein:eval-if-bound 'display-line-numbers-mode)
(when (fboundp 'display-line-numbers-mode)
(display-line-numbers-mode -1)))
(when (ein:eval-if-bound 'linum-mode)
(when (fboundp 'linum-mode)
(linum-mode -1)))
(when (ein:eval-if-bound 'undo-tree-mode)
(when (fboundp 'undo-tree-mode)
(undo-tree-mode -1)))
(when visual-line-mode
(visual-line-mode -1))
(if (eq type 'host)
(setq syntax-propertize-function nil)
(aif pm--syntax-propertize-function-original
(progn
(setq syntax-propertize-function it)
(add-function :before-until (local 'syntax-propertize-function)
#'poly-ein--unrelated-span)
(add-function :filter-args (local 'syntax-propertize-function)
#'poly-ein--span-start-end)))
(add-function :around (local 'font-lock-syntactic-face-function)
(apply-partially #'poly-ein--narrow-to-inner #'identity))))
(defun poly-ein--record-window-buffer ()
"(pm--visible-buffer-name) needs to get onto window's prev-buffers.
But `C-x b` seems to consult `buffer-list' and not the C (window)->prev_buffers."
(when (buffer-base-buffer)
(let* ((buffer-list (frame-parameter nil 'buffer-list))
(pos-visible (seq-position
buffer-list
(pm--visible-buffer-name)
(lambda (x visible*)
(string-prefix-p (buffer-name x) visible*)))))
;; no way to know if i've switched in or out of indirect buf.
;; (if in, I *don't* want to add visible to buffer-list)
(cond ((and (numberp pos-visible) (> pos-visible 0))
(let ((visible-buffer (nth pos-visible buffer-list)))
(setcdr (nthcdr (1- pos-visible) buffer-list)
(nthcdr (1+ pos-visible) buffer-list))
(set-frame-parameter nil 'buffer-list (cons visible-buffer buffer-list))))
((null pos-visible)
(set-frame-parameter nil 'buffer-list
(cons (buffer-base-buffer) buffer-list)))))))
(defun poly-ein-init-input-cell (_type)
"Contrary to intuition, this inits the entire buffer of input cells
(collectively denoted by the chunkmode pm-inner/ein-input-cell), not each individual one."
(mapc (lambda (f) (add-hook 'after-change-functions f t t))
(buffer-local-value 'after-change-functions (pm-base-buffer)))
(setq-local font-lock-dont-widen t)
(setq-local syntax-propertize-chunks 0) ;; internal--syntax-propertize too far
(add-hook 'buffer-list-update-hook #'poly-ein--record-window-buffer nil t)
(add-hook 'ido-make-buffer-list-hook
(lambda ()
(defvar ido-temp-list)
(when-let ((visible (pm--visible-buffer-name)))
(ido-to-end (delq nil
(mapcar (lambda (x)
(when (string-prefix-p x visible) x))
ido-temp-list)))))
nil t)
(ein:notebook-mode)
(unless (eq 'ein:notebook-mode (caar minor-mode-map-alist))
;; move `ein:notebook-mode' to the head of `minor-mode-map-alist'
(when-let ((entry (assq 'ein:notebook-mode minor-mode-map-alist)))
(setf minor-mode-map-alist
(cons entry
(assq-delete-all 'ein:notebook-mode minor-mode-map-alist))))))
(defcustom pm-host/ein
(pm-host-chunkmode :name "ein"
:init-functions '(poly-ein-initialize))
"EIN host chunkmode"
:group 'poly-hostmodes
:type 'object)
(defcustom pm-inner/ein-input-cell
(pm-inner-overlay-chunkmode :name "ein-input-cell"
:init-functions '(poly-ein-initialize poly-ein-init-input-cell))
"EIN input cell."
:group 'poly-innermodes
:type 'object)
(defcustom poly-ein-mode-hook nil
"Hook for poly-ein-mode"
:type 'hook :group 'poly-ein)
(unless (fboundp 'with-suppressed-warnings)
(defmacro with-suppressed-warnings (warnings &rest body)
`(progn (ignore ',warnings) ,@body)))
;;;###autoload (autoload 'poly-ein-mode "poly-ein")
(with-suppressed-warnings ((obsolete easy-mmode-define-keymap))
(define-polymode poly-ein-mode
:lighter " PM-ipynb"
:hostmode 'pm-host/ein
:innermodes '(pm-inner/ein-input-cell)))
(defun poly-ein--copy-state (src-buf dest-buf)
"Dangerous to call this outside `poly-ein-set-buffer' (loses overlays)."
(unless (eq src-buf dest-buf)
(dolist (b (eieio-oref pm/polymode '-buffers))
(unless (eq b dest-buf)
(with-current-buffer b
(save-excursion
(save-restriction
(widen)
(dolist (ol (overlays-in (point-min) (point-max)))
(move-overlay ol (overlay-start ol) (overlay-end ol) dest-buf)))))))
(pm--move-vars (append ein:local-variables
'(header-line-format buffer-undo-list isearch-mode))
src-buf dest-buf)))
(defun poly-ein-set-buffer (src-buf dest-buf &optional switch)
(let ((pm-initialization-in-progress t))
(when (and (not (eq src-buf dest-buf))
(buffer-live-p src-buf)
(buffer-live-p dest-buf))
(cl-destructuring-bind (point window-start region-begin pos-visible _)
(with-current-buffer src-buf (list (point)
(window-start)
(and switch (region-active-p) (mark))
(pos-visible-in-window-p)
(when switch (deactivate-mark))))
(poly-ein--copy-state src-buf dest-buf)
(if switch
(switch-to-buffer dest-buf)
(set-buffer dest-buf))
(when region-begin
(setq deactivate-mark nil) ;; someone is setting this, I don't know who
(push-mark region-begin t t))
(goto-char point)
(setq syntax-propertize--done (point-min))
(when switch
(when pos-visible
(set-window-start (get-buffer-window) window-start))
(bury-buffer-internal src-buf)
(set-window-prev-buffers
nil
(assq-delete-all src-buf (window-prev-buffers nil)))
(run-hook-with-args 'polymode-switch-buffer-hook src-buf dest-buf)
(pm--run-hooks pm/polymode :switch-buffer-functions src-buf dest-buf)
(pm--run-hooks pm/chunkmode :switch-buffer-functions src-buf dest-buf))))))
(defsubst poly-ein--span-start-end (args)
(if (or pm-initialization-in-progress (not poly-ein-mode))
args
(let* ((span-start (cl-first args))
(span-end (cl-second args))
(range (pm-innermost-range (or span-start (point)))))
(setq span-start (max (or span-start (car range)) (car range)))
(setq span-end (min (or span-end (cdr range)) (cdr range)))
(append (list span-start span-end) (cddr args)))))
(defsubst poly-ein--unrelated-span (&optional beg _end)
(or pm-initialization-in-progress
(and poly-ein-mode
(let* ((span (pm-innermost-span (or beg (point))))
(span-mode (eieio-oref (nth 3 span) 'mode)))
;; only fontify type 'body (the other type is nil)
(or (null (nth 0 span)) (not (eq major-mode span-mode)))))))
(make-variable-buffer-local 'parse-sexp-lookup-properties)
(poly-ein--decorate-functions)
(provide 'poly-ein)

50
lisp/jupyter/Makefile Normal file
View File

@@ -0,0 +1,50 @@
EMACS ?= emacs
ELDEV ?= $(shell command -v eldev)
FILES = $(wildcard *.el)
ELCFILES = $(FILES:.el=.elc)
TESTFILES = $(foreach file,$(wildcard test/*.el),-l $(file))
TESTSELECTORS =
ifneq ($(TAGS),)
comma := ,
TESTSELECTORS := $(foreach tag,$(subst $(comma), ,$(TAGS)),"(tag $(tag))")
endif
ifneq ($(PATTERN),)
TESTSELECTORS := $(TESTSELECTORS) \"$(PATTERN)\"
endif
# ifneq ($(TESTSELECTORS),)
# TESTSELECTORS := (quote (or $(TESTSELECTORS)))
# endif
.PHONY: all
all: compile
.PHONY: eldev
eldev:
ifeq ($(ELDEV),)
$(error "Install eldev (https://github.com/doublep/eldev)")
endif
.PHONY: test
test:
$(ELDEV) test $(TESTSELECTORS)
.PHONY: clean
clean:
make -C js clean
@rm $(ELCFILES) 2>/dev/null || true
.PHONY: clean-eldev
clean-eldev:
@rm -rf .eldev/ 2>/dev/null || true
.PHONY: widgets
widgets:
make -C js
.PHONY: compile
compile:
$(ELDEV) compile

28
lisp/jupyter/js/Makefile Normal file
View File

@@ -0,0 +1,28 @@
SHELL = bash
NPM ?= $(shell command -v npm)
ifeq ($(NPM),)
$(error "Node not installed (https://nodejs.org/en/)")
endif
YARN ?= $(shell command -v yarn)
ifeq ($(YARN),)
# If yarn isn't already installed, it is built locally
YARN = ./node_modules/.bin/yarn
endif
.PHONY: all build clean
all: build
clean:
@rm -rf built/ 2>/dev/null || true
really-clean: clean
@rm -rf node_modules 2>/dev/null || true
build: built/index.built.js
built/index.built.js:
$(NPM) install
$(YARN) run build --progress

342
lisp/jupyter/js/emacs-jupyter.js Normal file
View File

@@ -0,0 +1,342 @@
// NOTE: Info on widgets http://ipywidgets.readthedocs.io/en/latest/examples/Widget%20Low%20Level.html
var disposable = require('@phosphor/disposable');
var coreutils = require('@jupyterlab/coreutils');
// The KernelFutureHandler allows comms to register their callbacks to be
// called when messages are received in response to a request sent to the
// kernel.
var KernelFutureHandler = require('@jupyterlab/services/kernel/future').KernelFutureHandler;
// The CommHandler object handles comm interaction to/from the kernel. It takes
// a target_name, usually jupyter.widget, and a comm_id. It takes care of
// sending comm messages to the kernel and calls the callback methods of a Comm
// when a comm_msg is received from the kernel.
//
// A Comm object is essentially a wrapper around a CommHandler that updates the
// CommHandler callbacks and registers callbacks on the futures created when a
// Comm sends a message on the shell channel.
var CommHandler = require('@jupyterlab/services/kernel/comm').CommHandler;
// A CommManager takes care of registering new comm targets and creating new
// comms and holding a list of all the live comms.
// It looks like I just ned to implement the IKernel interface and pass the
// object that implements it to CommManager, this way I can create new comms
// with CommManager.new_comm when handling comm_open messages. In the IKernel
// interface, I'll just redirect all the message sending functions to Emacs.
// It looks like widgets send messages through the callbacks of a
// KernelFutureHandler so I will have to redirect all received messages that
// originated from a request generated by skewer.postJSON back to the
// JavaScript environment. Emacs then acts as an intermediary, capturing kernel
// messages and re-packaging them to send to the Javascript environment.
//
// It looks like whenever the kernel receives a message it accesse the correct
// future object using this.futures.get and calls handleMsg function of the
// future.
//
// The flow of message with respect to Comm objects is that Comm object send
// shell messages, then widgets register callbacks on the future.
var EmacsJupyter = function(options, port) {
var _this = this;
this.username = options.username || '';
// This is the Jupyter session id
this.clientId = options.clientId;
this.isDisposed = false;
// A mapping from comm_id's to promises that resolve to their open Comm
// objects.
this.commPromises = new Map();
// The targetRegistry is a dictionary mapping target names to target
// functions that are called whenever a new Comm is requested to be open by
// the kernel. The target function gets called with the initial comm_open
// message data and a comm handler for the new Comm.
this.targetRegistry = {};
// A mapping of msg_id's for messages sent to the kernel and their
// KernelFutureHandler objects.
this.futures = new Map();
// The WidgetManager that connects comms to their corresponding widget
// models, construct widget views, load widget modules, and get the current
// widget state.
this.widgetManager = null;
this.widgetState = null;
// The CommManager that registers the target names and their target
// functions handles opening and closing comms for a particular
// target name.
this.commManager = null;
this.messagePromise = new Promise(function (resolve) { resolve(); });
window.addEventListener("unload", function(event) {
// TODO: Send widget state
});
// Localhost
this.wsPort = port;
this.ws = new WebSocket("ws://127.0.0.1:" + port);
this.ws.onopen = function () {
// Ensure that Emacs knows which websocket connection corresponds to
// each kernel client
_this.ws.send(JSON.stringify({
header: {
msg_type: "connect",
session: _this.clientId
}
}));
};
this.ws.onmessage = function(event) {
if(_this.isDisposed) {
return;
}
var msg = JSON.parse(event.data);
_this.messagePromise =
_this.messagePromise.then(function () {
if(msg.buffers && msg.buffers.length > 0) {
for(var i = 0; i < msg.buffers.length; i++) {
var bin = atob(msg.buffers[i]);
var len = bin.length;
var buf = new Uint8Array(len);
for(var j = 0; j < len; j++) {
buf[j] = bin.charCodeAt(j);
}
msg.buffers[i] = buf.buffer;
}
}
_this.handleMessage(msg);
});
};
};
exports.EmacsJupyter = EmacsJupyter;
EmacsJupyter.prototype.dispose = function () {
if (this.isDisposed) {
return;
}
this.isDisposed = true;
this.commPromises.forEach(function (promise, key) {
promise.then(function (comm) {
comm.dispose();
});
});
};
EmacsJupyter.prototype.registerCommTarget = function(targetName, callback) {
var _this = this;
this.targetRegistry[targetName] = callback;
return new disposable.DisposableDelegate(function () {
if (!_this.isDisposed) {
delete _this.targetRegistry[targetName];
}
});
};
EmacsJupyter.prototype.connectToComm = function (targetName, commId) {
var _this = this;
var id = commId || coreutils.uuid();
if (this.commPromises.has(id)) {
return this.commPromises.get(id);
}
var promise = Promise.resolve(void 0).then(function () {
return new CommHandler(targetName, id, _this, function () {
_this._unregisterComm(id);
});
});
this.commPromises.set(id, promise);
return promise;
};
EmacsJupyter.prototype.handleCommOpen = function (msg) {
var _this = this;
var content = msg.content;
if (this.isDisposed) {
return;
}
var promise = this.loadObject(content.target_name,
content.target_module,
this.targetRegistry)
.then(function (target) {
var comm = new CommHandler(content.target_name,
content.comm_id,
_this, function () {
_this._unregisterComm(content.comm_id);
});
var response;
try {
response = target(comm, msg);
}
catch (e) {
comm.close();
console.error('Exception opening new comm');
throw (e);
}
return Promise.resolve(response).then(function () {
if (_this.isDisposed) {
return null;
}
return comm;
});
});
this.commPromises.set(content.comm_id, promise);
};
EmacsJupyter.prototype.handleCommClose = function (msg) {
var _this = this;
var content = msg.content;
var promise = this.commPromises.get(content.comm_id);
if (!promise) {
console.error('Comm not found for comm id ' + content.comm_id);
return;
}
promise.then(function (comm) {
if (!comm) {
return;
}
_this._unregisterComm(comm.commId);
try {
var onClose = comm.onClose;
if (onClose) {
onClose(msg);
}
comm.dispose();
}
catch (e) {
console.error('Exception closing comm: ', e, e.stack, msg);
}
});
};
EmacsJupyter.prototype.handleCommMsg = function (msg) {
var promise = this.commPromises.get(msg.content.comm_id);
if (!promise) {
// We do have a registered comm for this comm id, ignore.
return;
}
promise.then(function (comm) {
if (!comm) {
return;
}
try {
var onMsg = comm.onMsg;
if (onMsg) {
onMsg(msg);
}
}
catch (e) {
console.error('Exception handling comm msg: ', e, e.stack, msg);
}
});
};
EmacsJupyter.prototype.loadObject = function(name, moduleName, registry) {
return new Promise(function (resolve, reject) {
// Try loading the view module using require.js
if (moduleName) {
if (typeof window.require === 'undefined') {
throw new Error('requirejs not found');
}
window.require([moduleName], function (mod) {
if (mod[name] === void 0) {
var msg = "Object '" + name + "' not found in module '" + moduleName + "'";
reject(new Error(msg));
}
else {
resolve(mod[name]);
}
}, reject);
}
else {
if (registry && registry[name]) {
resolve(registry[name]);
}
else {
reject(new Error("Object '" + name + "' not found in registry"));
}
}
});
}
EmacsJupyter.prototype._unregisterComm = function (commId) {
this.commPromises.delete(commId);
};
EmacsJupyter.prototype.sendShellMessage = function(msg, expectReply, disposeOnDone) {
var _this = this;
if (expectReply === void 0) { expectReply = false; }
if (disposeOnDone === void 0) { disposeOnDone = true; }
var future = new KernelFutureHandler(function () {
var msgId = msg.header.msg_id;
_this.futures.delete(msgId);
}, msg, expectReply, disposeOnDone, this);
this.ws.send(JSON.stringify(msg));
this.futures.set(msg.header.msg_id, future);
return future;
};
EmacsJupyter.prototype.requestCommInfo = function(targetName) {
var msg = {
channel: 'shell',
msg_type: 'comm_info_request',
// A message ID will be added by Emacs anyway
header: {msg_id: ''},
content: {target_name: targetName}
};
var future = this.sendShellMessage(msg, true);
return new Promise(function (resolve) {
future.onReply = resolve;
});
};
EmacsJupyter.prototype.handleMessage = function(msg) {
var _this = this;
var parentHeader = msg.parent_header;
var future = parentHeader && this.futures && this.futures.get(parentHeader.msg_id);
if (future) {
return new Promise(function (resolve, reject) {
try {
future.handleMsg(msg);
resolve(msg);
} catch(err) {
reject(err);
}
});
} else {
return new Promise(function (resolve, reject) {
switch(msg.msg_type) {
// Special messages not really a Jupyter message
case 'display_model':
_this.widgetManager.get_model(msg.content.model_id).then(function (model) {
_this.widgetManager.display_model(undefined, model);
});
break;
case 'clear_display':
var widget = _this.widgetManager.area;
while(widget.firstChild) {
widget.removeChild(widget.firstChild);
}
break;
// Regular Jupyter messages
case 'comm_open':
_this.handleCommOpen(msg);
// Periodically get the state of the widgetManager, this gets
// sent to the browser when its unloaded.
// _this.widgetManager.get_state({}).then(function (state) {
// _this.widgetState = state;
// });
break;
case 'comm_close':
_this.handleCommClose(msg);
break;
case 'comm_msg':
_this.handleCommMsg(msg);
break;
case 'status':
// Comes from the comm info messages
break;
default:
reject(new Error('Unhandled message', msg));
};
resolve(msg);
});
}
}

12
lisp/jupyter/js/index.js Normal file
View File

@@ -0,0 +1,12 @@
window.CommManager = require('@jupyter-widgets/base').shims.services.CommManager;
window.WidgetManager = require('./manager').WidgetManager;
window.EmacsJupyter = require('./emacs-jupyter').EmacsJupyter;
require('font-awesome/css/font-awesome.min.css');
require('@jupyter-widgets/controls/css/widgets.built.css');
document.addEventListener("DOMContentLoaded", function(event) {
var widget = document.createElement("div");
widget.setAttribute("id", "widget");
document.body.appendChild(widget);
});

82
lisp/jupyter/js/manager.js Normal file
View File

@@ -0,0 +1,82 @@
var base = require('@jupyter-widgets/base');
var output = require('@jupyter-widgets/output');
var controls = require('@jupyter-widgets/controls');
var PhosphorWidget = require('@phosphor/widgets').Widget;
var defineWidgetModules = function () {
if(window.define) {
window.define('@jupyter-widgets/output', [], function () { return output; });
window.define('@jupyter-widgets/base', [], function () { return base; });
window.define('@jupyter-widgets/controls', [], function () { return controls; });
} else {
setTimeout(defineWidgetModules, 50);
}
};
// requirejs loading is async so it may not be available on this event
window.addEventListener("DOMContentLoaded", function () {
defineWidgetModules();
});
var WidgetManager = exports.WidgetManager = function(kernel, area) {
base.ManagerBase.call(this);
this.kernel = kernel;
this.area = area;
};
WidgetManager.prototype = Object.create(base.ManagerBase.prototype);
WidgetManager.prototype.loadClass = function(className, moduleName, moduleVersion) {
return new Promise(function(resolve, reject) {
if (moduleName === '@jupyter-widgets/controls') {
resolve(controls);
} else if (moduleName === '@jupyter-widgets/base') {
resolve(base);
} else if (moduleName === '@jupyter-widgets/output')
resolve(output);
else {
var fallback = function(err) {
var failedId = err.requireModules && err.requireModules[0];
if (failedId) {
console.log('Falling back to unpkg.com for ' + moduleName + '@' + moduleVersion);
window.require(['https://unpkg.com/' + moduleName + '@' + moduleVersion + '/dist/index.js'], resolve, reject);
} else {
throw err;
}
};
window.require([moduleName + '.js'], resolve, fallback);
}
}).then(function(module) {
if (module[className]) {
return module[className];
} else {
return Promise.reject('Class ' + className + ' not found in module ' + moduleName + '@' + moduleVersion);
}
});
}
WidgetManager.prototype.display_view = function(msg, view, options) {
var _this = this;
return Promise.resolve(view).then(function(view) {
PhosphorWidget.attach(view.pWidget, _this.area);
view.on('remove', function() {
console.log('View removed', view);
});
view.trigger('displayed');
return view;
});
};
WidgetManager.prototype._get_comm_info = function() {
return this.kernel.requestCommInfo(this.comm_target_name).then(function(reply) {
return reply.content.comms;
});
};
WidgetManager.prototype._create_comm = function(targetName, commId, data, metadata) {
// Construct a comm that already exists
var comm = this.kernel.connectToComm(targetName, commId);
if(data || metadata) {
comm.open(data, metadata);
}
return Promise.resolve(new base.shims.services.Comm(comm));
}

33
lisp/jupyter/js/package.json Normal file
View File

@@ -0,0 +1,33 @@
{
"private": true,
"name": "emacs-jupyter",
"version": "0.3.0",
"description": "Integrate emacs-jupyter with widgets in a browser.",
"main": "index.js",
"scripts": {
"clean": "rm -rf built",
"build": "webpack",
"test": "npm run test:default",
"test:default": "echo \"No test specified\""
},
"author": "Nathaniel Nicandro",
"license": "GPL-2.0-or-later",
"dependencies": {
"@jupyter-widgets/base": "^1.2.2",
"@jupyter-widgets/controls": "^1.2.1",
"@jupyter-widgets/output": "^1.0.10",
"codemirror": "^5.9.0",
"font-awesome": "^4.7.0",
"npm": "^6.4.1",
"yarn": "^1.12.3"
},
"devDependencies": {
"css-loader": "^0.28.4",
"file-loader": "^0.11.2",
"json-loader": "^0.5.4",
"raw-loader": "^0.5.1",
"style-loader": "^0.18.1",
"url-loader": "^1.1.2",
"webpack": "^3.5.5"
}
}

29
lisp/jupyter/js/webpack.config.js Normal file
View File

@@ -0,0 +1,29 @@
var path = require('path');
module.exports = {
entry: "./index.js",
output: {
filename: 'index.built.js',
path: path.resolve(__dirname, 'built'),
publicPath: 'built/'
},
resolve: {
alias: {
'@jupyterlab/services/kernel/future': path.resolve(__dirname, 'node_modules/@jupyterlab/services/lib/kernel/future'),
'@jupyterlab/services/kernel/comm': path.resolve(__dirname, 'node_modules/@jupyterlab/services/lib/kernel/comm')
}
},
module: {
rules: [
{ test: /\.css$/, loader: "style-loader!css-loader" },
// jquery-ui loads some images
{ test: /\.(jpg|png|gif)$/, use: 'file-loader' },
// required to load font-awesome
{ test: /\.woff2(\?v=\d+\.\d+\.\d+)?$/, use: 'url-loader?mimetype=application/font-woff' },
{ test: /\.woff(\?v=\d+\.\d+\.\d+)?$/, use: 'url-loader?mimetype=application/font-woff' },
{ test: /\.ttf(\?v=\d+\.\d+\.\d+)?$/, use: 'url-loader?mimetype=application/octet-stream' },
{ test: /\.eot(\?v=\d+\.\d+\.\d+)?$/, use: 'file-loader' },
{ test: /\.svg(\?v=\d+\.\d+\.\d+)?$/, use: 'url-loader?mimetype=image/svg+xml' }
]
},
}

63
lisp/jupyter/jupyter-R.el Normal file
View File

@@ -0,0 +1,63 @@
;;; jupyter-R.el --- Jupyter support for R -*- lexical-binding: t -*-
;; Copyright (C) 2019-2024 Nathaniel Nicandro
;; Author: Jack Kamm <jackkamm@gmail.com>
;; Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; 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:
;; Support methods for integration with R.
;;; Code:
(require 'jupyter-repl)
(require 'jupyter-org-client)
(require 'jupyter-mime)
(defvar ess-font-lock-keywords)
(cl-defmethod jupyter-repl-initialize-fontification (&context (jupyter-lang R))
(when (featurep 'ess)
(setq-local ess-font-lock-keywords 'ess-R-font-lock-keywords))
(cl-call-next-method))
(cl-defmethod jupyter-org-result ((_mime (eql :text/html)) content params
&context (jupyter-lang R))
"If html DATA is an iframe, save it to a separate file and open in browser.
Otherwise, parse it as normal."
(if (plist-get (plist-get content :metadata) :isolated)
(let* ((data (plist-get content :data))
(file (or (alist-get :file params)
(jupyter-org-image-file-name data ".html"))))
(with-temp-file file
(insert data))
(browse-url-of-file file)
(jupyter-org-file-link file))
(cl-call-next-method)))
(cl-defmethod jupyter-insert ((_mime (eql :text/html)) data
&context (jupyter-lang R)
&optional metadata)
(if (plist-get metadata :isolated)
(jupyter-browse-url-in-temp-file data)
(cl-call-next-method)))
(provide 'jupyter-R)
;;; jupyter-R.el ends here

793
lisp/jupyter/jupyter-base.el Normal file
View File

@@ -0,0 +1,793 @@
;;; jupyter-base.el --- Core definitions for Jupyter -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 06 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:
;; This file holds the core requires, variables, and type definitions necessary
;; for jupyter.
;;; Code:
(eval-when-compile (require 'subr-x))
(require 'cl-lib)
(require 'eieio)
(require 'eieio-base)
(require 'json)
(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
(declare-function tramp-file-name-user "tramp")
(declare-function tramp-file-name-host "tramp")
(declare-function jupyter-message-content "jupyter-messages" (msg))
(declare-function jupyter-new-uuid "jupyter-messages")
(cl-deftype json-plist () '(satisfies json-plist-p))
;;; Custom variables
(defcustom jupyter-pop-up-frame nil
"Whether or not buffers should be displayed in a new frame by default.
Note, this variable is only considered when evaluating code
interactively with functions like `jupyter-eval-line-or-region'.
If equal to nil, frames will never be popped up. When equal to t,
pop-up frames instead of windows.
`jupyter-pop-up-frame' can also be a list of message type
keywords for messages which will cause frames to be used. For any
message type not in the list, windows will be used instead.
Currently only `execute_result', `error', and `stream'
messages consider this variable."
:group 'jupyter
:type '(choice (const :tag "Pop up frames" t)
(const :tag "Pop up windows" nil)
;; TODO: These are the only ones where `jupyter-pop-up-frame'
;; is checked at the moment.
(set (const "execute_result")
(const "error")
(const "stream"))))
(defcustom jupyter-use-zmq (and (locate-library "zmq") t)
"Whether or not ZMQ can be used to communicate with kernels.
If ZMQ is not available for use, kernels can only be launched
from a backing notebook server."
:group 'jupyter
:type 'boolean)
(defconst jupyter-root (file-name-directory load-file-name)
"Root directory containing emacs-jupyter.")
(defconst jupyter-protocol-version "5.3"
"The jupyter protocol version that is implemented.")
(defconst jupyter-message-types
(list "execute_result"
"execute_request"
"execute_reply"
"inspect_request"
"inspect_reply"
"complete_request"
"complete_reply"
"history_request"
"history_reply"
"is_complete_request"
"is_complete_reply"
"comm_info_request"
"comm_info_reply"
"comm_open"
"comm_msg"
"comm_close"
"kernel_info_request"
"kernel_info_reply"
"shutdown_request"
"shutdown_reply"
"interrupt_request"
"interrupt_reply"
"stream"
"display_data"
"update_display_data"
"execute_input"
"error"
"status"
"clear_output"
"input_reply"
"input_request")
"A list of valid Jupyter message types.")
(defconst jupyter-mime-types '(:application/vnd.jupyter.widget-view+json
:text/html :text/markdown
:image/svg+xml :image/jpeg :image/png
:text/latex :text/plain)
"MIME types handled by Jupyter.")
(defconst jupyter-nongraphic-mime-types '(:application/vnd.jupyter.widget-view+json
:text/html :text/markdown
:text/plain)
"MIME types that can be used in terminal Emacs.")
(defvar jupyter--debug nil
"When non-nil, some parts of Jupyter will emit debug statements.
If the symbol \='message, messages received by a kernel will only
be handled by clients when the function
`jupyter--debug-replay-requests' is called manually. This allows
for stepping through the code with Edebug.")
(defvar jupyter--debug-request-queue nil)
(defun jupyter-debug (format-string &rest args)
"Display a message when `jupyter--debug' is non-nil.
FORMAT-STRING and ARGS have the same meaning as in `message'."
(when jupyter--debug
(apply #'message (concat "Jupyter: " format-string) args)))
(defvar jupyter-default-timeout 2.5
"The default timeout in seconds for `jupyter-wait-until'.")
(defvar jupyter-long-timeout 10
"A longer timeout than `jupyter-default-timeout' used for some operations.
A longer timeout is needed, for example, when retrieving the
`jupyter-kernel-info' to allow for the kernel to startup.")
(defconst jupyter-version "1.0"
"Current version of Jupyter.")
;;; Macros
(defmacro jupyter-with-timeout (spec &rest wait-forms)
"Periodically evaluate WAIT-FORMS until timeout.
Or until WAIT-FORMS evaluates to a non-nil value.
Wait until timeout SECONDS, periodically evaluating WAIT-FORMS
until it returns non-nil. If WAIT-FORMS returns non-nil, stop
waiting and return its value. Otherwise if timeout SECONDS
elapses, evaluate TIMEOUT-FORMS and return its value.
If PROGRESS is non-nil and evaluates to a string, a progress
reporter will be used with PROGRESS as the message while waiting.
SPEC takes the form (PROGRESS SECONDS TIMEOUT-FORMS...).
\(fn (PROGRESS SECONDS TIMEOUT-FORMS...) WAIT-FORMS...)"
(declare (indent 1) (debug ((form form body) body)))
(let ((res (make-symbol "res"))
(prog (make-symbol "prog"))
(prog-msg (make-symbol "prog-msg"))
(timeout (make-symbol "timeout"))
(wait-time (make-symbol "wait-time")))
`(let* ((,res nil)
(,prog-msg ,(pop spec))
(,timeout ,(pop spec))
(,wait-time (/ ,timeout 10.0))
(,prog (and (stringp ,prog-msg)
(make-progress-reporter ,prog-msg))))
(with-timeout (,timeout ,@spec)
(while (not (setq ,res (progn ,@wait-forms)))
(accept-process-output nil ,wait-time)
(when ,prog (progress-reporter-update ,prog))))
(prog1 ,res
(when ,prog (progress-reporter-done ,prog))))))
(defmacro jupyter-with-insertion-bounds (beg end bodyform &rest afterforms)
"Bind BEG and END to `point-marker's, evaluate BODYFORM then AFTERFORMS.
The END marker will advance if BODYFORM inserts text in the
current buffer. Thus after BODYFORM is evaluated, AFTERFORMS will
have access to the bounds of the text inserted by BODYFORM in the
variables BEG and END. The result of evaluating BODYFORM is
returned."
(declare (indent 3) (debug (symbolp symbolp form body)))
`(let ((,beg (point-marker))
(,end (point-marker)))
(set-marker-insertion-type ,end t)
(unwind-protect
(prog1 ,bodyform ,@afterforms)
(set-marker ,beg nil)
(set-marker ,end nil))))
(defun jupyter-map-mime-bundle (mime-types content fun)
"For each mime-type in MIME-TYPES, call FUN with its data in CONTENT.
If the result of evaluating FUN on the data of a mime-type is
non-nil, return it. Otherwise, call FUN for the next mime-type.
Return nil if FUN was evaluated on all mime-types without a
non-nil result. FUN is only called on mime-types that have data
in CONTENT.
CONTENT is a mime bundle, a property list containing a :data key
and, optionally, a :metadata key that are themselves property
lists with mime-type keywords as keys.
A call to FUN looks like this
\(funcall fun MIME-TYPE \='(:data D :metadata M))
where D will be the data associated with MIME-TYPE in CONTENT and
M is any associated metadata."
(declare (indent 2))
(cl-destructuring-bind (&key data metadata &allow-other-keys)
content
(catch 'mime-type
(mapc
(lambda (mime-type)
(let ((d (plist-get data mime-type))
(m (plist-get metadata mime-type)))
(if d
(let ((r (funcall fun mime-type `(:data ,d :metadata ,m))))
(if r (throw 'mime-type r))))))
mime-types)
nil)))
(defun jupyter-mime-value (content mime)
"Extract a value from a mime bundle.
CONTENT has the same meaning as in `jupyter-map-mime-bundle'.
Return the value of MIME in CONTENT. If MIME is not in CONTENT,
return nil."
(jupyter-map-mime-bundle (list mime)
content
(lambda (_mime content)
(plist-get content :data))))
;;;; Display buffers
(defvar-local jupyter-display-buffer-marker nil
"The marker to store the last output position of an output buffer.
See `jupyter-with-display-buffer'.")
(defvar-local jupyter-display-buffer-request-id nil
"The last `jupyter-request' message ID that generated output.")
(defun jupyter-get-buffer-create (name)
"Return a buffer with some special properties.
- The buffer's name is based on NAME, specifically it will be
\"*jupyter-NAME*\"
- Its `major-mode' will be `special-mode'."
(let* ((bname (format "*jupyter-%s*" name))
(buffer (get-buffer bname)))
(unless buffer
(setq buffer (get-buffer-create bname))
(with-current-buffer buffer
;; For buffers such as the jupyter REPL, showing trailing whitespaces
;; may be a nuisance (as evidenced by the Python banner).
(setq-local show-trailing-whitespace nil)
(unless (eq major-mode 'special-mode)
(special-mode))))
buffer))
(defun jupyter--reset-display-buffer-p (arg)
"Return non-nil if the current output buffer should be reset.
If ARG is a `jupyter-request', reset the buffer if ARG's
`jupyter-request-id' is no equal to the
`jupyter-buffer-last-request-id'. If ARG is not a
`jupyter-request-id', return ARG."
(if (jupyter-request-p arg)
;; Reset the output buffer is the last request ID does not
;; match the current request's ID.
(let ((id (jupyter-request-id arg)))
(and (not (equal id jupyter-display-buffer-request-id))
(setq jupyter-display-buffer-request-id id)
t))
;; Otherwise reset the output buffer if RESET evaluates to a
;; non-nil value
arg))
(defmacro jupyter-with-display-buffer (name reset &rest body)
"In a buffer with a name derived from NAME current, evaluate BODY.
The buffer's name is obtained by a call to
`jupyter-get-buffer-create'.
A display buffer is similar to a *Help* buffer, but maintains its
previous output on subsequent invocations that use the same NAME
and BODY is wrapped using `jupyter-with-control-code-handling' so
that any insertions into the buffer that contain ANSI escape
codes are properly handled.
Note, before BODY is evaluated, `point' is moved to the end of
the most recent output.
Also note, the `jupyter-current-client' variable in the buffer
that BODY is evaluated in is let bound to whatever value it has
before making that buffer current.
RESET is a form or symbol that determines if the buffer should be
erased before evaluating BODY. If RESET is nil, no erasing of the
buffer is ever performed. If RESET evaluates to a
`jupyter-request' object, reset the buffer if the previous
request that generated output in the buffer is not the same
request. Otherwise if RESET evaluates to any non-nil value, reset
the output buffer."
(declare (indent 2) (debug (stringp [&or atom form] body)))
(let ((buffer (make-symbol "buffer"))
(client (make-symbol "client")))
`(let ((,client jupyter-current-client)
(,buffer (jupyter-get-buffer-create ,name)))
(setq other-window-scroll-buffer ,buffer)
(with-current-buffer ,buffer
(unless jupyter-display-buffer-marker
(setq jupyter-display-buffer-marker (point-max-marker))
(set-marker-insertion-type jupyter-display-buffer-marker t))
(let ((inhibit-read-only t)
(jupyter-current-client ,client))
(when (jupyter--reset-display-buffer-p ,reset)
(erase-buffer)
(set-marker jupyter-display-buffer-marker (point))
(setq ansi-color-context-region nil))
(goto-char jupyter-display-buffer-marker)
(jupyter-with-control-code-handling ,@body))))))
(defun jupyter-display-current-buffer-reuse-window (&optional msg-type alist &rest actions)
"Convenience function to call `display-buffer' on the `current-buffer'.
If a window showing the current buffer is already available,
re-use it.
If ALIST is non-nil it is used as the ACTION alist of
`display-buffer'.
If MSG-TYPE is specified, it should be one of the keywords in
`jupyter-message-types' and is used in setting `pop-up-frames'
and `pop-up-windows'. See `jupyter-pop-up-frame'.
The rest of the arguments are display ACTIONS tried after
attempting to re-use a window and before attempting to pop-up a
new window or frame."
(let* ((jupyter-pop-up-frame (jupyter-pop-up-frame-p msg-type))
(pop-up-frames (and jupyter-pop-up-frame 'graphic-only))
(pop-up-windows (not jupyter-pop-up-frame))
(display-buffer-base-action
(cons
(append '(display-buffer-reuse-window)
(delq nil actions))
alist)))
(display-buffer (current-buffer))))
(defun jupyter-pop-up-frame-p (msg-type)
"Return non-nil if a frame should be popped up for MSG-TYPE."
(or (eq jupyter-pop-up-frame t)
(member msg-type jupyter-pop-up-frame)))
(defun jupyter-display-current-buffer-guess-where (msg-type)
"Display the current buffer in a window or frame depending on MSG-TYPE.
Call `jupyter-display-current-buffer-reuse-window' passing
MSG-TYPE as argument. If MSG-TYPE should be displayed in a window
and the current buffer is not already being displayed, display
the buffer below the selected window."
(jupyter-display-current-buffer-reuse-window
msg-type nil (unless (jupyter-pop-up-frame-p msg-type)
#'display-buffer-below-selected)))
;;; Some useful classes
(defclass jupyter-instance-tracker ()
((tracking-symbol :type symbol))
:documentation "Similar to `eieio-instance-tracker', but keeping weak references.
To access all the objects in TRACKING-SYMBOL, use
`jupyter-all-objects'."
:abstract t)
(cl-defmethod initialize-instance ((obj jupyter-instance-tracker) &optional _slots)
(cl-call-next-method)
(let ((sym (oref obj tracking-symbol)))
(unless (hash-table-p (symbol-value sym))
(put sym 'jupyter-instance-tracker t)
(set sym (make-hash-table :weakness 'key)))
(puthash obj t (symbol-value sym))))
(defun jupyter-all-objects (sym)
"Return all tracked objects in tracking SYM.
SYM is a symbol used for tracking objects that inherit from the
class corresponding to the symbol `jupyter-instance-tracker'."
(let ((table (symbol-value sym)))
(when (hash-table-p table)
(cl-assert (get sym 'jupyter-instance-tracker) t)
(hash-table-keys table))))
(defclass jupyter-finalized-object ()
((finalizers :type list :initform nil))
:documentation "A list of finalizers."
:documentation "A base class for cleaning up resources.
Adds the method `jupyter-add-finalizer' which maintains a list of
finalizer functions to be called when the object is garbage
collected.")
(cl-defmethod jupyter-add-finalizer ((obj jupyter-finalized-object) finalizer)
"Cleanup resources automatically.
FINALIZER if a function to be added to a list of finalizers that
will be called when OBJ is garbage collected."
(cl-check-type finalizer function)
(push (make-finalizer finalizer) (oref obj finalizers)))
;;; Session object definition
(cl-defstruct (jupyter-session
(:constructor nil)
(:constructor
jupyter-session
(&key
(conn-info nil)
(id (jupyter-new-uuid))
(key nil))))
"A `jupyter-session' holds the information needed to
authenticate messages. A `jupyter-session' contains the following
fields:
- CONN-INFO :: The connection info. property list of the kernel
this session is used to sign messages for.
- ID :: A string of bytes that uniquely identifies this session.
- KEY :: The key used when signing messages. If KEY is nil,
message signing is not performed."
(conn-info nil :read-only t)
(id nil :read-only t)
(key nil :read-only t))
(cl-defmethod jupyter-session-endpoints ((session jupyter-session))
"Return a property list containing the endpoints from SESSION."
(cl-destructuring-bind
(&key shell_port iopub_port stdin_port hb_port control_port
ip transport
&allow-other-keys)
(jupyter-session-conn-info session)
(cl-assert (and transport ip))
(let ((addr (lambda (port) (format "%s://%s:%d" transport ip port))))
(cl-loop
for (channel . port) in `((:hb . ,hb_port)
(:stdin . ,stdin_port)
(:shell . ,shell_port)
(:iopub . ,iopub_port)
(:control . ,control_port))
do (cl-assert port) and
collect channel and collect (funcall addr port)))))
;;; Request object definition
(cl-defstruct jupyter-request
"Represents a request made to a kernel.
Requests sent by a client always return something that can be
interpreted as a `jupyter-request'. It holds the state of a
request as the kernel and client communicate messages between
each other. A client has a request table to keep track of all
requests that are not considered idle. The most recent idle
request is also kept track of.
Each request contains: a message ID, a request type, a request
message, a time sent, a last message received by the client that
sent it, and a list of message types that tell the client to not
call the handler methods of those types."
(id (jupyter-new-uuid) :read-only t)
(type nil :read-only t)
(content nil :read-only t)
(client nil :read-only nil)
(time (current-time) :read-only t)
(idle-p nil)
(last-message nil)
(messages nil)
(message-publisher nil)
(inhibited-handlers nil))
(defun jupyter-channel-from-request-type (type)
"Return the name of the channel that a request with TYPE is sent on."
(pcase type
((or "input_reply" "input_request") "stdin")
("interrupt_request" "control")
(_ "shell")))
;;; Connecting to a kernel's channels
(eval-when-compile (require 'tramp))
(defun jupyter-available-local-ports (n)
"Return a list of N ports available on the localhost."
(let (servers)
(unwind-protect
(cl-loop
repeat n
do (push (make-network-process
:name "jupyter-available-local-ports"
:server t
:host "127.0.0.1"
:service t)
servers)
finally return (mapcar (lambda (p) (cadr (process-contact p))) servers))
(mapc #'delete-process servers))))
(defun jupyter-make-ssh-tunnel (lport rport server remoteip)
(or remoteip (setq remoteip "127.0.0.1"))
(start-process
"jupyter-ssh-tunnel" nil
"ssh"
;; Run in background
"-f"
;; Wait until the tunnel is open
"-o ExitOnForwardFailure=yes"
;; Local forward
"-L" (format "127.0.0.1:%d:%s:%d" lport remoteip rport)
server
;; Close the tunnel if no other connections are made within 60
;; seconds
"sleep 60"))
(defun jupyter-read-connection (conn-file)
"Return the connection information in CONN-FILE.
Return a property list representation of the JSON in CONN-FILE, a
Jupyter connection file."
(let ((conn-info (jupyter-read-plist conn-file)))
;; Also validate the signature scheme here.
(cl-destructuring-bind (&key key signature_scheme &allow-other-keys)
conn-info
(when (and (> (length key) 0)
(not (functionp
(intern (concat "jupyter-" signature_scheme)))))
(error "Unsupported signature scheme: %s" signature_scheme)))
conn-info))
(defun jupyter-tunnel-connection (conn-file &optional server)
"Forward local ports to the remote ports in CONN-FILE.
CONN-FILE is the path to a Jupyter connection file, SERVER is the
host that the kernel connection in CONN-FILE is located. Return a
copy of the connection plist in CONN-FILE, but with the ports
replaced by the local ports used for the forwarding.
If CONN-FILE is a `tramp' file name, the SERVER argument will be
ignored and the host will be extracted from the information
contained in the file name.
Note only SSH tunnels are currently supported."
(catch 'no-tunnels
(let ((conn-info (jupyter-read-connection conn-file)))
(when (and (file-remote-p conn-file)
(functionp 'tramp-dissect-file-name))
(pcase-let (((cl-struct tramp-file-name method user host)
(tramp-dissect-file-name conn-file)))
(pcase method
;; TODO: Document this in the README along with the fact that
;; connection files can use /ssh: TRAMP files.
("docker"
;; Assume docker is using the -p argument to publish its exposed
;; ports to the localhost. The ports used in the container should
;; be the same ports accessible on the local host. For example, if
;; the shell port is on 1234 in the container, the published port
;; flag should be "-p 1234:1234".
(throw 'no-tunnels conn-info))
(_
(setq server (if user (concat user "@" host)
host))))))
(let* ((keys '(:hb_port :shell_port :control_port
:stdin_port :iopub_port))
(lports (jupyter-available-local-ports (length keys))))
(cl-loop
with remoteip = (plist-get conn-info :ip)
for (key maybe-rport) on conn-info by #'cddr
collect key and if (memq key keys)
collect (let ((lport (pop lports)))
(prog1 lport
(jupyter-make-ssh-tunnel lport maybe-rport server remoteip)))
else collect maybe-rport)))))
(defun jupyter-connection-file-to-session (conn-file)
"Return a `jupyter-session' based on CONN-FILE.
CONN-FILE is a Jupyter connection file. If CONN-FILE is a remote
file, open local SSH tunnels to the remote ports listed in
CONN-FILE. The returned session object will have the remote
ports remapped to the local ports."
(let ((conn-info (if (file-remote-p conn-file)
(jupyter-tunnel-connection conn-file)
(jupyter-read-connection conn-file))))
(jupyter-session
:conn-info conn-info
:key (plist-get conn-info :key))))
;;; Kernel I/O
(defvar jupyter-io-cache (make-hash-table :weakness 'key))
(cl-defgeneric jupyter-io (thing)
"Return the I/O object of THING.")
(cl-defmethod jupyter-io :around (thing)
"Cache the I/O object of THING in `jupyter-io-cache'."
(or (gethash thing jupyter-io-cache)
(puthash thing (cl-call-next-method) jupyter-io-cache)))
;;; Helper functions
(defun jupyter-canonicalize-language-string (str)
"Return STR with \" \" converted to \"-\".
The `file-name-nondirectory' of STR will be converted and
returned if it looks like a file path."
;; The call to `file-name-nondirectory' is here to be more robust when
;; running on systems like Guix or Nix. Some builders on those kinds of
;; systems will indiscriminately replace "python" with something like
;; "/gnu/store/.../bin/python" when building the kernelspecs.
(replace-regexp-in-string " " "-" (file-name-nondirectory str)))
(defvar server-buffer)
(defvar jupyter-current-client)
(defvar jupyter-server-mode-client-timer nil
"Timer used to unset `jupyter-current-client' from `server-buffer'.")
;; FIXME: This works if we only consider a single send request that will also
;; finish within TIMEOUT which is probably 99% of the cases. It doesn't work
;; for multiple requests that have been sent using different clients where one
;; sets the client in `server-buffer' and, before a file is opened by the
;; underlying kernel, another sets the client in `server-buffer'.
(defun jupyter-server-mode-set-client (client &optional timeout)
"Set CLIENT as the `jupyter-current-client' in the `server-buffer'.
Kill `jupyter-current-client's local value in `server-buffer'
after TIMEOUT seconds, defaulting to `jupyter-long-timeout'.
If a function causes a buffer to be displayed through
emacsclient, e.g. when a function calls an external command that
invokes the EDITOR, we don't know when the buffer will be
displayed. All we know is that the buffer that will be current
before display will be the `server-buffer'. So we temporarily set
`jupyter-current-client' in `server-buffer' so that the client
gets a chance to be propagated to the displayed buffer, see
`jupyter-repl-persistent-mode'.
For this to work properly you should have something like the
following in your Emacs configuration
(server-mode 1)
(setenv \"EDITOR\" \"emacsclient\")
before starting any Jupyter kernels. The kernel also has to know
that it should use EDITOR to open files."
(when (bound-and-true-p server-mode)
;; After switching to a server buffer, keep the client alive in `server-buffer'
;; to account for multiple files being opened by the server.
(unless (and (boundp 'server-switch-hook)
(memq #'jupyter-server-mode--unset-client-soon
server-switch-hook))
(add-hook 'server-switch-hook #'jupyter-server-mode--unset-client-soon))
(with-current-buffer (get-buffer-create server-buffer)
(setq jupyter-current-client client)
(jupyter-server-mode--unset-client-soon timeout))))
(defun jupyter-server-mode-unset-client ()
"Set `jupyter-current-client' to nil in `server-buffer'."
(when (and (bound-and-true-p server-mode)
(get-buffer server-buffer))
(with-current-buffer server-buffer
(setq jupyter-current-client nil))))
(defun jupyter-server-mode--unset-client-soon (&optional timeout)
(when (timerp jupyter-server-mode-client-timer)
(cancel-timer jupyter-server-mode-client-timer))
(setq jupyter-server-mode-client-timer
(run-at-time (or timeout jupyter-long-timeout)
nil #'jupyter-server-mode-unset-client)))
(defun jupyter-read-plist (file)
"Read a JSON encoded FILE as a property list."
(let ((json-object-type 'plist))
(json-read-file file)))
(defun jupyter-read-plist-from-string (string)
"Read a property list from a JSON encoded STRING."
(let ((json-object-type 'plist))
(json-read-from-string string)))
(defun jupyter-normalize-data (plist &optional metadata)
"Return a property list (:data DATA :metadata META) from PLIST.
DATA is a property list of mimetype data extracted from PLIST.
If PLIST is a message plist, DATA will be the value of the :data
key in the `jupyter-message-content'. Otherwise, DATA is either
the :data key of PLIST or PLIST itself.
A similar extraction process is performed for the :metadata key
of PLIST which will be the META argument in the return value. If
no :metadata key can be found, then META will be METADATA."
(list :data (or
;; Allow for passing message plists
(plist-get (jupyter-message-content plist) :data)
;; Allow for passing (jupyter-message-content msg)
(plist-get plist :data)
;; Otherwise assume the plist contains mimetypes
plist)
:metadata (or (plist-get (jupyter-message-content plist) :metadata)
(plist-get plist :metadata)
metadata)))
(defun jupyter-line-count-greater-p (str n)
"Return non-nil if STR has more than N lines."
(string-match-p
(format "^\\(?:[^\n]*\n\\)\\{%d,\\}" (1+ n))
str))
(defun jupyter-format-time-low-res (time)
"Return a description string describing TIME.
If TIME is nil return \"Never\", otherwise return strings like
\"1 day ago\", \"an hour ago\", \"in 10 minutes\", ...
depending on the relative value of TIME from the `current-time'.
TIME is assumed to have the same form as the return value of
`current-time'."
(if (null time) "Never"
(let* ((seconds (- (float-time time)
(float-time (current-time))))
(past (< seconds 0))
(seconds (abs seconds))
(minutes (floor (/ seconds 60.0)))
(hours (floor (/ seconds 3600.0)))
(days (floor (/ seconds 86400.0))))
(cond
((< seconds 60)
(if (or past
;; Account for discrepancies between time resolution
(< seconds 0.1))
"a few seconds ago"
"in a few seconds"))
((not (zerop days))
(format "%s%d day%s%s"
(if past "" "in ")
days
(if (= days 1) "" "s")
(if past " ago" "")))
((not (zerop hours))
(if (= hours 1)
(if past "an hour ago"
"in one hour")
(format "%s%d hours%s"
(if past "" "in ")
hours
(if hours " ago" ""))))
((not (zerop minutes))
(if (= minutes 1)
(if past "a minute ago"
"in one minute")
(format "%s%d minutes%s"
(if past "" "in ")
minutes
(if past " ago" ""))))))))
;;; Simple weak references
;; Thanks to Chris Wellon https://nullprogram.com/blog/2014/01/27/
(defun jupyter-weak-ref (object)
"Return a weak reference for OBJECT."
(let ((ref (make-hash-table :weakness 'value :size 1)))
(prog1 ref
(puthash t object ref))))
(defsubst jupyter-weak-ref-resolve (ref)
"Resolve a weak REF.
Return nil if the underlying object has been garbage collected,
otherwise return the underlying object."
(gethash t ref))
;;; Errors
(defun jupyter-error-if-not-client-class-p (class &optional check-class)
"Signal a wrong-type-argument error if CLASS is not a client class.
If CHECK-CLASS is provided check CLASS against it. CHECK-CLASS
defaults to `jupyter-kernel-client'."
(or check-class (setq check-class 'jupyter-kernel-client))
(cl-assert (class-p check-class))
(unless (child-of-class-p class check-class)
(signal 'wrong-type-argument
(list (list 'subclass check-class) class))))
(provide 'jupyter-base)
;;; jupyter-base.el ends here

45
lisp/jupyter/jupyter-c++.el Normal file
View File

@@ -0,0 +1,45 @@
;;; jupyter-c++.el --- Jupyter support for C++ -*- lexical-binding: t -*-
;; Copyright (C) 2019-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 12 April 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:
;; Support methods for integration with C++.
;;; Code:
(require 'jupyter-repl)
(cl-defmethod jupyter-repl-initialize-fontification (&context (jupyter-lang c++))
"Copy buffer local variables used for fontification to the REPL buffer."
(cl-loop
with c-vars = (jupyter-with-repl-lang-buffer
(cl-loop
for var-val in (buffer-local-variables)
if (string-prefix-p "c-" (symbol-name (car var-val)))
collect var-val))
for (var . val) in c-vars
do (set (make-local-variable var) val))
(cl-call-next-method))
(provide 'jupyter-c++)
;;; jupyter-c++.el ends here

187
lisp/jupyter/jupyter-channel-ioloop.el Normal file
View File

@@ -0,0 +1,187 @@
;;; jupyter-channel-ioloop.el --- Abstract class to communicate with a jupyter-channel in a subprocess -*- lexical-binding: t -*-
;; Copyright (C) 2019-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; 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:
;; Define a `jupyter-ioloop' that can be sent events to start, stop, or send a
;; message on a set of `jupyter-channel' objects. For example to start a
;; `jupyter-channel' in the subprocess environment you would do something like
;;
;; (jupyter-send ioloop 'start-channel TYPE ENDPOINT)
;;
;; where TYPE and ENDPOINT have the same meaning as in `jupyter-channel'.
;;
;; Note by default, no channels are available in the subprocess environment.
;; You initialize channels by setting the `jupyter-channel-ioloop-channels'
;; variable in the subprocess environment, e.g. using
;; `jupyter-ioloop-add-setup', before starting the `jupyter-ioloop'.
;;
;; When you call `jupyter-ioloop-start' a `jupyter-session' object needs to
;; passed as the second argument with whatever object you would like to receive
;; events as the third. The `jupyter-session-id' will be used as the value of
;; the :identity key in the call to `jupyter-start' when starting a
;; channel.
;;
;; Each event sent to the subprocess will send back a corresponding
;; confirmation event, the three events that can be sent and their
;; corresponding confirmation events are:
;;
;; (start-channel TYPE ENDPOINT) -> (start-channel TYPE)
;; (stop-channel TYPE) -> (stop-channel TYPE)
;; (send TYPE MSG-TYPE MSG MSG-ID) -> (sent MSG-ID)
;;
;; For the send event, the MSG-TYPE, MSG, and MSG-ID have the same meaning as
;; the TYPE, MSG, and MSG-ID arguments of the `jupyter-send' method of a
;; `jupyter-channel'.
;;
;; Ex.
;;
;; (let ((ioloop (jupyter-channel-ioloop))
;; (session (jupyter-session :id ...)))
;; (jupyter-start-ioloop ioloop session ...)
;; ...
;; (jupyter-send ioloop 'start-channel ...)
;; ...)
;;; Code:
(require 'jupyter-ioloop)
(defvar jupyter-channel-ioloop-session nil
"The `jupyter-session' used when initializing Jupyter channels.")
(defvar jupyter-channel-ioloop-channels nil
"A list of synchronous channels in an ioloop controlling Jupyter channels.")
(jupyter-ioloop-add-arg-type jupyter-channel
(lambda (arg)
`(or (object-assoc ,arg :type jupyter-channel-ioloop-channels)
(error "Channel not alive (%s)" ,arg))))
(defclass jupyter-channel-ioloop (jupyter-ioloop)
()
:abstract t)
(cl-defmethod initialize-instance ((ioloop jupyter-channel-ioloop) &optional _slots)
(cl-call-next-method)
(jupyter-ioloop-add-setup ioloop
(require 'jupyter-channel-ioloop))
(jupyter-channel-ioloop-add-start-channel-event ioloop)
(jupyter-channel-ioloop-add-stop-channel-event ioloop)
(jupyter-channel-ioloop-add-send-event ioloop)
(jupyter-ioloop-add-teardown ioloop
(mapc #'jupyter-stop jupyter-channel-ioloop-channels)))
(defun jupyter-channel-ioloop-set-session (ioloop session)
"In the IOLOOP, set SESSION as the `jupyter-channel-ioloop-session'.
Add a form to IOLOOP's setup that sets the variable
`jupyter-channel-ioloop-session' to a `jupyter-session' based on
SESSION's id and key. Remove any top level form in the setup that
sets `jupyter-channel-ioloop-session' via `setq' before doing so."
(cl-callf (lambda (setup)
(cons `(setq jupyter-channel-ioloop-session
(jupyter-session
:id ,(jupyter-session-id session)
:key ,(jupyter-session-key session)))
(cl-remove-if
(lambda (f) (and (eq (car f) 'setq)
(eq (cadr f) 'jupyter-channel-ioloop-session)))
setup)))
(oref ioloop setup)))
;;; Channel events
(defun jupyter-channel-ioloop-add-start-channel-event (ioloop)
"Add a start-channel event handler to IOLOOP.
The event fires when the IOLOOP receives a list with the form
(start-channel CHANNEL-TYPE ENDPOINT)
and shall stop any existing channel with CHANNEL-TYPE and start a
new channel with CHANNEL-TYPE connected to ENDPOINT. The
underlying socket IDENTITY is derived from
`jupyter-channel-ioloop-session' in the IOLOOP environment. The
channel will be added to the variable
`jupyter-channel-ioloop-channels' in the IOLOOP environment.
Note, before sending this event to IOLOOP, the corresponding
channel needs to be available in the
`jupyer-channel-ioloop-channels' variable. You can initialize
this variable in the setup form of IOLOOP.
A list with the form
(start-channel CHANNEL-TYPE)
is returned to the parent process."
(jupyter-ioloop-add-event
ioloop start-channel ((channel jupyter-channel) endpoint)
;; Stop the channel if it is already alive
(when (jupyter-alive-p channel)
(jupyter-stop channel))
;; Start the channel
(oset channel endpoint endpoint)
(let ((identity (jupyter-session-id jupyter-channel-ioloop-session)))
(jupyter-start channel :identity identity))
(list 'start-channel (oref channel type))))
(defun jupyter-channel-ioloop-add-stop-channel-event (ioloop)
"Add a stop-channel event handler to IOLOOP.
The event fires when the IOLOOP receives a list with the form
(stop-channel CHANNEL-TYPE)
If a channel with CHANNEL-TYPE exists and is alive, it is stopped.
A list with the form
(stop-channel CHANNEL-TYPE)
is returned to the parent process."
(jupyter-ioloop-add-event ioloop stop-channel (type)
(let ((channel (object-assoc type :type jupyter-channel-ioloop-channels)))
(when (and channel (jupyter-alive-p channel))
(jupyter-stop channel))
(list 'stop-channel type))))
(defun jupyter-channel-ioloop-add-send-event (ioloop)
"Add a send event handler to IOLOOP.
The event fires when the IOLOOP receives a list of the form
(send CHANNEL-TYPE MSG-TYPE MSG MSG-ID)
and calls (jupyter-send CHANNEL MSG-TYPE MSG MSG-ID) using the
channel corresponding to CHANNEL-TYPE in the IOLOOP environment.
A list of the form
(sent CHANNEL-TYPE MSG-ID)
is returned to the parent process."
(jupyter-ioloop-add-event
ioloop send ((channel jupyter-channel) msg-type msg msg-id)
(list 'sent (oref channel type)
(jupyter-send channel msg-type msg msg-id))))
(provide 'jupyter-channel-ioloop)
;;; jupyter-channel-ioloop.el ends here

73
lisp/jupyter/jupyter-channel.el Normal file
View File

@@ -0,0 +1,73 @@
;;; jupyter-channel.el --- Jupyter channel interface -*- lexical-binding: t -*-
;; Copyright (C) 2019-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; 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:
;; Defines the `jupyter-channel' interface.
;;; Code:
(require 'eieio)
(defclass jupyter-channel ()
((type
:type keyword
:initarg :type
:documentation "The type of this channel.")
(session
:type jupyter-session
:initarg :session
:documentation "The session object used to sign and send/receive messages.")
(endpoint
:type string
:initarg :endpoint
:documentation "The endpoint this channel is connected to.
Typical endpoints look like \"tcp://127.0.0.1:5555\"."))
:abstract t)
(cl-defmethod jupyter-start ((_channel jupyter-channel) &key _identity)
"Start a Jupyter CHANNEL using IDENTITY as the routing ID.
If CHANNEL is already alive, do nothing."
(cl-call-next-method))
(cl-defmethod jupyter-stop ((_channel jupyter-channel))
"Stop a Jupyter CHANNEL.
If CHANNEL is already stopped, do nothing."
(cl-call-next-method))
(cl-defmethod jupyter-alive-p ((_channel jupyter-channel))
"Return non-nil if a CHANNEL is alive."
(cl-call-next-method))
(cl-defmethod jupyter-send (_channel _type _message &optional _msg-id)
"On CHANNEL send MESSAGE which has message TYPE and optionally a MSG-ID."
(cl-call-next-method))
(cl-defmethod jupyter-recv (_channel &optional _dont-wait)
"Receive a message on CHANNEL.
If DONT-WAIT is non-nil, return nil immediately if there is no
message available to receive."
(cl-call-next-method))
(provide 'jupyter-channel)
;;; jupyter-channel.el ends here

1812
lisp/jupyter/jupyter-client.el Normal file
View File

File diff suppressed because it is too large Load Diff

192
lisp/jupyter/jupyter-env.el Normal file
View File

@@ -0,0 +1,192 @@
;;; jupyter-env.el --- Query the jupyter shell command for information -*- lexical-binding: t -*-
;; Copyright (C) 2019-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; 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:
;; Custom variables and functions related to calling the jupyter shell command
;; and its sub-commands for information.
;;; Code:
(require 'jupyter-base)
(eval-when-compile (require 'subr-x))
(defvar jupyter-runtime-directory nil
"The Jupyter runtime directory.
When a new kernel is started through `jupyter-start-kernel', this
directory is where kernel connection files are written to.
This variable should not be used. To obtain the runtime directory
call the function `jupyter-runtime-directory'.")
(defcustom jupyter-executable "jupyter"
"The `jupyter` command executable."
:type 'string
:group 'jupyter)
(defun jupyter-command (&rest args)
"Run a Jupyter shell command synchronously, return its output.
The shell command run is
jupyter ARGS...
If the command fails or the jupyter shell command doesn't exist,
return nil."
(let ((stderr-file (make-temp-file "jupyter"))
(stdout (get-buffer-create " *jupyter-command-stdout*")))
(unwind-protect
(let* ((status (apply #'process-file
jupyter-executable
nil
(list stdout stderr-file)
nil
args))
(buffer (find-file-noselect stderr-file)))
(unwind-protect
(with-current-buffer buffer
(unless (eq (point-min) (point-max))
(message "jupyter-command: Content written to stderr stream")
(while (not (eq (point) (point-max)))
(message " %s" (buffer-substring (line-beginning-position)
(line-end-position)))
(forward-line))))
(kill-buffer buffer))
(when (zerop status)
(with-current-buffer stdout
(string-trim-right (buffer-string)))))
(delete-file stderr-file)
(kill-buffer stdout))))
(defun jupyter-runtime-directory ()
"Return the runtime directory used by Jupyter.
Create the directory if necessary. If `default-directory' is a
remote directory, return the runtime directory on that remote.
As a side effect, the variable `jupyter-runtime-directory' is set
to the local runtime directory if it is nil."
(unless jupyter-runtime-directory
(setq jupyter-runtime-directory
(let ((default-directory (expand-file-name "~" user-emacs-directory)))
(file-name-as-directory (jupyter-command "--runtime-dir")))))
(let ((dir (if (file-remote-p default-directory)
(jupyter-command "--runtime-dir")
jupyter-runtime-directory)))
(unless dir
(error "Can't obtain runtime directory from jupyter shell command"))
(setq dir (concat (file-remote-p default-directory) dir))
(make-directory dir 'parents)
(file-name-as-directory dir)))
(defun jupyter-locate-python ()
"Return the path to the python executable in use by Jupyter.
If the `default-directory' is a remote directory, search on that
remote. Raise an error if the executable could not be found.
The paths examined are the data paths of \"jupyter --paths\" in
the order specified.
This function always returns the `file-local-name' of the path."
(let* ((remote (file-remote-p default-directory))
(paths (mapcar (lambda (x) (concat remote x))
(or (plist-get
(jupyter-read-plist-from-string
(jupyter-command "--paths" "--json"))
:data)
(error "Can't get search paths"))))
(path nil))
(cl-loop
with programs = '("bin/python3" "bin/python"
;; Need to also check Windows since paths can be
;; pointing to local or remote files.
"python3.exe" "python.exe")
with pred = (lambda (dir)
(cl-loop
for program in programs
for spath = (expand-file-name program dir)
thereis (setq path (and (file-exists-p spath) spath))))
for path in paths
thereis (locate-dominating-file path pred)
finally (error "No `python' found in search paths"))
(file-local-name path)))
(defun jupyter-write-connection-file (session)
"Write a connection file based on SESSION to `jupyter-runtime-directory'.
Return the path to the connection file."
(cl-check-type session jupyter-session)
(let* ((temporary-file-directory (jupyter-runtime-directory))
(json-encoding-pretty-print t)
(file (make-temp-file "emacs-kernel-" nil ".json")))
(prog1 file
(with-temp-file file
(insert (json-encode-plist
(jupyter-session-conn-info session)))))))
(defun jupyter-session-with-random-ports ()
"Return a `jupyter-session' with random channel ports.
The session can be used to write a connection file, see
`jupyter-write-connection-file'."
;; The actual work of making the connection file is left up to the
;; `jupyter kernel` shell command. This is done to support
;; launching remote kernels via TRAMP. The Jupyter suite of shell
;; commands probably exist on the remote system, so we rely on them
;; to figure out a set of open ports on the remote.
(with-temp-buffer
;; NOTE: On Windows, apparently the "jupyter kernel" command uses something
;; like an exec shell command to start the process which launches the kernel,
;; but exec like commands on Windows start a new process instead of replacing
;; the current one which results in the process we start here exiting after
;; the new process is launched. We call python directly to avoid this.
(let ((process (start-file-process
"jupyter-session-with-random-ports" (current-buffer)
(jupyter-locate-python) "-c"
"from jupyter_client.kernelapp import main; main()")))
(set-process-query-on-exit-flag process nil)
(jupyter-with-timeout
(nil jupyter-long-timeout
(error "`jupyter kernel` failed to show connection file path"))
(and (process-live-p process)
(goto-char (point-min))
(re-search-forward "Connection file: \\(.+\\)\n" nil t)))
(let* ((conn-file (concat
(save-match-data
(file-remote-p default-directory))
(match-string 1)))
(conn-info (jupyter-read-connection conn-file)))
;; Tell the `jupyter kernel` process to shutdown itself and
;; the launched kernel.
(interrupt-process process)
;; Wait until the connection file is cleaned up before
;; forgetting about the process completely.
(jupyter-with-timeout
(nil jupyter-default-timeout
(delete-file conn-file))
(file-exists-p conn-file))
(delete-process process)
(let ((new-key (jupyter-new-uuid)))
(plist-put conn-info :key new-key)
(jupyter-session
:conn-info conn-info
:key new-key))))))
(provide 'jupyter-env)
;;; jupyter-env.el ends here

502
lisp/jupyter/jupyter-ioloop.el Normal file
View File

@@ -0,0 +1,502 @@
;;; jupyter-ioloop.el --- Jupyter channel subprocess -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 03 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:
;; An ioloop encapsulates a subprocess that communicates with its parent
;; process in a pre-defined way. The parent process sends events (lists with a
;; head element tagging the type of event and the rest of the elements being
;; the arguments), via a call to the `jupyter-send' method of a
;; `jupyter-ioloop'. The ioloop subprocess then handles the event in its
;; environment. You add an event that can be handled in the ioloop environment
;; by calling `jupyter-ioloop-add-event' before calling `jupyter-ioloop-start'.
;;
;; When one of the events added through `jupyter-ioloop-add-event'
;; returns something other than nil, it is sent back to the parent
;; process and the handler function passed to `jupyter-ioloop-start'
;; is called.
;;
;; An example that will echo back what was sent to the ioloop as a message in
;; the parent process:
;;
;; (let ((ioloop (jupyter-ioloop))
;; (jupyter-ioloop-add-event ioloop echo (data)
;; "Return DATA back to the parent process."
;; (list 'echo data))
;; (jupyter-ioloop-start ioloop (lambda (event) (message "%s" (cadr event))))
;; (jupyter-send ioloop 'echo "Message")
;; (jupyter-ioloop-stop ioloop))
;;; Code:
(require 'jupyter-base)
(require 'zmq)
(eval-when-compile (require 'subr-x))
(defvar jupyter-ioloop-poller nil
"The polling object being used to poll for events in an ioloop.")
(defvar jupyter-ioloop-stdin nil
"A file descriptor or ZMQ socket used to receive events in an ioloop.")
(defvar jupyter-ioloop-nsockets 1
"The number of sockets being polled by `jupyter-ioloop-poller'.")
(defvar jupyter-ioloop-pre-hook nil
"A hook called at the start of every polling loop.
The hook is called with no arguments.")
(defvar jupyter-ioloop-post-hook nil
"A hook called at the end of every polling loop.
The hook is called with a single argument, the list of polling
events that occurred for this iteration or nil. The polling
events have the same value as the return value of
`zmq-poller-wait-all'.")
(defvar jupyter-ioloop-timers nil)
(defvar jupyter-ioloop-timeout 200
"Maximum time (in ms) to wait for polling events on `jupyter-ioloop-poller'.")
(defvar jupyter-ioloop--argument-types nil
"Argument types added via `jupyter-ioloop-add-arg-type'.")
(defun jupyter-ioloop-environment-p ()
"Return non-nil if this Emacs instance is an IOLoop subprocess."
(and noninteractive jupyter-ioloop-stdin jupyter-ioloop-poller))
(defclass jupyter-ioloop (jupyter-finalized-object)
((process :type (or null process) :initform nil)
(callbacks :type list :initform nil)
(events :type list :initform nil)
(setup :type list :initform nil)
(teardown :type list :initform nil))
:documentation "An interface for sending asynchronous messages via a subprocess.
An ioloop starts an Emacs subprocess setup to send events back
and forth between the parent Emacs process and the ioloop
asynchronously. The ioloop subprocess is essentially a polling
loop that polls its stdin and any sockets that may have been
created in the ioloop environment and performs pre-defined
actions when stdin sends an event. The structure of the
subprocess is the following
\(progn
(let ((jupyter-ioloop-poller (zmq-poller)))
<jupyter-ioloop-setup>
<send start event to parent>
(condition-case nil
(while t
(run-hook 'jupyter-ioloop-pre-hook)
<poll for stdin/socket events>
(run-hook 'jupyter-ioloop-post-hook))
(quit
<jupyter-ioloop-teardown>
<send quit event to parent>))))
<jupyter-ioloop-setup> is replaced by the form in the setup slot
of an ioloop and can be conveniently added to using
`jupyter-ioloop-add-setup'.
<jupyter-ioloop-teardown> is replaced with the teardown slot and
can be added to using `jupyter-ioloop-add-teardown'.
<poll for stdin/socket events> is replaced by code that will
listen for stdin/socket events using `jupyter-ioloop-poller'.
You add events to be handled by the subprocess using
`jupyter-ioloop-add-event', the return value of any event added
is what is sent to the parent Emacs process and what will
eventually be the sole argument to the handler function passed to
`jupyter-ioloop-start'. To suppress the subprocess from sending
anything back to the parent, ensure nil is returned by the form
created by `jupyter-ioloop-add-event'.
See `jupyter-channel-ioloop' for an example of its usage.")
(cl-defmethod initialize-instance ((ioloop jupyter-ioloop) &optional _slots)
(cl-call-next-method)
(jupyter-add-finalizer ioloop
(lambda ()
(with-slots (process) ioloop
(when (process-live-p process)
(delete-process process))))))
(defun jupyter-ioloop-wait-until (ioloop event cb &optional timeout progress-msg)
"Wait until EVENT occurs on IOLOOP.
If EVENT occurs, call CB and return its value if non-nil. CB is
called with a single argument, an event list whose first element
is EVENT. If CB returns nil, continue waiting until EVENT occurs
again or until TIMEOUT seconds elapses, TIMEOUT defaults to
`jupyter-default-timeout'. If TIMEOUT is reached, return nil.
If PROGRESS-MSG is non-nil, a progress reporter will be displayed
while waiting using PROGRESS-MSG as the message."
(declare (indent 2))
(cl-check-type ioloop jupyter-ioloop)
(jupyter-with-timeout
(progress-msg (or timeout jupyter-default-timeout))
(let ((e (jupyter-ioloop-last-event ioloop)))
(when (eq (car-safe e) event) (funcall cb e)))))
(defun jupyter-ioloop-last-event (ioloop)
"Return the last event received on IOLOOP."
(cl-check-type ioloop jupyter-ioloop)
(and (oref ioloop process)
(process-get (oref ioloop process) :last-event)))
(defmacro jupyter-ioloop-add-setup (ioloop &rest body)
"Set IOLOOP's `jupyter-ioloop-setup' slot to BODY.
BODY is the code that will be evaluated before the IOLOOP sends a
start event to the parent process."
(declare (indent 1))
`(setf (oref ,ioloop setup)
(append (oref ,ioloop setup)
(quote ,body))))
(defmacro jupyter-ioloop-add-teardown (ioloop &rest body)
"Set IOLOOP's `jupyter-ioloop-teardown' slot to BODY.
BODY is the code that will be evaluated just before the IOLOOP
sends a quit event to the parent process."
(declare (indent 1))
`(setf (oref ,ioloop teardown)
(append (oref ,ioloop teardown)
(quote ,body))))
(defmacro jupyter-ioloop-add-arg-type (tag fun)
"Add a new argument type for arguments in `jupyter-ioloop-add-event'.
If an argument has the form (arg TAG), where TAG is a symbol, in
the ARGS argument of `jupyter-ioloop-add-event', replace it with
the result of evaluating the form returned by FUN on arg in the
IOLOOP environment.
For example suppose we define an argument type, jupyter-channel:
(jupyter-ioloop-add-arg-type jupyter-channel
(lambda (arg)
`(or (object-assoc ,arg :type jupyter-channel-ioloop-channels)
(error \"Channel not alive (%s)\" ,arg))))
and define an event like
(jupyter-ioloop-add-event ioloop stop-channel ((channel jupyter-channel))
(jupyter-stop channel))
Finally after adding other events and starting the ioloop we send
an event like
(jupyter-send ioloop \='stop-channel :shell)
Then before the stop-channel event defined by
`jupyter-ioloop-add-event' is called in the IOLOOP environment,
the value for the channel argument passed by the `jupyter-send'
call is replaced by the form returned by the function specified
in the `jupyter-ioloop-add-arg-type' call."
(declare (indent 1))
`(progn
(setf (alist-get ',tag jupyter-ioloop--argument-types nil 'remove) nil)
;; NOTE: FUN is quoted to ensure lexical closures aren't created
(push (cons ',tag ,(list '\` fun)) jupyter-ioloop--argument-types)))
(defun jupyter-ioloop--replace-args (args)
"Convert special arguments in ARGS.
Map over ARGS, converting its elements into
,arg or ,(app (lambda (x) BODY) arg)
for use in a `pcase' form. The latter form occurs when one of
ARGS is of the form (arg TAG) where TAG is one of the keys in
`jupyter-ioloop--argument-types'. BODY will be replaced with the
result of calling the function associated with TAG in
`jupyter-ioloop--argument-types'.
Return the list of converted arguments."
(mapcar (lambda (arg)
(pcase arg
(`(,val ,tag)
(let ((form (alist-get tag jupyter-ioloop--argument-types)))
(list '\, (list 'app `(lambda (x) ,(funcall form 'x)) val))))
(_ (list '\, arg))))
args))
(defmacro jupyter-ioloop-add-event (ioloop event args &optional doc &rest body)
"For IOLOOP, add an EVENT handler.
ARGS is a list of arguments that are bound when EVENT occurs. DOC
is an optional documentation string describing what BODY, the
expression which will be evaluated when EVENT occurs, does. If
BODY evaluates to any non-nil value, it will be sent to the
parent Emacs process. A nil value for BODY means don't send
anything.
Some arguments are treated specially:
If one of ARGS is a list (<sym> tag) where <sym> is any symbol,
then the parent process that sends EVENT to IOLOOP is expected to
send a value that will be bound to <sym> and be handled by an
argument handler associated with tag before BODY is evaluated in
the IOLOOP process, see `jupyter-ioloop-add-arg-type'."
(declare (indent 3) (doc-string 4) (debug t))
(unless (stringp doc)
(when doc
(setq body (cons doc body))))
`(setf (oref ,ioloop events)
(cons (list (quote ,event) (quote ,args) (quote ,body))
(cl-remove-if (lambda (x) (eq (car x) (quote ,event)))
(oref ,ioloop events)))))
(defun jupyter-ioloop--event-dispatcher (ioloop exp)
"For IOLOOP return a form suitable for matching against EXP.
That is, return an expression which will cause an event to be
fired if EXP matches any event types handled by IOLOOP.
TODO: Explain these
By default this adds the events quit, callback, and timer."
(let ((user-events
(cl-loop
for (event args body) in (oref ioloop events)
for cond = (list '\` (cl-list*
event (jupyter-ioloop--replace-args args)))
if (memq event '(quit callback timer))
do (error "Event can't be one of quit, callback, or, timer")
;; cond = `(event ,arg1 ,arg2 ...)
else collect `(,cond ,@body))))
`(let* ((cmd ,exp)
(res (pcase cmd
,@user-events
;; Default events
(`(timer ,id ,period ,cb)
;; Ensure we don't send anything back to the parent process
(prog1 nil
(let ((timer (run-at-time 0.0 period (byte-compile cb))))
(puthash id timer jupyter-ioloop-timers))))
(`(callback ,cb)
;; Ensure we don't send anything back to the parent process
(prog1 nil
(setq jupyter-ioloop-timeout 0)
(add-hook 'jupyter-ioloop-pre-hook (byte-compile cb) 'append)))
('(quit) (signal 'quit nil))
(_ (error "Unhandled command %s" cmd)))))
;; Can only send lists at the moment
(when (and res (listp res)) (zmq-prin1 res)))))
(cl-defgeneric jupyter-ioloop-add-callback ()
(declare (indent 1)))
(cl-defmethod jupyter-ioloop-add-callback ((ioloop jupyter-ioloop) cb)
"In IOLOOP, add CB to be run in the IOLOOP environment.
CB is run at the start of every polling loop. Callbacks are
called in the order they are added.
WARNING: A function added as a callback should be quoted to avoid
sending closures to the IOLOOP. An example:
(jupyter-ioloop-add-callback ioloop
`(lambda () (zmq-prin1 \='foo \"bar\")))"
(cl-assert (functionp cb))
(cl-callf append (oref ioloop callbacks) (list cb))
(when (process-live-p (oref ioloop process))
(jupyter-send ioloop 'callback (macroexpand-all cb))))
(defun jupyter-ioloop-poller-add (socket events)
"Add SOCKET to be polled using the `jupyter-ioloop-poller'.
EVENTS are the polling events that should be listened for on
SOCKET. If `jupyter-ioloop-poller' is not a `zmq-poller' object
do nothing."
(when (zmq-poller-p jupyter-ioloop-poller)
(zmq-poller-add jupyter-ioloop-poller socket events)
(cl-incf jupyter-ioloop-nsockets)))
(defun jupyter-ioloop-poller-remove (socket)
"Remove SOCKET from the `jupyter-ioloop-poller'.
If `jupyter-ioloop-poller' is not a `zmq-poller' object do
nothing."
(when (zmq-poller-p jupyter-ioloop-poller)
(zmq-poller-remove jupyter-ioloop-poller socket)
(cl-decf jupyter-ioloop-nsockets)))
(defun jupyter-ioloop--body (ioloop on-stdin)
`(let (events)
(condition-case nil
(progn
,@(oref ioloop setup)
;; Initialize any callbacks that were added before the ioloop was
;; started
(setq jupyter-ioloop-pre-hook
(mapcar (lambda (f)
(when (symbolp f)
(setq f (symbol-function f)))
(unless (byte-code-function-p f)
(byte-compile f)))
(append jupyter-ioloop-pre-hook
(quote ,(mapcar #'macroexpand-all
(oref ioloop callbacks))))))
;; Notify the parent process we are ready to do something
(zmq-prin1 '(start))
(let ((on-stdin (byte-compile (lambda () ,on-stdin))))
(while t
(run-hooks 'jupyter-ioloop-pre-hook)
(setq events
(condition-case nil
(zmq-poller-wait-all
jupyter-ioloop-poller
jupyter-ioloop-nsockets
jupyter-ioloop-timeout)
((zmq-EAGAIN zmq-EINTR zmq-ETIMEDOUT) nil)))
(let ((stdin-event (zmq-assoc jupyter-ioloop-stdin events)))
(when stdin-event
(setq events (delq stdin-event events))
(funcall on-stdin)))
(run-hook-with-args 'jupyter-ioloop-post-hook events))))
(quit
,@(oref ioloop teardown)
(zmq-prin1 '(quit))))))
(defun jupyter-ioloop--function (ioloop port)
"Return the function that does the work of IOLOOP.
The returned function is suitable to send to a ZMQ subprocess for
evaluation using `zmq-start-process'.
If PORT is non-nil the returned function will create a ZMQ PULL
socket to receive events from the parent process on the PORT of
the local host, otherwise events are expected to be received on
STDIN. This is useful on Windows systems which don't allow
polling the STDIN file handle."
`(lambda (ctx)
(push ,(file-name-directory (locate-library "jupyter-base")) load-path)
(require 'jupyter-ioloop)
(setq jupyter-ioloop-poller (zmq-poller))
(setq jupyter-ioloop-stdin
,(if port
`(let ((sock (zmq-socket ctx zmq-PAIR)))
(prog1 sock
(zmq-connect sock (format "tcp://127.0.0.1:%s" ,port))))
0))
(zmq-poller-add jupyter-ioloop-poller jupyter-ioloop-stdin zmq-POLLIN)
,(jupyter-ioloop--body
ioloop (jupyter-ioloop--event-dispatcher
ioloop (if port '(read (zmq-recv jupyter-ioloop-stdin))
'(zmq-subprocess-read))))))
(defun jupyter-ioloop-alive-p (ioloop)
"Return non-nil if IOLOOP is ready to receive/send events."
(cl-check-type ioloop jupyter-ioloop)
(with-slots (process) ioloop
(and (process-live-p process) (process-get process :start))))
(defun jupyter-ioloop--make-filter (ioloop handler)
(lambda (event)
(let ((process (oref ioloop process)))
(process-put process :last-event event)
(cond
((eq (car-safe event) 'start)
(process-put process :start t))
((eq (car-safe event) 'quit)
(process-put process :quit t))
(t
(funcall handler event))))))
(cl-defmethod jupyter-ioloop-start ((ioloop jupyter-ioloop)
handler
&key buffer)
"Start an IOLOOP.
HANDLER is a function of one argument and will be passed an event
received by the subprocess that IOLOOP represents, an event is
just a list.
If IOLOOP was previously running, it is stopped first.
If BUFFER is non-nil it should be a buffer that will be used as
the IOLOOP subprocess buffer, see `zmq-start-process'."
(jupyter-ioloop-stop ioloop)
(let (stdin port)
;; NOTE: A socket is used to read input from the parent process to avoid
;; the stdin buffering done when using `read-from-minibuffer' in the
;; subprocess. When `noninteractive', `read-from-minibuffer' uses
;; `getc_unlocked' internally and `getc_unlocked' reads from the stdin FILE
;; object as opposed to reading directly from STDIN_FILENO. The problem is
;; that FILE objects are buffered streams which means that every message
;; the parent process sends does not necessarily correspond to a POLLIN
;; event on STDIN_FILENO in the subprocess. Since we only call
;; `read-from-minibuffer' when there is a POLLIN event on STDIN_FILENO
;; there is the potential that a message is waiting to be handled in the
;; buffer used by stdin which will only get handled if we send more
;; messages to the subprocess thereby creating more POLLIN events.
(when (or t (memq system-type '(windows-nt ms-dos cygwin)))
(setq stdin (zmq-socket (zmq-current-context) zmq-PAIR))
(setq port (zmq-bind-to-random-port stdin "tcp://127.0.0.1")))
(let ((process (zmq-start-process
(jupyter-ioloop--function ioloop (when stdin port))
:filter (jupyter-ioloop--make-filter ioloop handler)
:buffer buffer)))
(oset ioloop process process)
(when stdin
(process-put process :stdin stdin))
(jupyter-ioloop-wait-until ioloop 'start #'identity))))
(cl-defmethod jupyter-ioloop-stop ((ioloop jupyter-ioloop))
"Stop IOLOOP.
Send a quit event to IOLOOP, wait until it actually quits before
returning."
(with-slots (process) ioloop
(when (process-live-p process)
(jupyter-send ioloop 'quit)
(unless (jupyter-ioloop-wait-until ioloop 'quit #'identity)
(delete-process process))
(when-let* ((stdin (process-get process :stdin))
(socket-p (zmq-socket-p stdin)))
(zmq-unbind stdin (zmq-get-option stdin zmq-LAST-ENDPOINT))))))
(defvar jupyter-ioloop--send-buffer nil)
(defun jupyter-ioloop--dump-message (plist)
(with-current-buffer
(if (buffer-live-p jupyter-ioloop--send-buffer)
jupyter-ioloop--send-buffer
(setq jupyter-ioloop--send-buffer
(get-buffer-create " *jupyter-ioloop-send*")))
(erase-buffer)
(let (print-level print-length)
(prin1 plist (current-buffer)))
(buffer-string)))
(cl-defmethod jupyter-send ((ioloop jupyter-ioloop) &rest args)
"Using IOLOOP, send ARGS to its process.
All arguments passed to this function are sent as a list to the
process unchanged. This means that all arguments should be
serializable."
(with-slots (process) ioloop
(cl-assert (process-live-p process))
(let ((stdin (process-get process :stdin)))
(if stdin
(let ((msg (jupyter-ioloop--dump-message args)) sent)
(while (not sent)
(condition-case nil
(progn
(zmq-send stdin (encode-coding-string msg 'utf-8) zmq-DONTWAIT)
(setq sent t))
(zmq-EAGAIN (accept-process-output nil 0)))))
(zmq-subprocess-send process args)))))
(provide 'jupyter-ioloop)
;;; jupyter-ioloop.el ends here

54
lisp/jupyter/jupyter-javascript.el Normal file
View File

@@ -0,0 +1,54 @@
;;; jupyter-javascript.el --- Jupyter support for Javascript -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 23 Oct 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:
;; Support methods for integration with Javascript.
;;; Code:
(require 'jupyter-repl)
(declare-function js2-parse "ext:js2-mode")
(declare-function js2-mode-apply-deferred-properties "ext:js2-mode")
(cl-defmethod jupyter-repl-after-init (&context (jupyter-lang javascript)
(jupyter-repl-mode js2-mode))
"If `js2-mode' is used for Javascript kernels, enable syntax highlighting.
`js2-mode' does not use `font-lock-defaults', but their own
custom method."
(add-hook 'after-change-functions
(lambda (_beg _end len)
;; Insertions only
(when (= len 0)
(unless (jupyter-repl-cell-finalized-p)
(let ((cbeg (jupyter-repl-cell-code-beginning-position))
(cend (jupyter-repl-cell-code-end-position)))
(save-restriction
(narrow-to-region cbeg cend)
(js2-parse)
(js2-mode-apply-deferred-properties))))))
t t))
(provide 'jupyter-javascript)
;;; jupyter-javascript.el ends here

245
lisp/jupyter/jupyter-julia.el Normal file
View File

@@ -0,0 +1,245 @@
;;; jupyter-julia.el --- Jupyter support for Julia -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 23 Oct 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:
;; Support methods for integration with Julia.
;;; Code:
(eval-when-compile (require 'subr-x))
(require 'jupyter-repl)
(declare-function julia-latexsub-or-indent "ext:julia-mode" (arg))
(cl-defmethod jupyter-indent-line (&context (major-mode julia-mode))
"Call `julia-latexsub-or-indent'."
(call-interactively #'julia-latexsub-or-indent))
(cl-defmethod jupyter-load-file-code (file &context (jupyter-lang julia))
(format "include(\"%s\");" file))
;;; Completion
(cl-defmethod jupyter-completion-prefix (&context (jupyter-lang julia))
(cond
;; Completing argument lists
((and (char-before)
(eq (char-syntax (char-before)) ?\()
(or (not (char-after))
(looking-at-p "\\_>")
(not (memq (char-syntax (char-after)) '(?w ?_)))))
(buffer-substring-no-properties
(jupyter-completion-symbol-beginning (1- (point)))
(point)))
(t
(let ((prefix (cl-call-next-method "\\\\\\|\\.\\|::?" 2)))
(prog1 prefix
(when (consp prefix)
(let ((beg (- (point) (length (car prefix)))))
(cond
;; Include the \ in the prefix so it gets replaced if a canidate is
;; selected.
((eq (char-before beg) ?\\)
(setcar prefix (concat "\\" (car prefix))))
;; Also include : to complete symbols when used as dictionary keys
((and (eq (char-before beg) ?:)
(not (eq (char-before (1- beg)) ?:))
;; Except for when it is part of range expressions like 1:len
(not (memq (char-syntax (char-before (1- beg))) '(?w ?_))))
(setcar prefix (concat ":" (car prefix))))))))))))
(cl-defmethod jupyter-completion-post-completion (candidate
&context (jupyter-lang julia))
"Insert the unicode representation of a LaTeX completion."
(if (eq (aref candidate 0) ?\\)
(when (get-text-property 0 'annot candidate)
(search-backward candidate)
(delete-region (point) (match-end 0))
;; Alternatively use `julia-latexsub-or-indent', but I have found
;; problems with that.
(insert (string-trim (get-text-property 0 'annot candidate))))
(cl-call-next-method)))
;;; `markdown-mode'
(cl-defmethod jupyter-markdown-follow-link (link-text url _ref-label _title-text _bang
&context (jupyter-lang julia))
"Send a help query to the Julia REPL for LINK-TEXT if URL is \"@ref\".
If URL is \"@ref <section>\" then open a browser to the Julia
manual for <section>. Otherwise follow the link normally."
(if (string-prefix-p "@ref" url)
(if (string= url "@ref")
;; Links have the form `fun`
(let ((fun (substring link-text 1 -1)))
(if (not (eq major-mode 'jupyter-repl-mode))
(jupyter-inspect fun (1- (length fun)))
(goto-char (point-max))
(jupyter-repl-replace-cell-code (concat "?" fun))
(jupyter-repl-ret)))
(let* ((ref (split-string url))
(section (cadr ref)))
(browse-url
(format "https://docs.julialang.org/en/latest/manual/%s/" section))))
(cl-call-next-method)))
;;; `jupyter-repl-after-change'
(defvar ansi-color-names-vector)
(defun jupyter-julia-add-prompt (prompt color)
"Display PROMPT at the beginning of the cell using COLOR as the foreground.
Make the character after `point' invisible."
(add-text-properties (point) (1+ (point)) '(invisible t rear-nonsticky t))
(let ((ov (make-overlay (point) (1+ (point)) nil t))
(md (propertize prompt
'fontified t
'font-lock-face `((:foreground ,color)))))
(overlay-put ov 'after-string (propertize " " 'display md))
(overlay-put ov 'evaporate t)))
(defun jupyter-julia-pkg-prompt ()
"Return the Pkg prompt.
If the Pkg prompt can't be retrieved from the kernel, return
nil."
(let ((prompt-code "import Pkg; Pkg.REPLMode.promptf()"))
(jupyter-run-with-client jupyter-current-client
(jupyter-mlet* ((msg
(jupyter-reply
(jupyter-execute-request
:code ""
:silent t
:user-expressions (list :prompt prompt-code)))))
(cl-destructuring-bind (&key prompt &allow-other-keys)
(jupyter-message-get msg :user_expressions)
(cl-destructuring-bind (&key status data &allow-other-keys)
prompt
(jupyter-return
(when (equal status "ok")
(plist-get data :text/plain)))))))))
(cl-defmethod jupyter-repl-after-change ((_type (eql insert)) beg _end
&context (jupyter-lang julia))
"Change the REPL prompt when a REPL mode is entered."
(when (= beg (jupyter-repl-cell-code-beginning-position))
(save-excursion
(goto-char beg)
(when (and (bound-and-true-p blink-paren-function)
(eq (char-syntax (char-after)) ?\)))
;; Spoof `last-command-event' so that a "No matching paren" message
;; doesn't happen.
(setq last-command-event ?\[))
(cl-case (char-after)
(?\]
(when-let* ((pkg-prompt (jupyter-julia-pkg-prompt)))
(jupyter-julia-add-prompt
(substring pkg-prompt 1 (1- (length pkg-prompt)))
(aref ansi-color-names-vector 5)))) ; magenta
(?\;
(jupyter-julia-add-prompt
"shell> " (aref ansi-color-names-vector 1))) ; red
(?\?
(jupyter-julia-add-prompt
"help?> " (aref ansi-color-names-vector 3)))))) ; yellow
(cl-call-next-method))
(cl-defmethod jupyter-repl-after-change ((_type (eql delete)) beg _len
&context (jupyter-lang julia))
"Reset the prompt if needed."
(when (= beg (jupyter-repl-cell-code-beginning-position))
(jupyter-repl-cell-reset-prompt)))
;;; REPL font lock
(defun jupyter-julia--propertize-repl-mode-char (beg end)
(jupyter-repl-map-cells beg end
(lambda ()
;; Handle Julia package prompt so `syntax-ppss' works properly.
(when (and (eq (char-syntax (char-after (point-min))) ?\))
(= (point-min)
(save-restriction
(widen)
;; Looks at the position before the narrowed cell-code
;; which is why the widen is needed here.
(jupyter-repl-cell-code-beginning-position))))
(put-text-property
(point-min) (1+ (point-min)) 'syntax-table '(1 . ?.))))
#'ignore))
;;; `jupyter-repl-after-init'
(defun jupyter-julia--setup-hooks (client)
(jupyter-run-with-client client
(jupyter-sent
(jupyter-execute-request
:handlers nil
:store-history nil
:silent t
;; This is mainly for supporting the :dir header argument in
;; `org-mode' source blocks.
:code "\
if !isdefined(Main, :__JUPY_saved_dir)
Core.eval(Main, :(__JUPY_saved_dir = Ref(\"\")))
let popdir = () -> begin
if !isempty(Main.__JUPY_saved_dir[])
cd(Main.__JUPY_saved_dir[])
Main.__JUPY_saved_dir[] = \"\"
end
end
IJulia.push_posterror_hook(popdir)
IJulia.push_postexecute_hook(popdir)
end
end"))))
(cl-defmethod jupyter-repl-after-init (&context (jupyter-lang julia))
(if syntax-propertize-function
(add-function
:after (local 'syntax-propertize-function)
#'jupyter-julia--propertize-repl-mode-char)
(setq-local syntax-propertize-function #'jupyter-julia--propertize-repl-mode-char))
(jupyter-julia--setup-hooks jupyter-current-client)
;; Setup hooks after restart as well
(jupyter-add-hook jupyter-current-client 'jupyter-iopub-message-hook
(lambda (client msg)
(when (jupyter-message-status-starting-p msg)
(jupyter-julia--setup-hooks client)))))
;;; `jupyter-org'
(cl-defmethod jupyter-org-error-location (&context (jupyter-lang julia))
(when (and (re-search-forward "^Stacktrace:" nil t)
(re-search-forward "top-level scope" nil t)
(re-search-forward "In\\[[0-9]+\\]:\\([0-9]+\\)" nil t))
(string-to-number (match-string 1))))
(cl-defmethod org-babel-jupyter-transform-code (code changelist &context (jupyter-lang julia))
(when (plist-get changelist :dir)
(setq code
;; Stay on one line so that tracebacks will report the right line
;; numbers
(format "Main.__JUPY_saved_dir[] = pwd(); cd(\"%s\"); %s"
(plist-get changelist :dir) code)))
code)
(provide 'jupyter-julia)
;;; jupyter-julia.el ends here

416
lisp/jupyter/jupyter-kernel-process.el Normal file
View File

@@ -0,0 +1,416 @@
;;; jupyter-kernel-process.el --- Jupyter kernels as Emacs processes -*- lexical-binding: t -*-
;; Copyright (C) 2020-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 25 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:
;; Jupyter kernels as Emacs processes.
;;; Code:
(require 'jupyter-kernel)
(require 'jupyter-monads)
(defgroup jupyter-kernel-process nil
"Jupyter kernels as Emacs processes"
:group 'jupyter)
(declare-function jupyter-ioloop-start "jupyter-ioloop")
(declare-function jupyter-ioloop-stop "jupyter-ioloop")
(declare-function jupyter-send "jupyter-ioloop")
(declare-function jupyter-ioloop-alive-p "jupyter-ioloop")
(declare-function jupyter-channel-ioloop-set-session "jupyter-channel-ioloop")
(declare-function ansi-color-apply "ansi-color")
(declare-function jupyter-hb-pause "jupyter-zmq-channel")
(defvar jupyter--kernel-processes '()
"The list of kernel processes launched.
Elements look like (PROCESS CONN-FILE) where PROCESS is a kernel
process and CONN-FILE the associated connection file.
Cleaning up the list removes elements whose PROCESS is no longer
live. When removing an element, CONN-FILE will be deleted and
PROCESS's buffer killed.
The list is periodically cleaned up when a new process is
launched.
Also, just before Emacs exits any connection files that still
exist are deleted.")
;;; Kernel definition
(cl-defstruct (jupyter-kernel-process
(:include jupyter-kernel))
connect-p)
(cl-defmethod jupyter-process ((kernel jupyter-kernel-process))
"Return the process of KERNEL.
Return nil if KERNEL does not have an associated process."
(car (cl-find-if (lambda (x) (and (processp (car x))
(eq (process-get (car x) :kernel) kernel)))
jupyter--kernel-processes)))
(cl-defmethod jupyter-alive-p ((kernel jupyter-kernel-process))
(let ((process (jupyter-process kernel)))
(and (process-live-p process)
(cl-call-next-method))))
(defun jupyter-kernel-process (&rest args)
"Return a `jupyter-kernel-process' initialized with ARGS."
(apply #'make-jupyter-kernel-process args))
(cl-defmethod jupyter-kernel :extra "process" (&rest args)
"Return a kernel as an Emacs process.
If ARGS contains a :spec key with a value being a
`jupyter-kernelspec', a `jupyter-kernel-process' initialized from
it will be returned. The value can also be a string, in which
case it is considered the name of a kernelspec to use.
If ARGS contains a :conn-info key, a `jupyter-kernel-process'
with a session initialized from its value, either the name of a
connection file to read or a connection property list itself (see
`jupyter-read-connection'), will be returned. The remaining ARGS
will be used to initialize the returned kernel.
Call the next method if ARGS does not contain a :spec or
:conn-info key."
(if (plist-get args :server) (cl-call-next-method)
(let ((spec (plist-get args :spec))
(conn-info (plist-get args :conn-info)))
(cond
((and spec (not conn-info))
(when (stringp spec)
(plist-put args :spec
(or (jupyter-guess-kernelspec spec)
(error "No kernelspec matching name (%s)" spec))))
(cl-check-type (plist-get args :spec) jupyter-kernelspec)
(apply #'jupyter-kernel-process args))
(conn-info
(apply #'jupyter-kernel-process
:session (if (stringp conn-info)
(jupyter-connection-file-to-session conn-info)
conn-info)
(cl-loop
for (k v) on args by #'cddr
unless (eq k :conn-info) collect k and collect v)))
(t
(cl-call-next-method))))))
;;; Client connection
(cl-defmethod jupyter-zmq-io ((kernel jupyter-kernel-process))
(unless (jupyter-kernel-process-connect-p kernel)
(jupyter-launch kernel))
(let ((channels '(:shell :iopub :stdin :control))
session ch-group hb kernel-io ioloop shutdown)
(cl-macrolet ((continue-after
(cond on-timeout)
`(jupyter-with-timeout
(nil jupyter-default-timeout ,on-timeout)
,cond)))
(cl-labels ((set-session
()
(or (setq session (jupyter-kernel-session kernel))
(error "A session is needed to connect to a kernel's I/O")))
(set-ch-group
()
(let ((endpoints (jupyter-session-endpoints (set-session))))
(setq ch-group
(cl-loop
for ch in channels
collect ch
collect (list :endpoint (plist-get endpoints ch)
:alive-p nil)))))
(ch-put
(ch prop value)
(plist-put (plist-get ch-group ch) prop value))
(ch-get
(ch prop)
(plist-get (plist-get ch-group ch) prop))
(ch-alive-p
(ch)
(and ioloop (jupyter-ioloop-alive-p ioloop)
(ch-get ch :alive-p)))
(ch-start
(ch)
(unless (ch-alive-p ch)
(jupyter-send ioloop 'start-channel ch
(ch-get ch :endpoint))
(continue-after
(ch-alive-p ch)
(error "Channel failed to start: %s" ch))))
(ch-stop
(ch)
(when (ch-alive-p ch)
(jupyter-send ioloop 'stop-channel ch)
(continue-after
(not (ch-alive-p ch))
(error "Channel failed to stop: %s" ch))))
(start
()
(unless ioloop
(require 'jupyter-zmq-channel-ioloop)
(setq ioloop (make-instance 'jupyter-zmq-channel-ioloop))
(jupyter-channel-ioloop-set-session ioloop session))
(unless (jupyter-ioloop-alive-p ioloop)
(jupyter-ioloop-start
ioloop
(lambda (event)
(pcase (car event)
((and 'start-channel (let ch (cadr event)))
(ch-put ch :alive-p t))
((and 'stop-channel (let ch (cadr event)))
(ch-put ch :alive-p nil))
;; TODO: Get rid of this
('sent nil)
(_
(jupyter-run-with-io kernel-io
(jupyter-publish event))))))
(condition-case err
(cl-loop
for ch in channels
do (ch-start ch))
(error
(jupyter-ioloop-stop ioloop)
(signal (car err) (cdr err)))))
ioloop)
(stop
()
(when hb
(jupyter-hb-pause hb)
(setq hb nil))
(when ioloop
(when (jupyter-ioloop-alive-p ioloop)
(jupyter-ioloop-stop ioloop))
(setq ioloop nil))))
(set-ch-group)
(setq kernel-io
;; TODO: (jupyter-publisher :name "Session I/O" :fn ...)
;;
;; so that on error in a subscriber, the name can be
;; displayed to know where to look. This requires a
;; `jupyter-publisher' struct type.
(jupyter-publisher
(lambda (content)
(if shutdown
(error "Kernel I/O no longer available: %s"
(cl-prin1-to-string session))
(pcase (car content)
;; ('message channel idents . msg)
('message
(pop content)
;; Set the channel key of the message property list
(plist-put
(cddr content) :channel
(substring (symbol-name (car content)) 1))
(jupyter-content (cddr content)))
('send
;; Set the channel argument to a keyword so its
;; recognized by the ioloop
(setq content
(cons (car content)
(cons (intern (concat ":" (cadr content)))
(cddr content))))
(apply #'jupyter-send (start) content))
('hb
(unless hb
(setq hb
(let ((endpoints (set-session)))
(make-instance
'jupyter-hb-channel
:session session
:endpoint (plist-get endpoints :hb)))))
(jupyter-run-with-io (cadr content)
(jupyter-publish hb)))
(_ (error "Unhandled I/O: %s" content)))))))
(list kernel-io
(jupyter-subscriber
(lambda (action)
(pcase action
('interrupt
(jupyter-interrupt kernel))
('shutdown
(jupyter-shutdown kernel)
(stop)
(setq shutdown t))
('restart
(setq shutdown nil)
(jupyter-restart kernel)
(stop)
(set-ch-group)
(start))
(`(action ,fn)
(funcall fn kernel))))))))))
(cl-defmethod jupyter-io ((kernel jupyter-kernel-process))
"Return an I/O connection to KERNEL's session."
(jupyter-zmq-io kernel))
;;; Kernel management
(defun jupyter--gc-kernel-processes ()
(setq jupyter--kernel-processes
(cl-loop for (p conn-file) in jupyter--kernel-processes
if (process-live-p p) collect (list p conn-file)
else do (delete-process p)
(when (file-exists-p conn-file)
(delete-file conn-file))
and when (buffer-live-p (process-buffer p))
do (kill-buffer (process-buffer p)))))
(defun jupyter-delete-connection-files ()
"Delete all connection files created by Emacs."
;; Ensure Emacs can be killed on error
(ignore-errors
(cl-loop for (_ conn-file) in jupyter--kernel-processes
do (when (file-exists-p conn-file)
(delete-file conn-file)))))
(add-hook 'kill-emacs-hook #'jupyter-delete-connection-files)
(defun jupyter--start-kernel-process (name kernelspec conn-file)
(let* ((process-name (format "jupyter-kernel-%s" name))
(buffer-name (format " *jupyter-kernel[%s]*" name))
(process-environment
(append (jupyter-process-environment kernelspec)
process-environment))
(args (jupyter-kernel-argv kernelspec conn-file))
(atime (nth 4 (file-attributes conn-file)))
(process (apply #'start-file-process process-name
(generate-new-buffer buffer-name)
(car args) (cdr args))))
(set-process-query-on-exit-flag process jupyter--debug)
;; Wait until the connection file has been read before returning.
;; This is to give the kernel a chance to setup before sending it
;; messages.
;;
;; TODO: Replace with a check of the heartbeat channel.
(jupyter-with-timeout
((format "Starting %s kernel process..." name)
jupyter-long-timeout
(unless (process-live-p process)
(error "Kernel process exited:\n%s"
(with-current-buffer (process-buffer process)
(ansi-color-apply (buffer-string))))))
;; Windows systems may not have good time resolution when retrieving
;; the last access time of a file so we don't bother with checking that
;; the kernel has read the connection file and leave it to the
;; downstream initialization to ensure that we can communicate with a
;; kernel.
(or (memq system-type '(ms-dos windows-nt cygwin))
(let ((attribs (file-attributes conn-file)))
;; `file-attributes' can potentially return nil, in this case
;; just assume it has read the connection file so that we can
;; know for sure it is not connected if it fails to respond to
;; any messages we send it.
(or (null attribs)
(not (equal atime (nth 4 attribs)))))))
(jupyter--gc-kernel-processes)
(push (list process conn-file) jupyter--kernel-processes)
process))
(cl-defmethod jupyter-launch :before ((kernel jupyter-kernel-process))
"Ensure KERNEL has a non-nil SESSION slot.
A `jupyter-session' with random port numbers for the channels and
a newly generated message signing key will be set as the value of
KERNEL's SESSION slot if it is nil."
(pcase-let (((cl-struct jupyter-kernel-process session) kernel))
(unless session
(setf (jupyter-kernel-session kernel) (jupyter-session-with-random-ports))
;; This is here for stability when running the tests. Sometimes
;; the kernel ports are not set up fast enough due to the hack
;; done in `jupyter-session-with-random-ports'. The effect
;; seems to be messages that are sent but never received by the
;; kernel.
(sit-for 0.2))))
(cl-defmethod jupyter-launch ((kernel jupyter-kernel-process))
"Start KERNEL's process.
Do nothing if KERNEL's process is already live.
The process arguments are constructed from KERNEL's SPEC. The
connection file passed as argument to the process is first
written to file, its contents are generated from KERNEL's SESSION
slot.
See also https://jupyter-client.readthedocs.io/en/stable/kernels.html#kernel-specs"
(let ((process (jupyter-process kernel)))
(unless (process-live-p process)
(pcase-let (((cl-struct jupyter-kernel-process spec session) kernel))
(let ((conn-file (jupyter-write-connection-file session)))
(setq process (jupyter--start-kernel-process
(jupyter-kernel-name kernel) spec
conn-file))
;; Make local tunnels to the remote ports when connecting to
;; remote kernels. Update the session object to reflect
;; these changes.
(when (file-remote-p conn-file)
(setf (jupyter-kernel-session kernel)
(let ((conn-info (jupyter-tunnel-connection conn-file)))
(jupyter-session
:conn-info conn-info
:key (plist-get conn-info :key)))))))
(setf (process-get process :kernel) kernel)
(setf (process-sentinel process)
(lambda (process _)
(pcase (process-status process)
('signal
(let ((kernel (process-get process :kernel)))
(when kernel
(warn "Kernel died unexpectedly")
(jupyter-shutdown kernel)))))))))
(cl-call-next-method))
(cl-defmethod jupyter-shutdown ((kernel jupyter-kernel-process))
"Shutdown KERNEL by killing its process unconditionally."
(let ((process (jupyter-process kernel)))
(when process
(setf (process-get process :kernel) nil)
(delete-process process))
(cl-call-next-method)))
(cl-defmethod jupyter-restart ((_kernel jupyter-kernel-process))
(cl-call-next-method))
(cl-defmethod jupyter-interrupt ((kernel jupyter-kernel-process))
"Interrupt KERNEL's process.
The process can be interrupted when the interrupt mode of
KERNEL's spec. is \"signal\" or not specified.
See also https://jupyter-client.readthedocs.io/en/stable/kernels.html#kernel-specs"
(pcase-let* ((process (jupyter-process kernel))
((cl-struct jupyter-kernel-process spec) kernel)
((cl-struct jupyter-kernelspec plist) spec)
(imode (plist-get plist :interrupt_mode)))
(cond
((or (null imode) (string= imode "signal"))
(when (process-live-p process)
(interrupt-process process t)))
((string= imode "message")
(error "Send an interrupt_request using a client"))
(t (cl-call-next-method)))))
(provide 'jupyter-kernel-process)
;;; jupyter-kernel-process.el ends here

130
lisp/jupyter/jupyter-kernel.el Normal file
View File

@@ -0,0 +1,130 @@
;;; jupyter-kernel.el --- Kernels -*- lexical-binding: t -*-
;; Copyright (C) 2020-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 21 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:
;; Working with Jupyter kernels. This file contains the functions
;; used to control the lifetime of a kernel and how clients can
;; connect to launched kernels.
;;; Code:
(require 'jupyter-base)
(require 'jupyter-monads)
(require 'jupyter-kernelspec)
(defgroup jupyter-kernel nil
"Kernels"
:group 'jupyter)
;;; Kernel definition
(cl-defstruct jupyter-kernel
"A Jupyter kernel."
(spec (make-jupyter-kernelspec)
:type jupyter-kernelspec
:documentation "The kernelspec of this kernel.")
;; FIXME: Remove this slot, used by `jupyter-widget-client'.
(session nil :type jupyter-session))
(cl-defmethod jupyter-alive-p ((kernel jupyter-kernel))
"Return non-nil if KERNEL has been launched."
(and (jupyter-kernel-session kernel) t))
(cl-defmethod cl-print-object ((kernel jupyter-kernel) stream)
(princ (format "#<jupyter-kernel %s%s>"
(jupyter-kernelspec-name (jupyter-kernel-spec kernel))
(if (jupyter-alive-p kernel)
(concat " " (truncate-string-to-width
(jupyter-session-id (jupyter-kernel-session kernel))
9 nil nil "…"))
""))
stream))
(cl-defgeneric jupyter-kernel (&rest args)
"Return a kernel constructed from ARGS.
This method can be extended with extra primary methods for the
purposes of handling different forms of ARGS."
(let ((server (plist-get args :server))
(conn-info (plist-get args :conn-info))
(spec (plist-get args :spec)))
(cond
(server
(require 'jupyter-server-kernel)
(apply #'jupyter-kernel args))
((or conn-info spec)
(require 'jupyter-kernel-process)
(apply #'jupyter-kernel args))
(t (cl-call-next-method)))))
;;; Kernel management
(defun jupyter-kernel-name (kernel)
(jupyter-kernelspec-name
(jupyter-kernel-spec kernel)))
(cl-defmethod jupyter-launch ((kernel jupyter-kernel))
"Launch KERNEL."
(cl-assert (jupyter-alive-p kernel)))
(cl-defmethod jupyter-launch :before ((kernel jupyter-kernel))
"Notify that the kernel launched."
(message "Launching %s kernel..." (jupyter-kernel-name kernel)))
(cl-defmethod jupyter-launch :after ((kernel jupyter-kernel))
"Notify that the kernel launched."
(message "Launching %s kernel...done" (jupyter-kernel-name kernel)))
(cl-defmethod jupyter-shutdown ((kernel jupyter-kernel))
"Shutdown KERNEL.
Once a kernel has been shutdown it has no more connected clients
and the process it represents no longer exists.
The default implementation of this method disconnects all
connected clients of KERNEL and sets KERNEL's session slot to
nil."
(setf (jupyter-kernel-session kernel) nil))
(cl-defmethod jupyter-shutdown :before ((kernel jupyter-kernel))
"Notify that the kernel will be shutdown."
(message "%s kernel shutdown..." (jupyter-kernel-name kernel)))
(cl-defmethod jupyter-shutdown :after ((kernel jupyter-kernel))
"Notify that the kernel launched."
(message "%s kernel shutdown...done" (jupyter-kernel-name kernel)))
(cl-defmethod jupyter-restart ((kernel jupyter-kernel))
"Restart KERNEL.
The default implementation shuts down and then re-launches
KERNEL."
(jupyter-shutdown kernel)
(jupyter-launch kernel))
(cl-defmethod jupyter-interrupt ((_kernel jupyter-kernel))
"Interrupt KERNEL."
(ignore))
(provide 'jupyter-kernel)
;;; jupyter-kernel.el ends here

273
lisp/jupyter/jupyter-kernelspec.el Normal file
View File

@@ -0,0 +1,273 @@
;;; jupyter-kernelspec.el --- Jupyter kernelspecs -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 17 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:
;; Functions to work with kernelspecs found by the shell command
;;
;; jupyter kernelspec list
;;; Code:
(require 'json)
(require 'jupyter-env)
(defgroup jupyter-kernelspec nil
"Jupyter kernelspecs"
:group 'jupyter)
(declare-function jupyter-read-plist "jupyter-base" (file))
(declare-function jupyter-read-plist-from-string "jupyter-base" (file))
(cl-defstruct jupyter-kernelspec
(name "python"
:type string
:documentation "The name of the kernelspec."
:read-only t)
(plist nil
:type list
:documentation "The kernelspec as a property list."
:read-only t)
(resource-directory nil
:type (or null string)
:documentation "The resource directory."
:read-only t))
(defvar jupyter--kernelspecs (make-hash-table :test #'equal :size 5)
"A hash table mapping hosts to the kernelspecs available on them.
The top level hash-table maps hosts to nested hash-tables keyed
on virtual environment path or nil for a system-wide Jupyter
install: hosts[hash-table] -> venv[hash-table] -> kernelspecs.")
(defun jupyter-kernelspecs-ensure-cache (host)
"Return, creating if necessary, the hash-table for HOST."
(let ((cache (gethash host jupyter--kernelspecs)))
(if cache cache
(puthash host (make-hash-table :test #'equal :size 5)
jupyter--kernelspecs))))
(defun jupyter-kernelspecs-cache-put (host kernelspecs)
"Cache KERNELSPECS available on HOST.
This takes into account any currently active virtual
environment."
(let ((venv (getenv "VIRTUAL_ENV")))
(let ((cache (jupyter-kernelspecs-ensure-cache host)))
(puthash venv kernelspecs cache))))
(defun jupyter-kernelspecs-cache-get (host)
"Retrieve cached KERNELSPECS available on HOST.
This takes into account any currently active virtual
environment."
(let ((venv (getenv "VIRTUAL_ENV")))
(let ((cache (jupyter-kernelspecs-ensure-cache host)))
(gethash venv cache))))
(defun jupyter-available-kernelspecs (&optional refresh)
"Return the available kernelspecs.
Return a list of `jupyter-kernelspec's available on the host
associated with the `default-directory'. If `default-directory'
is a remote file name, return the list of available kernelspecs
on the remote system. The kernelspecs on the local system are
returned otherwise (taking into account any currently active
virtual environment).
On any system, the list is formed by parsing the output of the
shell command
jupyter kernelspec list --json
By default the available kernelspecs are cached. To force an
update of the cached kernelspecs, give a non-nil value to
REFRESH."
(let* ((host (or (file-remote-p default-directory) "local"))
(kernelspecs
(or (and (not refresh) (jupyter-kernelspecs-cache-get host))
(let ((specs
(plist-get
(let ((json (or (jupyter-command "kernelspec" "list"
"--json" "--log-level" "ERROR")
(error "\
Can't obtain kernelspecs from jupyter shell command"))))
(condition-case nil
(jupyter-read-plist-from-string json)
(error
(error "\
Jupyter kernelspecs couldn't be parsed from
jupyter kernelspec list --json
To investiagate further, run that command in a shell and examine
why it isn't returning valid JSON."))))
:kernelspecs)))
(jupyter-kernelspecs-cache-put
host
(sort
(cl-loop
for (kname spec) on specs by #'cddr
for name = (substring (symbol-name kname) 1)
for dir = (plist-get spec :resource_dir)
collect (make-jupyter-kernelspec
:name name
:resource-directory (concat
(unless (string= host "local") host)
dir)
:plist (plist-get spec :spec)))
(lambda (x y)
(string< (jupyter-kernelspec-name x)
(jupyter-kernelspec-name y)))))))))
kernelspecs))
(cl-defgeneric jupyter-kernelspecs (host &optional refresh)
"Return a list of kernelspecs on HOST.
If REFRESH is non-nil, then refresh the list of cached
kernelspecs first. Otherwise a cached version of the kernelspecs
may be returned.")
(cl-defmethod jupyter-kernelspecs ((host string) &optional refresh)
(let ((default-directory host))
(jupyter-available-kernelspecs refresh)))
(cl-defmethod jupyter-do-refresh-kernelspecs ()
(jupyter-kernelspecs default-directory 'refresh))
;;;###autoload
(defun jupyter-refresh-kernelspecs ()
"Refresh the list of available kernelspecs.
Execute this command if the kernelspecs seen by Emacs is out of
sync with those specified on your system or notebook server."
(interactive)
(message "Refreshing kernelspecs...")
(jupyter-do-refresh-kernelspecs)
(message "Refreshing kernelspecs...done"))
(defun jupyter-get-kernelspec (name &optional specs refresh)
"Get the kernelspec for a kernel named NAME.
If no kernelspec is found, return nil. Otherwise return the
kernelspec for the kernel named NAME.
If SPECS is provided, it is a list of kernelspecs that will be
searched. Otherwise the kernelspecs associated with the
`default-directory' are used.
Optional argument REFRESH has the same meaning as in
`jupyter-kernelspecs'."
(cl-loop
for kernelspec in (or specs (jupyter-kernelspecs default-directory refresh))
thereis (when (string= (jupyter-kernelspec-name kernelspec) name)
kernelspec)))
(defun jupyter-find-kernelspecs (re &optional specs refresh)
"Find all specs of kernels that have names matching RE.
RE is a regular expression use to match the name of a kernel.
Return a list of `jupyter-kernelspec' objects.
If SPECS is non-nil search SPECS, otherwise search the
kernelspecs associated with the `default-directory'.
Optional argument REFRESH has the same meaning as in
`jupyter-kernelspecs'."
(cl-remove-if-not
(lambda (kernelspec)
(string-match-p re (jupyter-kernelspec-name kernelspec)))
(or specs (jupyter-kernelspecs default-directory refresh))))
(defun jupyter-guess-kernelspec (name &optional specs refresh)
"Return the first kernelspec starting with NAME.
Raise an error if no kernelspec could be found.
SPECS and REFRESH have the same meaning as in
`jupyter-find-kernelspecs'."
(or (car (jupyter-find-kernelspecs (format "^%s" name) specs refresh))
(error "No valid kernelspec for kernel name (%s)" name)))
(defun jupyter-completing-read-kernelspec (&optional specs refresh)
"Use `completing-read' to select a kernel and return its kernelspec.
SPECS is a list of kernelspecs that will be used for completion,
if it is nil the kernelspecs associated with the
`default-directory' will be used.
Optional argument REFRESH has the same meaning as in
`jupyter-kernelspecs'."
(let* ((specs (or specs (jupyter-kernelspecs default-directory refresh)))
(display-names (if (null specs) (error "No kernelspecs available")
(mapcar (lambda (k)
(plist-get
(jupyter-kernelspec-plist k)
:display_name))
specs)))
(name (completing-read "kernel: " display-names nil t)))
(when (equal name "")
(error "No kernelspec selected"))
(nth (- (length display-names)
(length (member name display-names)))
specs)))
(defun jupyter-expand-environment-variables (var)
"Return VAR with all environment variables expanded.
VAR is a string, if VAR contains a sequence of characters like
${ENV_VAR}, substitute it with the value of ENV_VAR in
`process-environment'."
(let ((expanded "")
(start 0))
(while (string-match "\\${\\([^}]+\\)}" var start)
(cl-callf concat expanded
(substring var start (match-beginning 0))
(getenv (match-string 1 var)))
(setq start (match-end 0)))
(cl-callf concat expanded (substring var start))))
(defun jupyter-process-environment (kernelspec)
"Return a list of environment variables contained in KERNELSPEC.
The list of environment variables have the same form as the
entries in `process-environment'.
The environment variables returned are constructed from those in
the :env key of KERNELSPEC's property list."
(cl-loop
with env = (plist-get (jupyter-kernelspec-plist kernelspec) :env)
for (k v) on env by #'cddr
collect (format "%s=%s" (cl-subseq (symbol-name k) 1)
(jupyter-expand-environment-variables v))))
(defun jupyter-kernel-argv (kernelspec conn-file)
"Return a list of process arguments contained in KERNELSPEC.
The process arguments are the ones that should be passed to
kernel processes launched using KERNELSPEC.
CONN-FILE is the file name of a connection file, containing the
IP address and ports (among other things), a
launched kernel should connect to."
(cl-loop
with argv = (plist-get (jupyter-kernelspec-plist kernelspec) :argv)
for arg in (append argv nil)
if (equal arg "{connection_file}")
collect (file-local-name conn-file)
else if (equal arg "{resource_dir}")
collect (file-local-name
(jupyter-kernelspec-resource-directory
kernelspec))
else collect arg))
(provide 'jupyter-kernelspec)
;;; jupyter-kernelspec.el ends here

678
lisp/jupyter/jupyter-messages.el Normal file
View File

@@ -0,0 +1,678 @@
;;; jupyter-messages.el --- Jupyter messages -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; 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:
;; Routines to sign, encode, decode, send, and receive Jupyter messages.
;; Messages are represented as property lists, the contents of a message should
;; never be accessed directly since decoding of a message's contents is done on
;; demand. You access the message contents through `jupyter-message-content',
;; `jupyter-message-header', `jupyter-message-metadata', etc.
;;
;; There are convenience macros: `jupyter-with-message-content' and
;; `jupyter-with-message-data'.
;;
;; There are many convenience functions: `jupyter-message-data',
;; `jupyter-message-get', `jupyter-message-type',
;; `jupyter-message-status-idle-p', etc.
;;
;; See the "Convenience functions and macros" section.
;;; Code:
(eval-when-compile (require 'subr-x))
(require 'jupyter-base)
(require 'hmac-def)
(require 'parse-time)
(require 'json)
(declare-function jupyter-request "jupyter-monads" (type &rest content))
(declare-function jupyter-verify-inhibited-handlers "jupyter-client")
(defgroup jupyter-messages nil
"Jupyter messages"
:group 'jupyter)
(defconst jupyter-message-delimiter "<IDS|MSG>"
"The message delimiter required in the jupyter messaging protocol.")
(defconst jupyter--false :json-false
"The symbol used to disambiguate nil from boolean false.")
(defconst jupyter--empty-dict (make-hash-table :size 1)
"An empty hash table to disambiguate nil during encoding.
Message parts that are nil, but should be encoded into an empty
dictionary are set to this value so that they are encoded as
dictionaries.")
;;; UUID
(defun jupyter-new-uuid ()
"Return a version 4 UUID."
(format "%04x%04x-%04x-%04x-%04x-%06x%06x"
(cl-random 65536)
(cl-random 65536)
(cl-random 65536)
;; https://tools.ietf.org/html/rfc4122
(let ((r (cl-random 65536)))
(if (= (byteorder) ?l)
;; ?l = little-endian
(logior (logand r 4095) 16384)
;; big-endian
(logior (logand r 65295) 64)))
(let ((r (cl-random 65536)))
(if (= (byteorder) ?l)
(logior (logand r 49151) 32768)
(logior (logand r 65471) 128)))
(cl-random 16777216)
(cl-random 16777216)))
;;; Signing messages
(defun jupyter-sha256 (object)
"Return the SHA256 hash of OBJECT."
(secure-hash 'sha256 object nil nil t))
(define-hmac-function jupyter-hmac-sha256 jupyter-sha256 64 32)
(cl-defun jupyter-sign-message (session parts &optional (signer #'jupyter-hmac-sha256))
"Use SESSION to sign message PARTS.
Return the signature of PARTS. PARTS should be in the order of a
valid Jupyter message, see `jupyter-decode-message'. SIGNER is
the message signing function and should take two arguments, the
text to sign and the key used for signing. The default value
signs messages using `jupyter-hmac-sha256'."
(if (> (length (jupyter-session-key session)) 0)
(cl-loop
;; NOTE: Encoding to a unibyte representation due to an "Attempt to
;; change byte length of a string" error.
with key = (encode-coding-string
(jupyter-session-key session) 'utf-8 t)
with parts = (encode-coding-string
(cl-loop for part in parts concat part)
'utf-8 t)
for byte across (funcall signer parts key)
concat (format "%02x" byte))
""))
(defun jupyter--split-identities (parts)
"Extract the identities from a list of message PARTS.
Return a cons cell (IDENTS . REST-PARTS)."
(or (cl-loop
for (part . rest-parts) on parts by #'cdr
if (equal part jupyter-message-delimiter)
return (cons idents rest-parts)
else collect part into idents)
(error "Message delimiter not in message list")))
(defun jupyter--message-header (session msg-type msg-id)
"Return a message header.
The `:session' key of the header will have its value set to
SESSION's ID, and its `:msg_type' will be set to MSG-TYPE. MSG-ID
will be set to the value of the `:msg_id' key. The other fields
of the returned plist are `:version', `:username', and `:date'.
They are all set to appropriate default values."
(list
:msg_id msg-id
:msg_type msg-type
:version jupyter-protocol-version
:username user-login-name
:session (jupyter-session-id session)
:date (format-time-string "%FT%T.%6N%z" (current-time))))
;;; Encode/decoding messages
(defun jupyter--encode (part)
"Encode PART into a JSON string.
Take into account `jupyter-message-type' keywords by replacing
them with their appropriate message type strings according to the
Jupyter messaging spec. After encoding into a JSON
representation, return the UTF-8 encoded string.
If PART is a string, return the UTF-8 encoded string without
encoding into JSON first.
If PART is a list whose first element is the symbol,
`message-part', then return the second element of the list if it
is non-nil. If it is nil, then set the list's second element to
the result of calling `jupyter--encode' on the third element and
return the result."
(let ((original (if (fboundp 'json--print)
#'json--print
#'json-encode)))
(cl-letf (((symbol-function original)
(apply-partially #'jupyter--json-encode
(symbol-function original))))
(encode-coding-string
(cond
((stringp part) part)
(t (json-encode part)))
'utf-8 t))))
(defun jupyter--json-encode (original object)
(let (msg-type)
(cond
((eq (car-safe object) 'message-part)
(cl-destructuring-bind (_ encoded-rep decoded-rep) object
(or encoded-rep (setf (nth 1 object)
(jupyter--json-encode original decoded-rep)))))
((and (keywordp object)
(setf msg-type (plist-get jupyter-message-types object)))
(json-encode msg-type))
((and (listp object)
(= (length object) 4)
(cl-every #'integerp object))
(jupyter-encode-time object))
(t (funcall original object)))))
(defun jupyter--decode (part)
"Decode a message PART.
If PART is a list whose first element is the symbol,
`message-part', then return the third element of the list if it
is non-nil. If it is nil, then set the list's third element to
the result of calling `jupyter--decode' on the second element and
return the result.
Otherwise, if PART is a string decode it using UTF-8 encoding and
read it as a JSON string. If it is not valid JSON, return the
decoded string."
(if (eq (car-safe part) 'message-part)
(cl-destructuring-bind (_ encoded-rep decoded-rep) part
(or decoded-rep (setf (nth 2 part) (jupyter--decode encoded-rep))))
(let* ((json-object-type 'plist)
(str (decode-coding-string part 'utf-8)))
(condition-case nil
(json-read-from-string str)
;; If it can't be read as JSON, assume its just a regular
;; string
(json-unknown-keyword str)))))
(defun jupyter-decode-time (str)
"Decode an ISO 8601 time STR into a time object.
The returned object has the same form as the object returned by
`current-time'."
(unless (string-match-p "T[^.,Z+-]+" str)
(setq str (concat str "T00:00:00")))
(save-match-data
(string-match "T[^.,Z+-]+\\([.,]\\([0-9]+\\)\\)" str)
(let ((fraction (match-string 2 str)))
(when fraction
(setq str (replace-match "" nil nil str 1)))
(nconc (parse-iso8601-time-string str)
(if fraction
(let* ((plen (- 6 (length fraction)))
(pad (and (> plen 0) (expt 10 plen))))
(list (if pad (* pad (string-to-number fraction))
(string-to-number (substring fraction 0 6)))
0))
(list 0 0))))))
(defun jupyter-encode-time (time)
"Encode TIME into an ISO 8601 time string."
(format-time-string "%FT%T.%6N" time t))
(cl-defun jupyter-encode-raw-message (session
type
&rest plist
&key
content
(msg-id (jupyter-new-uuid))
parent-header
metadata
buffers
&allow-other-keys)
"Encode a message into a JSON string.
Similar to `jupyter-encode-message', but returns the JSON encoded
string instead of a list of the encoded parts.
PLIST is an extra property list added to the top level of the
message before encoding."
(declare (indent 2))
(cl-check-type session jupyter-session)
(cl-check-type metadata json-plist)
(cl-check-type content json-plist)
(cl-check-type parent-header json-plist)
(cl-check-type buffers list)
(or content (setq content jupyter--empty-dict))
(or parent-header (setq parent-header jupyter--empty-dict))
(or metadata (setq metadata jupyter--empty-dict))
(or buffers (setq buffers []))
(let (fplist)
(while plist
(cond
((memq (car plist)
'(:content :parent-header :metadata :buffers :msg-id))
(pop plist)
(pop plist))
(t
(push (prog1 (pop plist)
(push (pop plist) fplist))
fplist))))
(jupyter--encode
(cl-list*
:parent_header parent-header
:header (jupyter--message-header session type msg-id)
:content content
:metadata metadata
:buffers buffers
fplist))))
(cl-defun jupyter-encode-message (session
type
&key idents
content
(msg-id (jupyter-new-uuid))
parent-header
metadata
buffers
(signer #'jupyter-hmac-sha256))
(declare (indent 2))
(cl-check-type session jupyter-session)
(cl-check-type metadata json-plist)
(cl-check-type content json-plist)
(cl-check-type parent-header json-plist)
(cl-check-type buffers list)
(or content (setq content jupyter--empty-dict))
(or parent-header (setq parent-header jupyter--empty-dict))
(or metadata (setq metadata jupyter--empty-dict))
(and (stringp idents) (setq idents (list idents)))
(let ((parts (mapcar #'jupyter--encode
(list (jupyter--message-header session type msg-id)
parent-header
metadata
content))))
(nconc (cl-list* msg-id idents)
(cl-list* jupyter-message-delimiter
(jupyter-sign-message session parts signer)
parts)
buffers)))
(cl-defun jupyter-decode-message (session parts &key (signer #'jupyter-hmac-sha256))
"Use SESSION to decode message PARTS.
PARTS should be a list of message parts in the order of a valid
Jupyter message, i.e. a list of the form
(signature header parent-header metadata content buffers...)
If SESSION supports signing messages, then the signature
resulting from the signing of (cdr PARTS) using SESSION should be
equal to SIGNATURE. An error is thrown if it is not.
If SIGNER is non-nil it should be a function used to sign the
message. Otherwise the default signing function is used, see
`jupyter-sign-message'.
The returned plist has elements of the form
(message-part JSON PLIST)
for the keys `:header', `:parent-header', `:metadata', and
`:content'. JSON is the JSON encoded string of the message part.
For `:header' and `:parent-header', PLIST will be the decoded
message PLIST for the part. The other message parts are decoded
into property lists on demand, i.e. after a call to
`jupyter-message-metadata' or `jupyter-message-content' PLIST
will be decoded message part.
The binary buffers are left unchanged and will be the value of
the `:buffers' key in the returned plist. Also, the message ID
and type are available in the top level of the plist as `:msg_id'
and `:msg_type'."
(when (< (length parts) 5)
(error "Malformed message. Minimum length of parts is 5"))
(when (jupyter-session-key session)
(let ((signature (car parts)))
(when (= (length signature) 0)
(error "Unsigned message"))
;; TODO: digest_history
;; https://github.com/jupyter/jupyter_client/blob/7a0278af7c1652ac32356d6f00ae29d24d78e61c/jupyter_client/session.py#L915
(unless (string= (jupyter-sign-message session (cdr parts) signer) signature)
(error "Invalid signature (%s) for parts %S" signature (cdr parts)))))
(cl-destructuring-bind
(header parent-header metadata content &rest buffers)
(cdr parts)
(let ((dheader (jupyter--decode header)))
(list
:header (list 'message-part header dheader)
:msg_id (plist-get dheader :msg_id)
:msg_type (plist-get dheader :msg_type)
;; Also decode the parent header here since it is used quite often in
;; the parent Emacs process
:parent_header (list 'message-part parent-header
(jupyter--decode parent-header))
:metadata (list 'message-part metadata nil)
:content (list 'message-part content nil)
:buffers buffers))))
(defvar jupyter-inhibit-handlers)
(defmacro jupyter-with-client-handlers (handlers &rest body)
"Evaluate BODY with `jupyter-inhibit-handlers' bound according to HANDLERS.
HANDLERS has the inverted meaning of `jupyter-inhibit-handlers'."
(declare (indent 1) (debug (form body)))
(let ((h (make-symbol "handlers")))
`(let* ((,h ,handlers)
(jupyter-inhibit-handlers
(pcase ,h
('t nil)
('nil t)
(`(not . ,els) els)
(_ (cons 'not ,h)))))
(jupyter-verify-inhibited-handlers)
,@body)))
;;; Control messages
(cl-defun jupyter-interrupt-request (&key (handlers t))
(jupyter-with-client-handlers handlers
(jupyter-request "interrupt_request")))
;;; stdin messages
(cl-defun jupyter-input-reply (&key value (handlers t))
(jupyter-with-client-handlers handlers
(cl-check-type value string)
(jupyter-request "input_reply"
:value value)))
;;; shell messages
(cl-defun jupyter-kernel-info-request (&key (handlers t))
(jupyter-with-client-handlers handlers
(jupyter-request "kernel_info_request")))
(cl-defun jupyter-execute-request (&key code
(silent nil)
(store-history t)
(user-expressions nil)
(allow-stdin t)
(stop-on-error nil)
(handlers t))
(jupyter-with-client-handlers handlers
(cl-check-type code string)
(cl-check-type user-expressions json-plist)
(jupyter-request "execute_request"
:code code :silent (if silent t jupyter--false)
:store_history (if store-history t jupyter--false)
:user_expressions (or user-expressions jupyter--empty-dict)
:allow_stdin (if allow-stdin t jupyter--false)
:stop_on_error (if stop-on-error t jupyter--false))))
(cl-defun jupyter-inspect-request (&key code (pos 0) (detail 0)
(handlers t))
(jupyter-with-client-handlers handlers
(setq detail (or detail 0))
(unless (member detail '(0 1))
(error "Detail can only be 0 or 1 (%s)" detail))
(when (markerp pos)
(setq pos (marker-position pos)))
(cl-check-type code string)
(cl-check-type pos integer)
(jupyter-request "inspect_request"
:code code :cursor_pos pos :detail_level detail)))
(cl-defun jupyter-complete-request (&key code (pos 0) (handlers t))
(jupyter-with-client-handlers handlers
(when (markerp pos)
(setq pos (marker-position pos)))
(cl-check-type code string)
(cl-check-type pos integer)
(jupyter-request "complete_request"
:code code :cursor_pos pos)))
(cl-defun jupyter-history-request (&key
output
raw
(hist-access-type "tail")
session
start
stop
(n 10)
pattern
unique
(handlers t))
(jupyter-with-client-handlers handlers
(unless (member hist-access-type '("range" "tail" "search"))
(error "History access type can only be one of (range, tail, search)"))
(apply #'jupyter-request "history_request"
(append
(list :output (if output t jupyter--false) :raw (if raw t jupyter--false)
:hist_access_type hist-access-type)
(cond
((equal hist-access-type "range")
(cl-check-type session integer)
(cl-check-type start integer)
(cl-check-type stop integer)
(list :session session :start start :stop stop))
((equal hist-access-type "tail")
(cl-check-type n integer)
(list :n n))
((equal hist-access-type "search")
(cl-check-type pattern string)
(cl-check-type n integer)
(list :pattern pattern :unique (if unique t jupyter--false) :n n)))))))
(cl-defun jupyter-is-complete-request (&key code (handlers t))
(jupyter-with-client-handlers handlers
(cl-check-type code string)
(jupyter-request "is_complete_request"
:code code)))
(cl-defun jupyter-comm-info-request (&key (target-name "")
(handlers t))
(jupyter-with-client-handlers handlers
(cl-check-type target-name string)
(jupyter-request "comm_info_request"
:target_name target-name)))
(cl-defun jupyter-comm-open (&key id target-name data
(handlers t))
(jupyter-with-client-handlers handlers
(cl-check-type id string)
(cl-check-type target-name string)
(cl-check-type data json-plist)
(jupyter-request "comm_open"
:comm_id id :target_name target-name :data data)))
(cl-defun jupyter-comm-msg (&key id data (handlers t))
(jupyter-with-client-handlers handlers
(cl-check-type id string)
(cl-check-type data json-plist)
(jupyter-request "comm_msg"
:comm_id id :data data)))
(cl-defun jupyter-comm-close (&key id data (handlers t))
(jupyter-with-client-handlers handlers
(cl-check-type id string)
(cl-check-type data json-plist)
(jupyter-request "comm_close"
:comm_id id :data data)))
(cl-defun jupyter-shutdown-request (&key restart (handlers t))
(jupyter-with-client-handlers handlers
(jupyter-request "shutdown_request"
:restart (if restart t jupyter--false))))
;;; Convenience functions and macros
(defmacro jupyter-with-message-content (msg keys &rest body)
"For MSG, bind the corresponding KEYS of its contents then evaluate BODY.
KEYS is a list of key names found in the
`jupyter-message-content' of MSG. The values are bound to their
key names while evaluating BODY.
So to bind the :status key of MSG you would do
(jupyter-with-message-content msg (status)
BODY)"
(declare (indent 2) (debug (form listp body)))
(if keys
`(cl-destructuring-bind (&key ,@keys &allow-other-keys)
(jupyter-message-content ,msg)
,@body)
`(progn ,@body)))
(defmacro jupyter-with-message-data (msg varlist &rest body)
"For MSG, bind the mimetypes in VARLIST and evaluate BODY.
VARLIST has a similar form to the VARLIST of a `let' binding
except the `cadr' of each binding is a mimetype that will be
passed to `jupyter-message-data'.
So to bind the :text/plain mimetype of MSG to a variable, res,
you would do
(jupyter-with-message-data msg ((res text/plain))
BODY)"
(declare (indent 2) (debug (form (&rest (symbolp symbolp)) body)))
(let* ((m (make-symbol "msg"))
(vars
(mapcar (lambda (el)
(list (car el)
`(jupyter-message-data
,m ',(if (keywordp (cadr el)) (cadr el)
(intern (concat ":" (symbol-name (cadr el))))))))
varlist)))
(if vars `(let* ((,m ,msg) ,@vars)
,@body)
`(progn ,@body))))
(defmacro jupyter-message-lambda (keys &rest body)
"Return a function binding KEYS to fields of a message then evaluating BODY.
The returned function takes a single argument which is expected
to be a Jupyter message property list.
The elements of KEYS can either be a symbol, KEY, or a two
element list (VAL MIMETYPE). In the former case, KEY will be
bound to the corresponding value of KEY in the
`jupyter-message-content' of the message argument. In the latter
case, VAL will be bound to the value of the MIMETYPE found in the
`jupyter-message-data' of the message."
(declare (indent defun) (debug ((&rest [&or symbolp (symbolp symbolp)]) body)))
(let ((msg (cl-gensym "msg"))
content-keys
data-keys)
(while (car keys)
(let ((key (pop keys)))
(push key (if (listp key) data-keys content-keys))))
`(lambda (,msg)
,(cond
((and data-keys content-keys)
`(jupyter-with-message-content ,msg ,content-keys
(jupyter-with-message-data ,msg ,data-keys
,@body)))
(data-keys
`(jupyter-with-message-data ,msg ,data-keys
,@body))
(content-keys
`(jupyter-with-message-content ,msg ,content-keys
,@body))
(t
`(progn ,@body))))))
(defmacro jupyter--decode-message-part (key msg)
"Return a form to decode the value of KEY in MSG.
If the value of KEY is a list whose first element is the symbol
`message-part', then if the the third element of the list is nil
set it to the result of calling `jupyter--decode' on the second
element. If the third element is non-nil, return it. Otherwise
return the value of KEY in MSG."
`(let ((part (plist-get ,msg ,key)))
(if (and (consp part) (eq (car part) 'message-part))
(or (nth 2 part) (jupyter--decode part))
part)))
(defun jupyter-message-header (msg)
"Get the header of MSG."
(jupyter--decode-message-part :header msg))
(defun jupyter-message-parent-header (msg)
"Get the parent header of MSG."
(jupyter--decode-message-part :parent_header msg))
(defun jupyter-message-metadata (msg)
"Get the metadata key of MSG."
(jupyter--decode-message-part :metadata msg))
(defun jupyter-message-content (msg)
"Get the MSG contents."
(jupyter--decode-message-part :content msg))
(defsubst jupyter-message-id (msg)
"Get the ID of MSG."
(or (plist-get msg :msg_id)
(plist-get (jupyter-message-header msg) :msg_id)))
(defsubst jupyter-message-parent-id (msg)
"Get the parent ID of MSG."
(jupyter-message-id (jupyter-message-parent-header msg)))
(defsubst jupyter-message-type (msg)
"Get the type of MSG."
(or (plist-get msg :msg_type)
(plist-get (jupyter-message-header msg) :msg_type)))
(defsubst jupyter-message-session (msg)
"Get the session ID of MSG."
(plist-get (jupyter-message-header msg) :session))
(defsubst jupyter-message-parent-type (msg)
"Get the type of MSG's parent message."
(jupyter-message-type (jupyter-message-parent-header msg)))
(defun jupyter-message-time (msg)
"Get the MSG time.
The returned time has the same form as returned by
`current-time'."
(let* ((header (jupyter-message-header msg))
(date (plist-member header :data)))
(when (stringp (car date))
(setcar date (jupyter-decode-time (car date))))
(car date)))
(defsubst jupyter-message-get (msg key)
"Get the value in MSG's `jupyter-message-content' that corresponds to KEY."
(plist-get (jupyter-message-content msg) key))
(defsubst jupyter-message-data (msg mimetype)
"Get the message data for a specific mimetype.
MSG should be a message with a `:data' field in its contents.
MIMETYPE is should be a standard media mimetype
keyword (`:text/plain', `:image/png', ...). If the messages data
has a key corresponding to MIMETYPE, return the value. Otherwise
return nil."
(plist-get (jupyter-message-get msg :data) mimetype))
(defsubst jupyter-message-status-idle-p (msg)
"Determine if MSG is a status: idle message."
(and (string= (jupyter-message-type msg) "status")
(string= (jupyter-message-get msg :execution_state) "idle")))
(defun jupyter-message-status-starting-p (msg)
"Determine if MSG is a status: starting message."
(and (string= (jupyter-message-type msg) "status")
(string= (jupyter-message-get msg :execution_state) "starting")))
(provide 'jupyter-messages)
;;; jupyter-messages.el ends here

671
lisp/jupyter/jupyter-mime.el Normal file
View File

@@ -0,0 +1,671 @@
;;; jupyter-mime.el --- Insert mime types -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 09 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:
;; Routines for working with MIME types.
;; Also adds the following methods which may be extended:
;;
;; - jupyter-markdown-follow-link
;; - jupyter-insert
;;
;; For working with display IDs, currently rudimentary
;;
;; - jupyter-current-display
;; - jupyter-beginning-of-display
;; - jupyter-end-of-display
;; - jupyter-next-display-with-id
;; - jupyter-delete-current-display
;; - jupyter-update-display
;;; Code:
(require 'jupyter-base)
(require 'shr)
(require 'ansi-color)
(declare-function jupyter-message-content "jupyter-messages" (msg))
(declare-function org-format-latex "org" (prefix &optional beg end dir overlays msg forbuffer processing-type))
(declare-function markdown-link-at-pos "ext:markdown-mode" (pos))
(declare-function markdown-follow-link-at-point "ext:markdown-mode")
;;; User variables
(defcustom jupyter-image-max-width 0
"Maximum width of images in REPL.
Wider images are resized. Special value 0 means no limit."
:type 'integer
:group 'jupyter-repl)
;;; Implementation
(defvar-local jupyter-display-ids nil
"A hash table of display IDs.
Display IDs are implemented by setting the text property,
`jupyter-display', to the display ID requested by a
`:display-data' message. When a display is updated from an
`:update-display-data' message, the display ID from the initial
`:display-data' message is retrieved from this table and used to
find the display in the REPL buffer. See
`jupyter-update-display'.")
;;; Macros
;; Taken from `eshell-handle-control-codes'
(defun jupyter-handle-control-codes (beg end)
"Handle any control sequences between BEG and END."
(save-excursion
(goto-char beg)
(while (< (point) end)
(let ((char (char-after)))
(cond
((eq char ?\r)
(if (< (1+ (point)) end)
(if (memq (char-after (1+ (point)))
'(?\n ?\r))
(delete-char 1)
(let ((end (1+ (point))))
(beginning-of-line)
(delete-region (point) end)))
(add-text-properties (point) (1+ (point))
'(invisible t))
(forward-char)))
((eq char ?\a)
(delete-char 1)
(beep))
((eq char ?\C-h)
(delete-region (1- (point)) (1+ (point))))
(t
(forward-char)))))))
(defmacro jupyter-with-control-code-handling (&rest body)
"Handle control codes in any produced output generated by evaluating BODY.
After BODY is evaluated, call `jupyter-handle-control-codes'
on the region inserted by BODY."
(let ((beg (make-symbol "beg"))
(end (make-symbol "end")))
`(jupyter-with-insertion-bounds
,beg ,end (progn ,@body)
;; Handle continuation from previous messages
(when (eq (char-before ,beg) ?\r)
(move-marker ,beg (1- ,beg)))
(jupyter-handle-control-codes ,beg ,end))))
;;; Fontificiation routines
(defun jupyter-fontify-buffer-name (mode)
"Return the buffer name for fontifying MODE."
(format " *jupyter-fontify[%s]*" mode))
(defun jupyter-fontify-buffer (mode)
"Return the buffer used to fontify text for MODE.
Retrieve the buffer for MODE from `jupyter-fontify-buffers'.
If no buffer for MODE exists, create a new one."
(let ((buf (get-buffer-create (jupyter-fontify-buffer-name mode))))
(with-current-buffer buf
(unless (eq major-mode mode)
(delay-mode-hooks (funcall mode))))
buf))
(defun jupyter-fixup-font-lock-properties (beg end &optional object)
"Fixup the text properties in the `current-buffer' between BEG END.
If OBJECT is non-nil, fixup the text properties of OBJECT. Fixing
the text properties involves substituting any `face' property
with `font-lock-face'."
(let ((next beg) val)
(while (/= beg end)
(setq val (get-text-property beg 'face object)
next (next-single-property-change beg 'face object end))
(remove-text-properties beg next '(face) object)
(put-text-property beg next 'font-lock-face (or val 'default) object)
(setq beg next))))
(defun jupyter-add-font-lock-properties (start end &optional object use-face)
"Add font lock text properties between START and END in the `current-buffer'.
START, END, and OBJECT have the same meaning as in
`add-text-properties'. The properties added are the ones that
mark the text between START and END as fontified according to
font lock. Any text between START and END that does not have a
font-lock-face property will have the default face filled in for
the property and the face text property is swapped for
font-lock-face.
If USE-FACE is non-nil, do not replace the face text property
with font-lock-face."
(unless use-face
(jupyter-fixup-font-lock-properties start end object))
(add-text-properties start end '(fontified t font-lock-fontified t) object))
(defun jupyter-fontify-according-to-mode (mode str &optional use-face)
"Fontify a string according to MODE.
Return the fontified string. In addition to fontifying STR, if
MODE has a non-default `fill-forward-paragraph-function', STR
will be filled using `fill-region'.
If USE-FACE is non-nil, do not replace the face text property
with font-lock-face in the returned string."
(with-current-buffer (jupyter-fontify-buffer mode)
(erase-buffer)
(insert str)
(font-lock-ensure)
(jupyter-add-font-lock-properties (point-min) (point-max) nil use-face)
(when (not (memq fill-forward-paragraph-function
'(forward-paragraph)))
(fill-region (point-min) (point-max) t 'nosqueeze))
(buffer-string)))
(defun jupyter-fontify-region-according-to-mode (mode beg end)
"Fontify a region according to MODE.
Fontify the region between BEG and END in the current buffer
according to MODE. This works by creating a new indirect buffer,
enabling MODE in the new buffer, ensuring the region is font
locked, adding required text properties, and finally re-enabling
the `major-mode' that was current before the call to this
function."
(let ((restore-mode major-mode))
(with-current-buffer
(make-indirect-buffer
(current-buffer) (generate-new-buffer-name
(jupyter-fontify-buffer-name mode)))
(unwind-protect
(save-restriction
(narrow-to-region beg end)
(delay-mode-hooks (funcall mode))
(font-lock-ensure)
(jupyter-fixup-font-lock-properties beg end))
(kill-buffer)))
(funcall restore-mode)))
;;; Special handling of ANSI sequences
(defun jupyter-ansi-color-apply-on-region (begin end &optional face-prop)
"`ansi-color-apply-on-region' with Jupyter specific modifications.
In particular, does not delete escape sequences between BEGIN and
END from the buffer. Instead, an invisible text property with a
value of t is added to render the escape sequences invisible.
Also, the `ansi-color-apply-face-function' is hard-coded to a
custom function that prepends to the face property of the text
and also sets the FACE-PROP to the prepended face, if FACE-PROP
is nil it defaults to `font-lock-face'.
For convenience, a jupyter-invisible property is also added with
a value of t. This is mainly for modes like `org-mode' which
strip invisible properties during fontification. In such cases,
the jupyter-invisible property can act as an alias to the
invisible property by adding it to `char-property-alias-alist'."
(cl-letf (((symbol-function #'delete-region)
(lambda (beg end)
(add-text-properties beg end '(invisible t jupyter-invisible t))))
(ansi-color-apply-face-function
(lambda (beg end face)
(when face
(setq face (list face))
(font-lock-prepend-text-property beg end 'face face)
(put-text-property beg end (or face-prop 'font-lock-face) face)))))
(ansi-color-apply-on-region begin end)))
;;; `jupyter-insert' method
(cl-defgeneric jupyter-insert (_mime _data &optional _metadata)
"Insert MIME data in the current buffer.
Additions to this method should insert DATA assuming it has a
mime type of MIME. If METADATA is non-nil, it will be a property
list containing extra properties for inserting DATA such as
:width and :height for image mime types.
If MIME is considered handled, but does not insert anything in
the current buffer, return a non-nil value to indicate that MIME
has been handled."
(ignore))
(cl-defmethod jupyter-insert ((plist cons) &optional metadata)
"Insert the content contained in PLIST.
PLIST should be a property list that contains the key :data and
optionally the key :metadata. The value of :data shall be another
property list that contains MIME types as keys and their
representations as values. Alternatively, PLIST can be a full
message property list or be a property list that itself contains
mimetypes.
For each MIME type in `jupyter-mime-types' call
(jupyter-insert MIME (plist-get data MIME) (plist-get metadata MIME))
until one of the invocations inserts text into the current
buffer (tested by comparisons with `buffer-modified-tick') or
returns a non-nil value. When either of these cases occur, return
MIME.
Note on non-graphic displays, `jupyter-nongraphic-mime-types' is
used instead of `jupyter-mime-types'.
When no valid mimetype is present, a warning is shown and nil is
returned."
(cl-assert plist json-plist)
(let ((content (jupyter-normalize-data plist metadata)))
(cond
((let ((tick (buffer-modified-tick)))
(jupyter-map-mime-bundle (if (display-graphic-p) jupyter-mime-types
jupyter-nongraphic-mime-types)
content
(lambda (mime content)
(and (or (jupyter-insert
mime (plist-get content :data)
(plist-get content :metadata))
(/= tick (buffer-modified-tick)))
mime)))))
(t
(prog1 nil
(let ((warning
(format "No valid mimetype found: %s"
(cl-loop for (k _v) on (plist-get content :data)
by #'cddr collect k))))
(display-warning 'jupyter warning)))))))
;;; HTML
(defun jupyter--shr-put-image (spec alt &optional flags)
"Identical to `shr-put-image', but ensure :ascent is 50.
SPEC, ALT and FLAGS have the same meaning as in `shr-put-image'.
The :ascent of an image is set to 50 so that the image center
aligns on the current line."
(let ((image (shr-put-image spec alt flags)))
(prog1 image
(when image
;; Ensure we use an ascent of 50 so that the image center aligns with
;; the output prompt of a REPL buffer.
(setf (image-property image :ascent) 50)
(force-window-update)))))
(defun jupyter-browse-url-in-temp-file (data)
"Insert DATA into a temp file and call `browse-url-of-file' on it."
(let* ((secs (time-to-seconds))
;; Allow showing the same DATA, but only after a 10s period. This is
;; so that the same data doesn't get displayed multiple times very
;; quickly. See #121.
(secs (- secs (cl-rem secs 10)))
(hash (sha1 (concat data (format-time-string "%H%M%S" secs))))
(file (expand-file-name
(concat "emacs-jupyter-" hash ".html")
temporary-file-directory)))
(unless (file-exists-p file)
(with-temp-file file (insert data))
(browse-url-of-file file)
;; Give the external browser time to open the tmp file before deleting it
;; based on mm-display-external
(run-at-time
60 nil
(lambda ()
(ignore-errors (delete-file file)))))))
(defun jupyter--delete-script-tags (beg end)
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char beg)
(while (re-search-forward "<script[^>]*>" nil t)
(delete-region
(match-beginning 0)
(if (re-search-forward "</script>" nil t)
(point)
(point-max)))))))
(defun jupyter-insert-html (html)
"Parse and insert the HTML string using `shr'."
(jupyter-with-insertion-bounds
beg end (insert html)
;; TODO: We can't really do much about javascript so
;; delete those regions instead of trying to parse
;; them. Maybe just re-direct to a browser like with
;; widgets?
;; NOTE: Parsing takes a very long time when the text
;; is > ~500000 characters.
(jupyter--delete-script-tags beg end)
(let ((shr-put-image-function #'jupyter--shr-put-image)
;; Avoid issues with proportional fonts. Sometimes not all of the
;; text is rendered using proportional fonts. See #52.
(shr-use-fonts nil))
(if (save-excursion
(goto-char beg)
(looking-at "<\\?xml"))
;; Be strict about syntax when the html returned explicitly asks to
;; be parsed as xml. `libxml-parse-html-region' converts camel cased
;; tags/attributes such as viewBox to viewbox in the dom since html
;; is case insensitive. See #4.
(cl-letf (((symbol-function #'libxml-parse-html-region)
#'libxml-parse-xml-region))
(shr-render-region beg end))
(shr-render-region beg end)))
(jupyter-add-font-lock-properties beg end)))
;;; Markdown
(defvar markdown-hide-markup)
(defvar markdown-enable-math)
(defvar markdown-hide-urls)
(defvar markdown-fontify-code-blocks-natively)
(defvar markdown-mode-mouse-map)
(defvar jupyter-markdown-mouse-map
(let ((map (make-sparse-keymap)))
(define-key map [return] 'jupyter-markdown-follow-link-at-point)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'jupyter-markdown-follow-link-at-point)
map)
"Keymap when `point' is over a markdown link in the REPL buffer.")
(cl-defgeneric jupyter-markdown-follow-link (_link-text _url _ref-label _title-text _bang)
"Follow the markdown link at `point'."
(markdown-follow-link-at-point))
(defun jupyter-markdown-follow-link-at-point ()
"Handle markdown links specially."
(interactive)
(let ((link (markdown-link-at-pos (point))))
(when (car link)
(apply #'jupyter-markdown-follow-link (cddr link)))))
(defun jupyter-insert-markdown (text)
"Insert TEXT, fontifying it using `markdown-mode' first."
(let ((beg (point)))
(insert
(let ((markdown-hide-markup t)
(markdown-hide-urls t)
(markdown-enable-math t)
(markdown-fontify-code-blocks-natively t))
(jupyter-fontify-according-to-mode 'markdown-mode text)))
;; Update keymaps
(let ((end (point)) next)
(setq beg (next-single-property-change beg 'keymap nil end))
(while (/= beg end)
(setq next (next-single-property-change beg 'keymap nil end))
(when (eq (get-text-property beg 'keymap) markdown-mode-mouse-map)
(put-text-property beg next 'keymap jupyter-markdown-mouse-map))
(setq beg next)))))
;;; LaTeX
(defvar org-format-latex-options)
(defvar org-preview-latex-image-directory)
(defvar org-babel-jupyter-resource-directory)
(defvar org-preview-latex-default-process)
(defun jupyter-insert-latex (tex)
"Generate and insert a LaTeX image based on TEX.
Note that this uses `org-format-latex' to generate the LaTeX
image."
;; FIXME: Getting a weird error when killing the temp buffers created by
;; `org-format-latex'. When generating the image, it seems that the temp
;; buffers created have the same major mode and local variables as the REPL
;; buffer which causes the query function to ask to kill the kernel client
;; when the temp buffers are killed!
(let ((kill-buffer-query-functions nil)
;; This is added to in `org-babel-jupyter-initiate-session-by-key'
(kill-buffer-hook nil)
(org-format-latex-options
`(:foreground
default
:background default :scale 2.0
:matchers ,(plist-get org-format-latex-options :matchers))))
(jupyter-with-insertion-bounds
beg end (insert tex)
;; FIXME: Best way to cleanup these files? Just delete them by reading
;; the image data and using that for the image instead?
(org-format-latex
"ltximg" beg end org-babel-jupyter-resource-directory
'overlays nil 'forbuffer
;; Use the default method for creating image files
org-preview-latex-default-process)
;; Avoid deleting the image overlays due to text property changes
(dolist (o (overlays-in beg end))
(when (eq (overlay-get o 'org-overlay-type)
'org-latex-overlay)
(overlay-put o 'modification-hooks nil)))
(overlay-recenter end)
(goto-char end))))
;;; Images
(defun jupyter-insert-image (data type &optional metadata)
"Insert image DATA as TYPE in the current buffer.
TYPE has the same meaning as in `create-image'. METADATA is a
plist containing :width and :height keys that will be used as the
width and height of the image."
(cl-destructuring-bind (&key width height needs_background &allow-other-keys)
metadata
(let ((img (create-image
data type 'data :width width :height height
:max-width (when (> jupyter-image-max-width 0)
jupyter-image-max-width)
:mask (when needs_background
'(heuristic t)))))
(insert-image img))))
;;; Plain text
(defun jupyter-insert-ansi-coded-text (text)
"Insert TEXT, converting ANSI color codes to font lock faces."
(jupyter-with-insertion-bounds
beg end (insert (ansi-color-apply text))
(jupyter-fixup-font-lock-properties beg end)))
;;; `jupyter-insert' method additions
(cl-defmethod jupyter-insert ((_mime (eql :text/html)) data
&optional _metadata)
(if (not (functionp 'libxml-parse-html-region))
(cl-call-next-method)
(jupyter-insert-html data)
(insert "\n")))
(cl-defmethod jupyter-insert ((_mime (eql :text/markdown)) data
&context ((require 'markdown-mode nil t)
(eql markdown-mode))
&optional _metadata)
(jupyter-insert-markdown data))
(cl-defmethod jupyter-insert ((_mime (eql :text/latex)) data
&context ((require 'org nil t)
(eql org))
&optional _metadata)
(jupyter-insert-latex data)
(insert "\n"))
(cl-defmethod jupyter-insert ((_mime (eql :image/svg+xml)) data
&context ((and (image-type-available-p 'svg) t)
(eql t))
&optional metadata)
(jupyter-insert-image data 'svg metadata)
(insert "\n"))
(cl-defmethod jupyter-insert ((_mime (eql :image/jpeg)) data
&context ((and (image-type-available-p 'jpeg) t)
(eql t))
&optional metadata)
(jupyter-insert-image (base64-decode-string data) 'jpeg metadata)
(insert "\n"))
(cl-defmethod jupyter-insert ((_mime (eql :image/png)) data
&context ((and (image-type-available-p 'png) t)
(eql t))
&optional metadata)
(jupyter-insert-image (base64-decode-string data) 'png metadata)
(insert "\n"))
(cl-defmethod jupyter-insert ((_mime (eql :text/plain)) data
&optional _metadata)
;; Reset the context so that it doesn't leak into DATA if DATA has
;; no ANSI sequences.
(setq ansi-color-context nil)
(jupyter-insert-ansi-coded-text data)
(insert "\n"))
;;; Insert with display IDs
(cl-defmethod jupyter-insert :before ((_display-id string) &rest _ignore)
"Initialize `juptyer-display-ids'"
;; FIXME: Set the local display ID hash table for the current buffer, or
;; should display IDs be global? Then we would have to associate marker
;; positions as well in this table.
(unless jupyter-display-ids
(setq jupyter-display-ids (make-hash-table
:test #'equal
:weakness 'value))))
(cl-defmethod jupyter-insert ((display-id string) data &optional metadata)
"Associate DISPLAY-ID with DATA when inserting DATA.
DATA and METADATA have the same meaning as in
`jupyter-insert'.
The default implementation adds a jupyter-display text property
to any inserted text and a jupyter-display-begin property to the
first character.
Currently there is no support for associating a DISPLAY-ID if
DATA is displayed as a widget."
(jupyter-with-insertion-bounds
beg end (jupyter-insert data metadata)
;; Don't add display IDs to widgets since those are currently implemented
;; using an external browser and not in the current buffer.
(when (and (not (memq :application/vnd.jupyter.widget-view+json data))
(< beg end))
(let ((id (gethash display-id jupyter-display-ids)))
(unless id
(setq id (puthash display-id display-id jupyter-display-ids)))
(put-text-property beg end 'jupyter-display id)
(put-text-property beg (1+ beg) 'jupyter-display-begin t)))))
(cl-defgeneric jupyter-current-display ()
"Return the display ID for the display at `point'.
The default implementation returns the jupyter-display text
property at `point'."
(get-text-property (point) 'jupyter-display))
(cl-defgeneric jupyter-beginning-of-display ()
"Go to the beginning of the current Jupyter display.
The default implementation moves `point' to the position of the
character with a jupyter-display-begin property. If `point' is
already at a character with such a property, then `point' is
returned."
(if (get-text-property (point) 'jupyter-display-begin) (point)
(goto-char
(previous-single-property-change
(point) 'jupyter-display-begin nil (point-min)))))
(cl-defgeneric jupyter-end-of-display ()
"Go to the end of the current Jupyter display."
(goto-char
(min (next-single-property-change
(point) 'jupyter-display nil (point-max))
(next-single-property-change
(min (1+ (point)) (point-max))
'jupyter-display-begin nil (point-max)))))
(cl-defgeneric jupyter-next-display-with-id (id)
"Go to the start of the next display matching ID.
Return non-nil if successful. If no display with ID is found,
return nil without moving `point'.
The default implementation searches the current buffer for text
with a jupyter-display text property matching ID."
(or (and (bobp) (eq id (get-text-property (point) 'jupyter-display)))
(let ((pos (next-single-property-change (point) 'jupyter-display-begin)))
(while (and pos (not (eq (get-text-property pos 'jupyter-display) id)))
(setq pos (next-single-property-change pos 'jupyter-display-begin)))
(and pos (goto-char pos)))))
(cl-defgeneric jupyter-delete-current-display ()
"Delete the current Jupyter display.
The default implementation checks if `point' has a non-nil
jupyter-display text property, if so, it deletes the surrounding
region around `point' containing that same jupyter-display
property."
(when (jupyter-current-display)
(delete-region
(save-excursion (jupyter-beginning-of-display) (point))
(save-excursion (jupyter-end-of-display) (point)))))
(cl-defmethod jupyter-update-display ((display-id string) data &optional metadata)
"Update the display with DISPLAY-ID using DATA.
DATA and METADATA have the same meaning as in a `:display-data'
message."
(let ((id (and jupyter-display-ids
(gethash display-id jupyter-display-ids))))
(unless id
(error "Display ID not found (%s)" display-id))
(save-excursion
(goto-char (point-min))
(let (bounds)
(while (jupyter-next-display-with-id id)
(jupyter-delete-current-display)
(jupyter-with-insertion-bounds
beg end (if bounds (insert-buffer-substring
(current-buffer) (car bounds) (cdr bounds))
(jupyter-insert id data metadata))
(unless bounds
(setq bounds (cons (copy-marker beg) (copy-marker end))))
(pulse-momentary-highlight-region beg end 'secondary-selection)))
(when bounds
(set-marker (car bounds) nil)
(set-marker (cdr bounds) nil)))
(when (= (point) (point-min))
(error "No display matching id (%s)" id)))))
;;; Pandoc
(defun jupyter-pandoc-convert (from to from-string &optional callback)
"Use pandoc to convert a string in FROM format to TO format.
Starts a process and converts FROM-STRING, assumed to be in FROM
format, to a string in TO format and returns the converted
string.
If CALLBACK is specified, return the process object. When the
process exits, call CALLBACK with zero arguments and with the
buffer containing the converted string current."
(cl-assert (executable-find "pandoc"))
(let* ((process-connection-type nil)
(proc (start-process
"jupyter-pandoc"
(generate-new-buffer " *jupyter-pandoc*")
"pandoc" "-f" from "-t" to "--")))
(set-process-sentinel
proc (lambda (proc _)
(when (memq (process-status proc) '(exit signal))
(with-current-buffer (process-buffer proc)
(funcall callback)
(kill-buffer (process-buffer proc))))))
(process-send-string proc from-string)
(process-send-eof proc)
(if callback proc
(let ((to-string ""))
(setq callback (lambda () (setq to-string (buffer-string))))
(while (zerop (length to-string))
(accept-process-output nil 1))
to-string))))
(provide 'jupyter-mime)
;;; jupyter-mime.el ends here

494
lisp/jupyter/jupyter-monads.el Normal file
View File

@@ -0,0 +1,494 @@
;;; jupyter-monads.el --- Monadic Jupyter -*- lexical-binding: t -*-
;; Copyright (C) 2020-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 11 May 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:
;; TODO: Generalize `jupyter-with-io' and `jupyter-do' for any monad,
;; not just the I/O one.
;;
;; TODO: Allow pcase patterns in mlet*
;;
;; (jupyter-mlet* ((value (jupyter-server-kernel-io kernel)))
;; (pcase-let ((`(,kernel-sub ,event-pub) value))
;; ...))
;;
;; into
;;
;; (jupyter-mlet* ((`(,kernel-sub ,event-pub)
;; (jupyter-server-kernel-io kernel)))
;; ...)
;;; Code:
(require 'jupyter-base)
(require 'thunk)
(declare-function jupyter-handle-message "jupyter-client")
(declare-function jupyter-kernel-io "jupyter-client")
(declare-function jupyter-generate-request "jupyter-client")
(declare-function jupyter-wait-until-idle "jupyter-client" (req &optional timeout progress-msg))
(defgroup jupyter-monads nil
"Monadic Jupyter"
:group 'jupyter)
(defconst jupyter--return-nil (lambda (state) (cons nil state)))
(defun jupyter-return (value)
"Return a monadic value wrapping VALUE."
(declare (indent 0)
(compiler-macro
(lambda (exp)
(cond
((null value)
'jupyter--return-nil)
((if (atom value)
(not (symbolp value))
(eq (car value) 'quote))
`(lambda (state) (cons ,value state)))
(t exp)))))
(lambda (state) (cons value state)))
(defun jupyter-get-state ()
"Return a monadic valid whose unwrapped value is the current state."
(lambda (state) (cons state state)))
(defun jupyter-put-state (value)
"Return a monadic value that sets the current state to VALUE.
The unwrapped value is nil."
(lambda (_state) (cons nil value)))
(defun jupyter-bind (mvalue mfn)
"Bind MVALUE to MFN."
(declare (indent 1))
(lambda (state)
(pcase-let* ((`(,value . ,state) (funcall mvalue state)))
(funcall (funcall mfn value) state))))
(defmacro jupyter-mlet* (varlist &rest body)
"Bind the monadic values in VARLIST, evaluate BODY.
Return the result of evaluating BODY. The result of evaluating
BODY should be another monadic value."
(declare (indent 1) (debug ((&rest (symbolp form)) body)))
(if (null varlist)
(if (zerop (length body)) 'jupyter--return-nil
`(progn ,@body))
(pcase-let ((`(,name ,mvalue) (car varlist)))
`(jupyter-bind ,mvalue
(lambda (,name)
(jupyter-mlet* ,(cdr varlist)
,@body))))))
(defmacro jupyter-do (&rest actions)
"Return a monadic value that performs all actions in ACTIONS.
The actions are evaluated in the order given. The result of the
returned action is the result of the last action in ACTIONS."
(declare (indent 0) (debug (body)))
(if (zerop (length actions)) 'jupyter--return-nil
(let ((result (make-symbol "result")))
`(jupyter-mlet*
,(cl-loop
for action being the elements of actions using (index i)
for sym = (if (= i (1- (length actions))) result '_)
collect `(,sym ,action))
(jupyter-return ,result)))))
(defun jupyter-run-with-state (state mvalue)
"Pass STATE as the state to MVALUE, return the resulting value."
(declare (indent 1))
;; Discard the final state
(car (funcall mvalue state)))
(defmacro jupyter-run-with-io (io &rest body)
"Return the result of evaluating the I/O value BODY evaluates to.
All I/O operations are done in the context of IO."
(declare (indent 1) (debug (form body)))
`(jupyter-run-with-state ,io (progn ,@body)))
(defmacro jupyter-run-with-client (client &rest body)
"Return the result of evaluating the monadic value BODY evaluates to.
The initial state given to the monadic value is CLIENT."
(declare (indent 1) (debug (form body)))
`(jupyter-run-with-state ,client (progn ,@body)))
(defmacro jupyter-with-io (io &rest body)
"Return an I/O action evaluating BODY in IO's context.
The result of the returned action is the result of the I/O action
BODY evaluates to."
(declare (indent 1) (debug (form body)))
`(lambda (_)
(jupyter-run-with-io ,io ,@body)))
;;; Publisher/subscriber
(define-error 'jupyter-subscribed-subscriber
"A subscriber cannot be subscribed to.")
(defun jupyter-subscriber (sub-fn)
"Return a subscriber evaluating SUB-FN on published content.
SUB-FN should return the result of evaluating
`jupyter-unsubscribe' if the subscriber's subscription should be
canceled.
Ex. Unsubscribe after consuming one message
(jupyter-subscriber
(lambda (value)
(message \"The published content: %s\" value)
(jupyter-unsubscribe)))
Used like this, where sub is the above subscriber:
(jupyter-run-with-io (jupyter-publisher)
(jupyter-subscribe sub)
(jupyter-publish (list \='topic \"today's news\")))"
(declare (indent 0))
(lambda (sub-content)
(pcase sub-content
(`(content ,content) (funcall sub-fn content))
(`(subscribe ,_) (signal 'jupyter-subscribed-subscriber nil))
(_ (error "Unhandled subscriber content: %s" sub-content)))))
(defun jupyter-content (value)
"Arrange for VALUE to be sent to subscribers of a publisher."
(list 'content value))
(defsubst jupyter-unsubscribe ()
"Arrange for the current subscription to be canceled.
A subscriber (or publisher with a subscription) can return the
result of this function to cancel its subscription with the
publisher providing content."
(list 'unsubscribe))
(define-error 'jupyter-publisher-subscribers-had-errors
"Publisher's subscribers had errors")
(defun jupyter-pseudo-bind-content (pub-fn content subs)
"Apply PUB-FN on submitted CONTENT to produce published content.
Call each subscriber in SUBS on the published content. Remove
those subscribers that cancel their subscription.
When a subscriber signals an error it is noted and the remaining
subscribers are processed. After processing all subscribers, a
`jupyter-publisher-errors' error is raised with the data being
the list of errors raised when calling subscribers. Note, when a
subscriber errors, it remains in the list of subscribers."
(pcase (funcall pub-fn content)
((and `(content ,_) sub-content)
;; NOTE: The first element of SUBS is ignored here so that the
;; pointer to the subscriber list remains the same for each
;; publisher, even when subscribers are being destructively
;; removed.
(let ((errors nil))
(while (cadr subs)
(condition-case err
;; Publish subscriber content to subscribers
(pcase (funcall (cadr subs) sub-content)
;; Destructively remove the subscriber when it returns an
;; unsubscribe value.
('(unsubscribe) (setcdr subs (cddr subs)))
(_ (pop subs)))
(error
;; Skip over any subscribers that raised an error.
(pop subs)
(push err errors))))
;; Inform about the errors.
(when errors
(signal 'jupyter-publisher-subscribers-had-errors errors)))
nil)
;; Cancel a publisher's subscription to another publisher.
('(unsubscribe) '(unsubscribe))
(_ nil)))
(defun jupyter-publisher (&optional pub-fn)
"Return a publisher function.
A publisher function is a closure, function with a local scope,
that maintains a list of subscribers and distributes the content
that PUB-FN returns to each of them.
PUB-FN is a function that optionally returns content to
publish (by returning the result of `jupyter-content' on a
value). It's called when a value is submitted for publishing
using `jupyter-publish', like this:
(let ((pub (jupyter-publisher
(lambda (submitted-value)
(message \"Publishing %s to subscribers\" submitted-value)
(jupyter-content submitted-value)))))
(jupyter-run-with-io pub
(jupyter-publish (list 1 2 3))))
The default for PUB-FN is `jupyter-content'. See
`jupyter-subscribe' for an example on how to subscribe to a
publisher.
If no content is returned by PUB-FN, no content is sent to
subscribers.
A publisher can also be a subscriber of another publisher. In
this case, if PUB-FN returns the result of `jupyter-unsubscribe'
its subscription is canceled.
Ex. Publish the value 1 regardless of what is given to PUB-FN.
(jupyter-publisher
(lambda (_)
(jupyter-content 1)))
Ex. Publish \='app if \='app is given to a publisher, nothing is sent
to subscribers otherwise. In this case, a publisher is a
filter of the value given to it for publishing.
(jupyter-publisher
(lambda (value)
(if (eq value \='app)
(jupyter-content value))))"
(declare (indent 0))
(let ((subs (list 'subscribers))
(pub-fn (or pub-fn #'jupyter-content)))
;; A publisher value is either a value representing a subscriber
;; or a value representing content to send to subscribers.
(lambda (pub-value)
(pcase (car-safe pub-value)
('content (jupyter-pseudo-bind-content pub-fn (cadr pub-value) subs))
('subscribe (cl-pushnew (cadr pub-value) (cdr subs)))
(_ (error "Unhandled publisher content: %s" pub-value))))))
(defun jupyter-subscribe (sub)
"Return an I/O action that subscribes SUB to published content.
If a subscriber (or a publisher with a subscription to another
publisher) returns the result of `jupyter-unsubscribe', its
subscription is canceled.
Ex. Subscribe to a publisher and unsubscribe after receiving two
messages.
(let* ((msgs \='())
(pub (jupyter-publisher))
(sub (jupyter-subscriber
(lambda (n)
(if (> n 2) (jupyter-unsubscribe)
(push n msgs))))))
(jupyter-run-with-io pub
(jupyter-subscribe sub))
(cl-loop
for x in \='(1 2 3)
do (jupyter-run-with-io pub
(jupyter-publish x)))
(reverse msgs)) ; => \='(1 2)"
(declare (indent 0))
(lambda (io)
(funcall io (list 'subscribe sub))
(cons nil io)))
(defun jupyter-publish (value)
"Return an I/O action that submits VALUE to publish as content."
(declare (indent 0))
(lambda (io)
(funcall io (jupyter-content value))
(cons nil io)))
;;; Working with requests
(define-error 'jupyter-timeout-before-idle "Timeout before idle")
(defun jupyter-sent (dreq)
(jupyter-mlet* ((client (jupyter-get-state))
(req dreq))
(let ((type (jupyter-request-type req)))
(jupyter-run-with-io (jupyter-kernel-io client)
(jupyter-do
(jupyter-subscribe (jupyter-request-message-publisher req))
(jupyter-publish
(list 'send
(jupyter-channel-from-request-type type)
type
(jupyter-request-content req)
(jupyter-request-id req))))))
(jupyter-return req)))
(defun jupyter-idle (dreq &optional timeout)
"Wait until DREQ has become idle, return DREQ.
Signal a `jupyter-timeout-before-idle' error if TIMEOUT seconds
elapses and the request has not become idle yet."
(jupyter-mlet* ((req (jupyter-sent dreq)))
(or (jupyter-wait-until-idle req timeout)
(signal 'jupyter-timeout-before-idle (list req)))
(jupyter-return req)))
(defun jupyter-messages (dreq &optional timeout)
"Return all the messages of REQ.
TIMEOUT has the same meaning as in `jupyter-idle'."
(jupyter-mlet* ((req (jupyter-idle dreq timeout)))
(jupyter-return (jupyter-request-messages req))))
(defun jupyter-find-message (msg-type msgs)
"Return a message whose type is MSG-TYPE in MSGS."
(cl-find-if
(lambda (msg)
(let ((type (jupyter-message-type msg)))
(string= type msg-type)))
msgs))
(defun jupyter-reply (dreq &optional timeout)
"Return the reply message of REQ.
TIMEOUT has the same meaning as in `jupyter-idle'."
(jupyter-mlet* ((msgs (jupyter-messages dreq timeout)))
(jupyter-return
(cl-find-if
(lambda (msg)
(let ((type (jupyter-message-type msg)))
(string-suffix-p "_reply" type)))
msgs))))
(defun jupyter-result (dreq &optional timeout)
"Return the result message of REQ.
TIMEOUT has the same meaning as in `jupyter-idle'."
(jupyter-mlet* ((msgs (jupyter-messages dreq timeout)))
(jupyter-return
(cl-find-if
(lambda (msg)
(let ((type (jupyter-message-type msg)))
(string-suffix-p "_result" type)))
msgs))))
(defun jupyter-message-subscribed (dreq cbs)
"Return an IO action that subscribes CBS to a request's message publisher.
IO-REQ is an IO action that evaluates to a sent request. CBS is
an alist mapping message types to callback functions like
`((\"execute_reply\" ,(lambda (msg) ...))
...)
The returned IO action returns the sent request after subscribing
the callbacks."
(jupyter-mlet* ((req dreq))
(jupyter-run-with-io
(jupyter-request-message-publisher req)
(jupyter-subscribe
(jupyter-subscriber
(lambda (msg)
(when-let*
((msg-type (jupyter-message-type msg))
(fn (car (alist-get msg-type cbs nil nil #'string=))))
(funcall fn msg))))))
(jupyter-return req)))
;; When replaying messages, the request message publisher is already
;; unsubscribed from any upstream publishers.
(defun jupyter--debug-replay-requests ()
(setq jupyter--debug-request-queue (nreverse jupyter--debug-request-queue))
(while jupyter--debug-request-queue
(pcase-let ((`(,client ,req) (pop jupyter--debug-request-queue)))
(cl-loop
for msg in (jupyter-request-messages req)
do (condition-case nil
(jupyter-handle-message
client (plist-get msg :channel)
(cl-list* :parent-request req msg))
(error (setq jupyter--debug-request-queue
(nreverse jupyter--debug-request-queue))))))))
;;; Request
(defun jupyter-message-publisher (req)
(let ((id (jupyter-request-id req)))
(jupyter-publisher
(lambda (msg)
(pcase (jupyter-message-type msg)
;; Send what doesn't appear to be a message as is.
((pred null) (jupyter-content msg))
;; A status message after a request goes idle means there is
;; a new request and there will, theoretically, be no more
;; messages for the idle one.
;;
;; FIXME: Is that true? Figure out the difference between a
;; status: busy and a status: idle message.
((and type (guard (jupyter-request-idle-p req))
(guard (string= type "status")))
(jupyter-unsubscribe))
;; TODO: `jupyter-message-parent-id' -> `jupyter-parent-id'
;; and the like.
((guard (string= id (jupyter-message-parent-id msg)))
(setf (jupyter-request-last-message req) msg)
(cl-callf nconc (jupyter-request-messages req) (list msg))
(when (or (jupyter-message-status-idle-p msg)
;; Jupyter protocol 5.1, IPython
;; implementation 7.5.0 doesn't give
;; status: busy or status: idle messages
;; on kernel-info-requests. Whereas
;; IPython implementation 6.5.0 does.
;; Seen on Appveyor tests.
;;
;; TODO: May be related
;; jupyter/notebook#3705 as the problem
;; does happen after a kernel restart
;; when testing.
(string= (jupyter-message-type msg) "kernel_info_reply")
;; No idle message is received after a
;; shutdown reply so consider REQ as
;; having received an idle message in
;; this case.
(string= (jupyter-message-type msg) "shutdown_reply"))
(setf (jupyter-request-idle-p req) t))
(jupyter-content
(cl-list* :parent-request req msg))))))))
(defvar jupyter-inhibit-handlers)
(defun jupyter-request (type &rest content)
"Return an IO action that sends a `jupyter-request'.
TYPE is the message type of the message that CONTENT, a property
list, represents."
(declare (indent 1))
(let ((ih jupyter-inhibit-handlers))
(lambda (client)
(let* ((req (jupyter-generate-request
client
:type type
:content content
:client client
;; Anything sent to stdin is a reply not a request
;; so consider the "request" completed.
:idle-p (string= "stdin"
(jupyter-channel-from-request-type type))
:inhibited-handlers ih))
(pub (jupyter-message-publisher req)))
(setf (jupyter-request-message-publisher req) pub)
(if (eq jupyter--debug 'message)
(push (list client req) jupyter--debug-request-queue)
(when (string= (jupyter-request-type req)
"execute_request")
(jupyter-server-mode-set-client client))
(jupyter-run-with-io pub
(jupyter-subscribe
(jupyter-subscriber
(lambda (msg)
;; Only handle what looks to be a Jupyter message.
(when (jupyter-message-type msg)
(let ((channel (plist-get msg :channel)))
(jupyter-handle-message client channel msg))))))))
(cons req client)))))
(provide 'jupyter-monads)
;;; jupyter-monads.el ends here

1899
lisp/jupyter/jupyter-org-client.el Normal file
View File

File diff suppressed because it is too large Load Diff

686
lisp/jupyter/jupyter-org-extensions.el Normal file
View File

@@ -0,0 +1,686 @@
;;; jupyter-org-extensions.el --- Jupyter Org Extensions -*- lexical-binding: t; -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Carlos Garcia C. <carlos@binarycharly.com>
;; Created: 01 March 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:
;; Functions that extend the functionality of Org mode to interact with
;; jupyter source blocks.
;;; Code:
(require 'jupyter-kernelspec)
(require 'jupyter-org-client)
(eval-when-compile (require 'subr-x))
(declare-function org-babel-jupyter-initiate-session "ob-jupyter" (&optional session params))
(declare-function org-babel-jupyter-session-initiated-p "ob-jupyter" (&optional session params))
(declare-function org-babel-jupyter-src-block-session "ob-jupyter" ())
(declare-function org-babel-jupyter-language-p "ob-jupyter" (lang))
(declare-function org-in-src-block-p "org" (&optional inside))
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-previous-line-empty-p "org" ())
(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-next-line-empty-p "org" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-type "org-element" (element))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-put-property "org-element" (element property value))
(declare-function outline-show-entry "outline" ())
(declare-function avy-jump "ext:avy")
(declare-function ivy-read "ext:ivy")
(defcustom jupyter-org-jump-to-block-context-lines 3
"Number of lines to show when showing the context of a block.
The function `jupyter-org-jump-to-block' uses these many lines from the
beginning of a source block in a list."
:group 'ob-jupyter
:type 'integer)
(defun jupyter-org-closest-jupyter-language (&optional query)
"Return the language of the closest Jupyter source block.
If QUERY is non-nil, ask for a language to use instead. Asking
for which language to use is also done if no Jupyter source
blocks could be found in the buffer.
Distance is line based, not character based. Also, `point' is
assumed to not be inside a source block."
(org-save-outline-visibility nil
(or (save-excursion
(and (null query)
(cl-loop
with start = (line-number-at-pos)
with previous = (ignore-errors
(save-excursion
(org-babel-previous-src-block)
(point)))
with next = (ignore-errors
(save-excursion
(org-babel-next-src-block)
(point)))
with maybe-return-lang =
(lambda ()
(let ((info (org-babel-get-src-block-info 'light)))
(when (org-babel-jupyter-language-p (nth 0 info))
(cl-return (nth 0 info)))))
while (or previous next) do
(cond
((or
;; Maybe return the previous Jupyter source block's language
;; if it is closer to the start point than the next source
;; block
(and previous next (< (- start (line-number-at-pos previous))
(- (line-number-at-pos next) start)))
;; or when there is no next source block
(and (null next) previous))
(goto-char previous)
(funcall maybe-return-lang)
(setq previous (ignore-errors
(org-babel-previous-src-block)
(point))))
(next
(goto-char next)
(funcall maybe-return-lang)
(setq next (ignore-errors
(org-babel-next-src-block)
(point))))))))
;; If all else fails, query for the language to use
(let* ((kernelspec (jupyter-completing-read-kernelspec))
(lang (plist-get
(jupyter-kernelspec-plist kernelspec)
:language)))
(if (org-babel-jupyter-language-p lang) lang
(format "jupyter-%s" lang))))))
(defun jupyter-org-between-block-end-and-result-p ()
"If `point' is between a src-block and its result, return the result end.
`point' is considered between a src-block and its result when the
result begins where the src-block ends, i.e. when only whitespace
separates the two."
;; Move after a src block's results first if `point' is between a src
;; block and it's results. Don't do this if the results are not directly
;; after a src block, e.g. for named results that appear somewhere else.
(save-excursion
(let ((start (point)))
(when-let* ((src (and (org-save-outline-visibility nil
(ignore-errors (org-babel-previous-src-block)))
(org-element-context)))
(end (org-element-property :end src))
(result-pos (org-babel-where-is-src-block-result)))
(goto-char end)
(skip-chars-backward " \n\t\r")
(when (and (= result-pos end)
(< (point) start result-pos))
(goto-char result-pos)
(org-element-property :end (org-element-context)))))))
;;;###autoload
(defun jupyter-org-insert-src-block (&optional below query)
"Insert a src-block above `point'.
With prefix arg BELOW, insert it below `point'.
If `point' is in a src-block use the language of the src-block and
copy the header to the new block.
If QUERY is non-nil and `point' is not in a src-block, ask for
the language to use for the new block. Otherwise try to select a
language based on the src-block's near `point'."
(interactive (list current-prefix-arg nil))
(if (org-in-src-block-p)
(let* ((src (org-element-context))
(start (org-element-property :begin src))
(end (org-element-property :end src))
(lang (org-element-property :language src))
(switches (org-element-property :switches src))
(parameters (org-element-property :parameters src)))
(if below
(let ((location (progn
(goto-char start)
(org-babel-where-is-src-block-result))))
(if (not location)
(goto-char end)
(goto-char location)
(goto-char (org-element-property :end (org-element-context))))
(unless (org-previous-line-empty-p)
(insert "\n"))
(insert
(org-element-interpret-data
(org-element-put-property
(jupyter-org-src-block lang parameters "\n" switches)
:post-blank 1)))
(forward-line -3))
;; after current block
(goto-char (org-element-property :begin src))
(unless (org-previous-line-empty-p)
(insert "\n"))
(insert
(org-element-interpret-data
(org-element-put-property
(jupyter-org-src-block lang parameters "\n" switches)
:post-blank 1)))
(forward-line -3)))
;; not in a src block, insert a new block, query for jupyter kernel
(beginning-of-line)
(let* ((lang (jupyter-org-closest-jupyter-language query))
(src-block (jupyter-org-src-block lang nil "\n")))
(when-let* ((pos (jupyter-org-between-block-end-and-result-p)))
(goto-char pos)
(skip-chars-backward " \n\t\r"))
(unless (looking-at-p "^[\t ]*$")
;; Move past the current element first
(let ((elem (org-element-at-point)) parent)
(while (and (setq parent (org-element-property :parent elem))
(not (memq (org-element-type parent)
'(inlinetask))))
(setq elem parent))
(when elem
(goto-char (org-element-property
(if below :end :begin) elem))))
(cond
(below
(skip-chars-backward " \n\t\r")
(insert "\n"))
(t
(insert "\n")
(forward-line -1))))
(unless (or (bobp) (org-previous-line-empty-p))
(insert "\n"))
(insert (string-trim-right (org-element-interpret-data src-block)))
(unless (org-next-line-empty-p)
(insert "\n"))
(skip-chars-backward "\n")
(forward-line -1))))
;;;###autoload
(defun jupyter-org-split-src-block (&optional below)
"Split the current src block with point in upper block.
With a prefix BELOW move point to lower block."
(interactive "P")
(unless (org-in-src-block-p)
(error "Not in a source block"))
(beginning-of-line)
(org-babel-demarcate-block)
(if below
(progn
(org-babel-next-src-block)
(forward-line)
(open-line 1))
(forward-line -2)
(end-of-line)))
;;;###autoload
(defun jupyter-org-execute-and-next-block (&optional new)
"Execute his block and jump or add a new one.
If a new block is created, use the same language, switches and parameters.
With prefix arg NEW, always insert new cell."
(interactive "P")
(unless (org-in-src-block-p)
(error "Not in a source block"))
(let ((next-src-block
(save-excursion (ignore-errors (org-babel-next-src-block)))))
;; instert a new block before executing the current block; otherwise, the new
;; ... block gets added to the results of the next block (due to how
;; ... jupyter works)
(when (or new (not next-src-block))
(save-excursion
(jupyter-org-insert-src-block t)))
(org-babel-execute-src-block)
(org-babel-next-src-block)))
;;;###autoload
(defun jupyter-org-execute-to-point (any)
"Execute Jupyter source blocks that start before point.
Only execute Jupyter source blocks that have the same session.
Non-Jupyter source blocks are evaluated conditionally.
The session is selected in the following way:
* If `point' is at a Jupyter source block, use its session.
* If `point' is not at a Jupyter source block, examine the
source blocks before `point' and ask the user to select a
session if multiple exist. If there is only one session, use
it without asking.
* Finally, if a session could not be found, then no Jupyter
source blocks exist before `point'. In this case, no session
is selected and all the source blocks before `point' will be
evaluated, e.g. when all source blocks before `point' are
shell source blocks.
NOTE: If a session could be selected, only Jupyter source blocks
that have the same session are evaluated *without* evaluating any
other source blocks. You can also evaluate ANY source block that
doesn't have a Jupyter session by providing a prefix argument.
This is useful, e.g. to evaluate shell source blocks along with
Jupyter source blocks."
(interactive "P")
;; Use a marker here to account for buffer changes during evaluation of
;; source blocks.
(let* ((p (point-marker))
(session
(or (org-babel-jupyter-src-block-session)
(let (this-session sessions)
(catch 'done
(org-babel-map-src-blocks nil
(when (> (point) p)
(throw 'done t))
(when (and (setq this-session
(org-babel-jupyter-src-block-session))
(not (member this-session sessions)))
(push this-session sessions))))
(setq sessions (nreverse sessions))
(if (> (length sessions) 1)
(completing-read "Select session: " sessions)
(car sessions))))))
;; Move P after insertion at P
(set-marker-insertion-type p t)
(catch 'done
(org-babel-map-src-blocks nil
(when (> (point) p)
(throw 'done t))
;; If there is no SESSION that can be found, just evaluate any source
;; block.
;;
;; If a Jupyter based SESSION could be found, only source blocks that
;; have a Jupyter session matching SESSION are evaluated. When a source
;; block doesn't have a Jupyter session, it is only evaluated when ANY
;; is non-nil.
(when (or (null session)
(let ((this-session (org-babel-jupyter-src-block-session)))
(if (null this-session) any
(equal session this-session))))
(org-babel-execute-src-block))))
(goto-char p)
(set-marker p nil)))
;;;###autoload
(defun jupyter-org-execute-subtree (any)
"Execute Jupyter source blocks that start before point in the current subtree.
This function narrows the buffer to the current subtree and calls
`jupyter-org-execute-to-point'. See that function for the meaning
of the ANY argument."
(interactive "P")
(save-restriction
(org-narrow-to-subtree)
(jupyter-org-execute-to-point any)))
;;;###autoload
(defun jupyter-org-next-busy-src-block (arg &optional backward)
"Jump to the next busy source block.
With a prefix argument ARG, jump forward ARG many blocks.
When BACKWARD is non-nil, jump to the previous block."
(interactive "p")
(org-save-outline-visibility nil
(cl-loop
with count = (abs (or arg 1))
with origin = (point)
while (ignore-errors
(if backward (org-babel-previous-src-block)
(org-babel-next-src-block)))
thereis (when (jupyter-org-request-at-point)
(zerop (cl-decf count)))
finally (goto-char origin)
(user-error "No %s busy code blocks" (if backward "previous" "further"))))
(save-match-data (org-fold-show-context)))
;;;###autoload
(defun jupyter-org-previous-busy-src-block (arg)
"Jump to the previous busy source block.
With a prefix argument ARG, jump backward ARG many source blocks."
(interactive "p")
(jupyter-org-next-busy-src-block arg 'backward))
;;;###autoload
(defun jupyter-org-inspect-src-block ()
"Inspect the symbol under point when in a source block."
(interactive)
(unless (jupyter-org-with-src-block-client
(jupyter-inspect-at-point)
t)
(error "Not in a source block")))
;;;###autoload
(defun jupyter-org-restart-kernel-execute-block ()
"Restart the kernel of the source block where point is and execute it."
(interactive)
(jupyter-org-with-src-block-client
(jupyter-repl-restart-kernel))
(org-babel-execute-src-block-maybe))
;;;###autoload
(defun jupyter-org-restart-and-execute-to-point (&optional any)
"Kill the kernel and run all Jupyter src-blocks to point.
With a prefix argument, run ANY source block that doesn't have a
Jupyter session as well.
See `jupyter-org-execute-to-point' for more information on which
source blocks are evaluated."
(interactive "P")
(jupyter-org-with-src-block-client
(jupyter-repl-restart-kernel))
(jupyter-org-execute-to-point any))
;;;###autoload
(defun jupyter-org-restart-kernel-execute-buffer ()
"Restart kernel and execute buffer."
(interactive)
(jupyter-org-with-src-block-client
(jupyter-repl-restart-kernel))
(org-babel-execute-buffer))
;;;###autoload
(defun jupyter-org-jump-to-block (&optional context)
"Jump to a source block in the buffer using `ivy'.
If narrowing is in effect, jump to a block in the narrowed region.
Use a numeric prefix CONTEXT to specify how many lines of context to showin the
process of selecting a source block.
Defaults to `jupyter-org-jump-to-block-context-lines'."
(interactive
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
jupyter-org-jump-to-block-context-lines)))
(unless (require 'ivy nil t)
(error "Package `ivy' not installed"))
(let ((blocks '()))
(when (or (null context) (< context 1))
(setq context jupyter-org-jump-to-block-context-lines))
;; consider the #+SRC_BLOCK line of the block, thereby making CONTEXT
;; ... equivalent to actual lines after the block header
(setq context (1+ context))
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
(push (list (format "line %s:\n%s"
(line-number-at-pos (match-beginning 0))
(save-excursion
(goto-char (match-beginning 0))
(let ((s (point)))
(forward-line context)
(buffer-substring s (point)))))
(line-number-at-pos (match-beginning 0)))
blocks)))
(ivy-read "block: " (reverse blocks)
:action (lambda (candidate)
(goto-char (point-min))
(forward-line (1- (nth 1 candidate)))
(ignore-errors (outline-show-entry))
(recenter)))))
;;;###autoload
(defun jupyter-org-jump-to-visible-block ()
"Jump to a visible src block with avy."
(interactive)
(unless (require 'avy nil t)
(error "Package `avy' not installed"))
;; Jumping through these hoops to avoid depending on `avy'
(defalias 'jupyter-org-jump-to-visible-block
(byte-compile
`(lambda ()
(interactive)
(avy-with #'jupyter-org-jump-to-block
(avy-jump "#\\+begin_src"
:beg (point-min)
:end (point-max)))))
(documentation 'jupyter-org-jump-to-visible-block))
;; Now call the new definition
(jupyter-org-jump-to-visible-block))
;;;###autoload
(defun jupyter-org-edit-header ()
"Edit the src-block header in the minibuffer."
(interactive)
(let ((src-info (org-babel-get-src-block-info 'light)))
(unless src-info
(error "Not in a source block"))
(let* ((header-start (nth 5 src-info))
(header-end (save-excursion (goto-char header-start)
(line-end-position))))
(let ((header (read-string "Header: "
(buffer-substring header-start header-end))))
(save-excursion
(delete-region header-start header-end)
(goto-char header-start)
(insert header))))))
(defun jupyter-org-src-block-bounds ()
"Return the region containing the current source block.
If the source block has results, include the results in the
returned region. The region is returned as (BEGIN . END)"
(unless (org-in-src-block-p)
(error "Not in a source block"))
(let* ((src (org-element-context))
(results-start (org-babel-where-is-src-block-result))
(results-end
(when results-start
(save-excursion
(goto-char results-start)
(goto-char (org-babel-result-end))
;; if results are empty, take its empy line
(when (looking-at-p org-babel-result-regexp)
(forward-line 1))
(point)))))
`(,(org-element-property :begin src) .
,(or results-end (jupyter-org-element-end-before-blanks src)))))
;;;###autoload
(defun jupyter-org-kill-block-and-results ()
"Kill the block and its results."
(interactive)
(let ((region (jupyter-org-src-block-bounds)))
(kill-region (car region) (cdr region))))
;;;###autoload
(defun jupyter-org-copy-block-and-results ()
"Copy the src block at the current point and its results."
(interactive)
(let ((region (jupyter-org-src-block-bounds)))
(kill-new (buffer-substring (car region) (cdr region)))))
;;;###autoload
(defun jupyter-org-clone-block (&optional below)
"Clone the block above the current block.
If BELOW is non-nil, add the cloned block below."
(interactive "P")
(let* ((src (org-element-context))
(code (org-element-property :value src)))
(unless (org-in-src-block-p)
(error "Not in a source block"))
(jupyter-org-insert-src-block below)
(delete-char 1)
(insert code)
;; move to the end of the last line of the cloned block
(forward-line -1)
(end-of-line)))
;;;###autoload
(defun jupyter-org-merge-blocks ()
"Merge the current block with the next block."
(interactive)
(unless (org-in-src-block-p)
(error "Not in a source block"))
(let ((current-src-block (org-element-context)))
(org-babel-remove-result)
(org-babel-next-src-block)
(let* ((next-src-block (prog1 (org-element-context)
(org-babel-remove-result)))
(next-src-block-beg (set-marker
(make-marker)
(org-element-property :begin next-src-block)))
(next-src-block-end (set-marker
(make-marker)
(jupyter-org-element-end-before-blanks next-src-block))))
(goto-char (jupyter-org-element-end-before-blanks current-src-block))
(forward-line -1)
(insert
(delete-and-extract-region
(save-excursion
(goto-char (jupyter-org-element-begin-after-affiliated next-src-block))
(forward-line 1)
(point))
(save-excursion
(goto-char next-src-block-end)
(forward-line -1)
(point))))
;; delete a leftover space
(save-excursion
(goto-char next-src-block-end)
(when (looking-at-p "[[:space:]]*$")
(set-marker next-src-block-end (+ (line-end-position) 1))))
(delete-region next-src-block-beg next-src-block-end)
(set-marker next-src-block-beg nil)
(set-marker next-src-block-end nil)))
;; move to the end of the last line
(forward-line -1)
(end-of-line))
;;;###autoload
(defun jupyter-org-move-src-block (&optional below)
"Move source block before of after another.
If BELOW is non-nil, move the block down, otherwise move it up."
(interactive)
(unless (org-in-src-block-p)
(error "Not in a source block"))
;; throw error if there's no previous or next source block
(when (ignore-errors
(save-excursion
(if below
(org-babel-next-src-block)
(org-babel-previous-src-block))))
(let* ((region (jupyter-org-src-block-bounds))
(block (delete-and-extract-region (car region) (cdr region))))
;; if there is an empty line remaining, take that line as part of the
;; ... block
(when (and (looking-at-p "[[:space:]]*$") (/= (point) (point-max)))
(delete-region (line-beginning-position) (+ (line-end-position) 1))
(setq block (concat block "\n")))
(if below
;; if below, move past the next source block or its result
(let ((next-src-block-head (org-babel-where-is-src-block-head)))
(if next-src-block-head
(goto-char next-src-block-head)
(org-babel-next-src-block))
(let ((next-src-block (org-element-context))
(next-results-start (org-babel-where-is-src-block-result)))
(if (not next-results-start)
(goto-char (org-element-property :end next-src-block))
(goto-char next-results-start)
(goto-char (org-babel-result-end))
(when (and (looking-at-p org-babel-result-regexp)
(/= (point) (point-max)))
;; the results are empty, take the next empty line
(forward-line 1))
(when (looking-at-p "[[:space:]]*$")
(forward-line 1)))))
;; else, move to the begining of the previous block
(org-babel-previous-src-block))
;; keep cursor where the insertion takes place
(save-excursion (insert block)))))
;;;###autoload
(defun jupyter-org-clear-all-results ()
"Clear all results in the buffer."
(interactive)
(org-save-outline-visibility nil
(save-excursion
(goto-char (point-min))
(while (org-babel-next-src-block)
(org-babel-remove-result)))))
;;;###autoload
(defun jupyter-org-interrupt-kernel ()
"Interrupt the kernel."
(interactive)
(unless (org-in-src-block-p)
(error "Not in a source block"))
(jupyter-org-with-src-block-client
(jupyter-repl-interrupt-kernel)))
(defun jupyter-org-hydra/body ()
"Hack to bind a hydra only if the hydra package exists."
(interactive)
(unless (require 'hydra nil t)
(error "Package `hydra' not installed"))
;; unbinding this function and define the hydra
(fmakunbound 'jupyter-org-hydra/body)
(eval `(defhydra jupyter-org-hydra (:color blue :hint nil)
"
Execute Navigate Edit Misc
-------------------------------------------------------------------------------------------
_<return>_: current _p_: previous _C-p_: move up _/_: inspect
_C-<return>_: current to next _P_: previous busy _C-n_: move down _l_: clear result
_M-<return>_: to point _n_: next _x_: kill _L_: clear all
_C-M-<return>_: subtree to point _N_: next busy _c_: copy _i_: interrupt
_S-<return>_: Restart/block _g_: visible _o_: clone _C-s_: scratch buffer
_S-C-<return>_: Restart/to point _G_: any _m_: merge
_S-M-<return>_: Restart/buffer _<tab>_: (un)fold _s_: split
_r_: Goto repl ^ ^ _+_: insert above
^ ^ ^ ^ _=_: insert below
^ ^ ^ ^ _h_: header"
("<return>" org-ctrl-c-ctrl-c :color red)
("C-<return>" jupyter-org-execute-and-next-block :color red)
("M-<return>" jupyter-org-execute-to-point)
("C-M-<return>" jupyter-org-execute-subtree)
("S-<return>" jupyter-org-restart-kernel-execute-block)
("S-C-<return>" jupyter-org-restart-and-execute-to-point)
("S-M-<return>" jupyter-org-restart-kernel-execute-buffer)
("r" org-babel-switch-to-session)
("p" org-babel-previous-src-block :color red)
("P" jupyter-org-previous-busy-src-block :color red)
("n" org-babel-next-src-block :color red)
("N" jupyter-org-next-busy-src-block :color red)
("g" jupyter-org-jump-to-visible-block)
("G" jupyter-org-jump-to-block)
("<tab>" org-cycle :color red)
("C-p" jupyter-org-move-src-block :color red)
("C-n" (jupyter-org-move-src-block t) :color red)
("x" jupyter-org-kill-block-and-results)
("c" jupyter-org-copy-block-and-results)
("o" (jupyter-org-clone-block t))
("m" jupyter-org-merge-blocks)
("s" jupyter-org-split-src-block)
("+" (jupyter-org-insert-src-block nil current-prefix-arg))
("=" (jupyter-org-insert-src-block t current-prefix-arg))
("l" org-babel-remove-result)
("L" jupyter-org-clear-all-results)
("h" jupyter-org-edit-header)
("/" jupyter-org-inspect-src-block)
("i" jupyter-org-interrupt-kernel)
("C-s" org-babel-jupyter-scratch-buffer)))
(call-interactively #'jupyter-org-hydra/body))
(define-key jupyter-org-interaction-mode-map (kbd "C-c h") #'jupyter-org-hydra/body)
(provide 'jupyter-org-extensions)
;;; jupyter-org-extensions.el ends here

17
lisp/jupyter/jupyter-pkg.el Normal file
View File

@@ -0,0 +1,17 @@
(define-package "jupyter" "20240418.1642" "Jupyter"
'((emacs "26")
(cl-lib "0.5")
(org "9.1.6")
(zmq "0.10.10")
(simple-httpd "1.5.0")
(websocket "1.9"))
:commit "f1394d303be76a1fa44d4135b4f3ceab9387a16b" :authors
'(("Nathaniel Nicandro" . "nathanielnicandro@gmail.com"))
:maintainers
'(("Nathaniel Nicandro" . "nathanielnicandro@gmail.com"))
:maintainer
'("Nathaniel Nicandro" . "nathanielnicandro@gmail.com")
:url "https://github.com/emacs-jupyter/jupyter")
;; Local Variables:
;; no-byte-compile: t
;; End:

110
lisp/jupyter/jupyter-python.el Normal file
View File

@@ -0,0 +1,110 @@
;;; jupyter-python.el --- Jupyter support for python -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 23 Oct 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:
;; Support methods for integration with Python.
;;; Code:
(require 'jupyter-repl)
(require 'jupyter-org-client)
(declare-function org-babel-python-table-or-string "ob-python")
(cl-defmethod jupyter-handle-error :after ((client jupyter-repl-client) req msg
&context (jupyter-lang python)
(major-mode jupyter-repl-mode))
"Add spacing between the first occurance of ENAME and \"Traceback\".
Do this only when the traceback of REQ was inserted into the REPL
buffer."
(unless (equal (jupyter-message-parent-type msg) "comm_msg")
(jupyter-with-repl-buffer client
(jupyter-with-message-content msg (ename)
(save-excursion
(jupyter-repl-goto-cell req)
(goto-char (jupyter-repl-cell-code-end-position))
(when (and (search-forward ename nil t)
(looking-at "Traceback"))
(let ((len (- fill-column
jupyter-repl-prompt-margin-width
(- (point) (line-beginning-position))
(- (line-end-position) (point)))))
(insert-and-inherit
(propertize (make-string (if (> len 4) len 4) ? )
'read-only t)))))))))
(cl-defmethod jupyter-insert :around ((msg cons)
&context (jupyter-lang python)
&rest _ignore)
"Fontify docstrings after inserting inspect messages."
(let ((mime (cl-call-next-method)))
(prog1 mime
(cond
((and (eq mime :text/plain)
(string= (jupyter-message-type msg) "inspect_reply"))
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^Docstring:" nil t)
(jupyter-fontify-region-according-to-mode
#'rst-mode (1+ (point))
(or (and (re-search-forward "^\\(File\\|Type\\):" nil t)
(line-beginning-position))
(point-max))))))
(t nil)))))
(cl-defmethod jupyter-load-file-code (file &context (jupyter-lang python))
(concat "%run " file))
;;; `jupyter-org'
(cl-defmethod jupyter-org-result ((_mime (eql :text/plain)) _content params
&context (jupyter-lang python))
(let ((result (cl-call-next-method)))
(cond
((and (stringp result)
(not (member "scalar" (alist-get :result-params params))))
(org-babel-python-table-or-string result))
(t result))))
(cl-defmethod jupyter-org-error-location (&context (jupyter-lang python))
(and (or (save-excursion (re-search-forward "^----> \\([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

2179
lisp/jupyter/jupyter-repl.el Normal file
View File

File diff suppressed because it is too large Load Diff

1103
lisp/jupyter/jupyter-rest-api.el Normal file
View File

File diff suppressed because it is too large Load Diff

375
lisp/jupyter/jupyter-server-kernel.el Normal file
View File

@@ -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 <nathanielnicandro@gmail.com>
;; 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

574
lisp/jupyter/jupyter-server.el Normal file
View File

@@ -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 <nathanielnicandro@gmail.com>
;; 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-<return>") #'jupyter-server-kernel-list-launch-kernel)
(define-key map (kbd "<return>") #'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

881
lisp/jupyter/jupyter-tramp.el Normal file
View File

@@ -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 <nathanielnicandro@gmail.com>
;; 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

287
lisp/jupyter/jupyter-widget-client.el Normal file
View File

@@ -0,0 +1,287 @@
;;; jupyter-widget-client.el --- Widget support -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; 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

82
lisp/jupyter/jupyter-zmq-channel-ioloop.el Normal file
View File

@@ -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 <nathanielnicandro@gmail.com>
;; 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

252
lisp/jupyter/jupyter-zmq-channel.el Normal file
View File

@@ -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 <nathanielnicandro@gmail.com>
;; 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

44
lisp/jupyter/jupyter.el Normal file
View File

@@ -0,0 +1,44 @@
;;; jupyter.el --- Jupyter -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; 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

836
lisp/jupyter/ob-jupyter.el Normal file
View File

@@ -0,0 +1,836 @@
;;; ob-jupyter.el --- Jupyter integration with org-mode -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; 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

33
lisp/jupyter/widget.html Normal file
View File

@@ -0,0 +1,33 @@
<!DOCTYPE html>
<html>
<head>
<title>Jupyter Client</title>
<script type="application/javascript" src="/jupyter"></script>
<script type="application/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/require.js/2.3.5/require.min.js"></script>
<style type="text/css">
* {
font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
}
</style>
<script type="application/javascript">
var kernel;
document.addEventListener("DOMContentLoaded", function(event) {
// TODO: May not be available everywhere
var p = new URLSearchParams(window.location.search);
var kernel = new EmacsJupyter({username: p.get('username'),
clientId: p.get('clientId')},
p.get('port'));
var commManager = new CommManager(kernel);
var widgetManager = new WidgetManager(kernel, document.getElementById("widget"));
commManager.register_target(widgetManager.comm_target_name, function(comm, msg) {
widgetManager.handle_comm_open(comm, msg);
});
kernel.widgetManager = widgetManager;
kernel.commManager = commManager;
window.kernel = kernel;
});
</script>
</head>
<body>
</body>
</html>

1108
lisp/ox-ipynb.el Normal file
View File

File diff suppressed because it is too large Load Diff

12
lisp/request/request-pkg.el Normal file
View File

@@ -0,0 +1,12 @@
(define-package "request" "20230127.417" "Compatible layer for URL request"
'((emacs "24.4"))
:commit "01e338c335c07e4407239619e57361944a82cb8a" :authors
'(("Takafumi Arakaki <aka.tkf at gmail.com>"))
:maintainers
'(("Takafumi Arakaki <aka.tkf at gmail.com>"))
:maintainer
'("Takafumi Arakaki <aka.tkf at gmail.com>")
:url "https://github.com/tkf/emacs-request")
;; Local Variables:
;; no-byte-compile: t
;; End:

1234
lisp/request/request.el Normal file
View File

File diff suppressed because it is too large Load Diff

6
lisp/zmq/.ipynb_checkpoints/Untitled-checkpoint.ipynb Normal file
View File

@@ -0,0 +1,6 @@
{
"cells": [],
"metadata": {},
"nbformat": 4,
"nbformat_minor": 5
}

93
lisp/zmq/Makefile Normal file
View File

@@ -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

BIN
lisp/zmq/emacs-zmq.so Executable file
View File

Binary file not shown.

148
lisp/zmq/src/.deps/emacs_zmq_la-constants.Plo Normal file
View File

@@ -0,0 +1,148 @@
emacs_zmq_la-constants.lo: constants.c /usr/include/stdc-predef.h core.h \
/usr/include/stdlib.h /usr/include/bits/libc-header-start.h \
/usr/include/features.h /usr/include/features-time64.h \
/usr/include/bits/wordsize.h /usr/include/bits/timesize.h \
/usr/include/sys/cdefs.h /usr/include/bits/long-double.h \
/usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h \
/usr/include/bits/waitflags.h /usr/include/bits/waitstatus.h \
/usr/include/bits/floatn.h /usr/include/bits/floatn-common.h \
/usr/include/sys/types.h /usr/include/bits/types.h \
/usr/include/bits/typesizes.h /usr/include/bits/time64.h \
/usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \
/usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \
/usr/include/bits/stdint-intn.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/endianness.h \
/usr/include/bits/byteswap.h /usr/include/bits/uintn-identity.h \
/usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/types/sigset_t.h /usr/include/bits/types/__sigset_t.h \
/usr/include/bits/types/struct_timeval.h \
/usr/include/bits/types/struct_timespec.h \
/usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \
/usr/include/bits/pthreadtypes-arch.h \
/usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \
/usr/include/bits/struct_rwlock.h /usr/include/alloca.h \
/usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/bits/types/locale_t.h \
/usr/include/bits/types/__locale_t.h /usr/include/strings.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h \
/usr/include/zmq.h /usr/include/errno.h /usr/include/bits/errno.h \
/usr/include/linux/errno.h /usr/include/asm/errno.h \
/usr/include/asm-generic/errno.h /usr/include/asm-generic/errno-base.h \
/usr/include/stdio.h /usr/include/bits/types/__fpos_t.h \
/usr/include/bits/types/__mbstate_t.h \
/usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \
/usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \
/usr/include/bits/types/cookie_io_functions_t.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h \
/usr/include/stdint.h /usr/include/bits/wchar.h \
/usr/include/bits/stdint-uintn.h /usr/include/bits/stdint-least.h \
/usr/include/signal.h /usr/include/bits/signum-generic.h \
/usr/include/bits/signum-arch.h /usr/include/bits/types/sig_atomic_t.h \
/usr/include/bits/types/siginfo_t.h /usr/include/bits/types/__sigval_t.h \
/usr/include/bits/siginfo-arch.h /usr/include/bits/siginfo-consts.h \
/usr/include/bits/types/sigval_t.h /usr/include/bits/types/sigevent_t.h \
/usr/include/bits/sigevent-consts.h /usr/include/bits/sigaction.h \
/usr/include/bits/sigcontext.h /usr/include/bits/types/stack_t.h \
/usr/include/sys/ucontext.h /usr/include/bits/sigstack.h \
/usr/include/bits/sigstksz.h /usr/include/bits/ss_flags.h \
/usr/include/bits/types/struct_sigstack.h /usr/include/bits/sigthread.h \
/usr/include/bits/signal_ext.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h emacs-module.h
/usr/include/stdc-predef.h:
core.h:
/usr/include/stdlib.h:
/usr/include/bits/libc-header-start.h:
/usr/include/features.h:
/usr/include/features-time64.h:
/usr/include/bits/wordsize.h:
/usr/include/bits/timesize.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/long-double.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/bits/floatn.h:
/usr/include/bits/floatn-common.h:
/usr/include/sys/types.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/bits/time64.h:
/usr/include/bits/types/clock_t.h:
/usr/include/bits/types/clockid_t.h:
/usr/include/bits/types/time_t.h:
/usr/include/bits/types/timer_t.h:
/usr/include/bits/stdint-intn.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/endianness.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/uintn-identity.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/types/sigset_t.h:
/usr/include/bits/types/__sigset_t.h:
/usr/include/bits/types/struct_timeval.h:
/usr/include/bits/types/struct_timespec.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/bits/thread-shared-types.h:
/usr/include/bits/pthreadtypes-arch.h:
/usr/include/bits/atomic_wide_counter.h:
/usr/include/bits/struct_mutex.h:
/usr/include/bits/struct_rwlock.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-bsearch.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/bits/types/locale_t.h:
/usr/include/bits/types/__locale_t.h:
/usr/include/strings.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h:
/usr/include/zmq.h:
/usr/include/errno.h:
/usr/include/bits/errno.h:
/usr/include/linux/errno.h:
/usr/include/asm/errno.h:
/usr/include/asm-generic/errno.h:
/usr/include/asm-generic/errno-base.h:
/usr/include/stdio.h:
/usr/include/bits/types/__fpos_t.h:
/usr/include/bits/types/__mbstate_t.h:
/usr/include/bits/types/__fpos64_t.h:
/usr/include/bits/types/__FILE.h:
/usr/include/bits/types/FILE.h:
/usr/include/bits/types/struct_FILE.h:
/usr/include/bits/types/cookie_io_functions_t.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/stdio.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h:
/usr/include/stdint.h:
/usr/include/bits/wchar.h:
/usr/include/bits/stdint-uintn.h:
/usr/include/bits/stdint-least.h:
/usr/include/signal.h:
/usr/include/bits/signum-generic.h:
/usr/include/bits/signum-arch.h:
/usr/include/bits/types/sig_atomic_t.h:
/usr/include/bits/types/siginfo_t.h:
/usr/include/bits/types/__sigval_t.h:
/usr/include/bits/siginfo-arch.h:
/usr/include/bits/siginfo-consts.h:
/usr/include/bits/types/sigval_t.h:
/usr/include/bits/types/sigevent_t.h:
/usr/include/bits/sigevent-consts.h:
/usr/include/bits/sigaction.h:
/usr/include/bits/sigcontext.h:
/usr/include/bits/types/stack_t.h:
/usr/include/sys/ucontext.h:
/usr/include/bits/sigstack.h:
/usr/include/bits/sigstksz.h:
/usr/include/bits/ss_flags.h:
/usr/include/bits/types/struct_sigstack.h:
/usr/include/bits/sigthread.h:
/usr/include/bits/signal_ext.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h:
emacs-module.h:

149
lisp/zmq/src/.deps/emacs_zmq_la-context.Plo Normal file
View File

@@ -0,0 +1,149 @@
emacs_zmq_la-context.lo: context.c /usr/include/stdc-predef.h context.h \
core.h /usr/include/stdlib.h /usr/include/bits/libc-header-start.h \
/usr/include/features.h /usr/include/features-time64.h \
/usr/include/bits/wordsize.h /usr/include/bits/timesize.h \
/usr/include/sys/cdefs.h /usr/include/bits/long-double.h \
/usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h \
/usr/include/bits/waitflags.h /usr/include/bits/waitstatus.h \
/usr/include/bits/floatn.h /usr/include/bits/floatn-common.h \
/usr/include/sys/types.h /usr/include/bits/types.h \
/usr/include/bits/typesizes.h /usr/include/bits/time64.h \
/usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \
/usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \
/usr/include/bits/stdint-intn.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/endianness.h \
/usr/include/bits/byteswap.h /usr/include/bits/uintn-identity.h \
/usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/types/sigset_t.h /usr/include/bits/types/__sigset_t.h \
/usr/include/bits/types/struct_timeval.h \
/usr/include/bits/types/struct_timespec.h \
/usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \
/usr/include/bits/pthreadtypes-arch.h \
/usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \
/usr/include/bits/struct_rwlock.h /usr/include/alloca.h \
/usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/bits/types/locale_t.h \
/usr/include/bits/types/__locale_t.h /usr/include/strings.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h \
/usr/include/zmq.h /usr/include/errno.h /usr/include/bits/errno.h \
/usr/include/linux/errno.h /usr/include/asm/errno.h \
/usr/include/asm-generic/errno.h /usr/include/asm-generic/errno-base.h \
/usr/include/stdio.h /usr/include/bits/types/__fpos_t.h \
/usr/include/bits/types/__mbstate_t.h \
/usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \
/usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \
/usr/include/bits/types/cookie_io_functions_t.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h \
/usr/include/stdint.h /usr/include/bits/wchar.h \
/usr/include/bits/stdint-uintn.h /usr/include/bits/stdint-least.h \
/usr/include/signal.h /usr/include/bits/signum-generic.h \
/usr/include/bits/signum-arch.h /usr/include/bits/types/sig_atomic_t.h \
/usr/include/bits/types/siginfo_t.h /usr/include/bits/types/__sigval_t.h \
/usr/include/bits/siginfo-arch.h /usr/include/bits/siginfo-consts.h \
/usr/include/bits/types/sigval_t.h /usr/include/bits/types/sigevent_t.h \
/usr/include/bits/sigevent-consts.h /usr/include/bits/sigaction.h \
/usr/include/bits/sigcontext.h /usr/include/bits/types/stack_t.h \
/usr/include/sys/ucontext.h /usr/include/bits/sigstack.h \
/usr/include/bits/sigstksz.h /usr/include/bits/ss_flags.h \
/usr/include/bits/types/struct_sigstack.h /usr/include/bits/sigthread.h \
/usr/include/bits/signal_ext.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h emacs-module.h
/usr/include/stdc-predef.h:
context.h:
core.h:
/usr/include/stdlib.h:
/usr/include/bits/libc-header-start.h:
/usr/include/features.h:
/usr/include/features-time64.h:
/usr/include/bits/wordsize.h:
/usr/include/bits/timesize.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/long-double.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/bits/floatn.h:
/usr/include/bits/floatn-common.h:
/usr/include/sys/types.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/bits/time64.h:
/usr/include/bits/types/clock_t.h:
/usr/include/bits/types/clockid_t.h:
/usr/include/bits/types/time_t.h:
/usr/include/bits/types/timer_t.h:
/usr/include/bits/stdint-intn.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/endianness.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/uintn-identity.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/types/sigset_t.h:
/usr/include/bits/types/__sigset_t.h:
/usr/include/bits/types/struct_timeval.h:
/usr/include/bits/types/struct_timespec.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/bits/thread-shared-types.h:
/usr/include/bits/pthreadtypes-arch.h:
/usr/include/bits/atomic_wide_counter.h:
/usr/include/bits/struct_mutex.h:
/usr/include/bits/struct_rwlock.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-bsearch.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/bits/types/locale_t.h:
/usr/include/bits/types/__locale_t.h:
/usr/include/strings.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h:
/usr/include/zmq.h:
/usr/include/errno.h:
/usr/include/bits/errno.h:
/usr/include/linux/errno.h:
/usr/include/asm/errno.h:
/usr/include/asm-generic/errno.h:
/usr/include/asm-generic/errno-base.h:
/usr/include/stdio.h:
/usr/include/bits/types/__fpos_t.h:
/usr/include/bits/types/__mbstate_t.h:
/usr/include/bits/types/__fpos64_t.h:
/usr/include/bits/types/__FILE.h:
/usr/include/bits/types/FILE.h:
/usr/include/bits/types/struct_FILE.h:
/usr/include/bits/types/cookie_io_functions_t.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/stdio.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h:
/usr/include/stdint.h:
/usr/include/bits/wchar.h:
/usr/include/bits/stdint-uintn.h:
/usr/include/bits/stdint-least.h:
/usr/include/signal.h:
/usr/include/bits/signum-generic.h:
/usr/include/bits/signum-arch.h:
/usr/include/bits/types/sig_atomic_t.h:
/usr/include/bits/types/siginfo_t.h:
/usr/include/bits/types/__sigval_t.h:
/usr/include/bits/siginfo-arch.h:
/usr/include/bits/siginfo-consts.h:
/usr/include/bits/types/sigval_t.h:
/usr/include/bits/types/sigevent_t.h:
/usr/include/bits/sigevent-consts.h:
/usr/include/bits/sigaction.h:
/usr/include/bits/sigcontext.h:
/usr/include/bits/types/stack_t.h:
/usr/include/sys/ucontext.h:
/usr/include/bits/sigstack.h:
/usr/include/bits/sigstksz.h:
/usr/include/bits/ss_flags.h:
/usr/include/bits/types/struct_sigstack.h:
/usr/include/bits/sigthread.h:
/usr/include/bits/signal_ext.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h:
emacs-module.h:

150
lisp/zmq/src/.deps/emacs_zmq_la-core.Plo Normal file
View File

@@ -0,0 +1,150 @@
emacs_zmq_la-core.lo: core.c /usr/include/stdc-predef.h core.h \
/usr/include/stdlib.h /usr/include/bits/libc-header-start.h \
/usr/include/features.h /usr/include/features-time64.h \
/usr/include/bits/wordsize.h /usr/include/bits/timesize.h \
/usr/include/sys/cdefs.h /usr/include/bits/long-double.h \
/usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h \
/usr/include/bits/waitflags.h /usr/include/bits/waitstatus.h \
/usr/include/bits/floatn.h /usr/include/bits/floatn-common.h \
/usr/include/sys/types.h /usr/include/bits/types.h \
/usr/include/bits/typesizes.h /usr/include/bits/time64.h \
/usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \
/usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \
/usr/include/bits/stdint-intn.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/endianness.h \
/usr/include/bits/byteswap.h /usr/include/bits/uintn-identity.h \
/usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/types/sigset_t.h /usr/include/bits/types/__sigset_t.h \
/usr/include/bits/types/struct_timeval.h \
/usr/include/bits/types/struct_timespec.h \
/usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \
/usr/include/bits/pthreadtypes-arch.h \
/usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \
/usr/include/bits/struct_rwlock.h /usr/include/alloca.h \
/usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/bits/types/locale_t.h \
/usr/include/bits/types/__locale_t.h /usr/include/strings.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h \
/usr/include/zmq.h /usr/include/errno.h /usr/include/bits/errno.h \
/usr/include/linux/errno.h /usr/include/asm/errno.h \
/usr/include/asm-generic/errno.h /usr/include/asm-generic/errno-base.h \
/usr/include/stdio.h /usr/include/bits/types/__fpos_t.h \
/usr/include/bits/types/__mbstate_t.h \
/usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \
/usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \
/usr/include/bits/types/cookie_io_functions_t.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h \
/usr/include/stdint.h /usr/include/bits/wchar.h \
/usr/include/bits/stdint-uintn.h /usr/include/bits/stdint-least.h \
/usr/include/signal.h /usr/include/bits/signum-generic.h \
/usr/include/bits/signum-arch.h /usr/include/bits/types/sig_atomic_t.h \
/usr/include/bits/types/siginfo_t.h /usr/include/bits/types/__sigval_t.h \
/usr/include/bits/siginfo-arch.h /usr/include/bits/siginfo-consts.h \
/usr/include/bits/types/sigval_t.h /usr/include/bits/types/sigevent_t.h \
/usr/include/bits/sigevent-consts.h /usr/include/bits/sigaction.h \
/usr/include/bits/sigcontext.h /usr/include/bits/types/stack_t.h \
/usr/include/sys/ucontext.h /usr/include/bits/sigstack.h \
/usr/include/bits/sigstksz.h /usr/include/bits/ss_flags.h \
/usr/include/bits/types/struct_sigstack.h /usr/include/bits/sigthread.h \
/usr/include/bits/signal_ext.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h emacs-module.h \
/usr/include/assert.h
/usr/include/stdc-predef.h:
core.h:
/usr/include/stdlib.h:
/usr/include/bits/libc-header-start.h:
/usr/include/features.h:
/usr/include/features-time64.h:
/usr/include/bits/wordsize.h:
/usr/include/bits/timesize.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/long-double.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/bits/floatn.h:
/usr/include/bits/floatn-common.h:
/usr/include/sys/types.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/bits/time64.h:
/usr/include/bits/types/clock_t.h:
/usr/include/bits/types/clockid_t.h:
/usr/include/bits/types/time_t.h:
/usr/include/bits/types/timer_t.h:
/usr/include/bits/stdint-intn.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/endianness.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/uintn-identity.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/types/sigset_t.h:
/usr/include/bits/types/__sigset_t.h:
/usr/include/bits/types/struct_timeval.h:
/usr/include/bits/types/struct_timespec.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/bits/thread-shared-types.h:
/usr/include/bits/pthreadtypes-arch.h:
/usr/include/bits/atomic_wide_counter.h:
/usr/include/bits/struct_mutex.h:
/usr/include/bits/struct_rwlock.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-bsearch.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/bits/types/locale_t.h:
/usr/include/bits/types/__locale_t.h:
/usr/include/strings.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h:
/usr/include/zmq.h:
/usr/include/errno.h:
/usr/include/bits/errno.h:
/usr/include/linux/errno.h:
/usr/include/asm/errno.h:
/usr/include/asm-generic/errno.h:
/usr/include/asm-generic/errno-base.h:
/usr/include/stdio.h:
/usr/include/bits/types/__fpos_t.h:
/usr/include/bits/types/__mbstate_t.h:
/usr/include/bits/types/__fpos64_t.h:
/usr/include/bits/types/__FILE.h:
/usr/include/bits/types/FILE.h:
/usr/include/bits/types/struct_FILE.h:
/usr/include/bits/types/cookie_io_functions_t.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/stdio.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h:
/usr/include/stdint.h:
/usr/include/bits/wchar.h:
/usr/include/bits/stdint-uintn.h:
/usr/include/bits/stdint-least.h:
/usr/include/signal.h:
/usr/include/bits/signum-generic.h:
/usr/include/bits/signum-arch.h:
/usr/include/bits/types/sig_atomic_t.h:
/usr/include/bits/types/siginfo_t.h:
/usr/include/bits/types/__sigval_t.h:
/usr/include/bits/siginfo-arch.h:
/usr/include/bits/siginfo-consts.h:
/usr/include/bits/types/sigval_t.h:
/usr/include/bits/types/sigevent_t.h:
/usr/include/bits/sigevent-consts.h:
/usr/include/bits/sigaction.h:
/usr/include/bits/sigcontext.h:
/usr/include/bits/types/stack_t.h:
/usr/include/sys/ucontext.h:
/usr/include/bits/sigstack.h:
/usr/include/bits/sigstksz.h:
/usr/include/bits/ss_flags.h:
/usr/include/bits/types/struct_sigstack.h:
/usr/include/bits/sigthread.h:
/usr/include/bits/signal_ext.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h:
emacs-module.h:
/usr/include/assert.h:

157
lisp/zmq/src/.deps/emacs_zmq_la-emacs-zmq.Plo Normal file
View File

@@ -0,0 +1,157 @@
emacs_zmq_la-emacs-zmq.lo: emacs-zmq.c /usr/include/stdc-predef.h \
emacs-zmq.h core.h /usr/include/stdlib.h \
/usr/include/bits/libc-header-start.h /usr/include/features.h \
/usr/include/features-time64.h /usr/include/bits/wordsize.h \
/usr/include/bits/timesize.h /usr/include/sys/cdefs.h \
/usr/include/bits/long-double.h /usr/include/gnu/stubs.h \
/usr/include/gnu/stubs-64.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h \
/usr/include/bits/waitflags.h /usr/include/bits/waitstatus.h \
/usr/include/bits/floatn.h /usr/include/bits/floatn-common.h \
/usr/include/sys/types.h /usr/include/bits/types.h \
/usr/include/bits/typesizes.h /usr/include/bits/time64.h \
/usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \
/usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \
/usr/include/bits/stdint-intn.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/endianness.h \
/usr/include/bits/byteswap.h /usr/include/bits/uintn-identity.h \
/usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/types/sigset_t.h /usr/include/bits/types/__sigset_t.h \
/usr/include/bits/types/struct_timeval.h \
/usr/include/bits/types/struct_timespec.h \
/usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \
/usr/include/bits/pthreadtypes-arch.h \
/usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \
/usr/include/bits/struct_rwlock.h /usr/include/alloca.h \
/usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/bits/types/locale_t.h \
/usr/include/bits/types/__locale_t.h /usr/include/strings.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h \
/usr/include/zmq.h /usr/include/errno.h /usr/include/bits/errno.h \
/usr/include/linux/errno.h /usr/include/asm/errno.h \
/usr/include/asm-generic/errno.h /usr/include/asm-generic/errno-base.h \
/usr/include/stdio.h /usr/include/bits/types/__fpos_t.h \
/usr/include/bits/types/__mbstate_t.h \
/usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \
/usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \
/usr/include/bits/types/cookie_io_functions_t.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h \
/usr/include/stdint.h /usr/include/bits/wchar.h \
/usr/include/bits/stdint-uintn.h /usr/include/bits/stdint-least.h \
/usr/include/signal.h /usr/include/bits/signum-generic.h \
/usr/include/bits/signum-arch.h /usr/include/bits/types/sig_atomic_t.h \
/usr/include/bits/types/siginfo_t.h /usr/include/bits/types/__sigval_t.h \
/usr/include/bits/siginfo-arch.h /usr/include/bits/siginfo-consts.h \
/usr/include/bits/types/sigval_t.h /usr/include/bits/types/sigevent_t.h \
/usr/include/bits/sigevent-consts.h /usr/include/bits/sigaction.h \
/usr/include/bits/sigcontext.h /usr/include/bits/types/stack_t.h \
/usr/include/sys/ucontext.h /usr/include/bits/sigstack.h \
/usr/include/bits/sigstksz.h /usr/include/bits/ss_flags.h \
/usr/include/bits/types/struct_sigstack.h /usr/include/bits/sigthread.h \
/usr/include/bits/signal_ext.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h emacs-module.h \
util.h msg.h socket.h context.h poll.h /usr/include/assert.h
/usr/include/stdc-predef.h:
emacs-zmq.h:
core.h:
/usr/include/stdlib.h:
/usr/include/bits/libc-header-start.h:
/usr/include/features.h:
/usr/include/features-time64.h:
/usr/include/bits/wordsize.h:
/usr/include/bits/timesize.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/long-double.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/bits/floatn.h:
/usr/include/bits/floatn-common.h:
/usr/include/sys/types.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/bits/time64.h:
/usr/include/bits/types/clock_t.h:
/usr/include/bits/types/clockid_t.h:
/usr/include/bits/types/time_t.h:
/usr/include/bits/types/timer_t.h:
/usr/include/bits/stdint-intn.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/endianness.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/uintn-identity.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/types/sigset_t.h:
/usr/include/bits/types/__sigset_t.h:
/usr/include/bits/types/struct_timeval.h:
/usr/include/bits/types/struct_timespec.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/bits/thread-shared-types.h:
/usr/include/bits/pthreadtypes-arch.h:
/usr/include/bits/atomic_wide_counter.h:
/usr/include/bits/struct_mutex.h:
/usr/include/bits/struct_rwlock.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-bsearch.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/bits/types/locale_t.h:
/usr/include/bits/types/__locale_t.h:
/usr/include/strings.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h:
/usr/include/zmq.h:
/usr/include/errno.h:
/usr/include/bits/errno.h:
/usr/include/linux/errno.h:
/usr/include/asm/errno.h:
/usr/include/asm-generic/errno.h:
/usr/include/asm-generic/errno-base.h:
/usr/include/stdio.h:
/usr/include/bits/types/__fpos_t.h:
/usr/include/bits/types/__mbstate_t.h:
/usr/include/bits/types/__fpos64_t.h:
/usr/include/bits/types/__FILE.h:
/usr/include/bits/types/FILE.h:
/usr/include/bits/types/struct_FILE.h:
/usr/include/bits/types/cookie_io_functions_t.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/stdio.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h:
/usr/include/stdint.h:
/usr/include/bits/wchar.h:
/usr/include/bits/stdint-uintn.h:
/usr/include/bits/stdint-least.h:
/usr/include/signal.h:
/usr/include/bits/signum-generic.h:
/usr/include/bits/signum-arch.h:
/usr/include/bits/types/sig_atomic_t.h:
/usr/include/bits/types/siginfo_t.h:
/usr/include/bits/types/__sigval_t.h:
/usr/include/bits/siginfo-arch.h:
/usr/include/bits/siginfo-consts.h:
/usr/include/bits/types/sigval_t.h:
/usr/include/bits/types/sigevent_t.h:
/usr/include/bits/sigevent-consts.h:
/usr/include/bits/sigaction.h:
/usr/include/bits/sigcontext.h:
/usr/include/bits/types/stack_t.h:
/usr/include/sys/ucontext.h:
/usr/include/bits/sigstack.h:
/usr/include/bits/sigstksz.h:
/usr/include/bits/ss_flags.h:
/usr/include/bits/types/struct_sigstack.h:
/usr/include/bits/sigthread.h:
/usr/include/bits/signal_ext.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h:
emacs-module.h:
util.h:
msg.h:
socket.h:
context.h:
poll.h:
/usr/include/assert.h:

149
lisp/zmq/src/.deps/emacs_zmq_la-msg.Plo Normal file
View File

@@ -0,0 +1,149 @@
emacs_zmq_la-msg.lo: msg.c /usr/include/stdc-predef.h msg.h core.h \
/usr/include/stdlib.h /usr/include/bits/libc-header-start.h \
/usr/include/features.h /usr/include/features-time64.h \
/usr/include/bits/wordsize.h /usr/include/bits/timesize.h \
/usr/include/sys/cdefs.h /usr/include/bits/long-double.h \
/usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h \
/usr/include/bits/waitflags.h /usr/include/bits/waitstatus.h \
/usr/include/bits/floatn.h /usr/include/bits/floatn-common.h \
/usr/include/sys/types.h /usr/include/bits/types.h \
/usr/include/bits/typesizes.h /usr/include/bits/time64.h \
/usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \
/usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \
/usr/include/bits/stdint-intn.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/endianness.h \
/usr/include/bits/byteswap.h /usr/include/bits/uintn-identity.h \
/usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/types/sigset_t.h /usr/include/bits/types/__sigset_t.h \
/usr/include/bits/types/struct_timeval.h \
/usr/include/bits/types/struct_timespec.h \
/usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \
/usr/include/bits/pthreadtypes-arch.h \
/usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \
/usr/include/bits/struct_rwlock.h /usr/include/alloca.h \
/usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/bits/types/locale_t.h \
/usr/include/bits/types/__locale_t.h /usr/include/strings.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h \
/usr/include/zmq.h /usr/include/errno.h /usr/include/bits/errno.h \
/usr/include/linux/errno.h /usr/include/asm/errno.h \
/usr/include/asm-generic/errno.h /usr/include/asm-generic/errno-base.h \
/usr/include/stdio.h /usr/include/bits/types/__fpos_t.h \
/usr/include/bits/types/__mbstate_t.h \
/usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \
/usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \
/usr/include/bits/types/cookie_io_functions_t.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h \
/usr/include/stdint.h /usr/include/bits/wchar.h \
/usr/include/bits/stdint-uintn.h /usr/include/bits/stdint-least.h \
/usr/include/signal.h /usr/include/bits/signum-generic.h \
/usr/include/bits/signum-arch.h /usr/include/bits/types/sig_atomic_t.h \
/usr/include/bits/types/siginfo_t.h /usr/include/bits/types/__sigval_t.h \
/usr/include/bits/siginfo-arch.h /usr/include/bits/siginfo-consts.h \
/usr/include/bits/types/sigval_t.h /usr/include/bits/types/sigevent_t.h \
/usr/include/bits/sigevent-consts.h /usr/include/bits/sigaction.h \
/usr/include/bits/sigcontext.h /usr/include/bits/types/stack_t.h \
/usr/include/sys/ucontext.h /usr/include/bits/sigstack.h \
/usr/include/bits/sigstksz.h /usr/include/bits/ss_flags.h \
/usr/include/bits/types/struct_sigstack.h /usr/include/bits/sigthread.h \
/usr/include/bits/signal_ext.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h emacs-module.h
/usr/include/stdc-predef.h:
msg.h:
core.h:
/usr/include/stdlib.h:
/usr/include/bits/libc-header-start.h:
/usr/include/features.h:
/usr/include/features-time64.h:
/usr/include/bits/wordsize.h:
/usr/include/bits/timesize.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/long-double.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/bits/floatn.h:
/usr/include/bits/floatn-common.h:
/usr/include/sys/types.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/bits/time64.h:
/usr/include/bits/types/clock_t.h:
/usr/include/bits/types/clockid_t.h:
/usr/include/bits/types/time_t.h:
/usr/include/bits/types/timer_t.h:
/usr/include/bits/stdint-intn.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/endianness.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/uintn-identity.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/types/sigset_t.h:
/usr/include/bits/types/__sigset_t.h:
/usr/include/bits/types/struct_timeval.h:
/usr/include/bits/types/struct_timespec.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/bits/thread-shared-types.h:
/usr/include/bits/pthreadtypes-arch.h:
/usr/include/bits/atomic_wide_counter.h:
/usr/include/bits/struct_mutex.h:
/usr/include/bits/struct_rwlock.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-bsearch.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/bits/types/locale_t.h:
/usr/include/bits/types/__locale_t.h:
/usr/include/strings.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h:
/usr/include/zmq.h:
/usr/include/errno.h:
/usr/include/bits/errno.h:
/usr/include/linux/errno.h:
/usr/include/asm/errno.h:
/usr/include/asm-generic/errno.h:
/usr/include/asm-generic/errno-base.h:
/usr/include/stdio.h:
/usr/include/bits/types/__fpos_t.h:
/usr/include/bits/types/__mbstate_t.h:
/usr/include/bits/types/__fpos64_t.h:
/usr/include/bits/types/__FILE.h:
/usr/include/bits/types/FILE.h:
/usr/include/bits/types/struct_FILE.h:
/usr/include/bits/types/cookie_io_functions_t.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/stdio.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h:
/usr/include/stdint.h:
/usr/include/bits/wchar.h:
/usr/include/bits/stdint-uintn.h:
/usr/include/bits/stdint-least.h:
/usr/include/signal.h:
/usr/include/bits/signum-generic.h:
/usr/include/bits/signum-arch.h:
/usr/include/bits/types/sig_atomic_t.h:
/usr/include/bits/types/siginfo_t.h:
/usr/include/bits/types/__sigval_t.h:
/usr/include/bits/siginfo-arch.h:
/usr/include/bits/siginfo-consts.h:
/usr/include/bits/types/sigval_t.h:
/usr/include/bits/types/sigevent_t.h:
/usr/include/bits/sigevent-consts.h:
/usr/include/bits/sigaction.h:
/usr/include/bits/sigcontext.h:
/usr/include/bits/types/stack_t.h:
/usr/include/sys/ucontext.h:
/usr/include/bits/sigstack.h:
/usr/include/bits/sigstksz.h:
/usr/include/bits/ss_flags.h:
/usr/include/bits/types/struct_sigstack.h:
/usr/include/bits/sigthread.h:
/usr/include/bits/signal_ext.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h:
emacs-module.h:

149
lisp/zmq/src/.deps/emacs_zmq_la-poll.Plo Normal file
View File

@@ -0,0 +1,149 @@
emacs_zmq_la-poll.lo: poll.c /usr/include/stdc-predef.h poll.h core.h \
/usr/include/stdlib.h /usr/include/bits/libc-header-start.h \
/usr/include/features.h /usr/include/features-time64.h \
/usr/include/bits/wordsize.h /usr/include/bits/timesize.h \
/usr/include/sys/cdefs.h /usr/include/bits/long-double.h \
/usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h \
/usr/include/bits/waitflags.h /usr/include/bits/waitstatus.h \
/usr/include/bits/floatn.h /usr/include/bits/floatn-common.h \
/usr/include/sys/types.h /usr/include/bits/types.h \
/usr/include/bits/typesizes.h /usr/include/bits/time64.h \
/usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \
/usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \
/usr/include/bits/stdint-intn.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/endianness.h \
/usr/include/bits/byteswap.h /usr/include/bits/uintn-identity.h \
/usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/types/sigset_t.h /usr/include/bits/types/__sigset_t.h \
/usr/include/bits/types/struct_timeval.h \
/usr/include/bits/types/struct_timespec.h \
/usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \
/usr/include/bits/pthreadtypes-arch.h \
/usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \
/usr/include/bits/struct_rwlock.h /usr/include/alloca.h \
/usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/bits/types/locale_t.h \
/usr/include/bits/types/__locale_t.h /usr/include/strings.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h \
/usr/include/zmq.h /usr/include/errno.h /usr/include/bits/errno.h \
/usr/include/linux/errno.h /usr/include/asm/errno.h \
/usr/include/asm-generic/errno.h /usr/include/asm-generic/errno-base.h \
/usr/include/stdio.h /usr/include/bits/types/__fpos_t.h \
/usr/include/bits/types/__mbstate_t.h \
/usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \
/usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \
/usr/include/bits/types/cookie_io_functions_t.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h \
/usr/include/stdint.h /usr/include/bits/wchar.h \
/usr/include/bits/stdint-uintn.h /usr/include/bits/stdint-least.h \
/usr/include/signal.h /usr/include/bits/signum-generic.h \
/usr/include/bits/signum-arch.h /usr/include/bits/types/sig_atomic_t.h \
/usr/include/bits/types/siginfo_t.h /usr/include/bits/types/__sigval_t.h \
/usr/include/bits/siginfo-arch.h /usr/include/bits/siginfo-consts.h \
/usr/include/bits/types/sigval_t.h /usr/include/bits/types/sigevent_t.h \
/usr/include/bits/sigevent-consts.h /usr/include/bits/sigaction.h \
/usr/include/bits/sigcontext.h /usr/include/bits/types/stack_t.h \
/usr/include/sys/ucontext.h /usr/include/bits/sigstack.h \
/usr/include/bits/sigstksz.h /usr/include/bits/ss_flags.h \
/usr/include/bits/types/struct_sigstack.h /usr/include/bits/sigthread.h \
/usr/include/bits/signal_ext.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h emacs-module.h
/usr/include/stdc-predef.h:
poll.h:
core.h:
/usr/include/stdlib.h:
/usr/include/bits/libc-header-start.h:
/usr/include/features.h:
/usr/include/features-time64.h:
/usr/include/bits/wordsize.h:
/usr/include/bits/timesize.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/long-double.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/bits/floatn.h:
/usr/include/bits/floatn-common.h:
/usr/include/sys/types.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/bits/time64.h:
/usr/include/bits/types/clock_t.h:
/usr/include/bits/types/clockid_t.h:
/usr/include/bits/types/time_t.h:
/usr/include/bits/types/timer_t.h:
/usr/include/bits/stdint-intn.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/endianness.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/uintn-identity.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/types/sigset_t.h:
/usr/include/bits/types/__sigset_t.h:
/usr/include/bits/types/struct_timeval.h:
/usr/include/bits/types/struct_timespec.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/bits/thread-shared-types.h:
/usr/include/bits/pthreadtypes-arch.h:
/usr/include/bits/atomic_wide_counter.h:
/usr/include/bits/struct_mutex.h:
/usr/include/bits/struct_rwlock.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-bsearch.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/bits/types/locale_t.h:
/usr/include/bits/types/__locale_t.h:
/usr/include/strings.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h:
/usr/include/zmq.h:
/usr/include/errno.h:
/usr/include/bits/errno.h:
/usr/include/linux/errno.h:
/usr/include/asm/errno.h:
/usr/include/asm-generic/errno.h:
/usr/include/asm-generic/errno-base.h:
/usr/include/stdio.h:
/usr/include/bits/types/__fpos_t.h:
/usr/include/bits/types/__mbstate_t.h:
/usr/include/bits/types/__fpos64_t.h:
/usr/include/bits/types/__FILE.h:
/usr/include/bits/types/FILE.h:
/usr/include/bits/types/struct_FILE.h:
/usr/include/bits/types/cookie_io_functions_t.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/stdio.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h:
/usr/include/stdint.h:
/usr/include/bits/wchar.h:
/usr/include/bits/stdint-uintn.h:
/usr/include/bits/stdint-least.h:
/usr/include/signal.h:
/usr/include/bits/signum-generic.h:
/usr/include/bits/signum-arch.h:
/usr/include/bits/types/sig_atomic_t.h:
/usr/include/bits/types/siginfo_t.h:
/usr/include/bits/types/__sigval_t.h:
/usr/include/bits/siginfo-arch.h:
/usr/include/bits/siginfo-consts.h:
/usr/include/bits/types/sigval_t.h:
/usr/include/bits/types/sigevent_t.h:
/usr/include/bits/sigevent-consts.h:
/usr/include/bits/sigaction.h:
/usr/include/bits/sigcontext.h:
/usr/include/bits/types/stack_t.h:
/usr/include/sys/ucontext.h:
/usr/include/bits/sigstack.h:
/usr/include/bits/sigstksz.h:
/usr/include/bits/ss_flags.h:
/usr/include/bits/types/struct_sigstack.h:
/usr/include/bits/sigthread.h:
/usr/include/bits/signal_ext.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h:
emacs-module.h:

151
lisp/zmq/src/.deps/emacs_zmq_la-socket.Plo Normal file
View File

@@ -0,0 +1,151 @@
emacs_zmq_la-socket.lo: socket.c /usr/include/stdc-predef.h socket.h \
core.h /usr/include/stdlib.h /usr/include/bits/libc-header-start.h \
/usr/include/features.h /usr/include/features-time64.h \
/usr/include/bits/wordsize.h /usr/include/bits/timesize.h \
/usr/include/sys/cdefs.h /usr/include/bits/long-double.h \
/usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h \
/usr/include/bits/waitflags.h /usr/include/bits/waitstatus.h \
/usr/include/bits/floatn.h /usr/include/bits/floatn-common.h \
/usr/include/sys/types.h /usr/include/bits/types.h \
/usr/include/bits/typesizes.h /usr/include/bits/time64.h \
/usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \
/usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \
/usr/include/bits/stdint-intn.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/endianness.h \
/usr/include/bits/byteswap.h /usr/include/bits/uintn-identity.h \
/usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/types/sigset_t.h /usr/include/bits/types/__sigset_t.h \
/usr/include/bits/types/struct_timeval.h \
/usr/include/bits/types/struct_timespec.h \
/usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \
/usr/include/bits/pthreadtypes-arch.h \
/usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \
/usr/include/bits/struct_rwlock.h /usr/include/alloca.h \
/usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/bits/types/locale_t.h \
/usr/include/bits/types/__locale_t.h /usr/include/strings.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h \
/usr/include/zmq.h /usr/include/errno.h /usr/include/bits/errno.h \
/usr/include/linux/errno.h /usr/include/asm/errno.h \
/usr/include/asm-generic/errno.h /usr/include/asm-generic/errno-base.h \
/usr/include/stdio.h /usr/include/bits/types/__fpos_t.h \
/usr/include/bits/types/__mbstate_t.h \
/usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \
/usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \
/usr/include/bits/types/cookie_io_functions_t.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h \
/usr/include/stdint.h /usr/include/bits/wchar.h \
/usr/include/bits/stdint-uintn.h /usr/include/bits/stdint-least.h \
/usr/include/signal.h /usr/include/bits/signum-generic.h \
/usr/include/bits/signum-arch.h /usr/include/bits/types/sig_atomic_t.h \
/usr/include/bits/types/siginfo_t.h /usr/include/bits/types/__sigval_t.h \
/usr/include/bits/siginfo-arch.h /usr/include/bits/siginfo-consts.h \
/usr/include/bits/types/sigval_t.h /usr/include/bits/types/sigevent_t.h \
/usr/include/bits/sigevent-consts.h /usr/include/bits/sigaction.h \
/usr/include/bits/sigcontext.h /usr/include/bits/types/stack_t.h \
/usr/include/sys/ucontext.h /usr/include/bits/sigstack.h \
/usr/include/bits/sigstksz.h /usr/include/bits/ss_flags.h \
/usr/include/bits/types/struct_sigstack.h /usr/include/bits/sigthread.h \
/usr/include/bits/signal_ext.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h emacs-module.h \
/usr/include/assert.h
/usr/include/stdc-predef.h:
socket.h:
core.h:
/usr/include/stdlib.h:
/usr/include/bits/libc-header-start.h:
/usr/include/features.h:
/usr/include/features-time64.h:
/usr/include/bits/wordsize.h:
/usr/include/bits/timesize.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/long-double.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/bits/floatn.h:
/usr/include/bits/floatn-common.h:
/usr/include/sys/types.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/bits/time64.h:
/usr/include/bits/types/clock_t.h:
/usr/include/bits/types/clockid_t.h:
/usr/include/bits/types/time_t.h:
/usr/include/bits/types/timer_t.h:
/usr/include/bits/stdint-intn.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/endianness.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/uintn-identity.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/types/sigset_t.h:
/usr/include/bits/types/__sigset_t.h:
/usr/include/bits/types/struct_timeval.h:
/usr/include/bits/types/struct_timespec.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/bits/thread-shared-types.h:
/usr/include/bits/pthreadtypes-arch.h:
/usr/include/bits/atomic_wide_counter.h:
/usr/include/bits/struct_mutex.h:
/usr/include/bits/struct_rwlock.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-bsearch.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/bits/types/locale_t.h:
/usr/include/bits/types/__locale_t.h:
/usr/include/strings.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h:
/usr/include/zmq.h:
/usr/include/errno.h:
/usr/include/bits/errno.h:
/usr/include/linux/errno.h:
/usr/include/asm/errno.h:
/usr/include/asm-generic/errno.h:
/usr/include/asm-generic/errno-base.h:
/usr/include/stdio.h:
/usr/include/bits/types/__fpos_t.h:
/usr/include/bits/types/__mbstate_t.h:
/usr/include/bits/types/__fpos64_t.h:
/usr/include/bits/types/__FILE.h:
/usr/include/bits/types/FILE.h:
/usr/include/bits/types/struct_FILE.h:
/usr/include/bits/types/cookie_io_functions_t.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/stdio.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h:
/usr/include/stdint.h:
/usr/include/bits/wchar.h:
/usr/include/bits/stdint-uintn.h:
/usr/include/bits/stdint-least.h:
/usr/include/signal.h:
/usr/include/bits/signum-generic.h:
/usr/include/bits/signum-arch.h:
/usr/include/bits/types/sig_atomic_t.h:
/usr/include/bits/types/siginfo_t.h:
/usr/include/bits/types/__sigval_t.h:
/usr/include/bits/siginfo-arch.h:
/usr/include/bits/siginfo-consts.h:
/usr/include/bits/types/sigval_t.h:
/usr/include/bits/types/sigevent_t.h:
/usr/include/bits/sigevent-consts.h:
/usr/include/bits/sigaction.h:
/usr/include/bits/sigcontext.h:
/usr/include/bits/types/stack_t.h:
/usr/include/sys/ucontext.h:
/usr/include/bits/sigstack.h:
/usr/include/bits/sigstksz.h:
/usr/include/bits/ss_flags.h:
/usr/include/bits/types/struct_sigstack.h:
/usr/include/bits/sigthread.h:
/usr/include/bits/signal_ext.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h:
emacs-module.h:
/usr/include/assert.h:

149
lisp/zmq/src/.deps/emacs_zmq_la-util.Plo Normal file
View File

@@ -0,0 +1,149 @@
emacs_zmq_la-util.lo: util.c /usr/include/stdc-predef.h util.h core.h \
/usr/include/stdlib.h /usr/include/bits/libc-header-start.h \
/usr/include/features.h /usr/include/features-time64.h \
/usr/include/bits/wordsize.h /usr/include/bits/timesize.h \
/usr/include/sys/cdefs.h /usr/include/bits/long-double.h \
/usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h \
/usr/include/bits/waitflags.h /usr/include/bits/waitstatus.h \
/usr/include/bits/floatn.h /usr/include/bits/floatn-common.h \
/usr/include/sys/types.h /usr/include/bits/types.h \
/usr/include/bits/typesizes.h /usr/include/bits/time64.h \
/usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \
/usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \
/usr/include/bits/stdint-intn.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/endianness.h \
/usr/include/bits/byteswap.h /usr/include/bits/uintn-identity.h \
/usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/types/sigset_t.h /usr/include/bits/types/__sigset_t.h \
/usr/include/bits/types/struct_timeval.h \
/usr/include/bits/types/struct_timespec.h \
/usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \
/usr/include/bits/pthreadtypes-arch.h \
/usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \
/usr/include/bits/struct_rwlock.h /usr/include/alloca.h \
/usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/bits/types/locale_t.h \
/usr/include/bits/types/__locale_t.h /usr/include/strings.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h \
/usr/include/zmq.h /usr/include/errno.h /usr/include/bits/errno.h \
/usr/include/linux/errno.h /usr/include/asm/errno.h \
/usr/include/asm-generic/errno.h /usr/include/asm-generic/errno-base.h \
/usr/include/stdio.h /usr/include/bits/types/__fpos_t.h \
/usr/include/bits/types/__mbstate_t.h \
/usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \
/usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \
/usr/include/bits/types/cookie_io_functions_t.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h \
/usr/include/stdint.h /usr/include/bits/wchar.h \
/usr/include/bits/stdint-uintn.h /usr/include/bits/stdint-least.h \
/usr/include/signal.h /usr/include/bits/signum-generic.h \
/usr/include/bits/signum-arch.h /usr/include/bits/types/sig_atomic_t.h \
/usr/include/bits/types/siginfo_t.h /usr/include/bits/types/__sigval_t.h \
/usr/include/bits/siginfo-arch.h /usr/include/bits/siginfo-consts.h \
/usr/include/bits/types/sigval_t.h /usr/include/bits/types/sigevent_t.h \
/usr/include/bits/sigevent-consts.h /usr/include/bits/sigaction.h \
/usr/include/bits/sigcontext.h /usr/include/bits/types/stack_t.h \
/usr/include/sys/ucontext.h /usr/include/bits/sigstack.h \
/usr/include/bits/sigstksz.h /usr/include/bits/ss_flags.h \
/usr/include/bits/types/struct_sigstack.h /usr/include/bits/sigthread.h \
/usr/include/bits/signal_ext.h \
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h emacs-module.h
/usr/include/stdc-predef.h:
util.h:
core.h:
/usr/include/stdlib.h:
/usr/include/bits/libc-header-start.h:
/usr/include/features.h:
/usr/include/features-time64.h:
/usr/include/bits/wordsize.h:
/usr/include/bits/timesize.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/long-double.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stddef.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/bits/floatn.h:
/usr/include/bits/floatn-common.h:
/usr/include/sys/types.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/bits/time64.h:
/usr/include/bits/types/clock_t.h:
/usr/include/bits/types/clockid_t.h:
/usr/include/bits/types/time_t.h:
/usr/include/bits/types/timer_t.h:
/usr/include/bits/stdint-intn.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/endianness.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/uintn-identity.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/types/sigset_t.h:
/usr/include/bits/types/__sigset_t.h:
/usr/include/bits/types/struct_timeval.h:
/usr/include/bits/types/struct_timespec.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/bits/thread-shared-types.h:
/usr/include/bits/pthreadtypes-arch.h:
/usr/include/bits/atomic_wide_counter.h:
/usr/include/bits/struct_mutex.h:
/usr/include/bits/struct_rwlock.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-bsearch.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/bits/types/locale_t.h:
/usr/include/bits/types/__locale_t.h:
/usr/include/strings.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdarg.h:
/usr/include/zmq.h:
/usr/include/errno.h:
/usr/include/bits/errno.h:
/usr/include/linux/errno.h:
/usr/include/asm/errno.h:
/usr/include/asm-generic/errno.h:
/usr/include/asm-generic/errno-base.h:
/usr/include/stdio.h:
/usr/include/bits/types/__fpos_t.h:
/usr/include/bits/types/__mbstate_t.h:
/usr/include/bits/types/__fpos64_t.h:
/usr/include/bits/types/__FILE.h:
/usr/include/bits/types/FILE.h:
/usr/include/bits/types/struct_FILE.h:
/usr/include/bits/types/cookie_io_functions_t.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/stdio.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdint.h:
/usr/include/stdint.h:
/usr/include/bits/wchar.h:
/usr/include/bits/stdint-uintn.h:
/usr/include/bits/stdint-least.h:
/usr/include/signal.h:
/usr/include/bits/signum-generic.h:
/usr/include/bits/signum-arch.h:
/usr/include/bits/types/sig_atomic_t.h:
/usr/include/bits/types/siginfo_t.h:
/usr/include/bits/types/__sigval_t.h:
/usr/include/bits/siginfo-arch.h:
/usr/include/bits/siginfo-consts.h:
/usr/include/bits/types/sigval_t.h:
/usr/include/bits/types/sigevent_t.h:
/usr/include/bits/sigevent-consts.h:
/usr/include/bits/sigaction.h:
/usr/include/bits/sigcontext.h:
/usr/include/bits/types/stack_t.h:
/usr/include/sys/ucontext.h:
/usr/include/bits/sigstack.h:
/usr/include/bits/sigstksz.h:
/usr/include/bits/ss_flags.h:
/usr/include/bits/types/struct_sigstack.h:
/usr/include/bits/sigthread.h:
/usr/include/bits/signal_ext.h:
/usr/lib/gcc/x86_64-pc-linux-gnu/13.2.1/include/stdbool.h:
emacs-module.h:

1
lisp/zmq/src/.libs/emacs-zmq.la Symbolic link
View File

@@ -0,0 +1 @@
../emacs-zmq.la

41
lisp/zmq/src/.libs/emacs-zmq.lai Normal file
View File

@@ -0,0 +1,41 @@
# emacs-zmq.la - a libtool library file
# Generated by libtool (GNU libtool) 2.4.7.4-1ec8f-dirty
#
# Please DO NOT delete this file!
# It is necessary for linking the library.
# The name that we can dlopen(3).
dlname='emacs-zmq.so'
# Names of this library.
library_names='emacs-zmq.so emacs-zmq.so emacs-zmq.so'
# The name of the static archive.
old_library=''
# Linker flags that cannot go in dependency_libs.
inherited_linker_flags=''
# Libraries that this one depends upon.
dependency_libs=' -lzmq'
# Names of additional weak libraries provided by this library
weak_library_names=''
# Version information for emacs-zmq.
current=0
age=0
revision=0
# Is this an already installed library?
installed=yes
# Should we warn about portability when linking against -modules?
shouldnotlink=yes
# Files to dlopen/dlpreopen
dlopen=''
dlpreopen=''
# Directory that this library needs to be installed in:
libdir='/home/daniel/repos/emacs-conf/lisp/zmq/lib'

BIN
lisp/zmq/src/.libs/emacs-zmq.so Executable file
View File

Binary file not shown.

BIN
lisp/zmq/src/.libs/emacs_zmq_la-constants.o Normal file
View File

Binary file not shown.

BIN
lisp/zmq/src/.libs/emacs_zmq_la-context.o Normal file
View File

Binary file not shown.

Some files were not shown because too many files have changed in this diff Show More