Python autocompletion added, completly fast, and smart completion
This commit is contained in:
parent
742297e1ee
commit
35dfce4c79
38
README
38
README
|
|
@ -1,14 +1,16 @@
|
|||
Kuso IDE - A piece of Shit GNU Emacs based IDE
|
||||
Copyright (C) 2010-2011 Sameer Rahmani <lxsameer@gnu.org>
|
||||
Kuso IDE
|
||||
========
|
||||
A piece of Shit GNU Emacs based IDE
|
||||
Copyright (C) 2010-2013 Sameer Rahmani <lxsameer@gnu.org>
|
||||
|
||||
Contents
|
||||
==============================
|
||||
--------
|
||||
|
||||
1. License
|
||||
2. Dependencies
|
||||
|
||||
1. License
|
||||
==============================
|
||||
----------
|
||||
Kuso IDE 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 of the License, or
|
||||
|
|
@ -27,28 +29,32 @@ with this program; if not, write to the Free Software Foundation, Inc.,
|
|||
under the term of GNU FDL.
|
||||
|
||||
2. Dependencies
|
||||
=============================
|
||||
Kuso IDE have these prequest softwares:
|
||||
---------------
|
||||
Kuso IDE required these softwares:
|
||||
|
||||
|
||||
* GNU Emacs
|
||||
|
||||
Python dependencies
|
||||
-------------------
|
||||
* pep8
|
||||
* pyflakes
|
||||
* pychecker
|
||||
* pylint
|
||||
^^^^^^^^^^^^^^^^^^^
|
||||
* pep8
|
||||
* pyflakes
|
||||
* pychecker
|
||||
* pylint
|
||||
|
||||
For autocompetion:
|
||||
* jedi
|
||||
* epc
|
||||
|
||||
HTML dependencies
|
||||
-----------------
|
||||
* tidy
|
||||
^^^^^^^^^^^^^^^^^
|
||||
* tidy
|
||||
|
||||
CSS dependencies
|
||||
----------------
|
||||
* python-cssutils (pip install cssutils)
|
||||
^^^^^^^^^^^^^^^^
|
||||
* python-cssutils (pip install cssutils)
|
||||
|
||||
|
||||
3. Installation
|
||||
===============
|
||||
---------------
|
||||
Just run install.sh in its directory
|
||||
|
|
|
|||
|
|
@ -19,6 +19,13 @@
|
|||
(require 'python-mode)
|
||||
(define-key py-mode-map (kbd "\C-c @") 'uncomment-region)
|
||||
|
||||
;; python autocomplete
|
||||
(require 'deferred)
|
||||
(require 'epc)
|
||||
(autoload 'jedi:setup "jedi" nil t)
|
||||
(add-hook 'python-mode-hook 'jedi:setup)
|
||||
(setq jedi:setup-keys t)
|
||||
|
||||
;; php-mode -------------------------------------------------------------------
|
||||
(autoload 'php-mode "php-mode" "PHP editing mode" t)
|
||||
(add-to-list 'auto-mode-alist '("\\.php\\'" . php-mode))
|
||||
|
|
|
|||
|
|
@ -19,6 +19,13 @@
|
|||
(require 'python-mode)
|
||||
(define-key py-mode-map (kbd "\C-c @") 'uncomment-region)
|
||||
|
||||
;; python autocomplete
|
||||
(require 'deferred)
|
||||
(require 'epc)
|
||||
(autoload 'jedi:setup "jedi" nil t)
|
||||
(add-hook 'python-mode-hook 'jedi:setup)
|
||||
(setq jedi:setup-keys t)
|
||||
|
||||
;; php-mode -------------------------------------------------------------------
|
||||
(autoload 'php-mode "php-mode" "PHP editing mode" t)
|
||||
(add-to-list 'auto-mode-alist '("\\.php\\'" . php-mode))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,504 @@
|
|||
;;; concurrent.el --- Concurrent utility functions for emacs lisp
|
||||
|
||||
;; Copyright (C) 2010, 2011, 2012 SAKURAI Masashi
|
||||
|
||||
;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
|
||||
;; Version: 0.3.1
|
||||
;; Keywords: deferred, async, concurrent
|
||||
;; Package-Requires: ((deferred "0.3.1"))
|
||||
;; URL: https://github.com/kiwanami/emacs-deferred/blob/master/README-concurrent.markdown
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; 'concurrent.el' is a higher level library for concurrent tasks
|
||||
;; based on 'deferred.el'. This library has following features:
|
||||
;;
|
||||
;; - Generator
|
||||
;; - Green thread
|
||||
;; - Semaphore
|
||||
;; - Dataflow
|
||||
;; - Signal/Channel
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(require 'deferred)
|
||||
|
||||
(defvar cc:version nil "version number")
|
||||
(setq cc:version "0.3")
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
|
||||
(defmacro cc:aif (test-form then-form &rest else-forms)
|
||||
(declare (debug (form form &rest form)))
|
||||
`(let ((it ,test-form))
|
||||
(if it ,then-form ,@else-forms)))
|
||||
(put 'cc:aif 'lisp-indent-function 2)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Generator
|
||||
|
||||
(defun cc:generator-replace-yield (tree)
|
||||
"[internal] Replace `yield' symbols to calling a function in TREE."
|
||||
(let (ret)
|
||||
(loop for i in tree
|
||||
do (cond
|
||||
((eq i 'yield)
|
||||
(push 'funcall ret)
|
||||
(push i ret))
|
||||
((listp i)
|
||||
(push (cc:generator-replace-yield i) ret))
|
||||
(t
|
||||
(push i ret))))
|
||||
(nreverse ret)))
|
||||
|
||||
(defun cc:generator-line (line)
|
||||
"[internal] Return a macro expansion to execute the sexp LINE
|
||||
asynchronously."
|
||||
(cond
|
||||
;; function object
|
||||
((functionp line)
|
||||
`(setq ,chain (deferred:nextc ,chain ,line)))
|
||||
;; while loop form
|
||||
((eq 'while (car line))
|
||||
(let ((condition (cadr line))
|
||||
(body (cddr line)))
|
||||
`(setq ,chain
|
||||
(deferred:nextc ,chain
|
||||
(deferred:lambda (x)
|
||||
(if ,condition
|
||||
(deferred:nextc
|
||||
(progn
|
||||
,@(cc:generator-replace-yield body)) self)))))))
|
||||
;; statement
|
||||
(t
|
||||
`(setq ,chain
|
||||
(deferred:nextc ,chain
|
||||
(deferred:lambda (x) ,(cc:generator-replace-yield line)))))))
|
||||
|
||||
(defmacro cc:generator (callback &rest body)
|
||||
"Create a generator object. If BODY has `yield' symbols, it
|
||||
means calling callback function CALLBACK."
|
||||
(let ((chain (gensym))
|
||||
(cc (gensym))
|
||||
(waiter (gensym)))
|
||||
`(lexical-let*
|
||||
(,chain
|
||||
(,cc ,callback)
|
||||
(,waiter (deferred:new))
|
||||
(yield (lambda (x) (funcall ,cc x) ,waiter)))
|
||||
(setq ,chain ,waiter)
|
||||
,@(loop for i in body
|
||||
collect
|
||||
(cc:generator-line i))
|
||||
(lambda () (deferred:callback ,waiter)))))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Thread
|
||||
|
||||
(defun cc:thread-line (wait-time chain line)
|
||||
"[internal] Return a macro expansion to execute the sexp LINE asynchronously.
|
||||
WAIT-TIME is an interval time between tasks.
|
||||
CHAIN is the previous deferred task."
|
||||
(cond
|
||||
;; function object
|
||||
((functionp line)
|
||||
`(setq ,chain (deferred:nextc ,chain ,line)))
|
||||
;; while loop form
|
||||
((eq 'while (car line))
|
||||
(let ((condition (cadr line))
|
||||
(body (cddr line))
|
||||
(retsym (gensym)))
|
||||
`(setq ,chain
|
||||
(deferred:nextc ,chain
|
||||
(deferred:lambda (x)
|
||||
(if ,condition
|
||||
(deferred:nextc
|
||||
(let ((,retsym (progn ,@body)))
|
||||
(if (deferred-p ,retsym) ,retsym
|
||||
(deferred:wait ,wait-time)))
|
||||
self)))))))
|
||||
;; statement
|
||||
(t
|
||||
`(setq ,chain
|
||||
(deferred:nextc ,chain
|
||||
(lambda (x) ,line))))))
|
||||
|
||||
(defmacro cc:thread (wait-time-msec &rest body)
|
||||
"Return a thread object."
|
||||
(let ((chain (gensym))
|
||||
(dstart (gensym)))
|
||||
`(lexical-let*
|
||||
(,chain
|
||||
(,dstart (deferred:new)))
|
||||
(setq ,chain ,dstart)
|
||||
,@(loop for i in body
|
||||
collect
|
||||
(cc:thread-line wait-time-msec chain i))
|
||||
(deferred:callback ,dstart))))
|
||||
(put 'cc:thread 'lisp-indent-function 1)
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Semaphore
|
||||
|
||||
(defstruct cc:semaphore max-permits permits waiting-deferreds)
|
||||
|
||||
(defun cc:semaphore-create(permits-num)
|
||||
"Return a semaphore object with PERMITS-NUM permissions."
|
||||
(make-cc:semaphore :max-permits permits-num :permits permits-num))
|
||||
|
||||
(defun cc:semaphore-acquire(semaphore)
|
||||
"Acquire an execution permission and return deferred object to chain.
|
||||
If this semaphore object has permissions, the subsequent deferred
|
||||
task is executed immediately. If this semaphore object has no
|
||||
permissions, the subsequent deferred task is blocked. After the
|
||||
permission is returned, the task is executed."
|
||||
(cond
|
||||
((< 0 (cc:semaphore-permits semaphore))
|
||||
(decf (cc:semaphore-permits semaphore))
|
||||
(deferred:succeed))
|
||||
(t
|
||||
(let ((d (deferred:new)))
|
||||
(push d (cc:semaphore-waiting-deferreds semaphore))
|
||||
d))))
|
||||
|
||||
(defun cc:semaphore-release(semaphore)
|
||||
"Release an execution permission. The programmer is responsible to return the permissions."
|
||||
(when (<= (cc:semaphore-max-permits semaphore)
|
||||
(cc:semaphore-permits semaphore))
|
||||
(error "Too many calling semaphore-release. [max:%s <= permits:%s]"
|
||||
(cc:semaphore-max-permits semaphore)
|
||||
(cc:semaphore-permits semaphore)))
|
||||
(let ((waiting-deferreds
|
||||
(cc:semaphore-waiting-deferreds semaphore)))
|
||||
(cond
|
||||
(waiting-deferreds
|
||||
(let* ((d (car (last waiting-deferreds))))
|
||||
(setf (cc:semaphore-waiting-deferreds semaphore)
|
||||
(nbutlast waiting-deferreds))
|
||||
(deferred:callback-post d)))
|
||||
(t
|
||||
(incf (cc:semaphore-permits semaphore)))))
|
||||
semaphore)
|
||||
|
||||
(defun cc:semaphore-with (semaphore body-func &optional error-func)
|
||||
"Execute the task BODY-FUNC asynchronously with the semaphore block."
|
||||
(lexical-let ((semaphore semaphore))
|
||||
(deferred:try
|
||||
(deferred:nextc (cc:semaphore-acquire semaphore) body-func)
|
||||
:catch
|
||||
error-func
|
||||
:finally
|
||||
(lambda (x) (cc:semaphore-release semaphore)))))
|
||||
(put 'cc:semaphore-with 'lisp-indent-function 1)
|
||||
|
||||
(defun cc:semaphore-release-all (semaphore)
|
||||
"Release all permissions for resetting the semaphore object.
|
||||
If the semaphore object has some blocked tasks, this function
|
||||
return a list of the tasks and clear the list of the blocked
|
||||
tasks in the semaphore object."
|
||||
(setf (cc:semaphore-permits semaphore)
|
||||
(cc:semaphore-max-permits semaphore))
|
||||
(let ((ds (cc:semaphore-waiting-deferreds semaphore)))
|
||||
(when ds
|
||||
(setf (cc:semaphore-waiting-deferreds semaphore) nil))
|
||||
ds))
|
||||
|
||||
(defun cc:semaphore-interrupt-all (semaphore)
|
||||
"Clear the list of the blocked tasks in the semaphore and return a deferred object to chain.
|
||||
This function is used for the interruption cases."
|
||||
(when (cc:semaphore-waiting-deferreds semaphore)
|
||||
(setf (cc:semaphore-waiting-deferreds semaphore) nil)
|
||||
(setf (cc:semaphore-permits semaphore) 0))
|
||||
(cc:semaphore-acquire semaphore))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Signal / Channel
|
||||
|
||||
(defun cc:signal-channel (&optional name parent-channel)
|
||||
"Create a channel.
|
||||
NAME is a channel name for debug.
|
||||
PARENT-CHANNEL is an upstream channel. The observers of this channel can receive the upstream signals.
|
||||
In the case of using the function `cc:signal-send', the observers of the upstream channel can not receive the signals of this channel. The function `cc:signal-send-global' can send a signal to the upstream channels from the downstream channels."
|
||||
(lexical-let
|
||||
((ch (cons
|
||||
(or name (format "signal%s" (deferred:uid))) ; name for debug
|
||||
(cons
|
||||
parent-channel ; parent-channel
|
||||
nil)))) ; observers
|
||||
(when parent-channel
|
||||
(cc:signal-connect
|
||||
parent-channel
|
||||
t (lambda (event)
|
||||
(destructuring-bind
|
||||
(event-name event-args) event
|
||||
(apply 'cc:signal-send
|
||||
ch event-name event-args)))))
|
||||
ch))
|
||||
|
||||
(defmacro cc:signal-name (ch)
|
||||
"[internal] Return signal name."
|
||||
`(car ,ch))
|
||||
|
||||
(defmacro cc:signal-parent-channel (ch)
|
||||
"[internal] Return parent channel object."
|
||||
`(cadr ,ch))
|
||||
|
||||
(defmacro cc:signal-observers (ch)
|
||||
"[internal] Return observers."
|
||||
`(cddr ,ch))
|
||||
|
||||
(defun cc:signal-connect (channel event-sym &optional callback)
|
||||
"Append an observer for EVENT-SYM of CHANNEL and return a deferred object.
|
||||
If EVENT-SYM is `t', the observer receives all signals of the channel.
|
||||
If CALLBACK function is given, the deferred object executes the
|
||||
CALLBACK function asynchronously. One can connect subsequent
|
||||
tasks to the returned deferred object."
|
||||
(let ((d (if callback
|
||||
(deferred:new callback)
|
||||
(deferred:new))))
|
||||
(push (cons event-sym d)
|
||||
(cc:signal-observers channel))
|
||||
d))
|
||||
|
||||
(defun cc:signal-send (channel event-sym &rest args)
|
||||
"Send a signal to CHANNEL. If ARGS values are given, observers can get the values by following code: (lambda (event) (destructuring-bind (event-sym (args)) event ... )). "
|
||||
(let ((observers (cc:signal-observers channel))
|
||||
(event (list event-sym args)))
|
||||
(loop for i in observers
|
||||
for name = (car i)
|
||||
for d = (cdr i)
|
||||
if (or (eq event-sym name) (eq t name))
|
||||
do (deferred:callback-post d event))))
|
||||
|
||||
(defun cc:signal-send-global (channel event-sym &rest args)
|
||||
"Send a signal to the most upstream channel. "
|
||||
(cc:aif (cc:signal-parent-channel channel)
|
||||
(apply 'cc:signal-send-global it event-sym args)
|
||||
(apply 'cc:signal-send channel event-sym args)))
|
||||
|
||||
|
||||
(defun cc:signal-disconnect (channel deferred)
|
||||
"Remove the observer object DEFERRED from CHANNEL and return
|
||||
the removed deferred object. "
|
||||
(let ((observers (cc:signal-observers channel)) deleted)
|
||||
(setf
|
||||
(cc:signal-observers channel) ; place
|
||||
(loop for i in observers
|
||||
for d = (cdr i)
|
||||
unless (eq d deferred)
|
||||
collect i
|
||||
else
|
||||
do (push i deleted)))
|
||||
deleted))
|
||||
|
||||
(defun cc:signal-disconnect-all (channel)
|
||||
"Remove all observers."
|
||||
(setf
|
||||
(cc:signal-observers channel) ; place
|
||||
nil))
|
||||
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Dataflow
|
||||
|
||||
;; Dataflow variable entry
|
||||
(defstruct cc:dataflow key (value 'cc:dataflow-undefine) deferred-list)
|
||||
|
||||
(defun cc:dataflow-undefine-p (obj)
|
||||
"[internal] If the variable entry is not bound, return `t'."
|
||||
(eq 'cc:dataflow-undefine (cc:dataflow-value obj)))
|
||||
|
||||
(defun cc:dataflow-environment (&optional parent-env test-func channel)
|
||||
"Create a dataflow environment.
|
||||
PARENT-ENV is the default environment. If this environment doesn't have the entry A and the parent one has the entry A, this environment can return the entry A. One can override the entry, setting another entry A to this environment.
|
||||
TEST-FUNC is a test function that compares the entry keys. The default function is `equal'.
|
||||
CHANNEL is a channel object that sends signals of variable events. Observers can receive following signals:
|
||||
-get-first : the fist referrer is waiting for binding,
|
||||
-get-waiting : another referrer is waiting for binding,
|
||||
-set : a value is bound,
|
||||
-get : returned a bound value,
|
||||
-clear : cleared one entry,
|
||||
-clear-all : cleared all entries.
|
||||
"
|
||||
(let ((this (list parent-env
|
||||
(or test-func 'equal)
|
||||
(or channel
|
||||
(cc:signal-channel
|
||||
'dataflow
|
||||
(and parent-env
|
||||
(cc:dataflow-channel parent-env)))))))
|
||||
(cc:dataflow-init-connect this)
|
||||
this))
|
||||
|
||||
(defun cc:dataflow-init-connect (df)
|
||||
"[internal] Initialize the channel object."
|
||||
(lexical-let ((df df))
|
||||
(cc:dataflow-connect
|
||||
df 'set
|
||||
(lambda (args)
|
||||
(destructuring-bind (event (key)) args
|
||||
(let* ((obj (cc:dataflow-get-object-for-value df key))
|
||||
(value (and obj (cc:dataflow-value obj))))
|
||||
(when obj
|
||||
(loop for i in (cc:aif (cc:dataflow-get-object-for-deferreds df key)
|
||||
(cc:dataflow-deferred-list it) nil)
|
||||
do (deferred:callback-post i value))
|
||||
(setf (cc:dataflow-deferred-list obj) nil))))))))
|
||||
|
||||
(defmacro cc:dataflow-parent-environment (df)
|
||||
"[internal] Return the parent environment."
|
||||
`(car ,df))
|
||||
|
||||
(defmacro cc:dataflow-test (df)
|
||||
"[internal] Return the test function."
|
||||
`(cadr ,df))
|
||||
|
||||
(defmacro cc:dataflow-channel (df)
|
||||
"[internal] Return the channel object."
|
||||
`(caddr ,df))
|
||||
|
||||
(defmacro cc:dataflow-list (df)
|
||||
"[internal] Return the list of deferred object which are waiting for value binding."
|
||||
`(cdddr ,df))
|
||||
|
||||
(defun cc:dataflow-get-object-for-value (df key)
|
||||
"[internal] Return an entry object that is indicated by KEY.
|
||||
If the environment DF doesn't have the entry and the parent one has the entry, this function returns the entry of the parent environment. This function doesn't affect the waiting list."
|
||||
(or
|
||||
(loop for i in (cc:dataflow-list df)
|
||||
with test = (cc:dataflow-test df)
|
||||
if (and (funcall test key (cc:dataflow-key i))
|
||||
(not (cc:dataflow-undefine-p i)))
|
||||
return i)
|
||||
(deferred:aand
|
||||
(cc:dataflow-parent-environment df)
|
||||
(cc:dataflow-get-object-for-value it key))))
|
||||
|
||||
(defun cc:dataflow-get-object-for-deferreds (df key)
|
||||
"[internal] Return a list of the deferred objects those are waiting for value binding.
|
||||
This function doesn't affect the waiting list and doesn't refer the parent environment."
|
||||
(loop for i in (cc:dataflow-list df)
|
||||
with test = (cc:dataflow-test df)
|
||||
if (funcall test key (cc:dataflow-key i))
|
||||
return i))
|
||||
|
||||
(defun cc:dataflow-connect (df event-sym &optional callback)
|
||||
"Append an observer for EVENT-SYM of the channel of DF and return a deferred object.
|
||||
See the docstring of `cc:dataflow-environment' for details."
|
||||
(cc:signal-connect (cc:dataflow-channel df) event-sym callback))
|
||||
|
||||
(defun cc:dataflow-signal (df event &optional arg)
|
||||
"[internal] Send a signal to the channel of DF."
|
||||
(cc:signal-send (cc:dataflow-channel df) event arg))
|
||||
|
||||
(defun cc:dataflow-get (df key)
|
||||
"Return a deferred object that can refer the value which is indicated by KEY.
|
||||
If DF has the entry that bound value, the subsequent deferred task is executed immediately.
|
||||
If not, the task is deferred till a value is bound."
|
||||
(let ((obj (cc:dataflow-get-object-for-value df key)))
|
||||
(cond
|
||||
((and obj (cc:dataflow-value obj))
|
||||
(cc:dataflow-signal df 'get key)
|
||||
(deferred:succeed (cc:dataflow-value obj)))
|
||||
(t
|
||||
(setq obj (cc:dataflow-get-object-for-deferreds df key))
|
||||
(unless obj
|
||||
(setq obj (make-cc:dataflow :key key))
|
||||
(push obj (cc:dataflow-list df))
|
||||
(cc:dataflow-signal df 'get-first key))
|
||||
(let ((d (deferred:new)))
|
||||
(push d (cc:dataflow-deferred-list obj))
|
||||
(cc:dataflow-signal df 'get-waiting key)
|
||||
d)))))
|
||||
|
||||
(defun cc:dataflow-get-sync (df key)
|
||||
"Return the value which is indicated by KEY synchronously.
|
||||
If the environment DF doesn't have an entry of KEY, this function returns nil."
|
||||
(let ((obj (cc:dataflow-get-object-for-value df key)))
|
||||
(and obj (cc:dataflow-value obj))))
|
||||
|
||||
(defun cc:dataflow-set (df key value)
|
||||
"Bind the VALUE to KEY in the environment DF.
|
||||
If DF already has the bound entry of KEY, this function throws an error signal.
|
||||
VALUE can be nil as a value."
|
||||
(let ((obj (cc:dataflow-get-object-for-deferreds df key)))
|
||||
(cond
|
||||
((and obj (not (cc:dataflow-undefine-p obj)))
|
||||
;; overwrite!
|
||||
(error "Can not set a dataflow value. The key [%s] has already had a value. NEW:[%s] OLD:[%s]" key value (cc:dataflow-value obj)))
|
||||
(obj
|
||||
(setf (cc:dataflow-value obj) value))
|
||||
(t
|
||||
;; just value arrived
|
||||
(push (make-cc:dataflow :key key :value value)
|
||||
(cc:dataflow-list df))))
|
||||
;; value arrived and start deferred objects
|
||||
(cc:dataflow-signal df 'set key)
|
||||
value))
|
||||
|
||||
(defun cc:dataflow-clear (df key)
|
||||
"Clear the entry which is indicated by KEY.
|
||||
This function does nothing for the waiting deferred objects."
|
||||
(cc:dataflow-signal df 'clear key)
|
||||
(setf (cc:dataflow-list df)
|
||||
(loop for i in (cc:dataflow-list df)
|
||||
with test = (cc:dataflow-test df)
|
||||
unless (funcall test key (cc:dataflow-key i))
|
||||
collect i)))
|
||||
|
||||
(defun cc:dataflow-get-avalable-pairs (df)
|
||||
"Return an available key-value alist in the environment DF and the parent ones."
|
||||
(append
|
||||
(loop for i in (cc:dataflow-list df)
|
||||
for key = (cc:dataflow-key i)
|
||||
for val = (cc:dataflow-value i)
|
||||
unless (cc:dataflow-undefine-p i) collect (cons key val))
|
||||
(deferred:aand
|
||||
(cc:dataflow-parent-environment df)
|
||||
(cc:dataflow-get-avalable-pairs it))))
|
||||
|
||||
(defun cc:dataflow-get-waiting-keys (df)
|
||||
"Return a list of keys which have waiting deferred objects in the environment DF and the parent ones."
|
||||
(append
|
||||
(loop for i in (cc:dataflow-list df)
|
||||
for key = (cc:dataflow-key i)
|
||||
for val = (cc:dataflow-value i)
|
||||
if (cc:dataflow-undefine-p i) collect key)
|
||||
(deferred:aand
|
||||
(cc:dataflow-parent-environment df)
|
||||
(cc:dataflow-get-waiting-keys it))))
|
||||
|
||||
(defun cc:dataflow-clear-all (df)
|
||||
"Clear all entries in the environment DF.
|
||||
This function does nothing for the waiting deferred objects."
|
||||
(cc:dataflow-signal df 'clear-all)
|
||||
(setf (cc:dataflow-list df) nil))
|
||||
|
||||
|
||||
(provide 'concurrent)
|
||||
;;; concurrent.el ends here
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,952 @@
|
|||
;;; deferred.el --- Simple asynchronous functions for emacs lisp
|
||||
|
||||
;; Copyright (C) 2010, 2011, 2012 SAKURAI Masashi
|
||||
|
||||
;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
|
||||
;; Version: 0.3.1
|
||||
;; Keywords: deferred, async
|
||||
;; URL: https://github.com/kiwanami/emacs-deferred
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; 'deferred.el' is a simple library for asynchronous tasks.
|
||||
;; [https://github.com/kiwanami/emacs-deferred]
|
||||
|
||||
;; The API is almost the same as JSDeferred written by cho45. See the
|
||||
;; JSDeferred and Mochikit.Async web sites for further documentations.
|
||||
;; [https://github.com/cho45/jsdeferred]
|
||||
;; [http://mochikit.com/doc/html/MochiKit/Async.html]
|
||||
|
||||
;; A good introduction document (JavaScript)
|
||||
;; [http://cho45.stfuawsc.com/jsdeferred/doc/intro.en.html]
|
||||
|
||||
;;; Samples:
|
||||
|
||||
;; ** HTTP Access
|
||||
|
||||
;; (require 'url)
|
||||
;; (deferred:$
|
||||
;; (deferred:url-retrieve "http://www.gnu.org")
|
||||
;; (deferred:nextc it
|
||||
;; (lambda (buf)
|
||||
;; (insert (with-current-buffer buf (buffer-string)))
|
||||
;; (kill-buffer buf))))
|
||||
|
||||
;; ** Invoking command tasks
|
||||
|
||||
;; (deferred:$
|
||||
;; (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png")
|
||||
;; (deferred:nextc it
|
||||
;; (lambda (x) (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg")))
|
||||
;; (deferred:nextc it
|
||||
;; (lambda (x)
|
||||
;; (insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil)))))
|
||||
|
||||
;; See the readme for further API documentation.
|
||||
|
||||
;; ** Applications
|
||||
|
||||
;; *Inertial scrolling for Emacs
|
||||
;; [https://github.com/kiwanami/emacs-inertial-scroll]
|
||||
|
||||
;; This program makes simple multi-thread function, using
|
||||
;; deferred.el.
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defvar deferred:version nil "deferred.el version")
|
||||
(setq deferred:version "0.3")
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defmacro deferred:aand (test &rest rest)
|
||||
"[internal] Anaphoric AND."
|
||||
(declare (debug ("test" form &rest form)))
|
||||
`(let ((it ,test))
|
||||
(if it ,(if rest `(deferred:aand ,@rest) 'it))))
|
||||
|
||||
(defmacro deferred:$ (&rest elements)
|
||||
"Anaphoric function chain macro for deferred chains."
|
||||
(declare (debug (&rest form)))
|
||||
`(let (it)
|
||||
,@(loop for i in elements
|
||||
with it = nil
|
||||
collect
|
||||
`(setq it ,i))
|
||||
it))
|
||||
|
||||
(defmacro deferred:lambda (args &rest body)
|
||||
"Anaphoric lambda macro for self recursion."
|
||||
(declare (debug ("args" form &rest form)))
|
||||
(let ((argsyms (loop for i in args collect (gensym))))
|
||||
`(lambda (,@argsyms)
|
||||
(lexical-let (self)
|
||||
(setq self (lambda( ,@args ) ,@body))
|
||||
(funcall self ,@argsyms)))))
|
||||
|
||||
(defun deferred:setTimeout (f msec)
|
||||
"[internal] Timer function that emulates the `setTimeout' function in JS."
|
||||
(run-at-time (/ msec 1000.0) nil f))
|
||||
|
||||
(defun deferred:cancelTimeout (id)
|
||||
"[internal] Timer cancellation function that emulates the `cancelTimeout' function in JS."
|
||||
(cancel-timer id))
|
||||
|
||||
(defun deferred:run-with-idle-timer (sec f)
|
||||
"[internal] Wrapper function for run-with-idle-timer."
|
||||
(run-with-idle-timer sec nil f))
|
||||
|
||||
(defun deferred:call-lambda (f &optional arg)
|
||||
"[internal] Call a function with one or zero argument safely.
|
||||
The lambda function can define with zero and one argument."
|
||||
(condition-case err
|
||||
(funcall f arg)
|
||||
('wrong-number-of-arguments
|
||||
(display-warning 'deferred "\
|
||||
Callback that takes no argument may be specified.
|
||||
Passing callback with no argument is deprecated.
|
||||
Callback must take one argument.
|
||||
Or, this error is coming from somewhere inside of the callback: %S" err)
|
||||
(condition-case err2
|
||||
(funcall f)
|
||||
('wrong-number-of-arguments
|
||||
(signal 'wrong-number-of-arguments (cdr err))))))) ; return the first error
|
||||
|
||||
;; debug
|
||||
|
||||
(eval-and-compile
|
||||
(defvar deferred:debug nil "Debug output switch."))
|
||||
(defvar deferred:debug-count 0 "[internal] Debug output counter.")
|
||||
|
||||
(defmacro deferred:message (&rest args)
|
||||
"[internal] Debug log function."
|
||||
(when deferred:debug
|
||||
`(progn
|
||||
(with-current-buffer (get-buffer-create "*deferred:debug*")
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(insert (format "%5i %s\n" deferred:debug-count (format ,@args)))))
|
||||
(incf deferred:debug-count))))
|
||||
|
||||
(defun deferred:message-mark ()
|
||||
"[internal] Debug log function."
|
||||
(interactive)
|
||||
(deferred:message "==================== mark ==== %s"
|
||||
(format-time-string "%H:%M:%S" (current-time))))
|
||||
|
||||
(defun deferred:pp (d)
|
||||
(require 'pp)
|
||||
(deferred:$
|
||||
(deferred:nextc d
|
||||
(lambda (x)
|
||||
(pp-display-expression x "*deferred:pp*")))
|
||||
(deferred:error it
|
||||
(lambda (e)
|
||||
(pp-display-expression e "*deferred:pp*")))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (pop-to-buffer "*deferred:pp*")))))
|
||||
|
||||
(defvar deferred:debug-on-signal nil
|
||||
"If non nil, the value `debug-on-signal' is substituted this
|
||||
value in the `condition-case' form in deferred
|
||||
implementations. Then, Emacs debugger can catch an error occurred
|
||||
in the asynchronous tasks.")
|
||||
|
||||
(defmacro deferred:condition-case (var protected-form &rest handlers)
|
||||
"[internal] Custom condition-case. See the comment for
|
||||
`deferred:debug-on-signal'."
|
||||
(declare (debug (symbolp form &rest form)))
|
||||
`(cond
|
||||
((null deferred:debug-on-signal)
|
||||
(condition-case ,var ,protected-form ,@handlers))
|
||||
(t
|
||||
(let ((deferred:debug-on-signal-backup debug-on-signal))
|
||||
(setq debug-on-signal deferred:debug-on-signal)
|
||||
(unwind-protect
|
||||
(condition-case ,var ,protected-form ,@handlers)
|
||||
(setq debug-on-signal deferred:debug-on-signal-backup))))))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Back end functions of deferred tasks
|
||||
|
||||
(defvar deferred:tick-time 0.001
|
||||
"Waiting time between asynchronous tasks (second).
|
||||
The shorter waiting time increases the load of Emacs. The end
|
||||
user can tune this paramter. However, applications should not
|
||||
modify it because the applications run on various environments.")
|
||||
|
||||
(defvar deferred:queue nil
|
||||
"[internal] The execution queue of deferred objects.
|
||||
See the functions `deferred:post-task' and `deferred:worker'.")
|
||||
|
||||
(defmacro deferred:pack (a b c)
|
||||
`(cons ,a (cons ,b ,c)))
|
||||
|
||||
(defun deferred:schedule-worker ()
|
||||
"[internal] Schedule consuming a deferred task in the execution queue."
|
||||
(run-at-time deferred:tick-time nil 'deferred:worker))
|
||||
|
||||
(defun deferred:post-task (d which &optional arg)
|
||||
"[internal] Add a deferred object to the execution queue
|
||||
`deferred:queue' and schedule to execute.
|
||||
D is a deferred object. WHICH is a symbol, `ok' or `ng'. ARG is
|
||||
an argument value for execution of the deferred task."
|
||||
(push (deferred:pack d which arg) deferred:queue)
|
||||
(deferred:message "QUEUE-POST [%s]: %s"
|
||||
(length deferred:queue) (deferred:pack d which arg))
|
||||
(deferred:schedule-worker)
|
||||
d)
|
||||
|
||||
(defun deferred:clear-queue ()
|
||||
"Clear the execution queue. For test and debugging."
|
||||
(interactive)
|
||||
(deferred:message "QUEUE-CLEAR [%s -> 0]" (length deferred:queue))
|
||||
(setq deferred:queue nil))
|
||||
|
||||
(defun deferred:esc-msg (msg)
|
||||
"[internal] Escaping the character '%'."
|
||||
(replace-regexp-in-string
|
||||
"\\([^%]\\|^\\)%\\([^%]\\)" "\\1%%\\2" msg))
|
||||
|
||||
(defun deferred:worker ()
|
||||
"[internal] Consume a deferred task.
|
||||
Mainly this function is called by timer asynchronously."
|
||||
(when deferred:queue
|
||||
(let* ((pack (car (last deferred:queue)))
|
||||
(d (car pack))
|
||||
(which (cadr pack))
|
||||
(arg (cddr pack)) value)
|
||||
(setq deferred:queue (nbutlast deferred:queue))
|
||||
(condition-case err
|
||||
(setq value (deferred:exec-task d which arg))
|
||||
(error
|
||||
(deferred:message "ERROR : %s" err)
|
||||
(message "deferred error : %s" err)))
|
||||
value)))
|
||||
|
||||
(defun deferred:flush-queue! ()
|
||||
"Call all deferred tasks synchronously. For test and debugging."
|
||||
(let (value)
|
||||
(while deferred:queue
|
||||
(setq value (deferred:worker)))
|
||||
value))
|
||||
|
||||
(defun deferred:sync! (d)
|
||||
"Wait for the given deferred task. For test and debugging."
|
||||
(progn
|
||||
(lexical-let ((last-value 'deferred:undefined*))
|
||||
(deferred:nextc d
|
||||
(lambda (x) (setq last-value x)))
|
||||
(while (eq 'deferred:undefined* last-value)
|
||||
(sit-for 0.05)
|
||||
(sleep-for 0.05))
|
||||
last-value)))
|
||||
|
||||
|
||||
|
||||
;; Struct: deferred
|
||||
;;
|
||||
;; callback : a callback function (default `deferred:default-callback')
|
||||
;; errorback : an errorback function (default `deferred:default-errorback')
|
||||
;; cancel : a canceling function (default `deferred:default-cancel')
|
||||
;; next : a next chained deferred object (default nil)
|
||||
;; status : if 'ok or 'ng, this deferred has a result (error) value. (default nil)
|
||||
;; value : saved value (default nil)
|
||||
;;
|
||||
(defstruct deferred
|
||||
(callback 'deferred:default-callback)
|
||||
(errorback 'deferred:default-errorback)
|
||||
(cancel 'deferred:default-cancel)
|
||||
next status value)
|
||||
|
||||
(defun deferred:default-callback (i)
|
||||
"[internal] Default callback function."
|
||||
(identity i))
|
||||
|
||||
(defun deferred:default-errorback (error-msg)
|
||||
"[internal] Default errorback function."
|
||||
(error (deferred:esc-msg
|
||||
(cond
|
||||
((stringp error-msg) error-msg)
|
||||
((listp error-msg) (cadr error-msg))
|
||||
(t (format "%S" error-msg))))))
|
||||
|
||||
(defun deferred:default-cancel (d)
|
||||
"[internal] Default canceling function."
|
||||
(deferred:message "CANCEL : %s" d)
|
||||
(setf (deferred-callback d) 'deferred:default-callback)
|
||||
(setf (deferred-errorback d) 'deferred:default-errorback)
|
||||
(setf (deferred-next d) nil)
|
||||
d)
|
||||
|
||||
(defun deferred:exec-task (d which &optional arg)
|
||||
"[internal] Executing deferred task. If the deferred object has
|
||||
next deferred task or the return value is a deferred object, this
|
||||
function adds the task to the execution queue.
|
||||
D is a deferred object. WHICH is a symbol, `ok' or `ng'. ARG is
|
||||
an argument value for execution of the deferred task."
|
||||
(deferred:message "EXEC : %s / %s / %s" d which arg)
|
||||
(when (null d) (error "deferred:exec-task was given a nil."))
|
||||
(let ((callback (if (eq which 'ok)
|
||||
(deferred-callback d)
|
||||
(deferred-errorback d))))
|
||||
(cond
|
||||
(callback
|
||||
(let (value (next-deferred (deferred-next d)))
|
||||
(deferred:condition-case err
|
||||
(progn
|
||||
(setq value
|
||||
(deferred:call-lambda callback arg))
|
||||
(cond
|
||||
((deferred-p value)
|
||||
(deferred:message "WAIT NEST : %s" value)
|
||||
(if next-deferred
|
||||
(deferred:set-next value next-deferred)
|
||||
value))
|
||||
(t
|
||||
(if next-deferred
|
||||
(deferred:post-task next-deferred 'ok value)
|
||||
(setf (deferred-status d) 'ok)
|
||||
(setf (deferred-value d) value)
|
||||
value))))
|
||||
(error
|
||||
(cond
|
||||
(next-deferred
|
||||
(deferred:post-task next-deferred 'ng (error-message-string err)))
|
||||
(deferred:onerror
|
||||
(deferred:call-lambda deferred:onerror err))
|
||||
(t
|
||||
(deferred:message "ERROR : %s" err)
|
||||
(message "deferred error : %s" err)
|
||||
(setf (deferred-status d) 'ng)
|
||||
(setf (deferred-value d) (error-message-string err))
|
||||
(deferred:esc-msg (error-message-string err))))))))
|
||||
(t ; <= (null callback)
|
||||
(let ((next-deferred (deferred-next d)))
|
||||
(cond
|
||||
(next-deferred
|
||||
(deferred:exec-task next-deferred which arg))
|
||||
((eq which 'ok) arg)
|
||||
(t (error (deferred:esc-msg arg)))))))))
|
||||
|
||||
(defun deferred:set-next (prev next)
|
||||
"[internal] Connect deferred objects."
|
||||
(setf (deferred-next prev) next)
|
||||
(cond
|
||||
((eq 'ok (deferred-status prev))
|
||||
(setf (deferred-status prev) nil)
|
||||
(let ((ret (deferred:exec-task
|
||||
next 'ok (deferred-value prev))))
|
||||
(if (deferred-p ret) ret
|
||||
next)))
|
||||
((eq 'ng (deferred-status prev))
|
||||
(setf (deferred-status prev) nil)
|
||||
(let ((ret (deferred:exec-task next 'ng (deferred-value prev))))
|
||||
(if (deferred-p ret) ret
|
||||
next)))
|
||||
(t
|
||||
next)))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Basic functions for deferred objects
|
||||
|
||||
(defun deferred:new (&optional callback)
|
||||
"Create a deferred object."
|
||||
(if callback
|
||||
(make-deferred :callback callback)
|
||||
(make-deferred)))
|
||||
|
||||
(defun deferred:callback (d &optional arg)
|
||||
"Start deferred chain with a callback message."
|
||||
(deferred:exec-task d 'ok arg))
|
||||
|
||||
(defun deferred:errorback (d &optional arg)
|
||||
"Start deferred chain with an errorback message."
|
||||
(deferred:exec-task d 'ng arg))
|
||||
|
||||
(defun deferred:callback-post (d &optional arg)
|
||||
"Add the deferred object to the execution queue."
|
||||
(deferred:post-task d 'ok arg))
|
||||
|
||||
(defun deferred:errorback-post (d &optional arg)
|
||||
"Add the deferred object to the execution queue."
|
||||
(deferred:post-task d 'ng arg))
|
||||
|
||||
(defun deferred:cancel (d)
|
||||
"Cancel all callbacks and deferred chain in the deferred object."
|
||||
(deferred:message "CANCEL : %s" d)
|
||||
(funcall (deferred-cancel d) d)
|
||||
d)
|
||||
|
||||
(defun deferred:status (d)
|
||||
"Return a current status of the deferred object. The returned value means following:
|
||||
`ok': the callback was called and waiting for next deferred.
|
||||
`ng': the errorback was called and waiting for next deferred.
|
||||
nil: The neither callback nor errorback was not called."
|
||||
(deferred-status d))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Basic utility functions
|
||||
|
||||
(defvar deferred:onerror nil
|
||||
"Default error handler. This value is nil or a function that
|
||||
have one argument for the error message.")
|
||||
|
||||
(defun deferred:succeed (&optional arg)
|
||||
"Create a synchronous deferred object."
|
||||
(let ((d (deferred:new)))
|
||||
(deferred:exec-task d 'ok arg)
|
||||
d))
|
||||
|
||||
(defun deferred:fail (&optional arg)
|
||||
"Create a synchronous deferred object."
|
||||
(let ((d (deferred:new)))
|
||||
(deferred:exec-task d 'ok arg)
|
||||
d))
|
||||
|
||||
(defun deferred:next (&optional callback arg)
|
||||
"Create a deferred object and schedule executing. This function
|
||||
is a short cut of following code:
|
||||
(deferred:callback-post (deferred:new callback))."
|
||||
(let ((d (if callback
|
||||
(make-deferred :callback callback)
|
||||
(make-deferred))))
|
||||
(deferred:callback-post d arg)
|
||||
d))
|
||||
|
||||
(defun deferred:nextc (d callback)
|
||||
"Create a deferred object with OK callback and connect it to the given deferred object."
|
||||
(let ((nd (make-deferred :callback callback)))
|
||||
(deferred:set-next d nd)))
|
||||
|
||||
(defun deferred:error (d callback)
|
||||
"Create a deferred object with errorback and connect it to the given deferred object."
|
||||
(let ((nd (make-deferred :errorback callback)))
|
||||
(deferred:set-next d nd)))
|
||||
|
||||
(defun deferred:watch (d callback)
|
||||
"Create a deferred object with watch task and connect it to the given deferred object.
|
||||
The watch task CALLBACK can not affect deferred chains with
|
||||
return values. This function is used in following purposes,
|
||||
simulation of try-finally block in asynchronous tasks, progress
|
||||
monitoring of tasks."
|
||||
(lexical-let*
|
||||
((callback callback)
|
||||
(normal (lambda (x) (ignore-errors (deferred:call-lambda callback x)) x))
|
||||
(err (lambda (e) (ignore-errors (deferred:call-lambda callback e)) (error e))))
|
||||
(let ((nd (make-deferred :callback normal :errorback err)))
|
||||
(deferred:set-next d nd))))
|
||||
|
||||
(defun deferred:wait (msec)
|
||||
"Return a deferred object scheduled at MSEC millisecond later."
|
||||
(lexical-let
|
||||
((d (deferred:new)) (start-time (float-time)) timer)
|
||||
(deferred:message "WAIT : %s" msec)
|
||||
(setq timer (deferred:setTimeout
|
||||
(lambda ()
|
||||
(deferred:exec-task d 'ok
|
||||
(* 1000.0 (- (float-time) start-time)))
|
||||
nil) msec))
|
||||
(setf (deferred-cancel d)
|
||||
(lambda (x)
|
||||
(deferred:cancelTimeout timer)
|
||||
(deferred:default-cancel x)))
|
||||
d))
|
||||
|
||||
(defun deferred:wait-idle (msec)
|
||||
"Return a deferred object which will run when Emacs has been
|
||||
idle for MSEC millisecond."
|
||||
(lexical-let
|
||||
((d (deferred:new)) (start-time (float-time)) timer)
|
||||
(deferred:message "WAIT-IDLE : %s" msec)
|
||||
(setq timer
|
||||
(deferred:run-with-idle-timer
|
||||
(/ msec 1000.0)
|
||||
(lambda ()
|
||||
(deferred:exec-task d 'ok
|
||||
(* 1000.0 (- (float-time) start-time)))
|
||||
nil)))
|
||||
(setf (deferred-cancel d)
|
||||
(lambda (x)
|
||||
(deferred:cancelTimeout timer)
|
||||
(deferred:default-cancel x)))
|
||||
d))
|
||||
|
||||
(defun deferred:call (f &rest args)
|
||||
"Call the given function asynchronously."
|
||||
(lexical-let ((f f) (args args))
|
||||
(deferred:next
|
||||
(lambda (x)
|
||||
(apply f args)))))
|
||||
|
||||
(defun deferred:apply (f &optional args)
|
||||
"Call the given function asynchronously."
|
||||
(lexical-let ((f f) (args args))
|
||||
(deferred:next
|
||||
(lambda (x)
|
||||
(apply f args)))))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Utility functions
|
||||
|
||||
(defun deferred:empty-p (times-or-list)
|
||||
"[internal] Return non-nil if TIMES-OR-LIST is the number zero or nil."
|
||||
(or (and (numberp times-or-list) (<= times-or-list 0))
|
||||
(and (listp times-or-list) (null times-or-list))))
|
||||
|
||||
(defun deferred:loop (times-or-list func)
|
||||
"Return a iteration deferred object."
|
||||
(deferred:message "LOOP : %s" times-or-list)
|
||||
(if (deferred:empty-p times-or-list) (deferred:next)
|
||||
(lexical-let*
|
||||
(items (rd
|
||||
(cond
|
||||
((numberp times-or-list)
|
||||
(loop for i from 0 below times-or-list
|
||||
with ld = (deferred:next)
|
||||
do
|
||||
(push ld items)
|
||||
(setq ld
|
||||
(lexical-let ((i i) (func func))
|
||||
(deferred:nextc ld (lambda (x) (deferred:call-lambda func i)))))
|
||||
finally return ld))
|
||||
((listp times-or-list)
|
||||
(loop for i in times-or-list
|
||||
with ld = (deferred:next)
|
||||
do
|
||||
(push ld items)
|
||||
(setq ld
|
||||
(lexical-let ((i i) (func func))
|
||||
(deferred:nextc ld (lambda (x) (deferred:call-lambda func i)))))
|
||||
finally return ld)))))
|
||||
(setf (deferred-cancel rd)
|
||||
(lambda (x) (deferred:default-cancel x)
|
||||
(loop for i in items
|
||||
do (deferred:cancel i))))
|
||||
rd)))
|
||||
|
||||
(defun deferred:trans-multi-args (args self-func list-func main-func)
|
||||
"[internal] Check the argument values and dispatch to methods."
|
||||
(cond
|
||||
((and (= 1 (length args)) (consp (car args)) (not (functionp (car args))))
|
||||
(let ((lst (car args)))
|
||||
(cond
|
||||
((or (null lst) (null (car lst)))
|
||||
(deferred:next))
|
||||
((deferred:aand lst (car it) (or (functionp it) (deferred-p it)))
|
||||
;; a list of deferred objects
|
||||
(funcall list-func lst))
|
||||
((deferred:aand lst (consp it))
|
||||
;; an alist of deferred objects
|
||||
(funcall main-func lst))
|
||||
(t (error "Wrong argument type. %s" args)))))
|
||||
(t (funcall self-func args))))
|
||||
|
||||
(defun deferred:parallel-array-to-alist (lst)
|
||||
"[internal] Translation array to alist."
|
||||
(loop for d in lst
|
||||
for i from 0 below (length lst)
|
||||
collect (cons i d)))
|
||||
|
||||
(defun deferred:parallel-alist-to-array (alst)
|
||||
"[internal] Translation alist to array."
|
||||
(loop for pair in
|
||||
(sort alst (lambda (x y)
|
||||
(< (car x) (car y))))
|
||||
collect (cdr pair)))
|
||||
|
||||
(defun deferred:parallel-func-to-deferred (alst)
|
||||
"[internal] Normalization for parallel and earlier arguments."
|
||||
(loop for pair in alst
|
||||
for d = (cdr pair)
|
||||
collect
|
||||
(progn
|
||||
(unless (deferred-p d)
|
||||
(setf (cdr pair) (deferred:next d)))
|
||||
pair)))
|
||||
|
||||
(defun deferred:parallel-main (alst)
|
||||
"[internal] Deferred alist implementation for `deferred:parallel'. "
|
||||
(deferred:message "PARALLEL<KEY . VALUE>" )
|
||||
(lexical-let ((nd (deferred:new))
|
||||
(len (length alst))
|
||||
values)
|
||||
(loop for pair in
|
||||
(deferred:parallel-func-to-deferred alst)
|
||||
with cd ; current child deferred
|
||||
do
|
||||
(lexical-let ((name (car pair)))
|
||||
(setq cd
|
||||
(deferred:nextc (cdr pair)
|
||||
(lambda (x)
|
||||
(push (cons name x) values)
|
||||
(deferred:message "PARALLEL VALUE [%s/%s] %s"
|
||||
(length values) len (cons name x))
|
||||
(when (= len (length values))
|
||||
(deferred:message "PARALLEL COLLECTED")
|
||||
(deferred:post-task nd 'ok (nreverse values)))
|
||||
nil)))
|
||||
(deferred:error cd
|
||||
(lambda (e)
|
||||
(push (cons name e) values)
|
||||
(deferred:message "PARALLEL ERROR [%s/%s] %s"
|
||||
(length values) len (cons name e))
|
||||
(when (= (length values) len)
|
||||
(deferred:message "PARALLEL COLLECTED")
|
||||
(deferred:post-task nd 'ok (nreverse values)))
|
||||
nil))))
|
||||
nd))
|
||||
|
||||
(defun deferred:parallel-list (lst)
|
||||
"[internal] Deferred list implementation for `deferred:parallel'. "
|
||||
(deferred:message "PARALLEL<LIST>" )
|
||||
(lexical-let*
|
||||
((pd (deferred:parallel-main (deferred:parallel-array-to-alist lst)))
|
||||
(rd (deferred:nextc pd 'deferred:parallel-alist-to-array)))
|
||||
(setf (deferred-cancel rd)
|
||||
(lambda (x) (deferred:default-cancel x)
|
||||
(deferred:cancel pd)))
|
||||
rd))
|
||||
|
||||
(defun deferred:parallel (&rest args)
|
||||
"Return a deferred object that calls given deferred objects or
|
||||
functions in parallel and wait for all callbacks. The following
|
||||
deferred task will be called with an array of the return
|
||||
values. ARGS can be a list or an alist of deferred objects or
|
||||
functions."
|
||||
(deferred:message "PARALLEL : %s" args)
|
||||
(deferred:trans-multi-args args
|
||||
'deferred:parallel 'deferred:parallel-list 'deferred:parallel-main))
|
||||
|
||||
(defun deferred:earlier-main (alst)
|
||||
"[internal] Deferred alist implementation for `deferred:earlier'. "
|
||||
(deferred:message "EARLIER<KEY . VALUE>" )
|
||||
(lexical-let ((nd (deferred:new))
|
||||
(len (length alst))
|
||||
value results)
|
||||
(loop for pair in
|
||||
(deferred:parallel-func-to-deferred alst)
|
||||
with cd ; current child deferred
|
||||
do
|
||||
(lexical-let ((name (car pair)))
|
||||
(setq cd
|
||||
(deferred:nextc (cdr pair)
|
||||
(lambda (x)
|
||||
(push (cons name x) results)
|
||||
(cond
|
||||
((null value)
|
||||
(setq value (cons name x))
|
||||
(deferred:message "EARLIER VALUE %s" (cons name value))
|
||||
(deferred:post-task nd 'ok value))
|
||||
(t
|
||||
(deferred:message "EARLIER MISS [%s/%s] %s" (length results) len (cons name value))
|
||||
(when (eql (length results) len)
|
||||
(deferred:message "EARLIER COLLECTED"))))
|
||||
nil)))
|
||||
(deferred:error cd
|
||||
(lambda (e)
|
||||
(push (cons name e) results)
|
||||
(deferred:message "EARLIER ERROR [%s/%s] %s" (length results) len (cons name e))
|
||||
(when (and (eql (length results) len) (null value))
|
||||
(deferred:message "EARLIER FAILED")
|
||||
(deferred:post-task nd 'ok nil))
|
||||
nil))))
|
||||
nd))
|
||||
|
||||
(defun deferred:earlier-list (lst)
|
||||
"[internal] Deferred list implementation for `deferred:earlier'. "
|
||||
(deferred:message "EARLIER<LIST>" )
|
||||
(lexical-let*
|
||||
((pd (deferred:earlier-main (deferred:parallel-array-to-alist lst)))
|
||||
(rd (deferred:nextc pd (lambda (x) (cdr x)))))
|
||||
(setf (deferred-cancel rd)
|
||||
(lambda (x) (deferred:default-cancel x)
|
||||
(deferred:cancel pd)))
|
||||
rd))
|
||||
|
||||
|
||||
(defun deferred:earlier (&rest args)
|
||||
"Return a deferred object that calls given deferred objects or
|
||||
functions in parallel and wait for the first callback. The
|
||||
following deferred task will be called with the first return
|
||||
value. ARGS can be a list or an alist of deferred objects or
|
||||
functions."
|
||||
(deferred:message "EARLIER : %s" args)
|
||||
(deferred:trans-multi-args args
|
||||
'deferred:earlier 'deferred:earlier-list 'deferred:earlier-main))
|
||||
|
||||
(defmacro deferred:timeout (timeout-msec timeout-form d)
|
||||
"Time out macro on a deferred task D. If the deferred task D
|
||||
does not complete within TIMEOUT-MSEC, this macro cancels the
|
||||
deferred task and return the TIMEOUT-FORM."
|
||||
`(deferred:earlier
|
||||
(deferred:nextc (deferred:wait ,timeout-msec)
|
||||
(lambda (x) ,timeout-form))
|
||||
,d))
|
||||
|
||||
(defmacro* deferred:try (d &key catch finally)
|
||||
"Try-catch-finally macro. This macro simulates the
|
||||
try-catch-finally block asynchronously. CATCH and FINALLY can be
|
||||
nil. Because of asynchrony, this macro does not ensure that the
|
||||
task FINALLY should be called."
|
||||
(let ((chain
|
||||
(if catch `((deferred:error it ,catch)))))
|
||||
(when finally
|
||||
(setq chain (append chain `((deferred:watch it ,finally)))))
|
||||
`(deferred:$ ,d ,@chain)))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Application functions
|
||||
|
||||
(defvar deferred:uid 0 "[internal] Sequence number for some utilities. See the function `deferred:uid'.")
|
||||
|
||||
(defun deferred:uid ()
|
||||
"[internal] Generate a sequence number."
|
||||
(incf deferred:uid))
|
||||
|
||||
(defun deferred:buffer-string (strformat buf)
|
||||
"[internal] Return a string in the buffer with the given format."
|
||||
(format strformat
|
||||
(with-current-buffer buf (buffer-string))))
|
||||
|
||||
(defun deferred:process (command &rest args)
|
||||
"A deferred wrapper of `start-process'. Return a deferred
|
||||
object. The process name and buffer name of the argument of the
|
||||
`start-process' are generated by this function automatically.
|
||||
The next deferred object receives stdout string from the command
|
||||
process."
|
||||
(deferred:process-gen 'start-process command args))
|
||||
|
||||
(defun deferred:process-shell (command &rest args)
|
||||
"A deferred wrapper of `start-process-shell-command'. Return a deferred
|
||||
object. The process name and buffer name of the argument of the
|
||||
`start-process-shell-command' are generated by this function automatically.
|
||||
The next deferred object receives stdout string from the command
|
||||
process."
|
||||
(deferred:process-gen 'start-process-shell-command command args))
|
||||
|
||||
(defun deferred:process-buffer (command &rest args)
|
||||
"A deferred wrapper of `start-process'. Return a deferred
|
||||
object. The process name and buffer name of the argument of the
|
||||
`start-process' are generated by this function automatically.
|
||||
The next deferred object receives stdout buffer from the command
|
||||
process."
|
||||
(deferred:process-buffer-gen 'start-process command args))
|
||||
|
||||
(defun deferred:process-shell-buffer (command &rest args)
|
||||
"A deferred wrapper of `start-process-shell-command'. Return a deferred
|
||||
object. The process name and buffer name of the argument of the
|
||||
`start-process-shell-command' are generated by this function automatically.
|
||||
The next deferred object receives stdout buffer from the command
|
||||
process."
|
||||
(deferred:process-buffer-gen 'start-process-shell-command command args))
|
||||
|
||||
(defun deferred:process-gen (f command args)
|
||||
"[internal]"
|
||||
(lexical-let
|
||||
((pd (deferred:process-buffer-gen f command args)) d)
|
||||
(setq d (deferred:nextc pd
|
||||
(lambda (buf)
|
||||
(prog1
|
||||
(with-current-buffer buf (buffer-string))
|
||||
(kill-buffer buf)))))
|
||||
(setf (deferred-cancel d)
|
||||
(lambda (x)
|
||||
(deferred:default-cancel d)
|
||||
(deferred:default-cancel pd)))
|
||||
d))
|
||||
|
||||
(defun deferred:process-buffer-gen (f command args)
|
||||
"[internal]"
|
||||
(let ((d (deferred:next)) (uid (deferred:uid)))
|
||||
(lexical-let
|
||||
((f f) (command command) (args args)
|
||||
(proc-name (format "*deferred:*%s*:%s" command uid))
|
||||
(buf-name (format " *deferred:*%s*:%s" command uid))
|
||||
(pwd default-directory)
|
||||
(nd (deferred:new)) proc-buf proc)
|
||||
(deferred:nextc d
|
||||
(lambda (x)
|
||||
(setq proc-buf (get-buffer-create buf-name))
|
||||
(condition-case err
|
||||
(let ((default-directory pwd))
|
||||
(setq proc
|
||||
(if (null (car args))
|
||||
(apply f proc-name buf-name command nil)
|
||||
(apply f proc-name buf-name command args)))
|
||||
(set-process-sentinel
|
||||
proc
|
||||
(lambda (proc event)
|
||||
(cond
|
||||
((string-match "exited abnormally" event)
|
||||
(let ((msg (if (buffer-live-p proc-buf)
|
||||
(deferred:buffer-string
|
||||
(format "Process [%s] exited abnormally : %%s"
|
||||
command) proc-buf)
|
||||
(concat "Process exited abnormally: " proc-name))))
|
||||
(kill-buffer proc-buf)
|
||||
(deferred:post-task nd 'ng msg)))
|
||||
((equal event "finished\n")
|
||||
(deferred:post-task nd 'ok proc-buf)))))
|
||||
(setf (deferred-cancel nd)
|
||||
(lambda (x) (deferred:default-cancel x)
|
||||
(when proc
|
||||
(kill-process proc)
|
||||
(kill-buffer proc-buf)))))
|
||||
(error (deferred:post-task nd 'ng (error-message-string err))))
|
||||
nil))
|
||||
nd)))
|
||||
|
||||
(defmacro deferred:processc (d command &rest args)
|
||||
"Process chain of `deferred:process'."
|
||||
`(deferred:nextc ,d
|
||||
(lambda (,(gensym)) (deferred:process ,command ,@args))))
|
||||
|
||||
(defmacro deferred:process-bufferc (d command &rest args)
|
||||
"Process chain of `deferred:process-buffer'."
|
||||
`(deferred:nextc ,d
|
||||
(lambda (,(gensym)) (deferred:process-buffer ,command ,@args))))
|
||||
|
||||
(defmacro deferred:process-shellc (d command &rest args)
|
||||
"Process chain of `deferred:process'."
|
||||
`(deferred:nextc ,d
|
||||
(lambda (,(gensym)) (deferred:process-shell ,command ,@args))))
|
||||
|
||||
(defmacro deferred:process-shell-bufferc (d command &rest args)
|
||||
"Process chain of `deferred:process-buffer'."
|
||||
`(deferred:nextc ,d
|
||||
(lambda (,(gensym)) (deferred:process-shell-buffer ,command ,@args))))
|
||||
|
||||
(eval-after-load "url"
|
||||
;; for url package
|
||||
;; TODO: proxy, charaset
|
||||
'(progn
|
||||
|
||||
(defun deferred:url-retrieve (url &optional cbargs)
|
||||
"A wrapper function for url-retrieve. The next deferred
|
||||
object receives the buffer object that URL will load
|
||||
into. Currently dynamic binding variables are not supported."
|
||||
(lexical-let ((nd (deferred:new)) (url url) (cbargs cbargs) buf)
|
||||
(deferred:next
|
||||
(lambda (x)
|
||||
(condition-case err
|
||||
(setq buf
|
||||
(url-retrieve
|
||||
url (lambda (xx) (deferred:post-task nd 'ok buf))
|
||||
cbargs))
|
||||
(error (deferred:post-task nd 'ng err)))
|
||||
nil))
|
||||
(setf (deferred-cancel nd)
|
||||
(lambda (x)
|
||||
(when (buffer-live-p buf)
|
||||
(kill-buffer buf))))
|
||||
nd))
|
||||
|
||||
(defun deferred:url-delete-header (buf)
|
||||
(with-current-buffer buf
|
||||
(let ((pos (url-http-symbol-value-in-buffer
|
||||
'url-http-end-of-headers buf)))
|
||||
(when pos
|
||||
(delete-region (point-min) (1+ pos)))))
|
||||
buf)
|
||||
|
||||
(defun deferred:url-delete-buffer (buf)
|
||||
(when (and buf (buffer-live-p buf))
|
||||
(kill-buffer buf))
|
||||
nil)
|
||||
|
||||
(defun deferred:url-get (url &optional params)
|
||||
"Perform a HTTP GET method with `url-retrieve'. PARAMS is
|
||||
a parameter list of (key . value) or key. The next deferred
|
||||
object receives the buffer object that URL will load into."
|
||||
(when params
|
||||
(setq url
|
||||
(concat url "?" (deferred:url-param-serialize params))))
|
||||
(let ((d (deferred:$
|
||||
(deferred:url-retrieve url)
|
||||
(deferred:nextc it 'deferred:url-delete-header))))
|
||||
(deferred:set-next
|
||||
d (deferred:new 'deferred:url-delete-buffer))
|
||||
d))
|
||||
|
||||
(defun deferred:url-post (url &optional params)
|
||||
"Perform a HTTP POST method with `url-retrieve'. PARAMS is
|
||||
a parameter list of (key . value) or key. The next deferred
|
||||
object receives the buffer object that URL will load into."
|
||||
(lexical-let ((nd (deferred:new))
|
||||
(url url) (params params)
|
||||
buf)
|
||||
(deferred:next
|
||||
(lambda (x)
|
||||
(let ((url-request-method "POST")
|
||||
(url-request-extra-headers
|
||||
'(("Content-Type" . "application/x-www-form-urlencoded")))
|
||||
(url-request-data
|
||||
(deferred:url-param-serialize params)))
|
||||
(condition-case err
|
||||
(setq buf
|
||||
(url-retrieve
|
||||
url
|
||||
(lambda (&rest args)
|
||||
(deferred:post-task nd 'ok buf))))
|
||||
(error (deferred:post-task nd 'ng err))))
|
||||
nil))
|
||||
(setf (deferred-cancel nd)
|
||||
(lambda (x)
|
||||
(when (buffer-live-p buf)
|
||||
(kill-buffer buf))))
|
||||
(let ((d (deferred:nextc nd 'deferred:url-delete-header)))
|
||||
(deferred:set-next
|
||||
d (deferred:new 'deferred:url-delete-buffer))
|
||||
d)))
|
||||
|
||||
(defun deferred:url-escape (val)
|
||||
"[internal] Return a new string that is VAL URI-encoded."
|
||||
(unless (stringp val)
|
||||
(setq val (format "%s" val)))
|
||||
(url-hexify-string
|
||||
(encode-coding-string val 'utf-8)))
|
||||
|
||||
(defun deferred:url-param-serialize (params)
|
||||
"[internal] Serialize a list of (key . value) cons cells
|
||||
into a query string."
|
||||
(when params
|
||||
(mapconcat
|
||||
'identity
|
||||
(loop for p in params
|
||||
collect
|
||||
(cond
|
||||
((consp p)
|
||||
(concat
|
||||
(deferred:url-escape (car p)) "="
|
||||
(deferred:url-escape (cdr p))))
|
||||
(t
|
||||
(deferred:url-escape p))))
|
||||
"&")))
|
||||
))
|
||||
|
||||
|
||||
(provide 'deferred)
|
||||
;;; deferred.el ends here
|
||||
|
|
@ -0,0 +1,911 @@
|
|||
;;; epc.el --- A RPC stack for the Emacs Lisp
|
||||
|
||||
;; Copyright (C) 2011, 2012 Masashi Sakurai
|
||||
|
||||
;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
|
||||
;; Version: 0.1.1
|
||||
;; Keywords: lisp, rpc
|
||||
;; Package-Requires: ((concurrent "0.3.1") (ctable "0.1.1"))
|
||||
;; URL: https://github.com/kiwanami/emacs-epc
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This program is an asynchronous RPC stack for Emacs. Using this
|
||||
;; RPC stack, the Emacs can communicate with the peer process.
|
||||
;; Because the protocol is S-expression encoding and consists of
|
||||
;; asynchronous communications, the RPC response is fairly good.
|
||||
;;
|
||||
;; Current implementations for the EPC are followings:
|
||||
;; - epcs.el : Emacs Lisp implementation
|
||||
;; - RPC::EPC::Service : Perl implementation
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(require 'concurrent)
|
||||
(require 'ctable)
|
||||
|
||||
|
||||
;;==================================================
|
||||
;; Utility
|
||||
|
||||
(defvar epc:debug-out nil)
|
||||
(defvar epc:debug-buffer "*epc log*")
|
||||
|
||||
;;(setq epc:debug-out t)
|
||||
;;(setq epc:debug-out nil)
|
||||
|
||||
(defun epc:log-init ()
|
||||
(when (get-buffer epc:debug-buffer)
|
||||
(kill-buffer epc:debug-buffer)))
|
||||
|
||||
(defun epc:log (&rest args)
|
||||
(when epc:debug-out
|
||||
(with-current-buffer
|
||||
(get-buffer-create epc:debug-buffer)
|
||||
(buffer-disable-undo)
|
||||
(goto-char (point-max))
|
||||
(insert (apply 'format args) "\n"))))
|
||||
|
||||
(defun epc:make-procbuf (name)
|
||||
"[internal] Make a process buffer."
|
||||
(let ((buf (get-buffer-create name)))
|
||||
(with-current-buffer buf
|
||||
(set (make-local-variable 'kill-buffer-query-functions) nil)
|
||||
(erase-buffer) (buffer-disable-undo))
|
||||
buf))
|
||||
|
||||
(defun epc:document-function (function docstring)
|
||||
"Document FUNCTION with DOCSTRING. Use this for `defstruct' accessor etc."
|
||||
(put function 'function-documentation docstring))
|
||||
(put 'epc:document-function 'lisp-indent-function 'defun)
|
||||
(put 'epc:document-function 'doc-string-elt 2)
|
||||
|
||||
|
||||
;;==================================================
|
||||
;; Low Level Interface
|
||||
|
||||
(defvar epc:uid 1)
|
||||
|
||||
(defun epc:uid ()
|
||||
(incf epc:uid))
|
||||
|
||||
(defvar epc:accept-process-timeout 100 "[internal] msec")
|
||||
|
||||
|
||||
(defstruct epc:connection
|
||||
"Set of information for network connection and event handling.
|
||||
|
||||
name : Connection name. This name is used for process and buffer names.
|
||||
process : Connection process object.
|
||||
buffer : Working buffer for the incoming data.
|
||||
channel : Event channels for incoming messages."
|
||||
name process buffer channel)
|
||||
|
||||
(epc:document-function 'epc:connection-name
|
||||
"[internal] Connection name. This name is used for process and buffer names.
|
||||
|
||||
\(fn EPC:CONNECTION)")
|
||||
|
||||
(epc:document-function 'epc:connection-process
|
||||
"[internal] Connection process object.
|
||||
|
||||
\(fn EPC:CONNECTION)")
|
||||
|
||||
(epc:document-function 'epc:connection-buffer
|
||||
"[internal] Working buffer for the incoming data.
|
||||
|
||||
\(fn EPC:CONNECTION)")
|
||||
|
||||
(epc:document-function 'epc:connection-channel
|
||||
"[internal] Event channels for incoming messages.
|
||||
|
||||
\(fn EPC:CONNECTION)")
|
||||
|
||||
|
||||
(defun epc:connect (host port)
|
||||
"[internal] Connect the server, initialize the process and
|
||||
return epc:connection object."
|
||||
(epc:log ">> Connection start: %s:%s" host port)
|
||||
(lexical-let* ((connection-id (epc:uid))
|
||||
(connection-name (format "epc con %s" connection-id))
|
||||
(connection-buf (epc:make-procbuf (format "*%s*" connection-name)))
|
||||
(connection-process
|
||||
(open-network-stream connection-name connection-buf host port))
|
||||
(channel (cc:signal-channel connection-name))
|
||||
(connection (make-epc:connection
|
||||
:name connection-name
|
||||
:process connection-process
|
||||
:buffer connection-buf
|
||||
:channel channel)))
|
||||
(epc:log ">> Connection establish")
|
||||
(set-process-coding-system connection-process 'binary 'binary)
|
||||
(set-process-filter connection-process
|
||||
(lambda (p m)
|
||||
(epc:process-filter connection p m)))
|
||||
(set-process-sentinel connection-process
|
||||
(lambda (p e)
|
||||
(epc:process-sentinel connection p e)))
|
||||
(set-process-query-on-exit-flag connection-process nil)
|
||||
connection))
|
||||
|
||||
(defun epc:connection-reset (connection)
|
||||
"[internal] Reset the connection for restarting the process."
|
||||
(cc:signal-disconnect-all (epc:connection-channel connection))
|
||||
connection)
|
||||
|
||||
(defun epc:process-sentinel (connection process msg)
|
||||
(epc:log "!! Process Sentinel [%s] : %S : %S"
|
||||
(epc:connection-name connection) process msg)
|
||||
(epc:disconnect connection))
|
||||
|
||||
(defun epc:net-send (connection sexp)
|
||||
(let* ((msg (encode-coding-string
|
||||
(concat (epc:prin1-to-string sexp) "\n") 'utf-8-unix))
|
||||
(string (concat (epc:net-encode-length (length msg)) msg))
|
||||
(proc (epc:connection-process connection)))
|
||||
(epc:log ">> SEND : [%S]" string)
|
||||
(process-send-string proc string)))
|
||||
|
||||
(defun epc:disconnect (connection)
|
||||
(lexical-let
|
||||
((process (epc:connection-process connection))
|
||||
(buf (epc:connection-buffer connection))
|
||||
(name (epc:connection-name connection)))
|
||||
(epc:log "!! Disconnect [%s]" name)
|
||||
(when process
|
||||
(set-process-sentinel process nil)
|
||||
(delete-process process)
|
||||
(when (get-buffer buf) (kill-buffer buf)))
|
||||
(epc:log "!! Disconnected finished [%s]" name)))
|
||||
|
||||
(defun epc:process-filter (connection process message)
|
||||
(epc:log "INCOMING: [%s] [%S]" (epc:connection-name connection) message)
|
||||
(with-current-buffer (epc:connection-buffer connection)
|
||||
(goto-char (point-max))
|
||||
(insert message)
|
||||
(epc:process-available-input connection process)))
|
||||
|
||||
(defun epc:process-available-input (connection process)
|
||||
"Process all complete messages that have arrived from Lisp."
|
||||
(with-current-buffer (process-buffer process)
|
||||
(while (epc:net-have-input-p)
|
||||
(let ((event (epc:net-read-or-lose process))
|
||||
(ok nil))
|
||||
(epc:log "<< RECV [%S]" event)
|
||||
(unwind-protect
|
||||
(condition-case err
|
||||
(progn
|
||||
(apply 'cc:signal-send
|
||||
(cons (epc:connection-channel connection) event))
|
||||
(setq ok t))
|
||||
('error (epc:log "MsgError: %S / <= %S" err event)))
|
||||
(unless ok
|
||||
(epc:run-when-idle 'epc:process-available-input connection process)))))))
|
||||
|
||||
(defun epc:net-have-input-p ()
|
||||
"Return true if a complete message is available."
|
||||
(goto-char (point-min))
|
||||
(and (>= (buffer-size) 6)
|
||||
(>= (- (buffer-size) 6) (epc:net-decode-length))))
|
||||
|
||||
(defun epc:run-when-idle (function &rest args)
|
||||
"Call FUNCTION as soon as Emacs is idle."
|
||||
(apply #'run-at-time
|
||||
(if (featurep 'xemacs) itimer-short-interval 0)
|
||||
nil function args))
|
||||
|
||||
(defun epc:net-read-or-lose (process)
|
||||
(condition-case error
|
||||
(epc:net-read)
|
||||
(error
|
||||
(debug 'error error)
|
||||
(error "net-read error: %S" error))))
|
||||
|
||||
(defun epc:net-read ()
|
||||
"Read a message from the network buffer."
|
||||
(goto-char (point-min))
|
||||
(let* ((length (epc:net-decode-length))
|
||||
(start (+ 6 (point)))
|
||||
(end (+ start length)) content)
|
||||
(assert (plusp length))
|
||||
(prog1 (save-restriction
|
||||
(narrow-to-region start end)
|
||||
(read (decode-coding-string
|
||||
(buffer-string) 'utf-8-unix)))
|
||||
(delete-region (point-min) end))))
|
||||
|
||||
(defun epc:net-decode-length ()
|
||||
"Read a 24-bit hex-encoded integer from buffer."
|
||||
(string-to-number (buffer-substring-no-properties (point) (+ (point) 6)) 16))
|
||||
|
||||
(defun epc:net-encode-length (n)
|
||||
"Encode an integer into a 24-bit hex string."
|
||||
(format "%06x" n))
|
||||
|
||||
(defun epc:prin1-to-string (sexp)
|
||||
"Like `prin1-to-string' but don't octal-escape non-ascii characters.
|
||||
This is more compatible with the CL reader."
|
||||
(with-temp-buffer
|
||||
(let (print-escape-nonascii
|
||||
print-escape-newlines
|
||||
print-length
|
||||
print-level)
|
||||
(prin1 sexp (current-buffer))
|
||||
(buffer-string))))
|
||||
|
||||
|
||||
;;==================================================
|
||||
;; High Level Interface
|
||||
|
||||
(defstruct epc:manager
|
||||
"Root object that holds all information related to an EPC activity.
|
||||
|
||||
`epc:start-epc' returns this object.
|
||||
|
||||
title : instance name for displaying on the `epc:controller' UI
|
||||
server-process : process object for the peer
|
||||
commands : a list of (prog . args)
|
||||
port : port number
|
||||
connection : epc:connection instance
|
||||
methods : alist of method (name . function)
|
||||
sessions : alist of session (id . deferred)
|
||||
exit-hook : functions for after shutdown EPC connection"
|
||||
title server-process commands port connection methods sessions exit-hooks)
|
||||
|
||||
(epc:document-function 'epc:manager-title
|
||||
"Instance name (string) for displaying on the `epc:controller' UI
|
||||
|
||||
You can modify this slot using `setf' to change the title column
|
||||
in the `epc:controller' table UI.
|
||||
|
||||
\(fn EPC:MANAGER)")
|
||||
|
||||
(epc:document-function 'epc:manager-server-process
|
||||
"Process object for the peer.
|
||||
|
||||
This is *not* network process but the external program started by
|
||||
`epc:start-epc'. For network process, see `epc:connection-process'.
|
||||
|
||||
\(fn EPC:MANAGER)")
|
||||
|
||||
(epc:document-function 'epc:manager-commands
|
||||
"[internal] a list of (prog . args)
|
||||
|
||||
\(fn EPC:MANAGER)")
|
||||
|
||||
(epc:document-function 'epc:manager-port
|
||||
"Port number (integer).
|
||||
|
||||
\(fn EPC:MANAGER)")
|
||||
|
||||
(epc:document-function 'epc:manager-connection
|
||||
"[internal] epc:connection instance
|
||||
|
||||
\(fn EPC:MANAGER)")
|
||||
|
||||
(epc:document-function 'epc:manager-methods
|
||||
"[internal] alist of method (name . function)
|
||||
|
||||
\(fn EPC:MANAGER)")
|
||||
|
||||
(epc:document-function 'epc:manager-sessions
|
||||
"[internal] alist of session (id . deferred)
|
||||
|
||||
\(fn EPC:MANAGER)")
|
||||
|
||||
(epc:document-function 'epc:manager-exit-hooks
|
||||
"Hooks called after shutdown EPC connection.
|
||||
|
||||
Use `epc:manager-add-exit-hook' to add hook.
|
||||
|
||||
\(fn EPC:MANAGER)")
|
||||
|
||||
(defstruct epc:method
|
||||
"Object to hold serving method information.
|
||||
|
||||
name : method name (symbol) ex: 'test
|
||||
task : method function (function with one argument)
|
||||
arg-specs : arg-specs (one string) ex: \"(A B C D)\"
|
||||
docstring : docstring (one string) ex: \"A test function. Return sum of A,B,C and D\"
|
||||
"
|
||||
name task docstring arg-specs)
|
||||
|
||||
(epc:document-function 'epc:method-name
|
||||
"[internal] method name (symbol) ex: 'test
|
||||
|
||||
\(fn EPC:METHOD)")
|
||||
|
||||
(epc:document-function 'epc:method-task
|
||||
"[internal] method function (function with one argument)
|
||||
|
||||
\(fn EPC:METHOD)")
|
||||
|
||||
(epc:document-function 'epc:method-arg-specs
|
||||
"[internal] arg-specs (one string) ex: \"(A B C D)\"
|
||||
|
||||
\(fn EPC:METHOD)")
|
||||
|
||||
(epc:document-function 'epc:method-docstring
|
||||
"[internal] docstring (one string) ex: \"A test function. Return sum of A,B,C and D\"
|
||||
|
||||
\(fn EPC:METHOD)")
|
||||
|
||||
|
||||
(defvar epc:live-connections nil
|
||||
"[internal] A list of `epc:manager' objects those currently connect to the epc peer.
|
||||
This variable is for debug purpose.")
|
||||
|
||||
(defun epc:live-connections-add (mngr)
|
||||
"[internal] Add the EPC manager object."
|
||||
(push mngr epc:live-connections))
|
||||
|
||||
(defun epc:live-connections-delete (mngr)
|
||||
"[internal] Remove the EPC manager object."
|
||||
(setq epc:live-connections (delete mngr epc:live-connections)))
|
||||
|
||||
|
||||
(defun epc:start-epc (server-prog server-args)
|
||||
"Start the epc server program and return an epc:manager object.
|
||||
|
||||
Start server program SERVER-PROG with command line arguments
|
||||
SERVER-ARGS. The server program must print out the port it is
|
||||
using at the first line of its stdout. If the server prints out
|
||||
non-numeric value in the first line or does not print out the
|
||||
port number in three seconds, it is regarded as start-up
|
||||
failure."
|
||||
(let ((mngr (epc:start-server server-prog server-args)))
|
||||
(epc:init-epc-layer mngr)
|
||||
mngr))
|
||||
|
||||
(defun epc:server-process-name (uid)
|
||||
(format "epc:server:%s" uid))
|
||||
|
||||
(defun epc:server-buffer-name (uid)
|
||||
(format " *%s*" (epc:server-process-name uid)))
|
||||
|
||||
(defun epc:start-server (server-prog server-args)
|
||||
"[internal] Start a peer server and return an epc:manager instance which is set up partially."
|
||||
(let* ((uid (epc:uid))
|
||||
(process-name (epc:server-process-name uid))
|
||||
(process-buffer (get-buffer-create (epc:server-buffer-name uid)))
|
||||
(process (apply 'start-process
|
||||
process-name process-buffer
|
||||
server-prog server-args))
|
||||
(cont 1) port)
|
||||
(while cont
|
||||
(accept-process-output process 0 epc:accept-process-timeout t)
|
||||
(let ((port-str (with-current-buffer process-buffer
|
||||
(buffer-string))))
|
||||
(cond
|
||||
((string-match "^[0-9]+$" port-str)
|
||||
(setq port (string-to-number port-str)
|
||||
cont nil))
|
||||
((< 0 (length port-str))
|
||||
(error "Server may raise an error. \
|
||||
Use \"M-x epc:pop-to-last-server-process-buffer RET\" \
|
||||
to see full traceback:\n%s" port-str))
|
||||
((not (eq 'run (process-status process)))
|
||||
(setq cont nil))
|
||||
(t
|
||||
(incf cont)
|
||||
(when (< 30 cont) ; timeout 3 seconds
|
||||
(error "Timeout server response."))))))
|
||||
(set-process-query-on-exit-flag process nil)
|
||||
(make-epc:manager :server-process process
|
||||
:commands (cons server-prog server-args)
|
||||
:title (mapconcat 'identity (cons server-prog server-args) " ")
|
||||
:port port
|
||||
:connection (epc:connect "localhost" port))))
|
||||
|
||||
(defun epc:stop-epc (mngr)
|
||||
"Disconnect the connection for the server."
|
||||
(let* ((proc (epc:manager-server-process mngr))
|
||||
(buf (and proc (process-buffer proc))))
|
||||
(epc:disconnect (epc:manager-connection mngr))
|
||||
(when proc
|
||||
(accept-process-output proc 0 epc:accept-process-timeout t))
|
||||
(when (and proc (equal 'run (process-status proc)))
|
||||
(kill-process proc))
|
||||
(when buf (kill-buffer buf))
|
||||
(condition-case err
|
||||
(epc:manager-fire-exit-hook mngr)
|
||||
(error (epc:log "Error on exit-hooks : %S / " err mngr)))
|
||||
(epc:live-connections-delete mngr)))
|
||||
|
||||
(defun epc:start-epc-debug (port)
|
||||
"[internal] Return an epc:manager instance which is set up partially."
|
||||
(epc:init-epc-layer
|
||||
(make-epc:manager :server-process nil
|
||||
:commands (cons "[DEBUG]" nil)
|
||||
:port port
|
||||
:connection (epc:connect "localhost" port))))
|
||||
|
||||
(defun epc:args (args)
|
||||
"[internal] If ARGS is an atom, return it. If list, return the cadr of it."
|
||||
(cond
|
||||
((atom args) args)
|
||||
(t (cadr args))))
|
||||
|
||||
(defun epc:init-epc-layer (mngr)
|
||||
"[internal] Connect to the server program and return an epc:connection instance."
|
||||
(lexical-let*
|
||||
((mngr mngr)
|
||||
(conn (epc:manager-connection mngr))
|
||||
(channel (epc:connection-channel conn)))
|
||||
;; dispatch incoming messages with the lexical scope
|
||||
(loop for (method . body) in
|
||||
`((call
|
||||
. (lambda (args)
|
||||
(epc:log "SIG CALL: %S" args)
|
||||
(apply 'epc:handler-called-method ,mngr (epc:args args))))
|
||||
(return
|
||||
. (lambda (args)
|
||||
(epc:log "SIG RET: %S" args)
|
||||
(apply 'epc:handler-return ,mngr (epc:args args))))
|
||||
(return-error
|
||||
. (lambda (args)
|
||||
(epc:log "SIG RET-ERROR: %S" args)
|
||||
(apply 'epc:handler-return-error ,mngr (epc:args args))))
|
||||
(epc-error
|
||||
. (lambda (args)
|
||||
(epc:log "SIG EPC-ERROR: %S" args)
|
||||
(apply 'epc:handler-epc-error ,mngr (epc:args args))))
|
||||
(methods
|
||||
. (lambda (args)
|
||||
(epc:log "SIG METHODS: %S" args)
|
||||
(epc:handler-methods ,mngr (caadr args))))
|
||||
) do
|
||||
(cc:signal-connect channel method body))
|
||||
(epc:live-connections-add mngr)
|
||||
mngr))
|
||||
|
||||
|
||||
|
||||
(defun epc:manager-add-exit-hook (mngr hook-function)
|
||||
"Register the HOOK-FUNCTION which is called after the EPC connection closed by the EPC controller UI.
|
||||
HOOK-FUNCTION is a function with no argument."
|
||||
(let* ((hooks (epc:manager-exit-hooks mngr)))
|
||||
(setf (epc:manager-exit-hooks mngr) (cons hook-function hooks))
|
||||
mngr))
|
||||
|
||||
(defun epc:manager-fire-exit-hook (mngr)
|
||||
"[internal] Call exit-hooks functions of MNGR. After calling hooks, this functions clears the hook slot so as not to call doubly."
|
||||
(let* ((hooks (epc:manager-exit-hooks mngr)))
|
||||
(run-hooks hooks)
|
||||
(setf (epc:manager-exit-hooks mngr) nil)
|
||||
mngr))
|
||||
|
||||
(defun epc:manager-status-server-process (mngr)
|
||||
"[internal] Return the status of the process object for the peer process. If the process is nil, return nil."
|
||||
(and mngr
|
||||
(epc:manager-server-process mngr)
|
||||
(process-status (epc:manager-server-process mngr))))
|
||||
|
||||
(defun epc:manager-status-connection-process (mngr)
|
||||
"[internal] Return the status of the process object for the connection process."
|
||||
(and (epc:manager-connection mngr)
|
||||
(process-status (epc:connection-process
|
||||
(epc:manager-connection mngr)))))
|
||||
|
||||
(defun epc:manager-restart-process (mngr)
|
||||
"[internal] Restart the process and reconnect."
|
||||
(cond
|
||||
((null (epc:manager-server-process mngr))
|
||||
(error "Cannot restart this EPC process!"))
|
||||
(t
|
||||
(epc:stop-epc mngr)
|
||||
(let* ((cmds (epc:manager-commands mngr))
|
||||
(new-mngr (epc:start-server (car cmds) (cdr cmds))))
|
||||
(setf (epc:manager-server-process mngr)
|
||||
(epc:manager-server-process new-mngr))
|
||||
(setf (epc:manager-port mngr)
|
||||
(epc:manager-port new-mngr))
|
||||
(setf (epc:manager-connection mngr)
|
||||
(epc:manager-connection new-mngr))
|
||||
(setf (epc:manager-methods mngr)
|
||||
(epc:manager-methods new-mngr))
|
||||
(setf (epc:manager-sessions mngr)
|
||||
(epc:manager-sessions new-mngr))
|
||||
(epc:connection-reset (epc:manager-connection mngr))
|
||||
(epc:init-epc-layer mngr)
|
||||
(epc:live-connections-delete new-mngr)
|
||||
(epc:live-connections-add mngr)
|
||||
mngr))))
|
||||
|
||||
(defun epc:manager-send (mngr method &rest messages)
|
||||
"[internal] low-level message sending."
|
||||
(let* ((conn (epc:manager-connection mngr)))
|
||||
(epc:net-send conn (cons method messages))))
|
||||
|
||||
(defun epc:manager-get-method (mngr method-name)
|
||||
"[internal] Return a method object. If not found, return nil."
|
||||
(loop for i in (epc:manager-methods mngr)
|
||||
if (eq method-name (epc:method-name i))
|
||||
do (return i)))
|
||||
|
||||
(defun epc:handler-methods (mngr uid)
|
||||
"[internal] Return a list of information for registered methods."
|
||||
(let ((info
|
||||
(loop for i in (epc:manager-methods mngr)
|
||||
collect
|
||||
(list
|
||||
(epc:method-name i)
|
||||
(or (epc:method-arg-specs i) "")
|
||||
(or (epc:method-docstring i) "")))))
|
||||
(epc:manager-send mngr 'return uid info)))
|
||||
|
||||
(defun epc:handler-called-method (mngr uid name args)
|
||||
"[internal] low-level message handler for peer's calling."
|
||||
(lexical-let ((mngr mngr) (uid uid))
|
||||
(let* ((methods (epc:manager-methods mngr))
|
||||
(method (epc:manager-get-method mngr name)))
|
||||
(cond
|
||||
((null method)
|
||||
(epc:log "ERR: No such method : %s" name)
|
||||
(epc:manager-send mngr 'epc-error uid (format "EPC-ERROR: No such method : %s" name)))
|
||||
(t
|
||||
(condition-case err
|
||||
(let* ((f (epc:method-task method))
|
||||
(ret (apply f args)))
|
||||
(cond
|
||||
((deferred-p ret)
|
||||
(deferred:nextc ret
|
||||
(lambda (xx) (epc:manager-send mngr 'return uid xx))))
|
||||
(t (epc:manager-send mngr 'return uid ret))))
|
||||
(error
|
||||
(epc:log "ERROR : %S" err)
|
||||
(epc:manager-send mngr 'return-error uid err))))))))
|
||||
|
||||
(defun epc:manager-remove-session (mngr uid)
|
||||
"[internal] Remove a session from the epc manager object."
|
||||
(loop with ret = nil
|
||||
for pair in (epc:manager-sessions mngr)
|
||||
unless (eq uid (car pair))
|
||||
do (push pair ret)
|
||||
finally
|
||||
do (setf (epc:manager-sessions mngr) ret)))
|
||||
|
||||
(defun epc:handler-return (mngr uid args)
|
||||
"[internal] low-level message handler for normal returns."
|
||||
(let ((pair (assq uid (epc:manager-sessions mngr))))
|
||||
(cond
|
||||
(pair
|
||||
(epc:log "RET: id:%s [%S]" uid args)
|
||||
(epc:manager-remove-session mngr uid)
|
||||
(deferred:callback (cdr pair) args))
|
||||
(t ; error
|
||||
(epc:log "RET: NOT FOUND: id:%s [%S]" uid args)))))
|
||||
|
||||
(defun epc:handler-return-error (mngr uid args)
|
||||
"[internal] low-level message handler for application errors."
|
||||
(let ((pair (assq uid (epc:manager-sessions mngr))))
|
||||
(cond
|
||||
(pair
|
||||
(epc:log "RET-ERR: id:%s [%S]" uid args)
|
||||
(epc:manager-remove-session mngr uid)
|
||||
(deferred:errorback (cdr pair) (format "%S" args)))
|
||||
(t ; error
|
||||
(epc:log "RET-ERR: NOT FOUND: id:%s [%S]" uid args)))))
|
||||
|
||||
(defun epc:handler-epc-error (mngr uid args)
|
||||
"[internal] low-level message handler for epc errors."
|
||||
(let ((pair (assq uid (epc:manager-sessions mngr))))
|
||||
(cond
|
||||
(pair
|
||||
(epc:log "RET-EPC-ERR: id:%s [%S]" uid args)
|
||||
(epc:manager-remove-session mngr uid)
|
||||
(deferred:errorback (cdr pair) (list 'epc-error args)))
|
||||
(t ; error
|
||||
(epc:log "RET-EPC-ERR: NOT FOUND: id:%s [%S]" uid args)))))
|
||||
|
||||
|
||||
|
||||
(defun epc:call-deferred (mngr method-name args)
|
||||
"Call peer's method with args asynchronously. Return a deferred
|
||||
object which is called with the result."
|
||||
(let ((uid (epc:uid))
|
||||
(sessions (epc:manager-sessions mngr))
|
||||
(d (deferred:new)))
|
||||
(push (cons uid d) sessions)
|
||||
(setf (epc:manager-sessions mngr) sessions)
|
||||
(epc:manager-send mngr 'call uid method-name args)
|
||||
d))
|
||||
|
||||
(defun epc:define-method (mngr method-name task &optional arg-specs docstring)
|
||||
"Define a method and return a deferred object which is called by the peer."
|
||||
(let* ((method (make-epc:method
|
||||
:name method-name :task task
|
||||
:arg-specs arg-specs :docstring docstring))
|
||||
(methods (cons method (epc:manager-methods mngr))))
|
||||
(setf (epc:manager-methods mngr) methods)
|
||||
method))
|
||||
|
||||
(defun epc:query-methods-deferred (mngr)
|
||||
"Return a list of information for the peer's methods.
|
||||
The list is consisted of lists of strings:
|
||||
(name arg-specs docstring)."
|
||||
(let ((uid (epc:uid))
|
||||
(sessions (epc:manager-sessions mngr))
|
||||
(d (deferred:new)))
|
||||
(push (cons uid d) sessions)
|
||||
(setf (epc:manager-sessions mngr) sessions)
|
||||
(epc:manager-send mngr 'methods uid)
|
||||
d))
|
||||
|
||||
(defun epc:sync (mngr d)
|
||||
"Wrap deferred methods with synchronous waiting, and return the result.
|
||||
If an exception is occurred, this function throws the error."
|
||||
(lexical-let ((result 'epc:nothing))
|
||||
(deferred:$ d
|
||||
(deferred:nextc it
|
||||
(lambda (x) (setq result x)))
|
||||
(deferred:error it
|
||||
(lambda (er) (setq result (cons 'error er)))))
|
||||
(while (eq result 'epc:nothing)
|
||||
(save-current-buffer
|
||||
(accept-process-output
|
||||
(epc:connection-process (epc:manager-connection mngr))
|
||||
0 epc:accept-process-timeout t)))
|
||||
(if (and (consp result) (eq 'error (car result)))
|
||||
(error (cdr result)) result)))
|
||||
|
||||
(defun epc:call-sync (mngr method-name args)
|
||||
"Call peer's method with args synchronously and return the result.
|
||||
If an exception is occurred, this function throws the error."
|
||||
(epc:sync mngr (epc:call-deferred mngr method-name args)))
|
||||
|
||||
(defun epc:live-p (mngr)
|
||||
"Return non-nil when MNGR is an EPC manager object with a live
|
||||
connection."
|
||||
(let ((proc (ignore-errors
|
||||
(epc:connection-process (epc:manager-connection mngr)))))
|
||||
(and (processp proc)
|
||||
;; Same as `process-live-p' in Emacs >= 24:
|
||||
(memq (process-status proc) '(run open listen connect stop)))))
|
||||
|
||||
|
||||
;;==================================================
|
||||
;; Troubleshooting / Debugging support
|
||||
|
||||
(defun epc:pop-to-last-server-process-buffer ()
|
||||
"Open the buffer for most recently started server program process.
|
||||
This is useful when you want to check why the server program
|
||||
failed to start (e.g., to see its traceback / error message)."
|
||||
(interactive)
|
||||
(let ((buffer (get-buffer (epc:server-buffer-name epc:uid))))
|
||||
(if buffer
|
||||
(pop-to-buffer buffer)
|
||||
(error "No buffer for the last server process. \
|
||||
Probably the EPC connection exits correctly or you didn't start it yet."))))
|
||||
|
||||
|
||||
|
||||
;;==================================================
|
||||
;; Management Interface
|
||||
|
||||
(defun epc:controller ()
|
||||
"Display the management interface for EPC processes and connections.
|
||||
Process list.
|
||||
Session status, statistics and uptime.
|
||||
Peer's method list.
|
||||
Display process buffer.
|
||||
Kill sessions and connections.
|
||||
Restart process."
|
||||
(interactive)
|
||||
(let* ((buf-name "*EPC Controller*")
|
||||
(buf (get-buffer buf-name)))
|
||||
(unless (buffer-live-p buf)
|
||||
(setq buf (get-buffer-create buf-name)))
|
||||
(epc:controller-update-buffer buf)
|
||||
(pop-to-buffer buf)))
|
||||
|
||||
(defun epc:controller-update-buffer (buf)
|
||||
"[internal] Update buffer for the current epc processes."
|
||||
(let*
|
||||
((data (loop
|
||||
for mngr in epc:live-connections collect
|
||||
(list
|
||||
(epc:manager-server-process mngr)
|
||||
(epc:manager-status-server-process mngr)
|
||||
(epc:manager-status-connection-process mngr)
|
||||
(epc:manager-title mngr)
|
||||
(epc:manager-commands mngr)
|
||||
(epc:manager-port mngr)
|
||||
(length (epc:manager-methods mngr))
|
||||
(length (epc:manager-sessions mngr))
|
||||
mngr)))
|
||||
(param (copy-ctbl:param ctbl:default-rendering-param))
|
||||
(cp
|
||||
(ctbl:create-table-component-buffer
|
||||
:buffer buf :width nil
|
||||
:model
|
||||
(make-ctbl:model
|
||||
:column-model
|
||||
(list (make-ctbl:cmodel :title "<Process>" :align 'left)
|
||||
(make-ctbl:cmodel :title "<Proc>" :align 'center)
|
||||
(make-ctbl:cmodel :title "<Conn>" :align 'center)
|
||||
(make-ctbl:cmodel :title " Title " :align 'left :max-width 30)
|
||||
(make-ctbl:cmodel :title " Command " :align 'left :max-width 30)
|
||||
(make-ctbl:cmodel :title " Port " :align 'right)
|
||||
(make-ctbl:cmodel :title " Methods " :align 'right)
|
||||
(make-ctbl:cmodel :title " Live sessions " :align 'right))
|
||||
:data data)
|
||||
:custom-map epc:controller-keymap
|
||||
:param param)))
|
||||
(pop-to-buffer (ctbl:cp-get-buffer cp))))
|
||||
|
||||
(eval-when-compile ; introduce anaphoric variable `cp' and `mngr'.
|
||||
(defmacro epc:controller-with-cp (&rest body)
|
||||
`(let ((cp (ctbl:cp-get-component)))
|
||||
(when cp
|
||||
(let ((mngr (car (last (ctbl:cp-get-selected-data-row cp)))))
|
||||
,@body)))))
|
||||
|
||||
(defun epc:controller-update-command ()
|
||||
(interactive)
|
||||
(epc:controller-with-cp
|
||||
(epc:controller-update-buffer (current-buffer))))
|
||||
|
||||
(defun epc:controller-connection-restart-command ()
|
||||
(interactive)
|
||||
(epc:controller-with-cp
|
||||
(let* ((proc (epc:manager-server-process mngr))
|
||||
(msg (format "Restart the EPC process [%s] ? " proc)))
|
||||
(when (and proc (y-or-n-p msg))
|
||||
(epc:manager-restart-process mngr)
|
||||
(epc:controller-update-buffer (current-buffer))))))
|
||||
|
||||
(defun epc:controller-connection-kill-command ()
|
||||
(interactive)
|
||||
(epc:controller-with-cp
|
||||
(let* ((proc (epc:manager-server-process mngr))
|
||||
(msg (format "Kill the EPC process [%s] ? " proc)))
|
||||
(when (and proc (y-or-n-p msg))
|
||||
(epc:stop-epc mngr)
|
||||
(epc:controller-update-buffer (current-buffer))))))
|
||||
|
||||
(defun epc:controller-connection-buffer-command ()
|
||||
(interactive)
|
||||
(epc:controller-with-cp
|
||||
(switch-to-buffer
|
||||
(epc:connection-buffer (epc:manager-connection mngr)))))
|
||||
|
||||
(defun epc:controller-methods-show-command ()
|
||||
(interactive)
|
||||
(epc:controller-with-cp
|
||||
(epc:controller-methods mngr)))
|
||||
|
||||
(defun epc:controller-methods (mngr)
|
||||
"Display a list of methods for the MNGR process."
|
||||
(let* ((buf-name "*EPC Controller/Methods*")
|
||||
(buf (get-buffer buf-name)))
|
||||
(unless (buffer-live-p buf)
|
||||
(setq buf (get-buffer-create buf-name))
|
||||
(with-current-buffer buf
|
||||
(setq buffer-read-only t)))
|
||||
(lexical-let ((buf buf) (mngr mngr))
|
||||
(deferred:$
|
||||
(epc:query-methods-deferred mngr)
|
||||
(deferred:nextc it
|
||||
(lambda (methods)
|
||||
(epc:controller-methods-update-buffer buf mngr methods)
|
||||
(pop-to-buffer buf)))))))
|
||||
|
||||
(defface epc:face-title
|
||||
'((((class color) (background light))
|
||||
:foreground "Slategray4" :background "Gray90" :weight bold)
|
||||
(((class color) (background dark))
|
||||
:foreground "maroon2" :weight bold))
|
||||
"Face for titles" :group 'epc)
|
||||
|
||||
(defun epc:controller-methods-update-buffer (buf mngr methods)
|
||||
"[internal] Update methods list buffer for the epc process."
|
||||
(with-current-buffer buf
|
||||
(let* ((data
|
||||
(loop for m in methods collect
|
||||
(list
|
||||
(car m)
|
||||
(or (nth 1 m) "<Not specified>")
|
||||
(or (nth 2 m) "<Not specified>"))))
|
||||
(param (copy-ctbl:param ctbl:default-rendering-param))
|
||||
cp buffer-read-only)
|
||||
(erase-buffer)
|
||||
(insert
|
||||
(propertize
|
||||
(format "EPC Process : %s\n"
|
||||
(mapconcat 'identity (epc:manager-commands mngr) " "))
|
||||
'face 'epc:face-title) "\n")
|
||||
(setq cp (ctbl:create-table-component-region
|
||||
:model
|
||||
(make-ctbl:model
|
||||
:column-model
|
||||
(list (make-ctbl:cmodel :title "Method Name" :align 'left)
|
||||
(make-ctbl:cmodel :title "Arguments" :align 'left)
|
||||
(make-ctbl:cmodel :title "Document" :align 'left))
|
||||
:data data)
|
||||
:keymap epc:controller-methods-keymap
|
||||
:param param))
|
||||
(set (make-local-variable 'epc:mngr) mngr)
|
||||
(ctbl:cp-set-selected-cell cp '(0 . 0))
|
||||
(ctbl:cp-get-buffer cp))))
|
||||
|
||||
(defun epc:controller-methods-eval-command ()
|
||||
(interactive)
|
||||
(let ((cp (ctbl:cp-get-component)))
|
||||
(when cp
|
||||
(let* ((method-name (car (ctbl:cp-get-selected-data-row cp)))
|
||||
(args (eval-minibuffer
|
||||
(format "Arguments for calling [%s] : " method-name))))
|
||||
(deferred:$
|
||||
(epc:call-deferred epc:mngr method-name args)
|
||||
(deferred:nextc it
|
||||
(lambda (ret) (message "Result : %S" ret)))
|
||||
(deferred:error it
|
||||
(lambda (err) (message "Error : %S" ret))))))))
|
||||
|
||||
(defun epc:define-keymap (keymap-list &optional prefix)
|
||||
"[internal] Keymap utility."
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(mapc
|
||||
(lambda (i)
|
||||
(define-key map
|
||||
(if (stringp (car i))
|
||||
(read-kbd-macro
|
||||
(if prefix
|
||||
(replace-regexp-in-string "prefix" prefix (car i))
|
||||
(car i)))
|
||||
(car i))
|
||||
(cdr i)))
|
||||
keymap-list)
|
||||
map))
|
||||
|
||||
(defun epc:add-keymap (keymap keymap-list &optional prefix)
|
||||
(loop with nkeymap = (copy-keymap keymap)
|
||||
for i in keymap-list
|
||||
do
|
||||
(define-key nkeymap
|
||||
(if (stringp (car i))
|
||||
(read-kbd-macro
|
||||
(if prefix
|
||||
(replace-regexp-in-string "prefix" prefix (car i))
|
||||
(car i)))
|
||||
(car i))
|
||||
(cdr i))
|
||||
finally return nkeymap))
|
||||
|
||||
(defvar epc:controller-keymap
|
||||
(epc:define-keymap
|
||||
'(
|
||||
("g" . epc:controller-update-command)
|
||||
("R" . epc:controller-connection-restart-command)
|
||||
("D" . epc:controller-connection-kill-command)
|
||||
("K" . epc:controller-connection-kill-command)
|
||||
("m" . epc:controller-methods-show-command)
|
||||
("C-m" . epc:controller-methods-show-command)
|
||||
("B" . epc:controller-connection-buffer-command)
|
||||
)) "Keymap for the controller buffer.")
|
||||
|
||||
(defvar epc:controller-methods-keymap
|
||||
(epc:add-keymap
|
||||
ctbl:table-mode-map
|
||||
'(
|
||||
("q" . bury-buffer)
|
||||
("e" . epc:controller-methods-eval-command)
|
||||
)) "Keymap for the controller methods list buffer.")
|
||||
|
||||
(provide 'epc)
|
||||
;;; epc.el ends here
|
||||
|
|
@ -0,0 +1,995 @@
|
|||
;;; jedi.el --- a Python auto-completion for Emacs
|
||||
|
||||
;; Copyright (C) 2012 Takafumi Arakaki
|
||||
|
||||
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
|
||||
;; Package-Requires: ((epc "0.1.0") (auto-complete "1.4"))
|
||||
;; Version: 0.1.2alpha2
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
;; jedi.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.
|
||||
|
||||
;; jedi.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 jedi.el.
|
||||
;; If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'epc)
|
||||
(require 'auto-complete)
|
||||
(declare-function pos-tip-show "pos-tip")
|
||||
|
||||
|
||||
(defgroup jedi nil
|
||||
"Auto-completion for Python."
|
||||
:group 'completion
|
||||
:prefix "jedi:")
|
||||
|
||||
(defconst jedi:version "0.1.2alpha2")
|
||||
|
||||
(defvar jedi:source-dir (if load-file-name
|
||||
(file-name-directory load-file-name)
|
||||
default-directory))
|
||||
|
||||
(defvar jedi:epc nil)
|
||||
(make-variable-buffer-local 'jedi:epc)
|
||||
|
||||
(defvar jedi:server-script
|
||||
(convert-standard-filename
|
||||
(expand-file-name "jediepcserver.py" jedi:source-dir))
|
||||
"Full path to Jedi server script file ``jediepcserver.py``.")
|
||||
|
||||
|
||||
;;; Configuration variables
|
||||
|
||||
(defcustom jedi:server-command
|
||||
(list (let ((py (expand-file-name "env/bin/python" jedi:source-dir)))
|
||||
(if (file-exists-p py) py "python"))
|
||||
jedi:server-script)
|
||||
"Command used to run Jedi server.
|
||||
|
||||
If you setup Jedi requirements using ``make requirements`` command,
|
||||
`jedi:server-command' should be automatically set to::
|
||||
|
||||
'(\"JEDI:SOURCE-DIR/env/bin/python\"
|
||||
\"JEDI:SOURCE-DIR/jediepcserver.py\")
|
||||
|
||||
Otherwise, it should be set to::
|
||||
|
||||
'(\"python\" \"JEDI:SOURCE-DIR/jediepcserver.py\")
|
||||
|
||||
If you want to use your favorite Python executable, set
|
||||
`jedi:server-command' using::
|
||||
|
||||
(setq jedi:server-command
|
||||
(list \"YOUR-FAVORITE-PYTHON\" jedi:server-script))
|
||||
|
||||
If you want to pass some arguments to the Jedi server command,
|
||||
use `jedi:server-command'."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:server-args nil
|
||||
"Command line arguments to be appended to `jedi:server-command'.
|
||||
|
||||
If you want to add some special `sys.path' when starting Jedi
|
||||
server, do something like this::
|
||||
|
||||
(setq jedi:server-args
|
||||
'(\"--sys-path\" \"MY/SPECIAL/PATH\"
|
||||
\"--sys-path\" \"MY/OTHER/SPECIAL/PATH\"))
|
||||
|
||||
If you want to include some virtualenv, do something like this.
|
||||
Note that actual `VIRTUAL_ENV' is treated automatically. Also,
|
||||
you need to start Jedi EPC server with the same python version
|
||||
that you use for the virtualenv.::
|
||||
|
||||
(setq jedi:server-args
|
||||
'(\"--virtual-env\" \"SOME/VIRTUAL_ENV_1\"
|
||||
\"--virtual-env\" \"SOME/VIRTUAL_ENV_2\"))
|
||||
|
||||
To see what other arguments Jedi server can take, execute the
|
||||
following command::
|
||||
|
||||
python jediepcserver.py --help
|
||||
|
||||
|
||||
**Advanced usage**
|
||||
|
||||
Sometimes you want to configure how Jedi server is started per
|
||||
buffer. To do that, you should make this variable buffer local
|
||||
in `python-mode-hook' and set it to some buffer specific variable,
|
||||
like this::
|
||||
|
||||
(defun my-jedi-server-setup ()
|
||||
(let ((cmds (GET-SOME-PROJECT-SPECIFIC-COMMAND))
|
||||
(args (GET-SOME-PROJECT-SPECIFIC-ARGS)))
|
||||
(when cmds (set (make-local-variable 'jedi:server-command) cmds))
|
||||
(when args (set (make-local-variable 'jedi:server-args) args))))
|
||||
|
||||
(add-hook 'python-mode-hook 'my-jedi-server-setup)
|
||||
|
||||
Note that Jedi server run by the same command is pooled. So,
|
||||
there is only one Jedi server for the same set of command. If
|
||||
you want to check how many EPC servers are running, use the EPC
|
||||
GUI: M-x `epc:controller'. You will see a table of EPC connections
|
||||
for Jedi.el and other EPC applications.
|
||||
|
||||
If you want to start a new ad-hoc server for the current buffer,
|
||||
use the command `jedi:start-dedicated-server'."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:complete-on-dot nil
|
||||
"Non-`nil' means automatically start completion after inserting a dot.
|
||||
To make this option work, you need to use `jedi:setup' instead of
|
||||
`jedi:ac-setup' to start Jedi."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:tooltip-method '(pos-tip popup)
|
||||
"Configuration for `jedi:tooltip-show'.
|
||||
This is a list which may contain symbol(s) `pos-tip' and/or
|
||||
`popup'. It determines tooltip method to use. Setting this
|
||||
value to nil means to use minibuffer instead of tooltip."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:get-in-function-call-timeout 3000
|
||||
"Cancel request to server for call signature after this period
|
||||
specified in in millisecond."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:get-in-function-call-delay 1000
|
||||
"How long Jedi should wait before showing call signature
|
||||
tooltip in millisecond."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:goto-definition-config
|
||||
'((nil nil nil)
|
||||
(t nil nil)
|
||||
(nil definition nil)
|
||||
(t definition nil)
|
||||
(nil nil t )
|
||||
(t nil t )
|
||||
(nil definition t )
|
||||
(t definition t ))
|
||||
"Configure how prefix argument modifies `jedi:goto-definition' behavior.
|
||||
|
||||
Each element of the list is arguments (list) passed to
|
||||
`jedi:goto-definition'. Note that this variable has no effect on
|
||||
`jedi:goto-definition' when it is used as a lisp function
|
||||
|
||||
The following setting is default (last parts are omitted).
|
||||
Nth element is used as the argument when N universal prefix
|
||||
arguments (``C-u``) are given.::
|
||||
|
||||
(setq jedi:goto-definition-config
|
||||
'((nil nil nil) ; C-.
|
||||
(t nil nil) ; C-u C-.
|
||||
(nil definition nil) ; C-u C-u C-.
|
||||
(t definition nil) ; C-u C-u C-u C-.
|
||||
...))
|
||||
|
||||
For example, if you want to follow \"substitution path\" by default,
|
||||
use the setting like this::
|
||||
|
||||
(setq jedi:goto-definition-config
|
||||
'((nil definition nil)
|
||||
(t definition nil)
|
||||
(nil nil nil)
|
||||
(t nil nil)
|
||||
(nil definition t )
|
||||
(t definition t )
|
||||
(nil nil t )
|
||||
(t nil t )))
|
||||
|
||||
You can rearrange the order to have most useful sets of arguments
|
||||
at the top."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:doc-mode 'rst-mode
|
||||
"Major mode to use when showing document."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:doc-hook '(view-mode)
|
||||
"The hook that's run after showing a document."
|
||||
:type 'hook
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:doc-display-buffer 'display-buffer
|
||||
"A function to be called with a buffer to show document."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:install-imenu nil
|
||||
"[EXPERIMENTAL] If `t', use Jedi to create `imenu' index.
|
||||
To use this feature, you need to install the developmental
|
||||
version (\"dev\" branch) of Jedi."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:setup-keys nil
|
||||
"Setup recommended keybinds.
|
||||
|
||||
.. admonition:: Default keybinds
|
||||
|
||||
``<C-tab>`` : = `jedi:key-complete'
|
||||
Complete code at point. (`jedi:complete')
|
||||
|
||||
``C-.`` : = `jedi:key-goto-definition'
|
||||
Goto the definition of the object at point. (`jedi:goto-definition')
|
||||
|
||||
``C-c d`` : = `jedi:key-show-doc'
|
||||
Goto the definition of the object at point. (`jedi:show-doc')
|
||||
|
||||
``C-c r`` : = `jedi:key-related-names'
|
||||
Find related names of the object at point.
|
||||
(`helm-jedi-related-names' / `anything-jedi-related-names')
|
||||
|
||||
When `jedi:setup-keys' is non-`nil', recommended keybinds are set
|
||||
in `jedi-mode-map' when **loading** jedi.el. Therefore, you must
|
||||
set this value before jedi.el is loaded. As recommended usage of
|
||||
jedi.el is to call `jedi:setup' via `python-mode-hook' where
|
||||
`jedi:setup' is autloaded, setting `jedi:setup-keys' to `t' in
|
||||
you emacs setup (e.g., ``.emacs.d/init.el``) works fine.::
|
||||
|
||||
(setq jedi:setup-keys t)
|
||||
(add-hook 'python-mode-hook 'jedi:setup)
|
||||
|
||||
If you want to require jedi.el explicitly when loading Emacs,
|
||||
make sure to set `jedi:setup-keys' before loading jedi.el::
|
||||
|
||||
(setq jedi:setup-keys t)
|
||||
(require 'jedi)
|
||||
|
||||
Byte compiler warns about unbound variable if you set
|
||||
`jedi:setup-keys' before loading jedi.el. The proper way to
|
||||
suppress this warning is the following::
|
||||
|
||||
(eval-when-compile (require 'jedi nil t))
|
||||
(setq jedi:setup-keys t)
|
||||
|
||||
You can change these keybinds by changing `jedi:key-complete',
|
||||
`jedi:key-goto-definition', `jedi:key-show-doc', and
|
||||
`jedi:key-related-names'. For example, default keybind for
|
||||
ropemacs's `rope-show-doc' is same as `jedi:show-doc'. You can
|
||||
avoid collision by something like this::
|
||||
|
||||
(setq jedi:key-show-doc (kbd \"C-c D\"))"
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:key-complete (kbd "<C-tab>")
|
||||
"Keybind for command `jedi:complete'."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:key-goto-definition (kbd "C-.")
|
||||
"Keybind for command `jedi:goto-definition'."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:key-show-doc (kbd "C-c d")
|
||||
"Keybind for command `jedi:show-doc'."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:key-related-names (kbd "C-c r")
|
||||
"Keybind for command `helm-jedi-related-names' or
|
||||
`anything-jedi-related-names'."
|
||||
:group 'jedi)
|
||||
|
||||
(defcustom jedi:import-python-el-settings t
|
||||
"Automatically import setting from python.el variables."
|
||||
:group 'jedi)
|
||||
|
||||
|
||||
;;; Internal variables
|
||||
|
||||
(defvar jedi:get-in-function-call--d nil
|
||||
"Bounded to deferred object while requesting get-in-function-call.")
|
||||
|
||||
(defvar jedi:defined-names--singleton-d nil
|
||||
"Bounded to deferred object while requesting defined_names.")
|
||||
|
||||
|
||||
;;; Jedi mode
|
||||
|
||||
(defvar jedi-mode-map (make-sparse-keymap))
|
||||
|
||||
(defun jedi:handle-post-command ()
|
||||
(jedi:get-in-function-call-when-idle))
|
||||
|
||||
(define-minor-mode jedi-mode
|
||||
"Jedi mode.
|
||||
When `jedi-mode' is on, call signature is automatically shown as
|
||||
toolitp when inside of function call.
|
||||
|
||||
\\{jedi-mode-map}"
|
||||
:keymap jedi-mode-map
|
||||
:group 'jedi
|
||||
(let ((map jedi-mode-map))
|
||||
(if jedi:complete-on-dot
|
||||
(define-key map "." 'jedi:dot-complete)
|
||||
(define-key map "." nil)))
|
||||
(if jedi-mode
|
||||
(progn
|
||||
(when jedi:install-imenu
|
||||
(add-hook 'after-change-functions 'jedi:after-change-handler nil t)
|
||||
(jedi:defined-names-deferred)
|
||||
(setq imenu-create-index-function 'jedi:create-imenu-index))
|
||||
(add-hook 'post-command-hook 'jedi:handle-post-command nil t)
|
||||
(add-hook 'kill-buffer-hook 'jedi:server-pool--gc-when-idle nil t))
|
||||
(remove-hook 'post-command-hook 'jedi:handle-post-command t)
|
||||
(remove-hook 'after-change-functions 'jedi:after-change-handler t)
|
||||
(remove-hook 'kill-buffer-hook 'jedi:server-pool--gc-when-idle t)
|
||||
(jedi:server-pool--gc-when-idle)))
|
||||
|
||||
(when jedi:setup-keys
|
||||
(let ((map jedi-mode-map))
|
||||
(define-key map jedi:key-complete 'jedi:complete)
|
||||
(define-key map jedi:key-goto-definition 'jedi:goto-definition)
|
||||
(define-key map jedi:key-show-doc 'jedi:show-doc)
|
||||
(let ((command (cond
|
||||
((featurep 'helm) 'helm-jedi-related-names)
|
||||
((featurep 'anything) 'anything-jedi-related-names))))
|
||||
(when command
|
||||
(define-key map jedi:key-related-names command)))))
|
||||
|
||||
|
||||
;;; EPC utils
|
||||
|
||||
(defun jedi:epc--live-p (mngr)
|
||||
"Return non-nil when MNGR is an EPC manager object with a live
|
||||
connection."
|
||||
(let ((proc (ignore-errors
|
||||
(epc:connection-process (epc:manager-connection mngr)))))
|
||||
(and (processp proc)
|
||||
;; Same as `process-live-p' in Emacs >= 24:
|
||||
(memq (process-status proc) '(run open listen connect stop)))))
|
||||
|
||||
(defun jedi:epc--start-epc (server-prog server-args)
|
||||
"Same as `epc:start-epc', but set query-on-exit flag for
|
||||
associated processes to nil."
|
||||
(let ((mngr (epc:start-epc server-prog server-args)))
|
||||
(set-process-query-on-exit-flag (epc:connection-process
|
||||
(epc:manager-connection mngr))
|
||||
nil)
|
||||
(set-process-query-on-exit-flag (epc:manager-server-process mngr) nil)
|
||||
mngr))
|
||||
|
||||
|
||||
;;; Server pool
|
||||
|
||||
(defvar jedi:server-pool--table (make-hash-table :test 'equal)
|
||||
"A hash table that holds a pool of EPC server instances.")
|
||||
|
||||
(defun jedi:server-pool--start (command)
|
||||
"Get an EPC server instance from server pool by COMMAND as a
|
||||
key, or start new one if there is none."
|
||||
(let ((cached (gethash command jedi:server-pool--table)))
|
||||
(if (and cached (jedi:epc--live-p cached))
|
||||
cached
|
||||
(let* ((default-directory jedi:source-dir)
|
||||
(mngr (jedi:epc--start-epc (car command) (cdr command))))
|
||||
(puthash command mngr jedi:server-pool--table)
|
||||
(jedi:server-pool--gc-when-idle)
|
||||
mngr))))
|
||||
|
||||
(defun jedi:-get-servers-in-use ()
|
||||
"Return a list of non-nil `jedi:epc' in all buffers."
|
||||
(loop with mngr-list
|
||||
for buffer in (buffer-list)
|
||||
for mngr = (with-current-buffer buffer jedi:epc)
|
||||
when (and mngr (not (memq mngr mngr-list)))
|
||||
collect mngr into mngr-list
|
||||
finally return mngr-list))
|
||||
|
||||
(defvar jedi:server-pool--gc-timer nil)
|
||||
|
||||
(defun jedi:server-pool--gc ()
|
||||
"Stop unused servers."
|
||||
(let ((servers-in-use (jedi:-get-servers-in-use)))
|
||||
(maphash
|
||||
(lambda (key mngr)
|
||||
(unless (memq mngr servers-in-use)
|
||||
(remhash key jedi:server-pool--table)
|
||||
(epc:stop-epc mngr)))
|
||||
jedi:server-pool--table))
|
||||
;; Clear timer so that GC is started next time
|
||||
;; `jedi:server-pool--gc-when-idle' is called.
|
||||
(setq jedi:server-pool--gc-timer nil))
|
||||
|
||||
(defun jedi:server-pool--gc-when-idle ()
|
||||
"Run `jedi:server-pool--gc' when idle."
|
||||
(unless jedi:server-pool--gc-timer
|
||||
(setq jedi:server-pool--gc-timer
|
||||
(run-with-idle-timer 10 nil 'jedi:server-pool--gc))))
|
||||
|
||||
|
||||
;;; Server management
|
||||
|
||||
(defun jedi:start-server ()
|
||||
(if (jedi:epc--live-p jedi:epc)
|
||||
(message "Jedi server is already started!")
|
||||
(setq jedi:epc (jedi:server-pool--start
|
||||
(append jedi:server-command jedi:server-args))))
|
||||
jedi:epc)
|
||||
|
||||
(defun jedi:stop-server ()
|
||||
"Stop Jedi server. Use this command when you want to restart
|
||||
Jedi server (e.g., when you changed `jedi:server-command' or
|
||||
`jedi:server-args'). Jedi srever will be restarted automatically
|
||||
later when it is needed."
|
||||
(interactive)
|
||||
(if jedi:epc
|
||||
(epc:stop-epc jedi:epc)
|
||||
(message "Jedi server is already killed."))
|
||||
(setq jedi:epc nil)
|
||||
;; It could be non-nil due to some error. Rescue it in that case.
|
||||
(setq jedi:get-in-function-call--d nil)
|
||||
(setq jedi:defined-names--singleton-d nil))
|
||||
|
||||
(defun jedi:get-epc ()
|
||||
(if (jedi:epc--live-p jedi:epc)
|
||||
jedi:epc
|
||||
(jedi:start-server)))
|
||||
|
||||
;;;###autoload
|
||||
(defun jedi:start-dedicated-server (command)
|
||||
"Start Jedi server dedicated to this buffer.
|
||||
This is useful, for example, when you want to use different
|
||||
`sys.path' for some buffer. When invoked as an interactive
|
||||
command, it asks you how to start the Jedi server. You can edit
|
||||
the command in minibuffer to specify the way Jedi server run.
|
||||
|
||||
If you want to setup how Jedi server is started programmatically
|
||||
per-buffer/per-project basis, make `jedi:server-command' and
|
||||
`jedi:server-args' buffer local and set it in `python-mode-hook'.
|
||||
See also: `jedi:server-args'."
|
||||
(interactive
|
||||
(list (split-string-and-unquote
|
||||
(read-string "Run Jedi server: "
|
||||
(mapconcat
|
||||
#'identity
|
||||
(append jedi:server-command
|
||||
jedi:server-args)
|
||||
" ")))))
|
||||
;; Reset `jedi:epc' so that a new server is created when COMMAND is
|
||||
;; new. If it is already in the server pool, the server instance
|
||||
;; already in the pool is picked up by `jedi:start-server'.
|
||||
(setq jedi:epc nil)
|
||||
;; Set `jedi:server-command', so that this command is used
|
||||
;; when restarting EPC server of this buffer.
|
||||
(set (make-local-variable 'jedi:server-command) command)
|
||||
(set (make-local-variable 'jedi:server-args) nil)
|
||||
(jedi:start-server))
|
||||
|
||||
(defun jedi:call-deferred (method-name)
|
||||
"Call ``Script(...).METHOD-NAME`` and return a deferred object."
|
||||
(let ((source (buffer-substring-no-properties (point-min) (point-max)))
|
||||
(line (count-lines (point-min) (min (1+ (point)) (point-max))))
|
||||
(column (current-column))
|
||||
(source-path buffer-file-name))
|
||||
(epc:call-deferred (jedi:get-epc)
|
||||
method-name
|
||||
(list source line column source-path))))
|
||||
|
||||
|
||||
;;; Completion
|
||||
|
||||
(defvar jedi:complete-reply nil
|
||||
"Last reply to `jedi:complete-request'.")
|
||||
|
||||
(defvar jedi:complete-request-point 0
|
||||
;; It is passed to `=', so do not initialize this value by `nil'.
|
||||
"The point where `jedi:complete-request' is called.")
|
||||
|
||||
(defun jedi:complete-request ()
|
||||
"Request ``Script(...).complete`` and return a deferred object.
|
||||
`jedi:complete-reply' is set to the reply sent from the server."
|
||||
(setq jedi:complete-request-point (point))
|
||||
(deferred:nextc (jedi:call-deferred 'complete)
|
||||
(lambda (reply)
|
||||
(setq jedi:complete-reply reply))))
|
||||
|
||||
;;;###autoload
|
||||
(defun* jedi:complete (&key (expand ac-expand-on-auto-complete))
|
||||
"Complete code at point."
|
||||
(interactive)
|
||||
(lexical-let ((expand expand))
|
||||
(deferred:nextc (jedi:complete-request)
|
||||
(lambda ()
|
||||
(let ((ac-expand-on-auto-complete expand))
|
||||
(auto-complete '(ac-source-jedi-direct)))))))
|
||||
|
||||
(defun jedi:dot-complete ()
|
||||
"Insert dot and complete code at point."
|
||||
(interactive)
|
||||
(insert ".")
|
||||
(unless (ac-cursor-on-diable-face-p)
|
||||
(jedi:complete :expand nil)))
|
||||
|
||||
|
||||
;;; AC source
|
||||
|
||||
(defun jedi:ac-direct-matches ()
|
||||
(mapcar
|
||||
(lambda (x)
|
||||
(destructuring-bind (&key word doc description symbol)
|
||||
x
|
||||
(popup-make-item word
|
||||
:symbol symbol
|
||||
:document (unless (equal doc "") doc)
|
||||
:summary description)))
|
||||
jedi:complete-reply))
|
||||
|
||||
(defun jedi:ac-direct-prefix ()
|
||||
(or (ac-prefix-default)
|
||||
(when (= jedi:complete-request-point (point))
|
||||
jedi:complete-request-point)))
|
||||
|
||||
;; (makunbound 'ac-source-jedi-direct)
|
||||
(ac-define-source jedi-direct
|
||||
'((candidates . jedi:ac-direct-matches)
|
||||
(prefix . jedi:ac-direct-prefix)
|
||||
(init . jedi:complete-request)
|
||||
(requires . -1)))
|
||||
|
||||
;;;###autoload
|
||||
(defun jedi:ac-setup ()
|
||||
"Add Jedi AC sources to `ac-sources'."
|
||||
(interactive)
|
||||
(add-to-list 'ac-sources 'ac-source-jedi-direct))
|
||||
|
||||
|
||||
;;; Call signature (get_in_function_call)
|
||||
|
||||
(defface jedi:highlight-function-argument
|
||||
'((t (:inherit bold)))
|
||||
"Face used for the argument at point in a function's argument list"
|
||||
:group 'jedi)
|
||||
|
||||
(defun* jedi:get-in-function-call--construct-call-signature
|
||||
(&key params index call_name)
|
||||
(let ((current-arg (nth index params)))
|
||||
(when (and current-arg (null jedi:tooltip-method))
|
||||
(setf (nth index params)
|
||||
(propertize current-arg 'face 'jedi:highlight-function-argument)))
|
||||
(concat call_name "(" (mapconcat #'identity params ", ") ")")))
|
||||
|
||||
(defun jedi:get-in-function-call--tooltip-show (args)
|
||||
(when (and args (not ac-completing))
|
||||
(jedi:tooltip-show
|
||||
(apply #'jedi:get-in-function-call--construct-call-signature args))))
|
||||
|
||||
(defun jedi:get-in-function-call ()
|
||||
"Manually show call signature tooltip."
|
||||
(interactive)
|
||||
(deferred:nextc
|
||||
(jedi:call-deferred 'get_in_function_call)
|
||||
#'jedi:get-in-function-call--tooltip-show))
|
||||
|
||||
(defun jedi:get-in-function-call-when-idle ()
|
||||
"Show tooltip when Emacs is ilde."
|
||||
(unless jedi:get-in-function-call--d
|
||||
(setq jedi:get-in-function-call--d
|
||||
(deferred:try
|
||||
(deferred:$
|
||||
(deferred:wait-idle jedi:get-in-function-call-delay)
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(when jedi-mode ; cursor may be moved
|
||||
(deferred:timeout
|
||||
jedi:get-in-function-call-timeout
|
||||
nil
|
||||
(jedi:call-deferred 'get_in_function_call)))))
|
||||
(deferred:nextc it #'jedi:get-in-function-call--tooltip-show))
|
||||
:finally
|
||||
(lambda ()
|
||||
(setq jedi:get-in-function-call--d nil))))))
|
||||
|
||||
(defun jedi:tooltip-show (string)
|
||||
(cond
|
||||
((and (memq 'pos-tip jedi:tooltip-method) window-system
|
||||
(featurep 'pos-tip))
|
||||
(pos-tip-show (jedi:string-fill-paragraph string)
|
||||
'popup-tip-face nil nil 0))
|
||||
((and (memq 'popup jedi:tooltip-method)
|
||||
(featurep 'popup))
|
||||
(popup-tip string))
|
||||
(t (when (stringp string)
|
||||
(let ((message-log-max nil))
|
||||
(message string))))))
|
||||
|
||||
(defun jedi:string-fill-paragraph (string &optional justify)
|
||||
(with-temp-buffer
|
||||
(erase-buffer)
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(fill-paragraph justify)
|
||||
(buffer-string)))
|
||||
|
||||
|
||||
;;; Goto
|
||||
|
||||
(defvar jedi:goto-definition--index nil)
|
||||
(defvar jedi:goto-definition--cache nil)
|
||||
|
||||
(defun jedi:goto-definition (&optional other-window deftype use-cache index)
|
||||
"Goto the definition of the object at point.
|
||||
|
||||
See `jedi:goto-definition-config' for how this function works
|
||||
when universal prefix arguments \(``C-u``) are given. If
|
||||
*numeric* prefix argument(s) \(e.g., ``M-0``) are given, goto
|
||||
point of the INDEX-th result. Note that you cannot mix universal
|
||||
and numeric prefixes. It is Emacs's limitation. If you mix both
|
||||
kinds of prefix, you get numeric prefix.
|
||||
|
||||
When used as a lisp function, popup a buffer when OTHER-WINDOW is
|
||||
non-nil. DEFTYPE must be either `assignment' (default) or
|
||||
`definition'. When USE-CACHE is non-nil, use the locations of
|
||||
the last invocation of this command. If INDEX is specified, goto
|
||||
INDEX-th result."
|
||||
(interactive
|
||||
(if (integerp current-prefix-arg)
|
||||
(list nil nil nil current-prefix-arg)
|
||||
(nth (let ((i (car current-prefix-arg)))
|
||||
(if i (floor (log i 4)) 0))
|
||||
jedi:goto-definition-config)))
|
||||
(cond
|
||||
((and (or use-cache index)
|
||||
jedi:goto-definition--cache)
|
||||
(setq jedi:goto-definition--index (or index 0))
|
||||
(jedi:goto-definition--nth other-window))
|
||||
((and (eq last-command 'jedi:goto-definition)
|
||||
(> (length jedi:goto-definition--cache) 1))
|
||||
(jedi:goto-definition-next other-window))
|
||||
(t
|
||||
(setq jedi:goto-definition--index (or index 0))
|
||||
(lexical-let ((other-window other-window))
|
||||
(deferred:nextc (jedi:call-deferred
|
||||
(case deftype
|
||||
((assignment nil) 'goto)
|
||||
(definition 'get_definition)
|
||||
(t (error "Unsupported deftype: %s" deftype))))
|
||||
(lambda (reply)
|
||||
(jedi:goto-definition--callback reply other-window)))))))
|
||||
|
||||
(defun jedi:goto-definition-next (&optional other-window)
|
||||
"Goto the next cached definition. See: `jedi:goto-definition'."
|
||||
(interactive "P")
|
||||
(let ((len (length jedi:goto-definition--cache))
|
||||
(n (1+ jedi:goto-definition--index)))
|
||||
(setq jedi:goto-definition--index (if (>= n len) 0 n))
|
||||
(jedi:goto-definition--nth other-window)))
|
||||
|
||||
(defun jedi:goto-definition--callback (reply other-window)
|
||||
(if (not reply)
|
||||
(message "Definition not found.")
|
||||
(setq jedi:goto-definition--cache reply)
|
||||
(jedi:goto-definition--nth other-window t)))
|
||||
|
||||
(defun jedi:goto--line-column (line column)
|
||||
"Like `goto-char' but specify the position by LINE and COLUMN."
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line))
|
||||
(forward-char column))
|
||||
|
||||
(defun jedi:goto-definition--nth (other-window &optional try-next)
|
||||
(let* ((len (length jedi:goto-definition--cache))
|
||||
(n jedi:goto-definition--index)
|
||||
(next (lambda ()
|
||||
(when (< n (1- len))
|
||||
(incf jedi:goto-definition--index)
|
||||
(jedi:goto-definition--nth other-window)
|
||||
t))))
|
||||
(destructuring-bind (&key line_nr column module_path module_name
|
||||
&allow-other-keys)
|
||||
(nth n jedi:goto-definition--cache)
|
||||
(cond
|
||||
((equal module_name "__builtin__")
|
||||
(unless (and try-next (funcall next))
|
||||
(message "Cannot see the definition of __builtin__.")))
|
||||
((not (and module_path (file-exists-p module_path)))
|
||||
(unless (and try-next (funcall next))
|
||||
(message "File '%s' does not exist." module_path)))
|
||||
(t
|
||||
(push-mark)
|
||||
(funcall (if other-window #'find-file-other-window #'find-file)
|
||||
module_path)
|
||||
(jedi:goto--line-column line_nr column)
|
||||
(jedi:goto-definition--notify-alternatives len n))))))
|
||||
|
||||
(defun jedi:goto-definition--notify-alternatives (len n)
|
||||
(unless (= len 1)
|
||||
(message
|
||||
"%d-th point in %d candidates.%s"
|
||||
(1+ n)
|
||||
len
|
||||
;; Note: It must be `last-command', not `last-command' because
|
||||
;; this function is called in deferred at the first time.
|
||||
(if (eq last-command 'jedi:goto-definition)
|
||||
(format " Type %s to go to the next point."
|
||||
(key-description
|
||||
(car (where-is-internal 'jedi:goto-definition))))
|
||||
""))))
|
||||
|
||||
|
||||
;;; Full name
|
||||
|
||||
(defun jedi:get-full-name-deferred ()
|
||||
(deferred:$
|
||||
(jedi:call-deferred 'get_definition)
|
||||
(deferred:nextc it
|
||||
(lambda (reply)
|
||||
(loop for def in reply
|
||||
do (destructuring-bind (&key full_name &allow-other-keys)
|
||||
def
|
||||
(when full_name
|
||||
(return full_name))))))))
|
||||
|
||||
(defun* jedi:get-full-name-sync (&key (timeout 500))
|
||||
(epc:sync
|
||||
(jedi:get-epc)
|
||||
(deferred:timeout timeout nil (jedi:get-full-name-deferred))))
|
||||
|
||||
|
||||
;;; Related names
|
||||
|
||||
(defun jedi:related-names--source (name candidates)
|
||||
`((name . ,name)
|
||||
(candidates . ,candidates)
|
||||
(recenter)
|
||||
(type . file-line)))
|
||||
|
||||
(defun jedi:related-names--to-file-line (reply)
|
||||
(mapcar
|
||||
(lambda (x)
|
||||
(destructuring-bind
|
||||
(&key line_nr column module_name module_path description)
|
||||
x
|
||||
(format "%s:%s: %s - %s" module_path line_nr
|
||||
module_name description)))
|
||||
reply))
|
||||
|
||||
(defun jedi:related-names--helm (helm)
|
||||
(lexical-let ((helm helm))
|
||||
(deferred:nextc
|
||||
(let ((to-file-line #'jedi:related-names--to-file-line))
|
||||
(deferred:parallel
|
||||
(deferred:nextc (jedi:call-deferred 'related_names) to-file-line)
|
||||
(deferred:nextc (jedi:call-deferred 'goto) to-file-line)))
|
||||
(lambda (candidates-list)
|
||||
(funcall
|
||||
helm
|
||||
:sources (list (jedi:related-names--source "Jedi Related Names"
|
||||
(car candidates-list))
|
||||
(jedi:related-names--source "Jedi Goto"
|
||||
(cadr candidates-list)))
|
||||
:buffer (format "*%s jedi:related-names*" helm))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-jedi-related-names ()
|
||||
"Find related names of the object at point using `helm' interface."
|
||||
(interactive)
|
||||
(jedi:related-names--helm 'helm))
|
||||
|
||||
;;;###autoload
|
||||
(defun anything-jedi-related-names ()
|
||||
"Find related names of the object at point using `anything' interface."
|
||||
(interactive)
|
||||
(jedi:related-names--helm 'anything))
|
||||
|
||||
|
||||
;;; Show document (get-definition)
|
||||
|
||||
(defvar jedi:doc-buffer-name "*jedi:doc*")
|
||||
|
||||
(defun jedi:show-doc ()
|
||||
"Show the documentation of the object at point."
|
||||
(interactive)
|
||||
(deferred:nextc (jedi:call-deferred 'get_definition)
|
||||
(lambda (reply)
|
||||
(with-current-buffer (get-buffer-create jedi:doc-buffer-name)
|
||||
(loop with has-doc = nil
|
||||
with first = t
|
||||
with inhibit-read-only = t
|
||||
initially (erase-buffer)
|
||||
for def in reply
|
||||
do (destructuring-bind
|
||||
(&key doc desc_with_module line_nr module_path
|
||||
&allow-other-keys)
|
||||
def
|
||||
(unless (or (null doc) (equal doc ""))
|
||||
(if first
|
||||
(setq first nil)
|
||||
(insert "\n\n---\n\n"))
|
||||
(insert "Docstring for " desc_with_module "\n\n" doc)
|
||||
(setq has-doc t)))
|
||||
finally do
|
||||
(if (not has-doc)
|
||||
(message "Document not found.")
|
||||
(progn
|
||||
(goto-char (point-min))
|
||||
(when (fboundp jedi:doc-mode)
|
||||
(funcall jedi:doc-mode))
|
||||
(run-hooks 'jedi:doc-hook)
|
||||
(funcall jedi:doc-display-buffer (current-buffer)))))))))
|
||||
|
||||
|
||||
;;; Defined names (imenu)
|
||||
|
||||
(defvar jedi:defined-names--cache nil)
|
||||
(make-variable-buffer-local 'jedi:defined-names--cache)
|
||||
|
||||
(defun jedi:defined-names-deferred ()
|
||||
(deferred:nextc
|
||||
(epc:call-deferred
|
||||
(jedi:get-epc)
|
||||
'defined_names
|
||||
(list (buffer-substring-no-properties (point-min) (point-max))
|
||||
buffer-file-name))
|
||||
(lambda (reply)
|
||||
(setq jedi:defined-names--cache reply))))
|
||||
|
||||
(defun jedi:defined-names--singleton-deferred ()
|
||||
"Like `jedi:defined-names-deferred', but make sure that only
|
||||
one request at the time is emitted."
|
||||
(unless jedi:defined-names--singleton-d
|
||||
(setq jedi:defined-names--singleton-d
|
||||
(deferred:watch (jedi:defined-names-deferred)
|
||||
(lambda (_) (setq jedi:defined-names--singleton-d nil))))))
|
||||
|
||||
(defun jedi:after-change-handler (&rest _)
|
||||
(unless (or (ac-menu-live-p) (ac-inline-live-p))
|
||||
(jedi:defined-names--singleton-deferred)))
|
||||
|
||||
(defun jedi:create-imenu-index-1 (def)
|
||||
(destructuring-bind (&key name line_nr column &allow-other-keys) def
|
||||
(cons name (save-excursion (jedi:goto--line-column line_nr column)
|
||||
(point-marker)))))
|
||||
|
||||
(defun jedi:create-imenu-index (&optional items)
|
||||
"`imenu-create-index-function' for Jedi.el.
|
||||
Return an object described in `imenu--index-alist'."
|
||||
(loop for (def . subdefs) in (or items jedi:defined-names--cache)
|
||||
if subdefs
|
||||
collect (append
|
||||
(list (plist-get def :full_name)
|
||||
(jedi:create-imenu-index-1 def))
|
||||
(jedi:create-imenu-index subdefs))
|
||||
else
|
||||
collect (jedi:create-imenu-index-1 def)))
|
||||
|
||||
|
||||
;;; Meta info
|
||||
|
||||
(defun jedi:get-jedi-version-request ()
|
||||
"Request version of Python modules and return a deferred object."
|
||||
(epc:call-deferred (jedi:get-epc) 'get_jedi_version nil))
|
||||
|
||||
(defun jedi:show-jedi-version ()
|
||||
(interactive)
|
||||
(deferred:nextc (jedi:get-jedi-version-request)
|
||||
(lambda (reply)
|
||||
(let ((standard-output (get-buffer-create "*jedi:version*")))
|
||||
(with-current-buffer standard-output
|
||||
(emacs-lisp-mode)
|
||||
(erase-buffer)
|
||||
(pp reply)
|
||||
(display-buffer standard-output))))))
|
||||
|
||||
(defun jedi:print-jedi-version ()
|
||||
(pp (epc:sync (jedi:get-epc) (jedi:get-jedi-version-request))))
|
||||
|
||||
|
||||
;;; Setup
|
||||
|
||||
(defun jedi:import-python-el-settings-setup ()
|
||||
"Make jedi aware of python.el virtualenv and path settings.
|
||||
This is automatically added to the `jedi-mode-hook' when
|
||||
`jedi:import-python-el-settings' is non-nil."
|
||||
(let ((args))
|
||||
(when (bound-and-true-p python-shell-extra-pythonpaths)
|
||||
(mapc
|
||||
(lambda (path)
|
||||
(setq args (append (list "--sys-path" path) args)))
|
||||
python-shell-extra-pythonpaths))
|
||||
(when (bound-and-true-p python-shell-virtualenv-path)
|
||||
(setq args
|
||||
(append
|
||||
(list "--virtual-env" python-shell-virtualenv-path)
|
||||
args)))
|
||||
(when args
|
||||
(set (make-local-variable 'jedi:server-args)
|
||||
(append args jedi:server-args)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun jedi:setup ()
|
||||
"Fully setup jedi.el for current buffer.
|
||||
It setups `ac-sources' (calls `jedi:ac-setup') and turns
|
||||
`jedi-mode' on.
|
||||
|
||||
This function is intended to be called from `python-mode-hook',
|
||||
like this::
|
||||
|
||||
(add-hook 'python-mode-hook 'jedi:setup)
|
||||
|
||||
You can also call this function as a command, to quickly test
|
||||
what jedi can do."
|
||||
(interactive)
|
||||
(jedi:ac-setup)
|
||||
(when jedi:import-python-el-settings
|
||||
;; Hack to access buffer/dir-local vars: http://bit.ly/Y5IfMV.
|
||||
;; Given that `jedi:setup' is added to the `python-mode-hook'
|
||||
;; this will modify `hack-local-variables-hook' on python
|
||||
;; buffers only and will allow us to access buffer/directory
|
||||
;; local variables in `jedi:import-python-el-settings-setup'.
|
||||
(add-hook 'hack-local-variables-hook
|
||||
#'jedi:import-python-el-settings-setup nil t))
|
||||
(jedi-mode 1))
|
||||
|
||||
|
||||
;;; Debugging
|
||||
|
||||
|
||||
(defvar jedi:server-command--backup nil)
|
||||
(defvar jedi:server-args--backup nil)
|
||||
|
||||
(defun jedi:toggle-debug-server ()
|
||||
"Setup `jedi:server-command' and `jedi:server-args' to debug
|
||||
server using pdb or ipdb.
|
||||
|
||||
When this command is called, it essentially execute the following
|
||||
code::
|
||||
|
||||
(jedi:stop-server)
|
||||
(setq jedi:server-command (list \"cat\" \"jedi-port.log\" )
|
||||
jedi:server-args nil)
|
||||
|
||||
It means to pass the port number recorded in the file
|
||||
jedi-port.log to EPC client.
|
||||
|
||||
To start Jedi server in terminal and record port to the file,
|
||||
use the following command::
|
||||
|
||||
python jediepcserver.py --port-file jedi-port.log --pdb
|
||||
|
||||
This command will be copied in the kill-ring (clipboard) when
|
||||
this command is called. You can use `--ipdb` instead of `--pdb`
|
||||
to use ipdb instead of pdb.
|
||||
|
||||
Calling this command again restores the original setting of
|
||||
`jedi:server-command' and `jedi:server-args' then stops the
|
||||
running server."
|
||||
(interactive)
|
||||
(if jedi:server-command--backup
|
||||
(progn
|
||||
(setq jedi:server-command jedi:server-command--backup
|
||||
jedi:server-args jedi:server-args--backup)
|
||||
(jedi:stop-server)
|
||||
(message "Quit debugging. Original setting restored."))
|
||||
(setq jedi:server-command--backup jedi:server-command
|
||||
jedi:server-args--backup jedi:server-args
|
||||
jedi:server-command (list "cat" (expand-file-name
|
||||
"jedi-port.log" jedi:source-dir))
|
||||
jedi:server-args nil)
|
||||
(jedi:stop-server)
|
||||
(kill-new "python jediepcserver.py --port-file jedi-port.log --ipdb")
|
||||
(message "Now, start server with: --port-file jedi-port.log --ipdb.\
|
||||
(command is copied in the kill-ring)")))
|
||||
|
||||
|
||||
(provide 'jedi)
|
||||
|
||||
;; Local Variables:
|
||||
;; coding: utf-8
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;;; jedi.el ends here
|
||||
|
|
@ -0,0 +1,299 @@
|
|||
"""
|
||||
Jedi EPC server.
|
||||
|
||||
Copyright (C) 2012 Takafumi Arakaki
|
||||
|
||||
Author: Takafumi Arakaki <aka.tkf at gmail.com>
|
||||
|
||||
This file is NOT part of GNU Emacs.
|
||||
|
||||
Jedi EPC server 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.
|
||||
|
||||
Jedi EPC server 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 Jedi EPC server.
|
||||
If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
"""
|
||||
|
||||
import os
|
||||
import sys
|
||||
import re
|
||||
import itertools
|
||||
import logging
|
||||
import site
|
||||
|
||||
jedi = None # I will load it later
|
||||
|
||||
|
||||
PY3 = (sys.version_info[0] >= 3)
|
||||
NEED_ENCODE = not PY3
|
||||
|
||||
|
||||
def jedi_script(source, line, column, source_path):
|
||||
if NEED_ENCODE:
|
||||
source = source.encode('utf-8')
|
||||
source_path = source_path and source_path.encode('utf-8')
|
||||
return jedi.Script(source, line, column, source_path or '')
|
||||
|
||||
|
||||
def candidate_symbol(comp):
|
||||
"""
|
||||
Return a character representing completion type.
|
||||
|
||||
:type comp: jedi.api.Completion
|
||||
:arg comp: A completion object returned by `jedi.Script.complete`.
|
||||
|
||||
"""
|
||||
try:
|
||||
return comp.type[0].lower()
|
||||
except (AttributeError, TypeError):
|
||||
return '?'
|
||||
|
||||
|
||||
def candidates_description(comp):
|
||||
"""
|
||||
Return `comp.description` in an appropriate format.
|
||||
|
||||
* Avoid return a string 'None'.
|
||||
* Strip off all newlines. This is required for using
|
||||
`comp.description` as candidate summary.
|
||||
|
||||
"""
|
||||
desc = comp.description
|
||||
return _WHITESPACES_RE.sub(' ', desc) if desc and desc != 'None' else ''
|
||||
_WHITESPACES_RE = re.compile(r'\s+')
|
||||
|
||||
|
||||
def complete(*args):
|
||||
reply = []
|
||||
for comp in jedi_script(*args).complete():
|
||||
reply.append(dict(
|
||||
word=comp.word,
|
||||
doc=comp.doc,
|
||||
description=candidates_description(comp),
|
||||
symbol=candidate_symbol(comp),
|
||||
))
|
||||
return reply
|
||||
|
||||
|
||||
def get_in_function_call(*args):
|
||||
call_def = jedi_script(*args).get_in_function_call()
|
||||
if call_def:
|
||||
return dict(
|
||||
# p.get_code(False) should do the job. But jedi-vim use replace.
|
||||
# So follow what jedi-vim does...
|
||||
params=[p.get_code().replace('\n', '') for p in call_def.params],
|
||||
index=call_def.index,
|
||||
call_name=call_def.call_name,
|
||||
)
|
||||
else:
|
||||
return [] # nil
|
||||
|
||||
|
||||
def _goto(method, *args):
|
||||
"""
|
||||
Helper function for `goto` and `related_names`.
|
||||
|
||||
:arg method: `jedi.Script.goto` or `jedi.Script.related_names`
|
||||
:arg args: Arguments to `jedi_script`
|
||||
|
||||
"""
|
||||
# `definitions` is a list. Each element is an instances of
|
||||
# `jedi.api_classes.BaseOutput` subclass, i.e.,
|
||||
# `jedi.api_classes.RelatedName` or `jedi.api_classes.Definition`.
|
||||
definitions = method(jedi_script(*args))
|
||||
return [dict(
|
||||
column=d.column,
|
||||
line_nr=d.line_nr,
|
||||
module_path=d.module_path if d.module_path != '__builtin__' else [],
|
||||
module_name=d.module_name,
|
||||
description=d.description,
|
||||
) for d in definitions]
|
||||
|
||||
|
||||
def goto(*args):
|
||||
return _goto(jedi.Script.goto, *args)
|
||||
|
||||
|
||||
def related_names(*args):
|
||||
return _goto(jedi.Script.related_names, *args)
|
||||
|
||||
|
||||
def definition_to_dict(d):
|
||||
return dict(
|
||||
doc=d.doc,
|
||||
description=d.description,
|
||||
desc_with_module=d.desc_with_module,
|
||||
line_nr=d.line_nr,
|
||||
column=d.column,
|
||||
module_path=d.module_path,
|
||||
name=getattr(d, 'name', []),
|
||||
full_name=getattr(d, 'full_name', []),
|
||||
type=getattr(d, 'type', []),
|
||||
)
|
||||
|
||||
|
||||
def get_definition(*args):
|
||||
definitions = jedi_script(*args).get_definition()
|
||||
return list(map(definition_to_dict, definitions))
|
||||
|
||||
|
||||
def get_names_recursively(definition):
|
||||
"""
|
||||
Fetch interesting defined names in sub-scopes under `definition`.
|
||||
|
||||
:type names: jedi.api_classes.Definition
|
||||
|
||||
"""
|
||||
d = definition_to_dict(definition)
|
||||
# FIXME: use appropriate method to do this (when Jedi implement some)
|
||||
if definition.description.startswith('class '):
|
||||
ds = definition.defined_names()
|
||||
return [d] + list(map(get_names_recursively, ds))
|
||||
else:
|
||||
return [d]
|
||||
|
||||
|
||||
def defined_names(*args):
|
||||
return list(map(get_names_recursively, jedi.api.defined_names(*args)))
|
||||
|
||||
|
||||
def get_module_version(module):
|
||||
try:
|
||||
from pkg_resources import get_distribution, DistributionNotFound
|
||||
try:
|
||||
return get_distribution(module.__name__).version
|
||||
except DistributionNotFound:
|
||||
pass
|
||||
except ImportError:
|
||||
pass
|
||||
|
||||
notfound = object()
|
||||
for key in ['__version__', 'version']:
|
||||
version = getattr(module, key, notfound)
|
||||
if version is not notfound:
|
||||
return version
|
||||
|
||||
|
||||
def get_jedi_version():
|
||||
import epc
|
||||
import sexpdata
|
||||
return [dict(
|
||||
name=module.__name__,
|
||||
file=getattr(module, '__file__', []),
|
||||
version=get_module_version(module) or [],
|
||||
) for module in [sys, jedi, epc, sexpdata]]
|
||||
|
||||
|
||||
def jedi_epc_server(address='localhost', port=0, port_file=sys.stdout,
|
||||
sys_path=[], virtual_env=[],
|
||||
debugger=None, log=None, log_level=None):
|
||||
add_virtualenv_path()
|
||||
for p in virtual_env:
|
||||
add_virtualenv_path(p)
|
||||
sys_path = map(os.path.expandvars, map(os.path.expanduser, sys_path))
|
||||
sys.path = [''] + list(filter(None, itertools.chain(sys_path, sys.path)))
|
||||
# Workaround Jedi's module cache. Use this workaround until Jedi
|
||||
# got an API to set module paths.
|
||||
# See also: https://github.com/davidhalter/jedi/issues/36
|
||||
import_jedi()
|
||||
import epc.server
|
||||
server = epc.server.EPCServer((address, port))
|
||||
server.register_function(complete)
|
||||
server.register_function(get_in_function_call)
|
||||
server.register_function(goto)
|
||||
server.register_function(related_names)
|
||||
server.register_function(get_definition)
|
||||
server.register_function(defined_names)
|
||||
server.register_function(get_jedi_version)
|
||||
|
||||
port_file.write(str(server.server_address[1])) # needed for Emacs client
|
||||
port_file.write("\n")
|
||||
port_file.flush()
|
||||
if port_file is not sys.stdout:
|
||||
port_file.close()
|
||||
|
||||
if log:
|
||||
server.log_traceback = True
|
||||
handler = logging.FileHandler(filename=log, mode='w')
|
||||
if log_level:
|
||||
log_level = getattr(logging, log_level.upper())
|
||||
handler.setLevel(log_level)
|
||||
server.logger.setLevel(log_level)
|
||||
server.logger.addHandler(handler)
|
||||
if debugger:
|
||||
server.set_debugger(debugger)
|
||||
handler = logging.StreamHandler()
|
||||
handler.setLevel(logging.DEBUG)
|
||||
server.logger.addHandler(handler)
|
||||
server.logger.setLevel(logging.DEBUG)
|
||||
|
||||
server.serve_forever()
|
||||
server.logger.info('exit')
|
||||
return server
|
||||
|
||||
|
||||
def import_jedi():
|
||||
global jedi
|
||||
import jedi
|
||||
import jedi.parsing
|
||||
import jedi.evaluate
|
||||
import jedi.api
|
||||
return jedi
|
||||
|
||||
|
||||
def add_virtualenv_path(venv=os.getenv('VIRTUAL_ENV')):
|
||||
"""Add virtualenv's site-packages to `sys.path`."""
|
||||
if not venv:
|
||||
return
|
||||
venv = os.path.abspath(venv)
|
||||
path = os.path.join(
|
||||
venv, 'lib', 'python%d.%d' % sys.version_info[:2], 'site-packages')
|
||||
sys.path.insert(0, path)
|
||||
site.addsitedir(path)
|
||||
|
||||
|
||||
def main(args=None):
|
||||
import argparse
|
||||
parser = argparse.ArgumentParser(
|
||||
formatter_class=argparse.RawTextHelpFormatter,
|
||||
description=__doc__)
|
||||
parser.add_argument(
|
||||
'--address', default='localhost')
|
||||
parser.add_argument(
|
||||
'--port', default=0, type=int)
|
||||
parser.add_argument(
|
||||
'--port-file', '-f', default='-', type=argparse.FileType('wt'),
|
||||
help='file to write port on. default is stdout.')
|
||||
parser.add_argument(
|
||||
'--sys-path', '-p', default=[], action='append',
|
||||
help='paths to be inserted at the top of `sys.path`.')
|
||||
parser.add_argument(
|
||||
'--virtual-env', '-v', default=[], action='append',
|
||||
help='paths to be used as if VIRTUAL_ENV is set to it.')
|
||||
parser.add_argument(
|
||||
'--log', help='save server log to this file.')
|
||||
parser.add_argument(
|
||||
'--log-level',
|
||||
choices=['CRITICAL', 'ERROR', 'WARN', 'INFO', 'DEBUG'],
|
||||
help='logging level for log file.')
|
||||
parser.add_argument(
|
||||
'--pdb', dest='debugger', const='pdb', action='store_const',
|
||||
help='start pdb when error occurs.')
|
||||
parser.add_argument(
|
||||
'--ipdb', dest='debugger', const='ipdb', action='store_const',
|
||||
help='start ipdb when error occurs.')
|
||||
ns = parser.parse_args(args)
|
||||
jedi_epc_server(**vars(ns))
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
main()
|
||||
|
|
@ -2,4 +2,4 @@
|
|||
# name: log
|
||||
# key: log
|
||||
# --
|
||||
console.${1:log}( $0 );
|
||||
console.${1:log}($0);
|
||||
|
|
|
|||
|
|
@ -0,0 +1,254 @@
|
|||
;;; test-jedi.el --- Tests for jedi.el
|
||||
|
||||
;; Copyright (C) 2012 Takafumi Arakaki
|
||||
|
||||
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
;; test-jedi.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.
|
||||
|
||||
;; test-jedi.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 test-jedi.el.
|
||||
;; If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(require 'ert)
|
||||
|
||||
(require 'mocker)
|
||||
|
||||
(require 'jedi)
|
||||
|
||||
|
||||
(defun jedi-testing:sync (d)
|
||||
(epc:sync (jedi:get-epc) d))
|
||||
|
||||
(ert-deftest jedi:version ()
|
||||
"Check if `jedi:version' can be parsed by `version-to-list'."
|
||||
(version-to-list jedi:version))
|
||||
|
||||
|
||||
;;; EPC
|
||||
|
||||
(ert-deftest jedi:complete-request ()
|
||||
(jedi-testing:sync
|
||||
(with-temp-buffer
|
||||
(erase-buffer)
|
||||
(insert "import json" "\n" "json.l")
|
||||
(jedi:complete-request)))
|
||||
(should (equal (sort (jedi:ac-direct-matches) #'string-lessp)
|
||||
'("load" "loads"))))
|
||||
|
||||
(ert-deftest jedi:get-in-function-call-request ()
|
||||
(destructuring-bind (&key params index call_name)
|
||||
(jedi-testing:sync
|
||||
(with-temp-buffer
|
||||
(erase-buffer)
|
||||
(insert "isinstance(obj,")
|
||||
(jedi:call-deferred 'get_in_function_call)))
|
||||
(should (equal params '("object" "class_or_type_or_tuple")))
|
||||
(should (equal index 1))
|
||||
(should (equal call_name "isinstance"))))
|
||||
|
||||
(ert-deftest jedi:goto-request ()
|
||||
(let ((reply
|
||||
(jedi-testing:sync
|
||||
(with-temp-buffer
|
||||
(erase-buffer)
|
||||
(insert "import json" "\n" "json.load")
|
||||
(jedi:call-deferred 'goto)))))
|
||||
(destructuring-bind (&key line_nr module_path
|
||||
column module_name description)
|
||||
(car reply)
|
||||
(should (integerp line_nr))
|
||||
(should (stringp module_path)))))
|
||||
|
||||
(ert-deftest jedi:get-definition-request ()
|
||||
(let ((reply
|
||||
(jedi-testing:sync
|
||||
(with-temp-buffer
|
||||
(erase-buffer)
|
||||
(insert "import json" "\n" "json.load")
|
||||
(jedi:call-deferred 'get_definition)))))
|
||||
(destructuring-bind (&key doc desc_with_module line_nr column module_path
|
||||
full_name name type description)
|
||||
(car reply)
|
||||
(should (stringp doc))
|
||||
(should (stringp desc_with_module))
|
||||
(should (integerp line_nr))
|
||||
(should (integerp column))
|
||||
(should (stringp module_path)))))
|
||||
|
||||
|
||||
;;; Server pool
|
||||
|
||||
(defmacro jedi-testing:with-mocked-server (start-epc-records
|
||||
epc--live-p-records
|
||||
buffers
|
||||
&rest body)
|
||||
(declare (indent 3))
|
||||
`(let ((jedi:server-pool--table (make-hash-table :test 'equal))
|
||||
(jedi:server-pool--gc-timer nil)
|
||||
,@(mapcar
|
||||
(lambda (b) `(,b (generate-new-buffer "*jedi test*")))
|
||||
buffers))
|
||||
(mocker-let
|
||||
((jedi:epc--start-epc (x y) ,start-epc-records)
|
||||
(jedi:epc--live-p (x) ,epc--live-p-records)
|
||||
;; Probably this mocking is too "strong". What I need to
|
||||
;; mock is only `buffer-list' in `jedi:-get-servers-in-use'.
|
||||
(buffer-list
|
||||
()
|
||||
((:input nil
|
||||
:output-generator
|
||||
(lambda ()
|
||||
(loop for b in (list ,@buffers)
|
||||
when (buffer-live-p b) collect b))
|
||||
:min-occur 0)))
|
||||
(jedi:server-pool--gc-when-idle
|
||||
()
|
||||
((:record-cls 'mocker-stub-record))))
|
||||
(macrolet ((check-restart (&rest args)
|
||||
`(jedi-testing:check-start-server ,@args))
|
||||
(set-server
|
||||
(command &optional args)
|
||||
`(progn
|
||||
(set (make-local-variable 'jedi:server-command) ,command)
|
||||
(set (make-local-variable 'jedi:server-args) ,args))))
|
||||
(unwind-protect
|
||||
(progn ,@body)
|
||||
(mapc #'kill-buffer (list ,@buffers)))))))
|
||||
|
||||
(defun jedi-testing:check-start-server (buffer command server)
|
||||
(with-current-buffer buffer
|
||||
(should-not jedi:epc)
|
||||
(should (eq (let ((jedi:server-command command)
|
||||
(jedi:server-args nil))
|
||||
(jedi:start-server))
|
||||
server))
|
||||
(should (eq jedi:epc server))))
|
||||
|
||||
(ert-deftest jedi:pool-single-server ()
|
||||
"Successive call of `jedi:start-server' with the same setup should
|
||||
return the same server instance."
|
||||
(jedi-testing:with-mocked-server
|
||||
;; Mock `epc:start-epc':
|
||||
((:input '("python" ("jediepcserver.py")) :output 'dummy-server))
|
||||
;; Mock `jedi:epc--live-p':
|
||||
((:input '(nil) :output nil) ; via `jedi:start-server'
|
||||
(:input '(dummy-server) :output t)) ; via `jedi:server-pool--start'
|
||||
;; Buffers to use:
|
||||
(buf1 buf2)
|
||||
(check-restart buf1 '("python" "jediepcserver.py") 'dummy-server)
|
||||
(check-restart buf2 '("python" "jediepcserver.py") 'dummy-server)))
|
||||
|
||||
(ert-deftest jedi:pool-per-buffer-server ()
|
||||
"Successive call of `jedi:start-server' with different setups should
|
||||
return the different server instances."
|
||||
(jedi-testing:with-mocked-server
|
||||
;; Mock `epc:start-epc':
|
||||
((:input '("python" ("jediepcserver.py")) :output 'dummy-server-1)
|
||||
(:input '("python3" ("jediepcserver.py")) :output 'dummy-server-2))
|
||||
;; Mock `jedi:epc--live-p':
|
||||
((:input '(nil) :output nil)) ; via `jedi:start-server'
|
||||
;; Buffers to use:
|
||||
(buf1 buf2)
|
||||
(check-restart buf1 '("python" "jediepcserver.py") 'dummy-server-1)
|
||||
(check-restart buf2 '("python3" "jediepcserver.py") 'dummy-server-2)))
|
||||
|
||||
(ert-deftest jedi:pool-restart-per-buffer-server ()
|
||||
"When one of the server died, only the died server must be
|
||||
rebooted; not still living ones."
|
||||
(jedi-testing:with-mocked-server
|
||||
;; Mock `epc:start-epc':
|
||||
((:input '("python" ("jediepcserver.py")) :output 'dummy-server-1)
|
||||
(:input '("python3" ("jediepcserver.py")) :output 'dummy-server-2)
|
||||
(:input '("python" ("jediepcserver.py")) :output 'dummy-server-3))
|
||||
;; Mock `jedi:epc--live-p':
|
||||
((:input '(nil) :output nil) ; via `jedi:start-server'
|
||||
(:input '(dummy-server-1) :output t)
|
||||
(:input '(nil) :output nil) ; via `jedi:start-server'
|
||||
(:input '(dummy-server-1) :output nil) ; server is stopped
|
||||
(:input '(nil) :output nil) ; via `jedi:start-server'
|
||||
(:input '(dummy-server-2) :output t)
|
||||
(:input '(nil) :output nil) ; via `jedi:start-server'
|
||||
(:input '(dummy-server-3) :output t))
|
||||
;; Buffers to use:
|
||||
(buf1 buf2 buf3)
|
||||
(check-restart buf1 '("python" "jediepcserver.py") 'dummy-server-1)
|
||||
(check-restart buf2 '("python3" "jediepcserver.py") 'dummy-server-2)
|
||||
(check-restart buf3 '("python" "jediepcserver.py") 'dummy-server-1)
|
||||
(mapc (lambda (b) (with-current-buffer b (setq jedi:epc nil)))
|
||||
(list buf1 buf2 buf3))
|
||||
;; Now, ``(jedi:epc--live-p dummy-server-1)`` will return nil:
|
||||
(check-restart buf1 '("python" "jediepcserver.py") 'dummy-server-3)
|
||||
(check-restart buf2 '("python3" "jediepcserver.py") 'dummy-server-2)
|
||||
(check-restart buf3 '("python" "jediepcserver.py") 'dummy-server-3)))
|
||||
|
||||
(ert-deftest jedi:pool-buffer-local-server-setting ()
|
||||
"Locally set `jedi:server-command' and `jedi:server-args' must be used."
|
||||
(jedi-testing:with-mocked-server
|
||||
;; Mock `epc:start-epc':
|
||||
((:input '("server" ("-abc")) :output 'dummy-1)
|
||||
(:input '("server" ("-xyz")) :output 'dummy-2))
|
||||
;; Mock `jedi:epc--live-p':
|
||||
((:input '(nil) :output nil) ; via `jedi:start-server'
|
||||
(:input '(dummy-1) :output t)) ; via `jedi:server-pool--start'
|
||||
;; Buffers to use:
|
||||
(buf1 buf2 buf3)
|
||||
;; Set buffer local `jedi:server-command':
|
||||
(with-current-buffer buf1 (set-server '("server" "-abc")))
|
||||
(with-current-buffer buf2 (set-server '("server" "-xyz")))
|
||||
(with-current-buffer buf3 (set-server '("server" "-abc")))
|
||||
;; Check that the buffer local `jedi:server-command' is used:
|
||||
(should (eq (with-current-buffer buf1 (jedi:start-server)) 'dummy-1))
|
||||
(should (eq (with-current-buffer buf2 (jedi:start-server)) 'dummy-2))
|
||||
(should (eq (with-current-buffer buf3 (jedi:start-server)) 'dummy-1))))
|
||||
|
||||
(ert-deftest jedi:pool-gc-when-no-jedi-buffers ()
|
||||
"GC should stop servers when there is no Jedi buffers."
|
||||
(jedi-testing:with-mocked-server
|
||||
;; Mock `epc:start-epc':
|
||||
((:input '("server" ("-abc")) :output 'dummy-1)
|
||||
(:input '("server" ("-xyz")) :output 'dummy-2))
|
||||
;; Mock `jedi:epc--live-p':
|
||||
((:input '(nil) :output nil)) ; via `jedi:start-server'
|
||||
;; Buffers to use:
|
||||
(buf1 buf2)
|
||||
;; Check that in this mocked environment there is no server yet:
|
||||
(should (= (length (jedi:-get-servers-in-use)) 0))
|
||||
;; Start servers:
|
||||
(check-restart buf1 '("server" "-abc") 'dummy-1)
|
||||
(check-restart buf2 '("server" "-xyz") 'dummy-2)
|
||||
;; GC should not stop servers in use:
|
||||
(jedi:server-pool--gc)
|
||||
(should (= (length (jedi:-get-servers-in-use)) 2))
|
||||
;; GC should stop unused servers:
|
||||
(mapc #'kill-buffer (list buf1 buf2))
|
||||
(mocker-let ((epc:stop-epc (x) ((:input '(dummy-1))
|
||||
(:input '(dummy-2)))))
|
||||
(jedi:server-pool--gc))
|
||||
(should (= (length (jedi:-get-servers-in-use)) 0))))
|
||||
|
||||
(provide 'test-jedi)
|
||||
|
||||
;; Local Variables:
|
||||
;; coding: utf-8
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;;; test-jedi.el ends here
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
import os
|
||||
from contextlib import contextmanager
|
||||
|
||||
from jediepcserver import add_virtualenv_path
|
||||
|
||||
|
||||
@contextmanager
|
||||
def osenv(*args, **kwds):
|
||||
def putenvs(dct):
|
||||
for (k, v) in dct.items():
|
||||
if v is None:
|
||||
del os.environ[k]
|
||||
else:
|
||||
os.environ[k] = v
|
||||
newenv = dict(*args, **kwds)
|
||||
oldenv = dict(zip(newenv, map(os.getenv, newenv)))
|
||||
try:
|
||||
putenvs(newenv)
|
||||
yield
|
||||
finally:
|
||||
putenvs(oldenv)
|
||||
|
||||
|
||||
def test_add_virtualenv_path_runs_fine_in_non_virtualenv():
|
||||
# See: https://github.com/tkf/emacs-jedi/issues/3
|
||||
with osenv(VIRTUAL_ENV=None):
|
||||
add_virtualenv_path()
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(require 'auto-complete)
|
||||
(setq jedi:setup-keys t)
|
||||
(require 'jedi)
|
||||
(global-auto-complete-mode +1)
|
||||
(add-hook 'python-mode-hook 'jedi:setup)
|
||||
(setq jedi:complete-on-dot t)
|
||||
Loading…
Reference in New Issue