change python config, add jupyter and ein
This commit is contained in:
1109
lisp/ein/ein-cell.el
Normal file
1109
lisp/ein/ein-cell.el
Normal file
File diff suppressed because it is too large
Load Diff
331
lisp/ein/ein-classes.el
Normal file
331
lisp/ein/ein-classes.el
Normal 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
34
lisp/ein/ein-completer.el
Normal 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
353
lisp/ein/ein-contents-api.el
Normal 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
174
lisp/ein/ein-core.el
Normal 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
230
lisp/ein/ein-dev.el
Normal 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
63
lisp/ein/ein-events.el
Normal 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
63
lisp/ein/ein-file.el
Normal 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
729
lisp/ein/ein-gat.el
Normal 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
126
lisp/ein/ein-ipdb.el
Normal 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
81
lisp/ein/ein-ipynb-mode.el
Normal 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
435
lisp/ein/ein-jupyter.el
Normal 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
612
lisp/ein/ein-kernel.el
Normal 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
56
lisp/ein/ein-kernelinfo.el
Normal 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
55
lisp/ein/ein-kill-ring.el
Normal 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
116
lisp/ein/ein-log.el
Normal 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
8082
lisp/ein/ein-markdown-mode.el
Normal file
File diff suppressed because it is too large
Load Diff
65
lisp/ein/ein-node.el
Normal file
65
lisp/ein/ein-node.el
Normal 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
1011
lisp/ein/ein-notebook.el
Normal file
File diff suppressed because it is too large
Load Diff
826
lisp/ein/ein-notebooklist.el
Normal file
826
lisp/ein/ein-notebooklist.el
Normal 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
180
lisp/ein/ein-notification.el
Normal 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
187
lisp/ein/ein-output-area.el
Normal 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
98
lisp/ein/ein-pager.el
Normal 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
15
lisp/ein/ein-pkg.el
Normal 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
215
lisp/ein/ein-process.el
Normal 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
160
lisp/ein/ein-python-send.el
Normal 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
56
lisp/ein/ein-pytools.el
Normal 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
223
lisp/ein/ein-query.el
Normal 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
50
lisp/ein/ein-scratchsheet.el
Normal 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
230
lisp/ein/ein-shared-output.el
Normal 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
193
lisp/ein/ein-traceback.el
Normal 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
721
lisp/ein/ein-utils.el
Normal 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
119
lisp/ein/ein-websocket.el
Normal 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
1161
lisp/ein/ein-worksheet.el
Normal file
File diff suppressed because it is too large
Load Diff
52
lisp/ein/ein.el
Normal file
52
lisp/ein/ein.el
Normal 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
458
lisp/ein/ob-ein.el
Normal 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
496
lisp/ein/poly-ein.el
Normal 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)
|
||||
Reference in New Issue
Block a user