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

change python config, add jupyter and ein

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

663
lisp/zmq/zmq.el Normal file
View File

@@ -0,0 +1,663 @@
;;; zmq.el --- ZMQ bindings in elisp -*- lexical-binding: t -*-
;; Copyright (C) 2018 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 05 Jan 2018
;; URL: https://github.com/nnicandro/emacs-zmq
;; Keywords: comm
;; Version: 1.0.0
;; Package-Requires: ((cl-lib "0.5") (emacs "26"))
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Bindings to the ZMQ distributed messaging library in
;; Emacs.
;;; Code:
(require 'cl-lib)
(defgroup zmq nil
"ZMQ bindings for Emacs"
:group 'communication)
(defconst zmq-emacs-version "v1.0.0")
(defvar zmq-current-context nil
"The context set by the function `zmq-current-context'.")
(cl-deftype zmq-socket () '(satisfies zmq-socket-p))
(defun zmq-current-context ()
"Return the value of the variable `zmq-current-context' if non-nil.
Otherwise, create a new `zmq-context', bind it to the
variable `zmq-current-context', and return the newly created
context."
(or zmq-current-context
(setq zmq-current-context (zmq-context))))
(defun zmq-assoc (item list)
"Find the first match whose car is equal to ITEM in LIST.
`zmq-equal' is used for comparison."
(cl-assoc item list :test #'zmq-equal))
;;; Tunneling
;; TODO: Add password handling
(defun zmq-make-tunnel (lport rport server &optional remoteip)
"Forward traffic from LPORT on the localhost to REMOTEIP:RPORT on SERVER.
If REMOTEIP is nil, forward LPORT to RPORT on SERVER.
Forwarding is done with ssh."
(or remoteip (setq remoteip "127.0.0.1"))
(start-process
"zmq-tunnel" nil
"ssh"
;; Run in background
"-f"
;; Wait until the tunnel is open
"-o ExitOnForwardFailure=yes"
;; Local forward
"-L" (format "127.0.0.1:%d:%s:%d" lport remoteip rport)
server
;; Close the tunnel if no other connections are made within 60
;; seconds
"sleep 60"))
;;; Socket functions
(defun zmq-bind-to-random-port (sock addr &optional min-port max-port max-tries)
"Bind SOCK to ADDR on a random port.
ADDR must be an address string without the port.
Randomly bind SOCK to ADDR on a port in the range
[MIN-PORT,MAX-PORT)
If the port assigned is in use on ADDR, try a different port. If
SOCK could not be bound after MAX-TRIES return nil, otherwise
return the port SOCK was bound to. MIN-PORT defaults to 49152,
MAX-PORT defaults to 65536, and MAX-TRIES defaults to 100."
(setq min-port (or min-port 49152)
max-port (or max-port 65536)
max-tries (or max-tries 100))
(let (port)
(while (not (or port (zerop max-tries)))
(setq port (+ (cl-random (- max-port min-port)) min-port))
(condition-case nil
(zmq-bind sock (format "%s:%d" addr port))
((zmq-EACCES zmq-EADDRINUSE)
(setq port nil
max-tries (1- max-tries)))))
port))
;;; Sending/receiving multipart messages
(defun zmq-send-multipart (sock parts &optional flags)
"Send a multipart message on SOCK.
PARTS is a list of message parts to send on SOCK. FLAGS has the
same meaning as `zmq-send'."
(or flags (setq flags 0))
(while parts
(let ((part (zmq-message (car parts))))
(zmq-message-send
part sock (if (not (null (cdr parts)))
(logior flags zmq-SNDMORE)
flags))
(setq parts (cdr parts)))))
(defun zmq-recv-multipart (sock &optional flags)
"Receive a multipart message from SOCK.
FLAGS has the same meaning as in `zmq-recv'."
(let (res)
(catch 'recvd
(while t
(let ((part (zmq-message)))
(zmq-message-recv part sock flags)
(setq res (cons (zmq-message-data part) res))
(unless (zmq-message-more-p part)
(throw 'recvd (nreverse res))))))))
;;; Setting/getting options from contexts, sockets, messages
(defun zmq--set-get-option (set object option &optional value)
"Helper function for `zmq-get-option' and `zmq-set-option'.
If SET is non-nil, set OBJECT's OPTION to VALUE. Otherwise get
OPTION's value, ignoring any VALUE argument."
(let ((fun (cond
((zmq-socket-p object)
(if set #'zmq-socket-set #'zmq-socket-get))
((zmq-context-p object)
(if set #'zmq-context-set #'zmq-context-get))
((zmq-message-p object)
(if set #'zmq-message-set #'zmq-message-get))
(t (signal 'wrong-type-argument
(list
'(zmq-socket-p zmq-context-p zmq-message-p)
object))))))
(if set (funcall fun object option value)
(funcall fun object option))))
(defun zmq-set-option (object option value)
"For OBJECT, set OPTION to VALUE.
OBJECT can be a `zmq-socket', `zmq-context', or a `zmq-message'.
The OPTION set should correspond to one of the options available
for that particular object."
(zmq--set-get-option 'set object option value))
(defun zmq-get-option (object option)
"For OBJECT, get OPTION's value.
OBJECT can be a `zmq-socket', `zmq-context', or a `zmq-message'.
The OPTION to get should correspond to one of the options
available for that particular object."
(zmq--set-get-option nil object option))
(defconst zmq-message-properties '((:socket-type . "Socket-Type")
(:identity . "Identity")
(:resource . "Resource")
(:peer-address . "Peer-Address")
(:user-id . "User-Id"))
"Alist mapping keywords to their corresponding message property.
A message's metadata property can be accessed through
`zmq-message-property'.")
(defun zmq-message-property (message property)
"Get a MESSAGE's metadata PROPERTY.
PROPERTY is a keyword and can only be one of those in
`zmq-message-properties'."
(let ((prop (cdr (assoc property zmq-message-properties))))
(unless prop
(signal 'args-out-of-range
(list (mapcar #'car zmq-message-properties) prop)))
(decode-coding-string (zmq-message-gets message prop) 'utf-8)))
;;; Subprocesses
(define-error 'zmq-subprocess-error "Error in ZMQ subprocess")
(defun zmq-flush (stream)
"Flush STREAM.
STREAM can be one of `stdout', `stdin', or `stderr'."
(set-binary-mode stream t)
(set-binary-mode stream nil))
(defun zmq-prin1 (sexp)
"Print SEXP using `prin1' and flush `stdout' afterwards."
(prin1 sexp)
(zmq-flush 'stdout))
(defvar zmq--subprocess-debug nil
"If non-nil, capture backtraces in subprocesses.
Send backtraces as subprocess errors to the parent Emacs process.
In addition, log any stderr messages produced by the subprocess
as messages in the parent Emacs process.")
(defvar zmq-backtrace nil
"The backtrace stored when debugging the subprocess.")
(defun zmq--init-subprocess (&optional backtrace)
"Initialize the ZMQ subprocess.
Call `zmq-subprocess-read' and assuming the read s-expression is
a function, call the function. If the function accepts a single
argument, pass the `zmq-context' created by a call to the
function `zmq-current-context' as the argument.
If BACKTRACE is non-nil and an error occurs when evaluating, send
the backtrace to the parent process. This should only be used for
debugging purposes."
(if (not noninteractive) (error "Not a subprocess")
(let* ((debug-on-event nil)
(coding-system-for-write 'utf-8-emacs)
(signal-hook-function
(when backtrace
(lambda (&rest _)
(setq zmq-backtrace
(with-temp-buffer
(let ((standard-output (current-buffer)))
(backtrace))
(buffer-string)))))))
(condition-case err
(let* ((sexp (eval (zmq-subprocess-read)))
(wrap-context (= (length (cadr sexp)) 1)))
(if wrap-context
(funcall sexp (zmq-current-context))
(funcall sexp)))
(error
(zmq-prin1 (cons 'error (list (car err)
(or zmq-backtrace
(cdr err))))))))))
(defvar-local zmq--subprocess-parse-state nil
"The parse state of the output read from a subprocess.")
(defsubst zmq--subprocess-skip-delete-to-sexp ()
"Skip to the start of a list.
Delete the region between `point' and the start of the next list.
Only skip and delete if `zmq--subprocess-parse-state' is nil."
(unless zmq--subprocess-parse-state
(delete-region
(point) (+ (point) (skip-syntax-forward "^(")))))
(defun zmq--subprocess-read-output (output)
"Return a list of s-expressions read from OUTPUT.
OUTPUT is inserted into the `current-buffer' and `read' until the
first incomplete s-expression or until all s-expressions of
OUTPUT have been processed. After reading, the contents of the
`current-buffer' from `point-min' up to the last valid
s-expression is removed and a list of all the valid s-expressions
in OUTPUT is returned.
Any other text in OUTPUT that is not an s-expression is ignored.
Also note, for this function to work properly the same buffer
should be current for subsequent calls."
(let (accum)
(save-excursion (insert output))
(zmq--subprocess-skip-delete-to-sexp)
(while (/= (point) (point-max))
(setq zmq--subprocess-parse-state
(parse-partial-sexp
(point) (point-max) 0
nil zmq--subprocess-parse-state))
(when (= (nth 0 zmq--subprocess-parse-state) 0)
;; When a complete top-level s-expression has been
;; parsed, collect into the accumulated list of
;; complete s-expressions.
(let ((beg (nth 2 zmq--subprocess-parse-state))
(end (point)))
(goto-char beg)
(unwind-protect
(push (read (current-buffer)) accum)
(setq zmq--subprocess-parse-state nil)
(goto-char end)
(delete-region beg end))))
(zmq--subprocess-skip-delete-to-sexp))
(nreverse accum)))
(defun zmq--subprocess-handle-stderr (process)
"Print PROCESS' stderr as messages.
Do this only if the PROCESS has a non-nil :debug property."
(when (process-get process :debug)
(let ((stderr (process-get process :stderr)))
(unless (zerop (buffer-size (process-buffer stderr)))
(with-current-buffer (process-buffer stderr)
(let ((prefix (concat "STDERR[" (process-name process) "]: ")))
(goto-char (point-min))
(while (/= (point) (point-max))
(message "%s%s" prefix (buffer-substring
(line-beginning-position)
(line-end-position)))
(forward-line))
(erase-buffer)))))))
(defun zmq--subprocess-filter (process output)
"Create a stream of s-expressions based on PROCESS' OUTPUT.
If PROCESS has a non-nil `:filter' property then it should be a
function with the same meaning as the EVENT-FILTER argument in
`zmq-start-process', OUTPUT will be converted into a list of
s-expressions and the `:filter' function called for every valid
s-expression in OUTPUT.
As a special case, if the `car' of an s-expression is the symbol
error, a `zmq-subprocess-error' is signaled using the `cdr' of
the list for the error data."
(zmq--subprocess-handle-stderr process)
(with-current-buffer (process-buffer process)
(goto-char (process-mark process))
(let ((filter (process-get process :filter)))
(when filter
(let ((stream (let ((inhibit-read-only t))
(zmq--subprocess-read-output output))))
(cl-loop
for event in stream
if (and (listp event) (eq (car event) 'error)) do
;; TODO: Better way to handle this
(signal 'zmq-subprocess-error (cdr event))
else do (with-demoted-errors "Error in ZMQ subprocess filter: %S"
(funcall filter event))))))
(set-marker (process-mark process) (point-max))))
(defun zmq--subprocess-sentinel (process event)
"Sentinel function for ZMQ subprocesses.
If a PROCESS has a `:sentinel' property that is a function, the
function is called with identical arguments as this function.
When EVENT represents any of the events that notify when a
subprocess has exited, kill the process buffer only when the
`:owns-buffer' property of the PROCESS is non-nil. Otherwise the
process buffer is left alive and assumed to be a buffer that was
initially passed to `zmq-start-process'."
(let ((sentinel (process-get process :sentinel)))
(unwind-protect
(when (functionp sentinel)
(funcall sentinel process event))
(when (memq (process-status process) '(exit signal))
(delete-process process)
(when (process-get process :owns-buffer)
(kill-buffer (process-buffer process)))
(let ((stderr (process-get process :stderr)))
(when (process-live-p stderr)
(delete-process stderr))
(when (buffer-live-p (process-buffer stderr))
(kill-buffer (process-buffer stderr))))))))
(defvar zmq--subprocess-send-buffer nil)
;; Adapted from `async--insert-sexp' in the `async' package :)
(defun zmq-subprocess-send (process sexp)
"Send an s-expression to PROCESS' STDIN.
PROCESS should be an Emacs subprocess that decodes messages sent
on its STDIN using `zmq-subprocess-read'.
The SEXP is first encoded with the `utf-8-emacs' coding system and
then encoded using Base 64 encoding before being sent to the
subprocess."
(declare (indent 1))
(let ((print-circle t)
(print-escape-nonascii t)
print-level print-length)
(with-current-buffer
(if (buffer-live-p zmq--subprocess-send-buffer)
zmq--subprocess-send-buffer
(setq zmq--subprocess-send-buffer
(get-buffer-create " *zmq-subprocess-send*")))
(erase-buffer)
(prin1 sexp (current-buffer))
(encode-coding-region (point-min) (point-max) 'utf-8-emacs)
(base64-encode-region (point-min) (point-max) t)
(goto-char (point-min)) (insert ?\")
(goto-char (point-max)) (insert ?\" ?\n)
(process-send-region process (point-min) (point-max)))))
(defun zmq-subprocess-read ()
"Read a single s-expression from STDIN.
This does the decoding of the encoding described in
`zmq-subprocess-send' and returns the s-expression. This is only
meant to be called from an Emacs subprocess."
(if (not noninteractive) (error "Not in a subprocess")
(read (decode-coding-string
(base64-decode-string (read-minibuffer ""))
'utf-8-emacs))))
(defun zmq-set-subprocess-filter (process event-filter)
"Set the event filter function for PROCESS.
EVENT-FILTER has the same meaning as in `zmq-start-process'."
(process-put process :filter event-filter))
(defun zmq-set-subprocess-sentinel (process sentinel)
"Set the sentinel function for PROCESS.
SENTINEL has the same meaning as in `zmq-start-process'."
(process-put process :sentinel sentinel))
(defun zmq-set-subprocess-buffer (process buffer)
"Set PROCESS' buffer to BUFFER.
Delete PROCESS' current buffer if it was automatically created
when `zmq-start-process' was called. It is the responsibility of
the caller to cleanup BUFFER when PROCESS exits after a call to
this function."
(let ((marker (process-mark process)))
;; Copy over any pending results
(with-current-buffer (process-buffer process)
(copy-to-buffer buffer (point-min) (point-max)))
(set-process-buffer process buffer)
(set-marker marker (marker-position marker) buffer)
(when (process-get process :owns-buffer)
(kill-buffer (process-buffer process))
(setf (process-get process :owns-buffer) nil))))
(cl-defun zmq-start-process (sexp &key filter sentinel buffer debug)
"Start an Emacs subprocess initializing it with SEXP.
Return the newly created process.
SEXP is either a lambda form or a function symbol. In both cases
the function can either take 0 or 1 arguments. If SEXP takes 1
argument, then a new context object will be passed as the
argument of the function.
FILTER is a function that takes a single argument, a complete
s-expression read from the process' stdout. This means that care
should be taken when writing SEXP to ensure that it only prints
out lists. Anything other value that SEXP prints will be ignored.
SENTINEL has the same meaning as in `make-process'.
BUFFER will be set as the `process-buffer' for the returnd
process if non-nil. When BUFFER is nil, a new buffer will be
created. When a BUFFER is supplied, it should not be used for any
other purpose after a call to this function since it will be used
to store intermediate output from the subprocess. If this
function creates a new buffer, that buffer will be killed on
process exit, but it is the responsiblity of the caller to kill
the buffer if a buffer is supplied to this function.
If DEBUG is non-nil, then the subprocess returns a backtrace if
it errors out and prints its stderr as messages in the parent
Emacs process."
(or debug (setq debug zmq--subprocess-debug))
(cond
((functionp sexp)
(unless (listp sexp)
(setq sexp (symbol-function sexp))))
(t (error "Can only send functions to processes")))
(cl-destructuring-bind (min . max) (func-arity sexp)
(unless (and (<= min 1) (or (not (numberp max)) (<= max 1)))
(error "Invalid function to send to process, can only have 0 or 1 arguments")))
(let* ((zmq-path (locate-library "zmq.el"))
(cmd (format "(zmq--init-subprocess %s)" (when debug t)))
;; stderr is split from stdout since the former is used by
;; Emacs to print messages that we don't want intermixed
;; with what the subprocess returns.
(stderr (make-pipe-process
:name "zmq stderr"
:buffer (generate-new-buffer " *zmq*")
:noquery t
:stop (not debug)))
(process (make-process
:name "zmq"
:buffer (or buffer (generate-new-buffer " *zmq*"))
:noquery t
:connection-type 'pipe
:coding 'no-conversion
:filter #'zmq--subprocess-filter
:sentinel #'zmq--subprocess-sentinel
:stderr stderr
:command (list
(file-truename
(expand-file-name invocation-name
invocation-directory))
"-Q" "-batch"
"-L" (file-name-directory zmq-path)
"-l" zmq-path "--eval" cmd))))
(process-put process :debug debug)
(process-put process :stderr stderr)
(process-put process :filter filter)
(process-put process :sentinel sentinel)
(process-put process :owns-buffer (null buffer))
(with-current-buffer (process-buffer process)
(let ((inhibit-read-only t))
(erase-buffer))
(special-mode))
(zmq-subprocess-send process (macroexpand-all sexp))
process))
;;; Download releases
(defun zmq--system-configuration-list (string)
(save-match-data
(string-match "\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)\\(?:-\\(.+\\)\\)?" string)
(let ((arch (match-string 1 string))
(vendor (match-string 2 string))
(sys (match-string 3 string))
(abi (match-string 4 string)))
(list arch vendor sys abi))))
(defun zmq--system-configuration ()
(cl-destructuring-bind (arch vendor sys abi)
(zmq--system-configuration-list system-configuration)
;; Attempt to handle common systems
(cond
((string-prefix-p "darwin" sys)
;; On OSX the sys part of the host is like
;; darwin17.1.0, but the binaries are compatible across
;; multiple versions. TODO: Figure out the actual ABI
;; compatibility.
(concat arch "-" vendor "-darwin"))
((and (member vendor '("pc" "unknown" "none"))
(equal sys "linux"))
(concat arch "-" sys "-" abi))
(t
system-configuration))))
(defun zmq--insert-url-contents (url)
;; Attempt to download URL using various methods
(cond
((and (executable-find "curl")
;; -s = silent, -L = follow redirects
(let ((default-process-coding-system '(binary . binary)))
(zerop (call-process "curl" nil (current-buffer) nil
"-s" "-L" url)))))
((and (executable-find "wget")
;; -q = quiet, -O - = output to stdout
(let ((default-process-coding-system '(binary . binary)))
(zerop (call-process "wget" nil (current-buffer) nil
"-q" "-O" "-" url)))))
(t
(require 'url-handlers)
(let ((buf (url-retrieve-synchronously url)))
(url-insert buf)))))
(defmacro zmq--download-url (url &rest body)
(declare (indent 1))
`(with-temp-buffer
(set-buffer-multibyte nil)
(zmq--insert-url-contents ,url)
(goto-char (point-min))
,@body))
(defun zmq--download-and-extract-file (url tgz-file)
(message "Downloading %s/%s" url tgz-file)
(let ((sig (zmq--download-url (concat url "/" tgz-file ".sha256")
(forward-sexp)
(let ((end (point)))
(buffer-substring
(progn (backward-sexp) (point))
end)))))
(message "Verifying sha256 signature of %s" tgz-file)
(zmq--download-url (concat url "/" tgz-file)
(if (not (equal sig (secure-hash 'sha256 (buffer-string))))
(error "Signature did not match content")
;; We write the tar.gz file so that Emacs properly uncompresses
;; it through `jka-compr' otherwise `tar-untar-buffer' will
;; fail with a weird error.
(set-buffer-multibyte nil)
(write-region nil nil tgz-file)))
(let ((buffer (find-file-noselect tgz-file)))
(unwind-protect
(with-current-buffer buffer
(require 'tar-mode)
(tar-untar-buffer))
(kill-buffer buffer)
(delete-file tgz-file)))))
(defvar json-object-type)
(defun zmq--download-module (tag)
(let ((msg "Check%s for compatible module binary to download%s"))
(when (or noninteractive (y-or-n-p (format msg "" "? ")))
(when noninteractive
(message msg "ing" ""))
(catch 'failure
(let* ((api-url "https://api.github.com/repos/nnicandro/emacs-zmq/")
(repo-url "https://github.com/nnicandro/emacs-zmq/")
(release-url (concat api-url "releases/"))
(info (zmq--download-url (concat release-url tag)
(require 'json)
(let ((json-object-type 'plist))
(ignore-errors (json-read)))))
(tag-name (or (plist-get info :tag_name)
(throw 'failure nil)))
(ezmq-sys (concat "emacs-zmq-" (zmq--system-configuration)))
(assets (cl-remove-if-not
(lambda (x) (string-prefix-p ezmq-sys x))
(mapcar (lambda (x) (plist-get x :name))
(append (plist-get info :assets) nil)))))
(when assets
;; We have a signature file and a tar.gz file for each binary so the
;; minimum number of files is two.
(if (> (length assets) 2)
(error "TODO More than one file found")
(let* ((tgz-file (cl-find-if (lambda (x) (string-suffix-p ".tar.gz" x))
assets))
(tgz-dir (expand-file-name
(substring tgz-file 0
(- (length tgz-file)
(length ".tar.gz"))))))
(zmq--download-and-extract-file
(concat repo-url "releases/download/" tag-name) tgz-file)
(let* ((pat "emacs-zmq\\.\\(dll\\|so\\|dylib\\)$")
(lib (car (directory-files tgz-dir t pat))))
(copy-file lib (expand-file-name (file-name-nondirectory lib))))
t))))))))
;;; Load emacs-zmq
(defun zmq-load ()
"Load the ZMQ dynamic module."
;; Assume the module is already loaded when one of its functions is defined.
(unless (functionp #'zmq--cleanup-globrefs)
(if module-file-suffix
(let ((default-directory (file-name-directory (locate-library "zmq.el"))))
(if (load (expand-file-name "emacs-zmq") t)
(add-hook 'post-gc-hook #'zmq--cleanup-globrefs)
;; Can also be "latest"
(if (zmq--download-module (concat "tags/" zmq-emacs-version))
(zmq-load)
(let ((msg "ZMQ module not found. Build%s it%s"))
(when (or noninteractive (y-or-n-p (format msg "" "? ")))
(when noninteractive
(message msg "ing" ""))
(let ((emacs
(when (and invocation-directory invocation-name)
(file-truename
(expand-file-name invocation-name
invocation-directory)))))
(cl-labels
((load-zmq
(_buf status)
(if (string= status "finished\n")
(zmq-load)
(warn "Something went wrong when compiling the ZMQ module!"))
(remove-hook 'compilation-finish-functions #'load-zmq)
(exit-recursive-edit)))
(add-hook 'compilation-finish-functions #'load-zmq)
(compile (concat "make" (when emacs (concat " EMACS=" emacs))))
(recursive-edit))))))))
(user-error "Modules are not supported"))))
(zmq-load)
(provide 'zmq)
;; Local Variables:
;; byte-compile-warnings: (not free-vars unresolved)
;; End:
;;; zmq.el ends here