From 6b13795fa66a1796d9ef2b422f00a680b14ca186 Mon Sep 17 00:00:00 2001 From: brettlangdon Date: Mon, 20 Oct 2014 10:11:16 -0400 Subject: [PATCH] add jedi --- .../concurrent-autoloads.el | 15 + .../concurrent-pkg.el | 1 + .../concurrent-20140609.1940/concurrent.el | 509 +++++ .../ctable-20140304.1659/ctable-autoloads.el | 15 + .../elpa/ctable-20140304.1659/ctable-pkg.el | 1 + emacs.d/elpa/ctable-20140304.1659/ctable.el | 1908 +++++++++++++++++ .../deferred-autoloads.el | 15 + .../deferred-20140816.2205/deferred-pkg.el | 1 + .../elpa/deferred-20140816.2205/deferred.el | 963 +++++++++ .../elpa/elpy-20140810.7/elpy/__init__.pyc | Bin 0 -> 779 bytes emacs.d/elpa/elpy-20140810.7/elpy/compat.pyc | Bin 0 -> 1086 bytes .../elpa/elpy-20140810.7/elpy/jedibackend.pyc | Bin 0 -> 8213 bytes .../elpa/elpy-20140810.7/elpy/pydocutils.pyc | Bin 0 -> 3331 bytes .../elpa/elpy-20140810.7/elpy/ropebackend.pyc | Bin 0 -> 9996 bytes emacs.d/elpa/elpy-20140810.7/elpy/rpc.pyc | Bin 0 -> 5475 bytes emacs.d/elpa/elpy-20140810.7/elpy/server.pyc | Bin 0 -> 8005 bytes .../elpa/epc-20140609.2234/epc-autoloads.el | 16 + emacs.d/elpa/epc-20140609.2234/epc-pkg.el | 8 + emacs.d/elpa/epc-20140609.2234/epc.el | 965 +++++++++ emacs.d/elpa/epc-20140609.2234/epcs.el | 160 ++ emacs.d/elpa/jedi-20140321.1323/Makefile | 201 ++ .../elpa/jedi-20140321.1323/jedi-autoloads.el | 125 ++ emacs.d/elpa/jedi-20140321.1323/jedi-pkg.el | 7 + emacs.d/elpa/jedi-20140321.1323/jedi.el | 1352 ++++++++++++ .../elpa/jedi-20140321.1323/jediepcserver.py | 314 +++ emacs.d/elpa/jedi-20140321.1323/setup.py | 25 + .../python-environment-autoloads.el | 16 + .../python-environment-pkg.el | 7 + .../python-environment.el | 246 +++ .../test-python-environment.el | 209 ++ 30 files changed, 7079 insertions(+) create mode 100644 emacs.d/elpa/concurrent-20140609.1940/concurrent-autoloads.el create mode 100644 emacs.d/elpa/concurrent-20140609.1940/concurrent-pkg.el create mode 100644 emacs.d/elpa/concurrent-20140609.1940/concurrent.el create mode 100644 emacs.d/elpa/ctable-20140304.1659/ctable-autoloads.el create mode 100644 emacs.d/elpa/ctable-20140304.1659/ctable-pkg.el create mode 100644 emacs.d/elpa/ctable-20140304.1659/ctable.el create mode 100644 emacs.d/elpa/deferred-20140816.2205/deferred-autoloads.el create mode 100644 emacs.d/elpa/deferred-20140816.2205/deferred-pkg.el create mode 100644 emacs.d/elpa/deferred-20140816.2205/deferred.el create mode 100644 emacs.d/elpa/elpy-20140810.7/elpy/__init__.pyc create mode 100644 emacs.d/elpa/elpy-20140810.7/elpy/compat.pyc create mode 100644 emacs.d/elpa/elpy-20140810.7/elpy/jedibackend.pyc create mode 100644 emacs.d/elpa/elpy-20140810.7/elpy/pydocutils.pyc create mode 100644 emacs.d/elpa/elpy-20140810.7/elpy/ropebackend.pyc create mode 100644 emacs.d/elpa/elpy-20140810.7/elpy/rpc.pyc create mode 100644 emacs.d/elpa/elpy-20140810.7/elpy/server.pyc create mode 100644 emacs.d/elpa/epc-20140609.2234/epc-autoloads.el create mode 100644 emacs.d/elpa/epc-20140609.2234/epc-pkg.el create mode 100644 emacs.d/elpa/epc-20140609.2234/epc.el create mode 100644 emacs.d/elpa/epc-20140609.2234/epcs.el create mode 100644 emacs.d/elpa/jedi-20140321.1323/Makefile create mode 100644 emacs.d/elpa/jedi-20140321.1323/jedi-autoloads.el create mode 100644 emacs.d/elpa/jedi-20140321.1323/jedi-pkg.el create mode 100644 emacs.d/elpa/jedi-20140321.1323/jedi.el create mode 100755 emacs.d/elpa/jedi-20140321.1323/jediepcserver.py create mode 100644 emacs.d/elpa/jedi-20140321.1323/setup.py create mode 100644 emacs.d/elpa/python-environment-20140321.1116/python-environment-autoloads.el create mode 100644 emacs.d/elpa/python-environment-20140321.1116/python-environment-pkg.el create mode 100644 emacs.d/elpa/python-environment-20140321.1116/python-environment.el create mode 100644 emacs.d/elpa/python-environment-20140321.1116/test-python-environment.el diff --git a/emacs.d/elpa/concurrent-20140609.1940/concurrent-autoloads.el b/emacs.d/elpa/concurrent-20140609.1940/concurrent-autoloads.el new file mode 100644 index 0000000..946bcfc --- /dev/null +++ b/emacs.d/elpa/concurrent-20140609.1940/concurrent-autoloads.el @@ -0,0 +1,15 @@ +;;; concurrent-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil nil ("concurrent.el") (21571 44956 836134 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; concurrent-autoloads.el ends here diff --git a/emacs.d/elpa/concurrent-20140609.1940/concurrent-pkg.el b/emacs.d/elpa/concurrent-20140609.1940/concurrent-pkg.el new file mode 100644 index 0000000..951091f --- /dev/null +++ b/emacs.d/elpa/concurrent-20140609.1940/concurrent-pkg.el @@ -0,0 +1 @@ +(define-package "concurrent" "20140609.1940" "Concurrent utility functions for emacs lisp" '((deferred "0.3.1")) :url "https://github.com/kiwanami/emacs-deferred/blob/master/README-concurrent.markdown" :keywords '("deferred" "async" "concurrent")) diff --git a/emacs.d/elpa/concurrent-20140609.1940/concurrent.el b/emacs.d/elpa/concurrent-20140609.1940/concurrent.el new file mode 100644 index 0000000..7f827a4 --- /dev/null +++ b/emacs.d/elpa/concurrent-20140609.1940/concurrent.el @@ -0,0 +1,509 @@ +;;; concurrent.el --- Concurrent utility functions for emacs lisp + +;; Copyright (C) 2010, 2011, 2012 SAKURAI Masashi + +;; Author: SAKURAI Masashi +;; Version: 20140609.1940 +;; X-Original-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 . + +;;; 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 + +(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 (chain 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 chain 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))) + +(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-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)))))))) + +(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) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions) +;; End: + +;;; concurrent.el ends here + diff --git a/emacs.d/elpa/ctable-20140304.1659/ctable-autoloads.el b/emacs.d/elpa/ctable-20140304.1659/ctable-autoloads.el new file mode 100644 index 0000000..25a6761 --- /dev/null +++ b/emacs.d/elpa/ctable-20140304.1659/ctable-autoloads.el @@ -0,0 +1,15 @@ +;;; ctable-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil nil ("ctable.el") (21571 44956 93448 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; ctable-autoloads.el ends here diff --git a/emacs.d/elpa/ctable-20140304.1659/ctable-pkg.el b/emacs.d/elpa/ctable-20140304.1659/ctable-pkg.el new file mode 100644 index 0000000..63a2e27 --- /dev/null +++ b/emacs.d/elpa/ctable-20140304.1659/ctable-pkg.el @@ -0,0 +1 @@ +(define-package "ctable" "20140304.1659" "Table component for Emacs Lisp" 'nil :url "https://github.com/kiwanami/emacs-ctable" :keywords '("table")) diff --git a/emacs.d/elpa/ctable-20140304.1659/ctable.el b/emacs.d/elpa/ctable-20140304.1659/ctable.el new file mode 100644 index 0000000..975fe2b --- /dev/null +++ b/emacs.d/elpa/ctable-20140304.1659/ctable.el @@ -0,0 +1,1908 @@ +;;; ctable.el --- Table component for Emacs Lisp + +;; Copyright (C) 2011, 2012, 2013, 2014 SAKURAI Masashi + +;; Author: SAKURAI Masashi +;; URL: https://github.com/kiwanami/emacs-ctable +;; Version: 20140304.1659 +;; X-Original-Version: 0.1.2 +;; Keywords: table + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This program is a table component for Emacs Lisp. +;; Other programs can use this table component for the application UI. + +;;; Installation: + +;; Place this program in your load path and add following code. + +;; (require 'ctable) + +;;; Usage: + +;; Executing the command `ctbl:open-table-buffer', switch to the table buffer. + +;; Table data which are shown in the table view, are collected +;; by the `ctbl:model' objects. See the function `ctbl:demo' for example. +;; See the README document for the details. + +;;; Code: + +(require 'cl) + +(declare-function popup-tip "popup") +(declare-function pos-tip-show "pos-tip") + + +;;; Models and Parameters + +(defstruct ctbl:model + "Table model structure + +data : Table data as a list of rows. A row contains a list of columns. + If an instance of `ctbl:async-model' is given, the model is built up asynchronously. +column-model : A list of column models. +sort-state : The current sort order as a list of column indexes. + The index number of the first column is 1. + If the index is negative, the sort order is reversed." + data column-model sort-state) + + +(defstruct ctbl:async-model + "Asynchronous data model + +request : Data request function which receives 4 arguments (begin-num length fn(row-list) fe(errmsg)). + This function should return the next data which begins with `begin-num' and has the length + as `length', evaluating the continuation function `fn' with the data. + If the function `fn' is given `nil', it means no more data. + If the error function `fe' is evaluated with `errmsg', the message is displayed for the user. +init-num : Initial row number. (Default 20) +more-num : Increase row number. (Default 20) +reset : Reset function which is called when user executes update command. (Can be nil) +cancel : Cancel function of data requesting. (Can be nil) + +For forward compatibility, these callback functions should have a `&rest' keyword at the end of argument list. +" + request (init-num 20) (more-num 20) reset cancel) + + +(defstruct ctbl:cmodel + "Table column model structure + +title : title string. +sorter : sorting function which transforms a cell value into sort value. + It should return -1, 0 and 1. If nil, `ctbl:sort-string-lessp' is used. +align : text alignment: 'left, 'right and 'center. (default: right) +max-width : maximum width of the column. if nil, no constraint. (default: nil) +min-width : minimum width of the column. if nil, no constraint. (default: nil) +click-hooks : a list of functions for header clicking with two arguments + the `ctbl:component' object and the `ctbl:cmodel' one. + (default: '(`ctbl:cmodel-sort-action'))" + title sorter align max-width min-width + (click-hooks '(ctbl:cmodel-sort-action))) + + +(defstruct ctbl:param + "Rendering parameters + +display-header : if t, display the header row with column models. +fixed-header : if t, display the header row in the header-line area. +bg-colors : '(((row-id . col-id) . colorstr) (t . default-color) ... ) or (lambda (model row-id col-id) colorstr or nil) +vline-colors : \"#RRGGBB\" or '((0 . colorstr) (t . default-color)) or (lambda (model col-index) colorstr or nil) +hline-colors : \"#RRGGBB\" or '((0 . colorstr) (t . default-color)) or (lambda (model row-index) colorstr or nil) +draw-vlines : 'all or '(0 1 2 .. -1) or (lambda (model col-index) t or nil ) +draw-hlines : 'all or '(0 1 2 .. -1) or (lambda (model row-index) t or nil ) +vertical-line horizontal-line : | - +left-top-corner right-top-corner left-bottom-corner right-bottom-corner : + +top-junction bottom-junction left-junction right-junction cross-junction : +" + display-header fixed-header + bg-colors vline-colors hline-colors draw-vlines draw-hlines vertical-line horizontal-line + left-top-corner right-top-corner left-bottom-corner right-bottom-corner + top-junction bottom-junction left-junction right-junction cross-junction) + +(defvar ctbl:completing-read 'completing-read + "Customize for completing-read function. + +To use `ido-completing-read', put the following sexp into your +Emacs init file: + +(eval-after-load 'ido + '(progn + (setq ctbl:completing-read 'ido-completing-read)))") + + +(defvar ctbl:default-rendering-param + (make-ctbl:param + :display-header t + :fixed-header nil + :bg-colors nil + :vline-colors "DarkGray" + :hline-colors "DarkGray" + :draw-vlines 'all + :draw-hlines '(1) + :vertical-line ?| + :horizontal-line ?- + :left-top-corner ?+ + :right-top-corner ?+ + :left-bottom-corner ?+ + :right-bottom-corner ?+ + :top-junction ?+ + :bottom-junction ?+ + :left-junction ?+ + :right-junction ?+ + :cross-junction ?+ + ) + "Default rendering parameters.") + +(defvar ctbl:tooltip-method '(pos-tip popup minibuffer) + "Preferred tooltip methods in order.") + +(defvar ctbl:component) +(defvar ctbl:header-text) + +;;; Faces + +(defface ctbl:face-row-select + '((((class color) (background light)) + :background "WhiteSmoke") + (((class color) (background dark)) + :background "Blue4")) + "Face for row selection" :group 'ctable) + +(defface ctbl:face-cell-select + '((((class color) (background light)) + :background "Mistyrose1") + (((class color) (background dark)) + :background "Blue2")) + "Face for cell selection" :group 'ctable) + +(defface ctbl:face-continue-bar + '((((class color) (background light)) + :background "OldLace") + (((class color) (background dark)) + :background "Gray26")) + "Face for continue bar" :group 'ctable) + +;;; Utilities + +(defun ctbl: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 ctbl:cell-id (row-id col-id) + "[internal] Create a cell-id object" + (cons row-id col-id)) + +(defun ctbl:tp (text prop value) + "[internal] Put a text property to the entire text string." + (if (< 0 (length text)) + (put-text-property 0 (length text) prop value text)) + text) + +(defvar ctbl:uid 1) + +(defun ctbl:uid () + "[internal] Generate an unique number." + (incf ctbl:uid)) + +(defun ctbl:fill-keymap-property (begin end keymap) + "[internal] Put the given text property to the region between BEGIN and END. +If the text already has some keymap property, the text is skipped." + (save-excursion + (goto-char begin) + (loop with pos = begin with nxt = nil + until (or (null pos) (<= end pos)) + when (get-text-property pos 'keymap) do + (setq pos (next-single-property-change pos 'keymap)) + else do + (setq nxt (next-single-property-change pos 'keymap)) + (when (null nxt) (setq nxt end)) + (put-text-property pos (min nxt end) 'keymap keymap)))) + +;; Model functions + +(defun ctbl:model-column-length (model) + "[internal] Return the column number." + (length (ctbl:model-column-model model))) + +(defun ctbl:model-row-length (model) + "[internal] Return the row number." + (length (ctbl:model-data model))) + +(defun ctbl:model-modify-sort-key (model col-index) + "Modify the list of sort keys for the column headers." + (let* ((sort-keys (ctbl:model-sort-state model)) + (col-key (1+ col-index))) + (cond + ((eq (car sort-keys) col-key) + (setf (ctbl:model-sort-state model) + (cons (- col-key) (cdr sort-keys)))) + ((eq (car sort-keys) (- col-key)) + (setf (ctbl:model-sort-state model) + (cons col-key (cdr sort-keys)))) + (t + (setf (ctbl:model-sort-state model) + (cons col-key (delete (- col-key) + (delete col-key sort-keys)))))) + (ctbl:model-sort-state model))) + +(defun ctbl:cmodel-sort-action (cp col-index) + "Sorting action for click on the column headers. +If data is an instance of `ctbl:async-model', this function do nothing." + (let* ((model (ctbl:cp-get-model cp))) + (unless (ctbl:async-model-p (ctbl:model-data model)) + (ctbl:model-modify-sort-key model col-index) + (ctbl:cp-update cp)))) + + +;;; ctable framework + +;; Component + +(defstruct ctbl:component + "Component + +This structure defines attributes of the table component. +These attributes are internal use. Other programs should access +through the functions of the component interface. + +dest : an object of `ctbl:dest' +model : an object of the table model +selected : selected cell-id: (row index . col index) +param : rendering parameter object +sorted-data : sorted data to display the table view. + see `ctbl:cp-get-selected-data-row' and `ctbl:cp-get-selected-data-cell'. +update-hooks : a list of hook functions for update event +selection-change-hooks : a list of hook functions for selection change event +click-hooks : a list of hook functions for click event +states : alist of arbitrary data for internal use" + dest model param selected sorted-data + update-hooks selection-change-hooks click-hooks states) + + +;; Rendering Destination + +(defstruct ctbl:dest + "Rendering Destination + +This structure object is the abstraction of the rendering +destinations, such as buffers, regions and so on. + +type : identify symbol for destination type. (buffer, region, text) +buffer : a buffer object of rendering destination. +min-func : a function that returns upper limit of rendering destination. +max-func : a function that returns lower limit of rendering destination. +width : width of the reference size. (number, nil or full) +height : height of the reference size. (number, nil or full) +clear-func : a function that clears the rendering destination. +before-update-func : a function that is called at the beginning of rendering routine. +after-update-func : a function that is called at the end of rendering routine. +select-ol : a list of overlays for selection" + type buffer min-func max-func width height + clear-func before-update-func after-update-func select-ol) + +(eval-when-compile + (defmacro ctbl:dest-with-region (dest &rest body) + (declare (debug (form &rest form))) + (let (($dest (gensym))) + `(let ((,$dest ,dest)) + (with-current-buffer (ctbl:dest-buffer ,$dest) + (save-restriction + (narrow-to-region + (ctbl:dest-point-min ,$dest) (ctbl:dest-point-max ,$dest)) + ,@body)))))) +(put 'ctbl:dest-with-region 'lisp-indent-function 1) + +(defun ctbl:dest-point-min (c) + (funcall (ctbl:dest-min-func c))) + +(defun ctbl:dest-point-max (c) + (funcall (ctbl:dest-max-func c))) + +(defun ctbl:dest-clear (c) + (funcall (ctbl:dest-clear-func c))) + +(defun ctbl:dest-before-update (c) + (when (ctbl:dest-before-update-func c) + (funcall (ctbl:dest-before-update-func c)))) + +(defun ctbl:dest-after-update (c) + (when (ctbl:dest-after-update-func c) + (funcall (ctbl:dest-after-update-func c)))) + + +;; Buffer + +(defconst ctbl:table-buffer-name "*ctbl-table*" "[internal] Default buffer name for the table view.") + +(defun ctbl:dest-init-buffer (&optional buf width height custom-map) + "Create a buffer destination. +This destination uses an entire buffer and set up the major-mode +`ctbl:table-mode' and the key map `ctbl:table-mode-map'. BUF is +a buffer name to render the table view. If BUF is nil, the +default buffer name is used. WIDTH and HEIGHT are reference size +of the table view. If those are nil, the size of table is +calculated from the window that shows BUF or the selected window. +The component object is stored at the buffer local variable +`ctbl:component'. CUSTOM-MAP is the additional keymap that is +added to default keymap `ctbl:table-mode-map'." + (lexical-let + ((buffer (or buf (get-buffer-create (format "*Table: %d*" (ctbl:uid))))) + (window (or (and buf (get-buffer-window buf)) (selected-window))) + dest) + (setq dest + (make-ctbl:dest + :type 'buffer + :min-func 'point-min + :max-func 'point-max + :buffer buffer + :width width + :height height + :clear-func (lambda () + (with-current-buffer buffer + (erase-buffer))))) + (with-current-buffer buffer + (unless (eq major-mode 'ctbl:table-mode) + (ctbl:table-mode custom-map))) + dest)) + +;; Region + +(defun ctbl:dest-init-region (buf mark-begin mark-end &optional width height) + "Create a region destination. The table is drew between +MARK-BEGIN and MARK-END in the buffer BUF. MARK-BEGIN and +MARK-END are separated by more than one character, such as a +space. This destination is employed to be embedded in the some +application buffer. Because this destination does not set up +any modes and key maps for the buffer, the application that uses +the ctable is responsible to manage the buffer and key maps." + (lexical-let + ((mark-begin mark-begin) (mark-end mark-end) + (window (or (get-buffer-window buf) (selected-window)))) + (make-ctbl:dest + :type 'region + :min-func (lambda () (marker-position mark-begin)) + :max-func (lambda () (marker-position mark-end)) + :buffer buf + :width width + :height height + :clear-func + (lambda () + (ctbl:dest-region-clear (marker-position mark-begin) + (marker-position mark-end)))))) + +(defun ctbl:dest-region-clear (begin end) + "[internal] Clear the content text." + (when (< 2 (- end begin)) + (delete-region begin (1- end))) + (goto-char begin)) + +;; Inline text + +(defconst ctbl:dest-background-buffer " *ctbl:dest-background*") + +(defun ctbl:dest-init-inline (width height) + "Create a text destination." + (lexical-let + ((buffer (get-buffer-create ctbl:dest-background-buffer)) + (window (selected-window)) + dest) + (setq dest + (make-ctbl:dest + :type 'text + :min-func 'point-min + :max-func 'point-max + :buffer buffer + :width width + :height height + :clear-func (lambda () + (with-current-buffer buffer + (erase-buffer))))) + dest)) + +;; private functions + +(defun ctbl:dest-ol-selection-clear (dest) + "[internal] Clear the selection overlays on the current table view." + (loop for i in (ctbl:dest-select-ol dest) + do (delete-overlay i)) + (setf (ctbl:dest-select-ol dest) nil)) + +(defun ctbl:dest-ol-selection-set (dest cell-id) + "[internal] Put a selection overlay on CELL-ID. The selection overlay can be + put on some cells, calling this function many times. This + function does not manage the selections, just put the overlay." + (lexical-let (ols (row-id (car cell-id)) (col-id (cdr cell-id))) + (ctbl:dest-with-region dest + (ctbl:find-all-by-row-id + dest row-id + (lambda (tcell-id begin end) + (let ((overlay (make-overlay begin end))) + (overlay-put overlay 'face + (if (= (cdr tcell-id) col-id) + 'ctbl:face-cell-select + 'ctbl:face-row-select)) + (push overlay ols))))) + (setf (ctbl:dest-select-ol dest) ols))) + + +;; Component implementation + +(defun ctbl:cp-new (dest model param) + "[internal] Create a new component object. +DEST is a ctbl:dest object. MODEL is a model object. PARAM is a +rendering parameter object. This function is called by the +initialization functions, `ctbl:create-table-component-buffer', +`ctbl:create-table-component-region' and `ctbl:get-table-text'." + (let ((cp (make-ctbl:component + :selected '(0 . 0) + :dest dest + :model model + :param (or param ctbl:default-rendering-param)))) + (ctbl:cp-update cp) + cp)) + +(defun ctbl:cp-get-component () + "Return the component object on the current cursor position. +Firstly, getting a text property `ctbl:component' on the current +position. If no object is found in the text property, the buffer +local variable `ctbl:component' is tried to get. If no object is +found at the variable, return nil." + (let ((component (get-text-property (point) 'ctbl:component))) + (unless component + (unless (local-variable-p 'ctbl:component (current-buffer)) + (error "Not found ctbl:component attribute...")) + (setq component (buffer-local-value 'ctbl:component (current-buffer)))) + component)) + +;; Component : getters + +(defun ctbl:cp-get-selected (component) + "Return the selected cell-id of the component." + (ctbl:component-selected component)) + +(defun ctbl:cp-get-selected-data-row (component) + "Return the selected row data. If no cell is selected, return nil." + (let* ((rows (ctbl:component-sorted-data component)) + (cell-id (ctbl:component-selected component)) + (row-id (car cell-id)) (col-id (cdr cell-id))) + (if row-id (nth row-id rows) nil))) + +(defun ctbl:cp-get-selected-data-cell (component) + "Return the selected cell data. If no cell is selected, return nil." + (let* ((rows (ctbl:component-sorted-data component)) + (cell-id (ctbl:component-selected component)) + (row-id (car cell-id)) (col-id (cdr cell-id))) + (if row-id + (nth col-id (nth row-id rows)) + nil))) + +(defun ctbl:cp-get-model (component) + "Return the model object." + (ctbl:component-model component)) + +(defun ctbl:cp-set-model (component model) + "Replace the model object and update the destination." + (setf (ctbl:component-model component) model) + (ctbl:cp-update component)) + +(defun ctbl:cp-get-param (component) + "Return a rendering parameter object." + (ctbl:component-param component)) + +(defun ctbl:cp-get-buffer (component) + "Return a buffer object on which the component draws the content." + (ctbl:dest-buffer (ctbl:component-dest component))) + +;; Component : setters + +(defun ctbl:cp-move-cursor (dest cell-id) + "[internal] Just move the cursor onto the CELL-ID. +If CELL-ID is not found, return nil. This function +is called by `ctbl:cp-set-selected-cell'." + (let ((pos (ctbl:find-by-cell-id dest cell-id))) + (cond + (pos + (goto-char pos) + (unless (eql (selected-window) (get-buffer-window (current-buffer))) + (set-window-point (get-buffer-window (current-buffer)) pos)) + t) + (t nil)))) + +(defun ctbl:cp-set-selected-cell (component cell-id) + "Select the cell on the component. If the current view doesn't contain the cell, +this function updates the view to display the cell." + (let ((last (ctbl:component-selected component)) + (dest (ctbl:component-dest component)) + (model (ctbl:component-model component))) + (when (ctbl:cp-move-cursor dest cell-id) + (setf (ctbl:component-selected component) cell-id) + (ctbl:dest-before-update dest) + (ctbl:dest-ol-selection-clear dest) + (ctbl:dest-ol-selection-set dest cell-id) + (ctbl:dest-after-update dest) + (unless (equal last cell-id) + (ctbl:cp-fire-selection-change-hooks component))))) + +;; Hook + +(defun ctbl:cp-add-update-hook (component hook) + "Add the update hook function to the component. +HOOK is a function that has no argument." + (push hook (ctbl:component-update-hooks component))) + +(defun ctbl:cp-add-selection-change-hook (component hook) + "Add the selection change hook function to the component. +HOOK is a function that has no argument." + (push hook (ctbl:component-selection-change-hooks component))) + +(defun ctbl:cp-add-click-hook (component hook) + "Add the click hook function to the component. +HOOK is a function that has no argument." + (push hook (ctbl:component-click-hooks component))) + +;; update + +(defun ctbl:cp-update (component) + "Clear and re-draw the component content." + (let* ((buf (ctbl:cp-get-buffer component)) + (dest (ctbl:component-dest component))) + (with-current-buffer buf + (ctbl:dest-before-update dest) + (ctbl:dest-ol-selection-clear dest) + (let (buffer-read-only) + (ctbl:dest-with-region dest + (ctbl:dest-clear dest) + (cond + ;; asynchronous model + ((ctbl:async-model-p + (ctbl:model-data (ctbl:component-model component))) + (lexical-let ((cp component)) + (ctbl:async-state-on-update cp) + (ctbl:render-async-main + dest + (ctbl:component-model component) + (ctbl:component-param component) + (lambda (rows &optional astate) + (setf (ctbl:component-sorted-data cp) rows) + (when astate + (ctbl:cp-states-set cp 'async-state astate)))))) + ;; synchronous model + (t + (setf (ctbl:component-sorted-data component) + (ctbl:render-main + dest + (ctbl:component-model component) + (ctbl:component-param component))))))) + (ctbl:cp-set-selected-cell + component (ctbl:component-selected component)) + (ctbl:dest-after-update dest) + (ctbl:cp-fire-update-hooks component)))) + +;; Component : privates + +(defun ctbl:cp-states-get (component key) + "[internal] Get a value from COMPONENT with KEY." + (cdr (assq key (ctbl:component-states component)))) + +(defun ctbl:cp-states-set (component key value) + "[internal] Set a value with KEY." + (let ((pair (assq key (ctbl:component-states component)))) + (cond + ((null pair) + (push (cons key value) (ctbl:component-states component))) + (t + (setf (cdr pair) value))))) + +(defun ctbl:cp-fire-click-hooks (component) + "[internal] Call click hook functions of the component with no arguments." + (loop for f in (ctbl:component-click-hooks component) + do (condition-case err + (funcall f) + (error (message "CTable: Click / Hook error %S [%s]" f err))))) + +(defun ctbl:cp-fire-selection-change-hooks (component) + "[internal] Call selection change hook functions of the component with no arguments." + (loop for f in (ctbl:component-selection-change-hooks component) + do (condition-case err + (funcall f) + (error (message "CTable: Selection change / Hook error %S [%s]" f err))))) + +(defun ctbl:cp-fire-update-hooks (component) + "[internal] Call update hook functions of the component with no arguments." + (loop for f in (ctbl:component-update-hooks component) + do (condition-case err + (funcall f) + (error (message "Ctable: Update / Hook error %S [%s]" f err))))) + +(defun ctbl:find-position-fast (dest cell-id) + "[internal] Find the cell-id position using bi-section search." + (let* ((row-id (car cell-id)) + (row-id-lim (max (- row-id 10) 0)) + (min (ctbl:dest-point-min dest)) + (max (ctbl:dest-point-max dest)) + (mid (/ (+ min max) 2))) + (save-excursion + (loop for next = (next-single-property-change mid 'ctbl:cell-id nil max) + for cur-row-id = (and next (car (ctbl:cursor-to-cell next))) + do + (cond + ((>= next max) (return (point))) + ((null cur-row-id) (setq mid next)) + ((= cur-row-id row-id) + (goto-char mid) (beginning-of-line) + (return (point))) + ((and (< row-id-lim cur-row-id) (< cur-row-id row-id)) + (goto-char mid) (beginning-of-line) (forward-line) + (return (point))) + ((< cur-row-id row-id) + (setq min mid) + (setq mid (/ (+ min max) 2))) + ((< row-id cur-row-id) + (setq max mid) + (setq mid (/ (+ min max) 2)))))))) + +(defun ctbl:find-by-cell-id (dest cell-id) + "[internal] Return a point where the text property `ctbl:cell-id' +is equal to cell-id in the current table view. If CELL-ID is not +found in the current view, return nil." + (loop with pos = (ctbl:find-position-fast dest cell-id) + with end = (ctbl:dest-point-max dest) + for next = (next-single-property-change pos 'ctbl:cell-id nil end) + for text-cell = (and next (ctbl:cursor-to-cell next)) + while (and next (< next end)) do + (if (and text-cell (equal cell-id text-cell)) + (return next)) + (setq pos next))) + +(defun ctbl:find-all-by-cell-id (dest cell-id func) + "[internal] Call the function FUNC in each regions where the +text-property `ctbl:cell-id' is equal to CELL-ID. The argument function FUNC +receives two arguments, begin position and end one. This function is +mainly used at functions for putting overlays." + (loop with pos = (ctbl:find-position-fast dest cell-id) + with end = (ctbl:dest-point-max dest) + for next = (next-single-property-change pos 'ctbl:cell-id nil end) + for text-id = (and next (ctbl:cursor-to-cell next)) + while (and next (< next end)) do + (if (and text-id (equal cell-id text-id)) + (let ((cend (next-single-property-change + next 'ctbl:cell-id nil end))) + (return (funcall func next cend)))) + (setq pos next))) + +(defun ctbl:find-all-by-row-id (dest row-id func) + "[internal] Call the function FUNC in each regions where the +row-id of the text-property `ctbl:cell-id' is equal to +ROW-ID. The argument function FUNC receives three arguments, +cell-id, begin position and end one. This function is mainly used +at functions for putting overlays." + (loop with pos = (ctbl:find-position-fast dest (cons row-id nil)) + with end = (ctbl:dest-point-max dest) + for next = (next-single-property-change pos 'ctbl:cell-id nil end) + for text-id = (and next (ctbl:cursor-to-cell next)) + while (and next (< next end)) do + (when text-id + (cond + ((equal row-id (car text-id)) + (let ((cend (next-single-property-change + next 'ctbl:cell-id nil end))) + (funcall func text-id next cend))) + ((< row-id (car text-id)) + (return nil)))) + (setq pos next))) + +(defun ctbl:find-first-cell (dest) + "[internal] Return the first cell in the current buffer." + (let ((pos (next-single-property-change + (ctbl:dest-point-min dest) 'ctbl:cell-id))) + (and pos (ctbl:cursor-to-cell pos)))) + +(defun ctbl:find-last-cell (dest) + "[internal] Return the last cell in the current buffer." + (let ((pos (previous-single-property-change + (ctbl:dest-point-max dest) 'ctbl:cell-id))) + (and pos (ctbl:cursor-to-cell (1- pos))))) + +(defun ctbl:cursor-to-cell (&optional pos) + "[internal] Return the cell-id at the cursor. If the text does not +have the text-property `ctbl:cell-id', return nil." + (get-text-property (or pos (point)) 'ctbl:cell-id)) + +(defun ctbl:cursor-to-nearest-cell () + "Return the cell-id at the cursor. If the point of cursor does +not have the cell-id, search the cell-id around the cursor +position. If the current buffer is not table view (it may be +bug), this function may return nil." + (or (ctbl:cursor-to-cell) + (let* ((r (lambda () (when (not (eolp)) (forward-char)))) + (l (lambda () (when (not (bolp)) (backward-char)))) + (u (lambda () (when (not (bobp)) (line-move 1)))) + (d (lambda () (when (not (eobp)) (line-move -1)))) + (dest (ctbl:component-dest (ctbl:cp-get-component))) + get) + (setq get (lambda (cmds) + (save-excursion + (if (null cmds) (ctbl:cursor-to-cell) + (ignore-errors + (funcall (car cmds)) (funcall get (cdr cmds))))))) + (or (loop for i in `((,d) (,r) (,u) (,l) + (,d ,r) (,d ,l) (,u ,r) (,u ,l) + (,d ,d) (,r ,r) (,u ,u) (,l ,l)) + for id = (funcall get i) + if id return id) + (cond + ((> (/ (point-max) 2) (point)) + (ctbl:find-first-cell dest)) + (t (ctbl:find-last-cell dest))))))) + + +;; Commands + +(defun ctbl:navi-move-gen (drow dcol) + "[internal] Move to the cell with the abstract position." + (let* ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell)) + (row-id (car cell-id)) (col-id (cdr cell-id))) + (when (and cp cell-id) + (ctbl:navi-goto-cell (ctbl:cell-id (+ drow row-id) + (+ dcol col-id)))))) + +(defun ctbl:navi-move-up (&optional num) + "Move to the up neighbor cell." + (interactive "p") + (unless num (setq num 1)) + (ctbl:navi-move-gen (- num) 0)) + +(defun ctbl:navi-move-down (&optional num) + "Move to the down neighbor cell." + (interactive "p") + (unless num (setq num 1)) + (ctbl:navi-move-gen num 0)) + +(defun ctbl:navi-move-right (&optional num) + "Move to the right neighbor cell." + (interactive "p") + (unless num (setq num 1)) + (ctbl:navi-move-gen 0 num)) + +(defun ctbl:navi-move-left (&optional num) + "Move to the left neighbor cell." + (interactive "p") + (unless num (setq num 1)) + (ctbl:navi-move-gen 0 (- num))) + +(defun ctbl:navi-move-left-most () + "Move to the left most cell." + (interactive) + (let* ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell)) + (row-id (car cell-id))) + (when (and cp cell-id) + (ctbl:navi-goto-cell (ctbl:cell-id row-id 0))))) + +(defun ctbl:navi-move-right-most () + "Move to the right most cell." + (interactive) + (let* ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell)) + (row-id (car cell-id)) + (model (ctbl:cp-get-model cp)) + (cols (ctbl:model-column-length model))) + (when (and cp cell-id) + (ctbl:navi-goto-cell (ctbl:cell-id row-id (1- cols)))))) + +(defun ctbl:navi-goto-cell (cell-id) + "Move the cursor to CELL-ID and put selection." + (let ((cp (ctbl:cp-get-component))) + (when cp + (ctbl:cp-set-selected-cell cp cell-id)))) + +(defun ctbl:navi-on-click () + "Action handler on the cells." + (interactive) + (let ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell))) + (when (and cp cell-id) + (ctbl:cp-set-selected-cell cp cell-id) + (ctbl:cp-fire-click-hooks cp)))) + +(defun ctbl:navi-jump-to-column () + "Jump to a specified column of the current row." + (interactive) + (let* ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell)) + (row-id (car cell-id)) + (model (ctbl:cp-get-model cp)) + (cols (ctbl:model-column-length model)) + (col-names (mapcar 'ctbl:cmodel-title + (ctbl:model-column-model model))) + (completion-ignore-case t) + (col-name (funcall ctbl:completing-read "Column name: " col-names))) + (when (and cp cell-id) + (ctbl:navi-goto-cell + (ctbl:cell-id + row-id + (position col-name col-names :test 'equal)))))) + +(defun ctbl:action-update-buffer () + "Update action for the latest table model." + (interactive) + (let ((cp (ctbl:cp-get-component))) + (when cp + (ctbl:cp-update cp)))) + +(defun ctbl:action-column-header () + "Action handler on the header columns. (for normal key events)" + (interactive) + (ctbl:fire-column-header-action + (ctbl:cp-get-component) + (get-text-property (point) 'ctbl:col-id))) + +(defun ctbl:fire-column-header-action (cp col-id) + "[internal] Execute action handlers on the header columns." + (when (and cp col-id) + (loop with cmodel = (nth col-id (ctbl:model-column-model (ctbl:cp-get-model cp))) + for f in (ctbl:cmodel-click-hooks cmodel) + do (condition-case err + (funcall f cp col-id) + (error (message "Ctable: Header Click / Hook error %S [%s]" + f err)))))) + +(defun ctbl:render-column-header-keymap (col-id) + "[internal] Generate action handler on the header columns. (for header-line-format)" + (lexical-let ((col-id col-id)) + (let ((keymap (copy-keymap ctbl:column-header-keymap))) + (define-key keymap [header-line mouse-1] + (lambda () + (interactive) + (ctbl:fire-column-header-action (ctbl:cp-get-component) col-id))) + keymap))) + +(defvar ctbl:column-header-keymap + (ctbl:define-keymap + '(([mouse-1] . ctbl:action-column-header) + ("C-m" . ctbl:action-column-header) + ("RET" . ctbl:action-column-header) + )) + "Keymap for the header columns.") + +(defvar ctbl:table-mode-map + (ctbl:define-keymap + '( + ("k" . ctbl:navi-move-up) + ("j" . ctbl:navi-move-down) + ("h" . ctbl:navi-move-left) + ("l" . ctbl:navi-move-right) + + ("p" . ctbl:navi-move-up) + ("n" . ctbl:navi-move-down) + ("b" . ctbl:navi-move-left) + ("f" . ctbl:navi-move-right) + + ("c" . ctbl:navi-jump-to-column) + + ("e" . ctbl:navi-move-right-most) + ("a" . ctbl:navi-move-left-most) + + ("g" . ctbl:action-update-buffer) + + ([mouse-1] . ctbl:navi-on-click) + ("C-m" . ctbl:navi-on-click) + ("RET" . ctbl:navi-on-click) + + )) "Keymap for the table-mode buffer.") + +(defun ctbl:table-mode-map (&optional custom-map) + "[internal] Return a keymap object for the table buffer." + (cond + (custom-map + (set-keymap-parent custom-map ctbl:table-mode-map) + custom-map) + (t ctbl:table-mode-map))) + +(defvar ctbl:table-mode-hook nil + "This hook is called at end of setting up major mode `ctbl:table-mode'.") + +(defun ctbl:table-mode (&optional custom-map) + "Set up major mode `ctbl:table-mode'. + +\\{ctbl:table-mode-map}" + (kill-all-local-variables) + (setq truncate-lines t) + (use-local-map (ctbl:table-mode-map custom-map)) + (setq major-mode 'ctbl:table-mode + mode-name "Table Mode") + (setq buffer-undo-list t + buffer-read-only t) + (add-hook 'post-command-hook 'ctbl:start-tooltip-timer nil t) + (run-hooks 'ctbl:table-mode-hook)) + + +;; Rendering + +(defun ctbl:render-check-cell-width (rows cmodels column-widths) + "[internal] Return a list of rows. This function makes side effects: +cell widths are stored at COLUMN-WIDTHS, longer cell strings are truncated by +maximum width of the column models." + (loop for row in rows collect + (loop for c in row + for cm in cmodels + for cwmax = (ctbl:cmodel-max-width cm) + for i from 0 + for cw = (nth i column-widths) + for val = (format "%s" c) + collect + (progn + (when (and cwmax (< cwmax (string-width val))) + (setq val (truncate-string-to-width val cwmax))) + (when (< cw (string-width val)) + (setf (nth i column-widths) (string-width val))) + val)))) + +(defun ctbl:render-adjust-cell-width (cmodels column-widths total-width) + "[internal] Adjust column widths and return a list of column widths. +If TOTAL-WIDTH is nil, this function just returns COLUMN-WIDTHS. +If TOTAL-WIDTHS is shorter than sum of COLUMN-WIDTHS, this +function expands columns. The residual width is distributed over +the columns. If TOTAL-WIDTHS is longer than sum of +COLUMN-WIDTHS, this function shrinks columns to reduce the +surplus width." + (let ((init-total (loop for i in column-widths sum i))) + (cond + ((or (null total-width) + (= total-width init-total)) column-widths) + ((< total-width init-total) + (ctbl:render-adjust-cell-width-shrink + cmodels column-widths total-width init-total)) + (t + (ctbl:render-adjust-cell-width-expand + cmodels column-widths total-width init-total))))) + +(defun ctbl:render-adjust-cell-width-shrink (cmodels column-widths total-width init-total ) + "[internal] shrink column widths." + (let* ((column-widths (copy-sequence column-widths)) + (column-indexes (loop for i from 0 below (length cmodels) collect i)) + (residual (- init-total total-width))) + (loop for cnum = (length column-indexes) + until (or (= 0 cnum) (= 0 residual)) + do + (loop with ave-shrink = (max 1 (/ residual cnum)) + for idx in column-indexes + for cmodel = (nth idx cmodels) + for cwidth = (nth idx column-widths) + for min-width = (or (ctbl:cmodel-min-width cmodel) 1) + do + (cond + ((<= residual 0) (return)) ; complete + ((<= cwidth min-width) ; reject + (setq column-indexes (delete idx column-indexes))) + (t ; reduce + (let ((next-width (max 1 (- cwidth ave-shrink)))) + (incf residual (- next-width cwidth)) + (setf (nth idx column-widths) next-width)))))) + column-widths)) + +(defun ctbl:render-adjust-cell-width-expand (cmodels column-widths total-width init-total ) + "[internal] expand column widths." + (let* ((column-widths (copy-sequence column-widths)) + (column-indexes (loop for i from 0 below (length cmodels) collect i)) + (residual (- total-width init-total))) + (loop for cnum = (length column-indexes) + until (or (= 0 cnum) (= 0 residual)) + do + (loop with ave-expand = (max 1 (/ residual cnum)) + for idx in column-indexes + for cmodel = (nth idx cmodels) + for cwidth = (nth idx column-widths) + for max-width = (or (ctbl:cmodel-max-width cmodel) total-width) + do + (cond + ((<= residual 0) (return)) ; complete + ((<= max-width cwidth) ; reject + (setq column-indexes (delete idx column-indexes))) + (t ; expand + (let ((next-width (min max-width (+ cwidth ave-expand)))) + (incf residual (- cwidth next-width)) + (setf (nth idx column-widths) next-width)))))) + column-widths)) + +(defun ctbl:render-get-formats (cmodels column-widths) + "[internal] Return a list of the format functions." + (loop for cw in column-widths + for cm in cmodels + for al = (ctbl:cmodel-align cm) + collect + (lexical-let ((cw cw)) + (cond + ((eq al 'left) + (lambda (s) (ctbl:format-left cw s))) + ((eq al 'center) + (lambda (s) (ctbl:format-center cw s))) + (t + (lambda (s) (ctbl:format-right cw s))))))) + +(defun ctbl:render-choose-color (model param index) + "[internal] Choose rendering color." + (cond + ((null param) nil) + ((stringp param) param) + ((functionp param) + (funcall param model index)) + (t (let ((val (or (assq index param) + (assq t param)))) + (if val (cdr val) nil))))) + +(defun ctbl:render-bg-color (str row-id col-id model param) + "[internal] Return nil or the color string at the cell (row-id . cell-id)." + (let ((bgc-param (ctbl:param-bg-colors param))) + (cond + ((null bgc-param) nil) + ((functionp bgc-param) + (funcall bgc-param model row-id col-id str)) + (t + (let ((pair (or (assoc (cons row-id col-id) bgc-param) + (assoc t bgc-param)))) + (if pair (cdr pair) nil)))))) + +(defun ctbl:render-bg-color-put (str row-id col-id model param) + "[internal] Return the string with the background face." + (let ((bgcolor (ctbl:render-bg-color str row-id col-id model param))) + (if bgcolor + (let ((org-face (get-text-property 0 'face str))) + (propertize + (copy-sequence str) + 'face (if org-face + (append org-face (list ':background bgcolor)) + (list ':background bgcolor)))) + str))) + +(defun ctbl:render-line-color (str model param index) + "[internal] Return the propertize string." + (propertize (copy-sequence str) + 'face (list + ':foreground + (ctbl:render-choose-color model param index)))) + +(defun ctbl:render-vline-color (str model param index) + "[internal] Return the propertize string for vertical lines." + (ctbl:render-line-color str model (ctbl:param-vline-colors param) index)) + +(defun ctbl:render-hline-color (str model param index) + "[internal] Return the propertize string for horizontal lines." + (ctbl:render-line-color str model (ctbl:param-hline-colors param) index)) + +(defun ctbl:render-draw-vline-p (model param index) + "[internal] If a vertical line is needed at the column index, return t." + (cond + ((null param) nil) + ((eq 'all param) t) + ((functionp param) (funcall param model index)) + (t (and (consp param) (memq index param))))) + +(defun ctbl:render-draw-hline-p (model param index) + "[internal] If a horizontal line is needed at the row index, return t." + (cond + ((null param) nil) + ((eq 'all param) t) + ((functionp param) (funcall param model index)) + (t (memq index param)))) + +(defun ctbl:render-make-hline (column-widths model param index) + "[internal] " + (let ((vparam (ctbl:param-draw-vlines param)) + (hline (ctbl:param-horizontal-line param)) + left joint right) + (if (not (ctbl:render-draw-hline-p + model (ctbl:param-draw-hlines param) index)) + "" + (cond + ((eq 0 index) + (setq left (char-to-string (ctbl:param-left-top-corner param)) + joint (char-to-string (ctbl:param-top-junction param)) + right (char-to-string (ctbl:param-right-top-corner param)))) + ((eq -1 index) + (setq left (char-to-string (ctbl:param-left-bottom-corner param)) + joint (char-to-string (ctbl:param-bottom-junction param)) + right (char-to-string (ctbl:param-right-bottom-corner param)))) + (t + (setq left (char-to-string (ctbl:param-left-junction param)) + joint (char-to-string (ctbl:param-cross-junction param)) + right (char-to-string (ctbl:param-right-junction param))))) + (ctbl:render-hline-color + (concat + (if (ctbl:render-draw-vline-p model vparam 0) left) + (loop with ret = nil with endi = (length column-widths) + for cw in column-widths + for ci from 1 + for endp = (equal ci endi) + do + (push (make-string cw hline) ret) + (when (and (ctbl:render-draw-vline-p model vparam ci) + (not endp)) + (push joint ret)) + finally return (apply 'concat (reverse ret))) + (if (ctbl:render-draw-vline-p model vparam -1) right) + "\n") + model param index)))) + +(defun ctbl:render-join-columns (columns model param) + "[internal] Join a list of column strings with vertical lines." + (let (ret (V (char-to-string (ctbl:param-vertical-line param)))) + ;; left border line + (setq ret (if (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) 0) + (list (ctbl:render-vline-color V model param 0)) + nil)) + ;; content line + (loop with param-vl = (ctbl:param-draw-vlines param) + with param-vc = (ctbl:param-vline-colors param) + with endi = (length columns) + for i from 1 for endp = (equal i endi) + for cv in columns + for color = (ctbl:render-choose-color model param-vc i) + do + (push cv ret) + (when (and (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) i) + (not endp)) + (push (ctbl:render-vline-color V model param i) ret))) + ;; right border line + (when (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) -1) + (push (ctbl:render-vline-color V model param -1) ret)) + ;; join them + (mapconcat 'identity (reverse ret) ""))) + +(defun ctbl:render-sum-vline-widths (cmodels model param) + "[internal] Return a sum of the widths of vertical lines." + (let ((sum 0)) + ;; left border line + (when (ctbl:render-draw-vline-p model (ctbl:param-draw-vlines param) 0) + (incf sum)) + ;; content line + (loop with param-vl = (ctbl:param-draw-vlines param) + with endi = (length cmodels) + for i from 1 upto (length cmodels) + for endp = (equal i endi) do + (when (and (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) i) + (not endp)) + (incf sum))) + ;; right border line + (when (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) -1) + (incf sum)) + sum)) + +(defun ctbl:dest-width-get (dest) + "[internal] Return the column number to draw the table view. +Return nil, if the width is not given. Then, the renderer draws freely." + (let ((dwidth (ctbl:dest-width dest)) + (dwin (get-buffer-window))) + (cond + ((numberp dwidth) dwidth) + ((eq 'full dwidth) (window-width dwin)) + (t nil)))) + +(defun ctbl:dest-height-get (dest) + "[internal] Return the row number to draw the table view. +Return nil, if the height is not given. Then, the renderer draws freely." + (let ((dheight (ctbl:dest-height dest)) + (dwin (get-buffer-window))) + (cond + ((numberp dheight) dheight) + ((eq 'full dheight) (1- (window-height dwin))) + (t nil)))) + +(defun ctbl:render-main (dest model param) + "[internal] Rendering the table view. +This function assumes that the current buffer is the destination buffer." + (let* ((EOL "\n") drows + (cmodels (ctbl:model-column-model model)) + (rows (ctbl:sort + (copy-sequence (ctbl:model-data model)) cmodels + (ctbl:model-sort-state model))) + (column-widths + (loop for c in cmodels + for title = (ctbl:cmodel-title c) + collect (max (or (ctbl:cmodel-min-width c) 0) + (or (and title (length title)) 0)))) + column-formats) + ;; check cell widths + (setq drows (ctbl:render-check-cell-width rows cmodels column-widths)) + ;; adjust cell widths for ctbl:dest width + (when (ctbl:dest-width-get dest) + (setq column-widths + (ctbl:render-adjust-cell-width + cmodels column-widths + (- (ctbl:dest-width-get dest) + (ctbl:render-sum-vline-widths + cmodels model param))))) + (setq column-formats (ctbl:render-get-formats cmodels column-widths)) + (catch 'ctbl:insert-break + (when (ctbl:param-display-header param) + (ctbl:render-main-header dest model param + cmodels column-widths)) + (ctbl:render-main-content dest model param + cmodels drows column-widths column-formats)) + ;; return the sorted list + rows)) + +(defun ctbl:render-main-header (dest model param cmodels column-widths) + "[internal] Render the table header." + (let ((EOL "\n") + (header-string + (ctbl:render-join-columns + (loop for cm in cmodels + for i from 0 + for cw in column-widths + collect + (propertize + (ctbl:format-center cw (ctbl:cmodel-title cm)) + 'ctbl:col-id i + 'local-map (ctbl:render-column-header-keymap i) + 'mouse-face 'highlight)) + model param))) + (cond + ((and (eq 'buffer (ctbl:dest-type dest)) + (ctbl:param-fixed-header param)) + ;; buffer header-line + (let* ((fcol (/ (car (window-fringes)) + (frame-char-width))) + (header-text (concat (make-string fcol ? ) header-string))) + (setq header-line-format header-text) + ;; save header-text for hscroll updating + (set (make-local-variable 'ctbl:header-text) header-text))) + (t + ;; content area + (insert ; border line + (ctbl:render-make-hline column-widths model param 0)) + (insert header-string EOL) ; header columns + )))) + +(defun ctbl:render-main-content (dest model param cmodels rows + column-widths column-formats + &optional begin-index) + "[internal] Render the table content." + (unless begin-index + (setq begin-index 0)) + (let ((EOL "\n") (row-num (length rows))) + (loop for cols in rows + for row-index from begin-index + do + (insert + (ctbl:render-make-hline + column-widths model param (1+ row-index))) + (insert + (ctbl:render-join-columns + (loop for i in cols + for s = (if (stringp i) i (format "%s" i)) + for fmt in column-formats + for cw in column-widths + for col-index from 0 + for str = (ctbl:render-bg-color-put + (funcall fmt s) row-index col-index + model param) + collect + (propertize str + 'ctbl:cell-id (cons row-index col-index) + 'ctbl:cell-width cw)) + model param) EOL)) + ;; bottom border line + (insert + (ctbl:render-make-hline column-widths model param -1)))) + + +;; async data model + +(defvar ctbl:continue-button-keymap + (ctbl:define-keymap + '(([mouse-1] . ctbl:action-continue-async-clicked) + ("C-m" . ctbl:action-continue-async-clicked) + ("RET" . ctbl:action-continue-async-clicked) + )) + "Keymap for the continue button.") + +;; async data / internal state + +(defstruct ctbl:async-state + "Rendering State [internal] + +status : symbol -> + normal : data still remains. this is the start state. + requested : requested data and waiting for response. + done : no data remains. this is the final state. +actual-width : actual width +column-widths : width of each columns +column-formats : format of each columns +next-index : row index number for next request +panel-begin : begin mark object for status panel +panel-end : end mark object for status panel +" + status actual-width column-widths column-formats + next-index panel-begin panel-end) + +(defun ctbl:async-state-on-update (component) + "[internal] Reset async data model." + (let* ((cp component) + (amodel (ctbl:model-data (ctbl:cp-get-model cp))) + (astate (ctbl:cp-states-get cp 'async-state))) + (when (and astate (ctbl:async-model-reset amodel)) + (funcall (ctbl:async-model-reset amodel))))) + +(defun ctbl:async-state-on-click-panel (component) + "[internal] This function is called when the user clicks the status panel." + (let* ((cp component) + (amodel (ctbl:model-data (ctbl:cp-get-model cp))) + (astate (ctbl:cp-states-get cp 'async-state))) + (when cp + (case (ctbl:async-state-status astate) + ('normal + (ctbl:render-async-continue cp)) + ('requested + (when (ctbl:async-model-cancel amodel) + (funcall (ctbl:async-model-cancel amodel)) + (ctbl:async-state-update-status (ctbl:component-dest cp) 'normal))))))) + +(defun ctbl:async-state-update-status (component next-status) + "[internal] Update internal status of async-state and update the status panel." + (let* ((cp component) + (dest (ctbl:component-dest cp)) + (amodel (ctbl:model-data (ctbl:cp-get-model cp))) + (astate (ctbl:cp-states-get cp 'async-state))) + (with-current-buffer (ctbl:dest-buffer dest) + (setf (ctbl:async-state-status astate) next-status) + (ctbl:async-state-update-status-panel dest astate amodel)))) + +(defun ctbl:async-state-update-status-panel (dest astate amodel) + "[internal] Rendering data model status panel with current state." + (let ((begin (ctbl:async-state-panel-begin astate)) + (end (ctbl:async-state-panel-end astate)) + (width (ctbl:async-state-actual-width astate))) + (save-excursion + (let (buffer-read-only) + (when (< 2 (- end begin)) + (delete-region begin (1- end))) + (goto-char begin) + (insert + (propertize + (case (ctbl:async-state-status astate) + ('done + (ctbl:format-center width "No more data.")) + ('requested + (cond + ((ctbl:async-model-cancel amodel) + (ctbl:format-center width "(Waiting for data. [Click to Cancel])")) + (t + (ctbl:format-center width "(Waiting for data...)")))) + ('normal + (ctbl:format-center width "[Click to retrieve more data.]")) + (t + (ctbl:format-center + width (format "(Error : %s)" (ctbl:async-state-status astate))))) + 'keymap ctbl:continue-button-keymap + 'face 'ctbl:face-continue-bar + 'mouse-face 'highlight) + "\n"))))) + +(defun ctbl:async-state-on-post-command-hook (component) + "[internal] Try auto requesting for asynchronous data." + (let* ((astate (ctbl:cp-states-get component 'async-state)) + (panel-begin-pos (marker-position + (ctbl:async-state-panel-begin astate)))) + (when (and (eq 'normal (ctbl:async-state-status astate)) + (< panel-begin-pos (window-end))) + (ctbl:action-continue-async-clicked)))) + +;; rendering async data + +(defun ctbl:render-async-main (dest model param rows-setter) + "[internal] Rendering the table view for async data model. +This function assumes that the current buffer is the destination buffer." + (lexical-let* + ((dest dest) (model model) (param param) (rows-setter rows-setter) + (amodel (ctbl:model-data model)) (buf (current-buffer)) + (cmodels (ctbl:model-column-model model))) + (funcall + (ctbl:async-model-request amodel) + 0 (ctbl:async-model-init-num amodel) + (lambda (rows) ; >> request succeeded + (with-current-buffer buf + (let (buffer-read-only drows column-formats + (column-widths + (loop for c in cmodels + for title = (ctbl:cmodel-title c) + collect (max (or (ctbl:cmodel-min-width c) 0) + (or (and title (length title)) 0)))) + (EOL "\n")) + ;; check cell widths + (setq drows (ctbl:render-check-cell-width rows cmodels column-widths)) + ;; adjust cell widths for ctbl:dest width + (when (ctbl:dest-width-get dest) + (setq column-widths + (ctbl:render-adjust-cell-width + cmodels column-widths + (- (ctbl:dest-width-get dest) + (ctbl:render-sum-vline-widths + cmodels model param))))) + (setq column-formats (ctbl:render-get-formats cmodels column-widths)) + (ctbl:render-main-header dest model param cmodels column-widths) + (ctbl:render-main-content dest model param cmodels drows column-widths column-formats) + (add-hook 'post-command-hook 'ctbl:post-command-hook-for-auto-request t t) + (let (mark-panel-begin mark-panel-end astate) + (setq mark-panel-begin (point-marker)) + (insert "\n") + (setq mark-panel-end (point-marker)) + (setq astate + (make-ctbl:async-state + :status 'normal + :actual-width (+ (ctbl:render-sum-vline-widths cmodels model param) + (loop for i in column-widths sum i)) + :column-widths column-widths :column-formats column-formats + :next-index (length rows) + :panel-begin mark-panel-begin :panel-end mark-panel-end)) + (ctbl:async-state-update-status-panel dest astate amodel) + (funcall rows-setter rows astate)) + (goto-char (ctbl:dest-point-min dest))))) + (lambda (errsym) ; >> request failed + (message "ctable : error -> %S" errsym))))) + +(defun ctbl:render-async-continue (component) + "[internal] Rendering subsequent data asynchronously." + (lexical-let* + ((cp component) (dest (ctbl:component-dest cp)) (buf (current-buffer)) + (model (ctbl:cp-get-model cp)) + (amodel (ctbl:model-data model)) + (astate (ctbl:cp-states-get cp 'async-state)) + (begin-index (ctbl:async-state-next-index astate))) + ;; status update + (ctbl:async-state-update-status cp 'requested) + (condition-case err + (funcall ; request async data + (ctbl:async-model-request amodel) + begin-index (ctbl:async-model-more-num amodel) + (lambda (rows) ; >> request succeeded + (with-current-buffer buf + (save-excursion + (let (buffer-read-only) + (cond + ((null rows) + ;; no more data + (ctbl:async-state-update-status cp 'done)) + (t + ;; continue data + (goto-char (1- (marker-position (ctbl:async-state-panel-begin astate)))) + (insert "\n") + (ctbl:render-main-content + dest model (ctbl:cp-get-param cp) (ctbl:model-column-model model) + rows (ctbl:async-state-column-widths astate) + (ctbl:async-state-column-formats astate) begin-index) + (backward-delete-char 1) + (ctbl:async-state-update-status cp 'normal) + ;; append row data (side effect!) + (setf (ctbl:component-sorted-data cp) + (append (ctbl:component-sorted-data cp) rows)) + (setf (ctbl:async-state-next-index astate) + (+ (length rows) begin-index)))))))) + (lambda (errsym) ; >> request failed + (ctbl:async-state-update-status cp errsym))) + (error ; >> request synchronously failed + (ctbl:async-state-update-status cp (cadr err)) + (message "ctable : error -> %S" err))))) + +;; async data actions + +(defun ctbl:action-continue-async-clicked () + "Action for clicking the continue button." + (interactive) + (let ((cp (ctbl:cp-get-component))) + (when cp + (ctbl:async-state-on-click-panel cp)))) + +(defun ctbl:post-command-hook-for-auto-request () + "[internal] This hook watches the buffer position of displayed window +to urge async data model to request next data chunk." + (let ((cp (ctbl:cp-get-component))) + (when (and cp (not (window-minibuffer-p))) + (ctbl:async-state-on-post-command-hook cp)))) + +(defun ctbl:async-model-wrapper (rows &optional init-num more-num) + "This function wraps a list of row data in an asynchronous data +model so as to avoid Emacs freezing with a large number of rows." + (lexical-let ((rows rows) (rest-rows rows) + (init-num (or init-num 100)) + (more-num (or more-num 100))) + (make-ctbl:async-model + :request + (lambda (row-num len responsef errorf &rest ignored) + (funcall + responsef + (cond + ((null rest-rows) nil) + (t + (nreverse + (loop with pos = rest-rows + with ret = nil + for i from 0 below len + do + (push (car pos) ret) + (setq pos (cdr pos)) + (unless pos (return ret)) + finally return ret))))) + (when rest-rows + (setq rest-rows (nthcdr len rest-rows)))) + :reset + (lambda (&rest ignored) (setq rest-rows rows)) + :init-num init-num :more-num more-num))) + + +;; tooltip + +(defun ctbl:pop-tooltip (string) + "[internal] Show STRING in tooltip." + (cond + ((and (memq 'pos-tip ctbl:tooltip-method) window-system (featurep 'pos-tip)) + (pos-tip-show (ctbl:string-fill-paragraph string) + 'popup-tip-face nil nil 0)) + ((and (memq 'popup ctbl:tooltip-method) (featurep 'popup)) + (popup-tip string)) + ((memq 'minibuffer ctbl:tooltip-method) + (let ((message-log-max nil)) + (message string))))) + +(defun ctbl:show-cell-in-tooltip (&optional unless-visible) + "Show cell at point in tooltip. +When UNLESS-VISIBLE is non-nil, show tooltip only when data in +cell is truncated." + (interactive) + (let* ((cp (ctbl:cp-get-component)) + (data (when cp (ctbl:cp-get-selected-data-cell cp)))) + (when data + (let ((string (if (stringp data) data (format "%S" data))) + (width (get-text-property (point) 'ctbl:cell-width))) + (when (or (not unless-visible) + (and (integerp width) (>= (length string) width))) + (ctbl:pop-tooltip string)))))) + +(defvar ctbl:tooltip-delay 1) + +(defvar ctbl:tooltip-timer nil) + +(defun ctbl:start-tooltip-timer () + (unless ctbl:tooltip-timer + (setq ctbl:tooltip-timer + (run-with-idle-timer ctbl:tooltip-delay nil + (lambda () + (ctbl:show-cell-in-tooltip t) + (setq ctbl:tooltip-timer nil)))))) + + +;; Rendering utilities + +(defun ctbl:format-truncate (org limit-width &optional ellipsis) + "[internal] Truncate a string ORG with LIMIT-WIDTH, like `truncate-string-to-width'." + (setq org (replace-regexp-in-string "\n" " " org)) + (if (< limit-width (string-width org)) + (let ((str (truncate-string-to-width + (substring org 0) limit-width 0 nil ellipsis))) + (when (< limit-width (string-width str)) + (setq str (truncate-string-to-width (substring org 0) + limit-width))) + (setq str (propertize str 'mouse-face 'highlight)) + (unless (get-text-property 0 'help-echo str) + (setq str (propertize str 'help-echo org))) + str) + org)) + +(defun ctbl:format-right (width string &optional padding) + "[internal] Format STRING, padding on the left with the character PADDING." + (let* ((padding (or padding ?\ )) + (cnt (or (and string + (ctbl:format-truncate string width t)) + "")) + (len (string-width cnt)) + (margin (max 0 (- width len)))) + (concat (make-string margin padding) cnt))) + +(defun ctbl:format-center (width string &optional padding) + "[internal] Format STRING in the center, padding on the both +sides with the character PADDING." + (let* ((padding (or padding ?\ )) + (cnt (or (and string + (ctbl:format-truncate string width t)) + "")) + (len (string-width cnt)) + (margin (max 0 (/ (- width len) 2)))) + (concat + (make-string margin padding) cnt + (make-string (max 0 (- width len margin)) padding)))) + +(defun ctbl:format-left (width string &optional padding) + "[internal] Format STRING, padding on the right with the character PADDING." + (let* ((padding (or padding ?\ )) + (cnt (or (and string + (ctbl:format-truncate string width t)) + "")) + (len (string-width cnt)) + (margin (max 0 (- width len)))) + (concat cnt (make-string margin padding)))) + +(defun ctbl:sort-string-lessp (i j) + "[internal] String comparator." + (cond + ((string= i j) 0) + ((string< i j) -1) + (t 1))) + +(defun ctbl:sort-number-lessp (i j) + "[internal] Number comparator." + (cond + ((= i j) 0) + ((< i j) -1) + (t 1))) + +(defun ctbl:sort (rows cmodels orders) + "[internal] Sort rows according to order indexes and column models." + (let* + ((comparator + (lambda (ref) + (lexical-let + ((ref ref) + (f (or (ctbl:cmodel-sorter (nth ref cmodels)) + 'ctbl:sort-string-lessp))) + (lambda (i j) + (funcall f (nth ref i) (nth ref j)))))) + (negative-comparator + (lambda (ref) + (lexical-let ((cp (funcall comparator ref))) + (lambda (i j) (- (funcall cp i j)))))) + (to-bool + (lambda (f) + (lexical-let ((f f)) + (lambda (i j) + (< (funcall f i j) 0))))) + (chain + (lambda (fs) + (lexical-let ((fs fs)) + (lambda (i j) + (loop for f in fs + for v = (funcall f i j) + unless (eq 0 v) + return v + finally return 0)))))) + (sort rows + (loop with fs = nil + for o in (reverse (copy-sequence orders)) + for gen = (if (< 0 o) comparator negative-comparator) + for f = (funcall gen (1- (abs o))) + do (push f fs) + finally return (funcall to-bool (funcall chain fs)))))) + +(defun ctbl:string-fill-paragraph (string &optional justify) + "[internal] `fill-paragraph' against STRING." + (with-temp-buffer + (erase-buffer) + (insert string) + (goto-char (point-min)) + (fill-paragraph justify) + (buffer-string))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; CTable API + +;; buffer + +(defun* ctbl:open-table-buffer(&key buffer width height custom-map model param) + "Open a table buffer simply. +This function uses the function +`ctbl:create-table-component-buffer' internally." + (let ((cp (ctbl:create-table-component-buffer + :buffer buffer :width width :height height + :custom-map custom-map :model model :param param))) + (switch-to-buffer (ctbl:cp-get-buffer cp)))) + +(defun* ctbl:create-table-component-buffer(&key buffer width height custom-map model param) + "Return a table buffer with some customize parameters. + +This function binds the component object at the +buffer local variable `ctbl:component'. + +The size of table is calculated from the window that shows BUFFER or the selected window. +BUFFER is the buffer to be rendered. If BUFFER is nil, this function creates a new buffer. +CUSTOM-MAP is the additional keymap that is added to default keymap `ctbl:table-mode-map'." + (let* ((dest (ctbl:dest-init-buffer buffer width height custom-map)) + (cp (ctbl:cp-new dest model param))) + (setf (ctbl:dest-after-update-func dest) + (lambda () + (ctbl:dest-buffer-update-header))) + (with-current-buffer (ctbl:dest-buffer dest) + (set (make-local-variable 'ctbl:component) cp)) + cp)) + +(defun ctbl:dest-buffer-update-header () + "[internal] After auto hscrolling, update the horizontal position of the header line." + (run-at-time 0.01 nil 'ctbl:dest-buffer-update-header--deferred)) + +(defun ctbl:dest-buffer-update-header--deferred () + "[internal] Adjust header line position." + (when (boundp 'ctbl:header-text) + (let* ((left (window-hscroll)) + (text (substring ctbl:header-text left))) + (setq header-line-format text)) + (force-window-update (current-buffer)))) + + +(defun ctbl:popup-table-buffer-easy (rows &optional header-row) + "Popup a table buffer from a list of rows." + (pop-to-buffer (ctbl:create-table-buffer-easy rows header-row))) + +(defun ctbl:open-table-buffer-easy (rows &optional header-row) + "Open a table buffer from a list of rows." + (switch-to-buffer (ctbl:create-table-buffer-easy rows header-row))) + +(defun ctbl:create-table-buffer-easy (rows &optional header-row) + "Return a table buffer from a list of rows." + (ctbl:cp-get-buffer + (ctbl:create-table-component-buffer + :model (ctbl:make-model-from-list rows header-row)))) + +(defun ctbl:make-model-from-list (rows &optional header-row) + "Make a `ctbl:model' instance from a list of rows." + (let* ((col-num (or (and header-row (length header-row)) + (and (car rows) (length (car rows))))) + (column-models + (if header-row + (loop for i in header-row + collect (make-ctbl:cmodel :title (format "%s" i) :min-width 5)) + (loop for i from 0 below col-num + for ch = (char-to-string (+ ?A i)) + collect (make-ctbl:cmodel :title ch :min-width 5))))) + (make-ctbl:model + :column-model column-models :data rows))) + +;; region + +(defun* ctbl:create-table-component-region(&key width height keymap model param) + "Insert markers of the rendering destination at current point and display the table view. + +This function returns a component object and stores it at the text property `ctbl:component'. + +WIDTH and HEIGHT are reference size of the table view. If those are nil, the size is calculated from the selected window. +KEYMAP is the keymap that is put to the text property `keymap'. If KEYMAP is nil, `ctbl:table-mode-map' is used." + (let (mark-begin mark-end) + (setq mark-begin (point-marker)) + (insert " ") + (setq mark-end (point-marker)) + (save-excursion + (let* ((dest (ctbl:dest-init-region (current-buffer) mark-begin mark-end width height)) + (cp (ctbl:cp-new dest model param)) + (after-update-func + (lexical-let ((keymap keymap) (cp cp)) + (lambda () + (ctbl:dest-with-region (ctbl:component-dest cp) + (let (buffer-read-only) + (put-text-property (point-min) (1- (point-max)) + 'ctbl:component cp) + (ctbl:fill-keymap-property + (point-min) (1- (point-max)) + (or keymap ctbl:table-mode-map)))))))) + (setf (ctbl:dest-after-update-func dest) after-update-func) + (funcall after-update-func) + cp)))) + + +;; inline + +(defun* ctbl:get-table-text(&key width height model param) + "Return a text that is drew the table view. + +In this case, the rendering destination object is disposable. So, +one can not modify the obtained text with `ctbl:xxx' functions. + +WIDTH and HEIGHT are reference size of the table view." + (let* ((dest (ctbl:dest-init-inline width height)) + (cp (ctbl:cp-new dest model param)) + text) + (setq text + (with-current-buffer (ctbl:cp-get-buffer cp) + (buffer-substring (point-min) (point-max)))) + (kill-buffer (ctbl:cp-get-buffer cp)) + text)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Demo + +(defun ctbl:demo () + "Sample code for implementation for the table model." + (interactive) + (let ((param (copy-ctbl:param ctbl:default-rendering-param))) + ;; rendering parameters + ;;(setf (ctbl:param-display-header param) nil) + (setf (ctbl:param-fixed-header param) t) + (setf (ctbl:param-hline-colors param) + '((0 . "#00000") (1 . "#909090") (-1 . "#ff0000") (t . "#00ff00"))) + (setf (ctbl:param-draw-hlines param) + (lambda (model row-index) + (cond ((memq row-index '(0 1 -1)) t) + (t (= 0 (% (1- row-index) 5)))))) + (setf (ctbl:param-bg-colors param) + (lambda (model row-id col-id str) + (cond ((string-match "CoCo" str) "LightPink") + ((= 0 (% (1- row-id) 2)) "Darkseagreen1") + (t nil)))) + (let ((cp + (ctbl:create-table-component-buffer + :width nil :height nil + :model + (make-ctbl:model + :column-model + (list (make-ctbl:cmodel + :title "A" :sorter 'ctbl:sort-number-lessp + :min-width 5 :align 'right) + (make-ctbl:cmodel + :title "Title" :align 'center + :sorter (lambda (a b) (ctbl:sort-number-lessp (length a) (length b)))) + (make-ctbl:cmodel + :title "Comment" :align 'left)) + :data + '((1 "Bon Tanaka" "8 Year Curry." 'a) + (2 "Bon Tanaka" "Nan-ban Curry." 'b) + (3 "Bon Tanaka" "Half Curry." 'c) + (4 "Bon Tanaka" "Katsu Curry." 'd) + (5 "Bon Tanaka" "Gyu-don." 'e) + (6 "CoCo Ichi" "Beaf Curry." 'f) + (7 "CoCo Ichi" "Poke Curry." 'g) + (8 "CoCo Ichi" "Yasai Curry." 'h) + (9 "Berkley" "Hamburger Curry." 'i) + (10 "Berkley" "Lunch set." 'j) + (11 "Berkley" "Coffee." k)) + :sort-state + '(2 1) + ) + :param param))) + (ctbl:cp-add-click-hook + cp (lambda () (message "CTable : Click Hook [%S]" + (ctbl:cp-get-selected-data-row cp)))) + (ctbl:cp-add-selection-change-hook cp (lambda () (message "CTable : Select Hook"))) + (ctbl:cp-add-update-hook cp (lambda () (message "CTable : Update Hook"))) + (switch-to-buffer (ctbl:cp-get-buffer cp))))) + +;; (progn (eval-current-buffer) (ctbl:demo)) + +(provide 'ctable) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions) +;; indent-tabs-mode: nil +;; End: + +;;; ctable.el ends here diff --git a/emacs.d/elpa/deferred-20140816.2205/deferred-autoloads.el b/emacs.d/elpa/deferred-20140816.2205/deferred-autoloads.el new file mode 100644 index 0000000..83750dd --- /dev/null +++ b/emacs.d/elpa/deferred-20140816.2205/deferred-autoloads.el @@ -0,0 +1,15 @@ +;;; deferred-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil nil ("deferred.el") (21571 44954 910371 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; deferred-autoloads.el ends here diff --git a/emacs.d/elpa/deferred-20140816.2205/deferred-pkg.el b/emacs.d/elpa/deferred-20140816.2205/deferred-pkg.el new file mode 100644 index 0000000..6671ad7 --- /dev/null +++ b/emacs.d/elpa/deferred-20140816.2205/deferred-pkg.el @@ -0,0 +1 @@ +(define-package "deferred" "20140816.2205" "Simple asynchronous functions for emacs lisp" 'nil :url "https://github.com/kiwanami/emacs-deferred" :keywords '("deferred" "async")) diff --git a/emacs.d/elpa/deferred-20140816.2205/deferred.el b/emacs.d/elpa/deferred-20140816.2205/deferred.el new file mode 100644 index 0000000..7e96302 --- /dev/null +++ b/emacs.d/elpa/deferred-20140816.2205/deferred.el @@ -0,0 +1,963 @@ +;;; deferred.el --- Simple asynchronous functions for emacs lisp + +;; Copyright (C) 2010, 2011, 2012 SAKURAI Masashi + +;; Author: SAKURAI Masashi +;; Version: 20140816.2205 +;; X-Original-Version: 0.3.2 +;; 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 . + +;;; Commentary: + +;; 'deferred.el' is a simple library for asynchronous tasks. +;; [https://github.com/kiwanami/emacs-deferred] + +;; The API is almost the same as JSDeferred written by cho45. See the +;; JSDeferred and Mochikit.Async web sites for further documentations. +;; [https://github.com/cho45/jsdeferred] +;; [http://mochikit.com/doc/html/MochiKit/Async.html] + +;; A good introduction document (JavaScript) +;; [http://cho45.stfuawsc.com/jsdeferred/doc/intro.en.html] + +;;; Samples: + +;; ** HTTP Access + +;; (require 'url) +;; (deferred:$ +;; (deferred:url-retrieve "http://www.gnu.org") +;; (deferred:nextc it +;; (lambda (buf) +;; (insert (with-current-buffer buf (buffer-string))) +;; (kill-buffer buf)))) + +;; ** Invoking command tasks + +;; (deferred:$ +;; (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png") +;; (deferred:nextc it +;; (lambda (x) (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg"))) +;; (deferred:nextc it +;; (lambda (x) +;; (insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil))))) + +;; See the readme for further API documentation. + +;; ** Applications + +;; *Inertial scrolling for Emacs +;; [https://github.com/kiwanami/emacs-inertial-scroll] + +;; This program makes simple multi-thread function, using +;; deferred.el. + +(require 'cl) + +(defvar deferred:version nil "deferred.el version") +(setq deferred:version "0.3.2") + +;;; 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))))) + +(defmacro* deferred:try (d &key catch finally) + "Try-catch-finally macro. This macro simulates the +try-catch-finally block asynchronously. CATCH and FINALLY can be +nil. Because of asynchrony, this macro does not ensure that the +task FINALLY should be called." + (let ((chain + (if catch `((deferred:error it ,catch))))) + (when finally + (setq chain (append chain `((deferred:watch it ,finally))))) + `(deferred:$ ,d ,@chain))) + +(defun deferred:setTimeout (f msec) + "[internal] Timer function that emulates the `setTimeout' function in JS." + (run-at-time (/ msec 1000.0) nil f)) + +(defun deferred:cancelTimeout (id) + "[internal] Timer cancellation function that emulates the `cancelTimeout' function in JS." + (cancel-timer id)) + +(defun deferred:run-with-idle-timer (sec f) + "[internal] Wrapper function for run-with-idle-timer." + (run-with-idle-timer sec nil f)) + +(defun deferred:call-lambda (f &optional arg) + "[internal] Call a function with one or zero argument safely. +The lambda function can define with zero and one argument." + (condition-case err + (funcall f arg) + ('wrong-number-of-arguments + (display-warning 'deferred "\ +Callback that takes no argument may be specified. +Passing callback with no argument is deprecated. +Callback must take one argument. +Or, this error is coming from somewhere inside of the callback: %S" err) + (condition-case 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 condition-case) + (indent 2)) + `(let ((debug-on-signal + (or debug-on-signal deferred:debug-on-signal))) + (condition-case ,var + ,protected-form + ,@handlers))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Back end functions of deferred tasks + +(defvar deferred:tick-time 0.001 + "Waiting time between asynchronous tasks (second). +The shorter waiting time increases the load of Emacs. The end +user can tune this 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:worker () + "[internal] Consume a deferred task. +Mainly this function is called by timer asynchronously." + (when deferred:queue + (let* ((pack (car (last deferred:queue))) + (d (car pack)) + (which (cadr pack)) + (arg (cddr pack)) value) + (setq deferred:queue (nbutlast deferred:queue)) + (condition-case err + (setq value (deferred:exec-task d which arg)) + (error + (deferred:message "ERROR : %s" err) + (message "deferred error : %s" err))) + value))) + +(defun deferred:flush-queue! () + "Call all deferred tasks synchronously. For test and debugging." + (let (value) + (while deferred:queue + (setq value (deferred:worker))) + value)) + +(defun deferred:sync! (d) + "Wait for the given deferred task. For test and debugging. +Error is raised if it is not processed within deferred chain D." + (progn + (lexical-let ((last-value 'deferred:undefined*) + uncaught-error) + (deferred:try + (deferred:nextc d + (lambda (x) (setq last-value x))) + :catch + (lambda (err) (setq uncaught-error err))) + (while (and (eq 'deferred:undefined* last-value) + (not uncaught-error)) + (sit-for 0.05) + (sleep-for 0.05)) + (when uncaught-error + (deferred:resignal uncaught-error)) + last-value))) + + + +;; Struct: deferred +;; +;; callback : a callback function (default `deferred:default-callback') +;; errorback : an errorback function (default `deferred:default-errorback') +;; cancel : a canceling function (default `deferred:default-cancel') +;; next : a next chained deferred object (default nil) +;; status : if 'ok or 'ng, this deferred has a result (error) value. (default nil) +;; value : saved value (default nil) +;; +(defstruct deferred + (callback 'deferred:default-callback) + (errorback 'deferred:default-errorback) + (cancel 'deferred:default-cancel) + next status value) + +(defun deferred:default-callback (i) + "[internal] Default callback function." + (identity i)) + +(defun deferred:default-errorback (err) + "[internal] Default errorback function." + (deferred:resignal err)) + +(defun deferred:resignal (err) + "[internal] Safely resignal ERR as an Emacs condition. + +If ERR is a cons (ERROR-SYMBOL . DATA) where ERROR-SYMBOL has an +`error-conditions' property, it is re-signaled unchanged. If ERR +is a string, it is signaled as a generic error using `error'. +Otherwise, ERR is formatted into a string as if by `print' before +raising with `error'." + (cond ((and (listp err) + (symbolp (car err)) + (get (car err) 'error-conditions)) + (signal (car err) (cdr err))) + ((stringp err) + (error "%s" err)) + (t + (error "%S" err)))) + +(defun deferred:default-cancel (d) + "[internal] Default canceling function." + (deferred:message "CANCEL : %s" d) + (setf (deferred-callback d) 'deferred:default-callback) + (setf (deferred-errorback d) 'deferred:default-errorback) + (setf (deferred-next d) nil) + d) + +(defun deferred:exec-task (d which &optional arg) + "[internal] Executing deferred task. If the deferred object has +next deferred task or the return value is a deferred object, this +function adds the task to the execution queue. +D is a deferred object. WHICH is a symbol, `ok' or `ng'. ARG is +an argument value for execution of the deferred task." + (deferred:message "EXEC : %s / %s / %s" d which arg) + (when (null d) (error "deferred:exec-task was given a nil.")) + (let ((callback (if (eq which 'ok) + (deferred-callback d) + (deferred-errorback d))) + (next-deferred (deferred-next d))) + (cond + (callback + (deferred:condition-case err + (let ((value (deferred:call-lambda callback arg))) + (cond + ((deferred-p value) + (deferred:message "WAIT NEST : %s" value) + (if next-deferred + (deferred:set-next value next-deferred) + value)) + (t + (if next-deferred + (deferred:post-task next-deferred 'ok value) + (setf (deferred-status d) 'ok) + (setf (deferred-value d) value) + value)))) + (error + (cond + (next-deferred + (deferred:post-task next-deferred 'ng err)) + (deferred:onerror + (deferred:call-lambda deferred:onerror err)) + (t + (deferred:message "ERROR : %S" err) + (message "deferred error : %S" err) + (setf (deferred-status d) 'ng) + (setf (deferred-value d) err) + err))))) + (t ; <= (null callback) + (cond + (next-deferred + (deferred:exec-task next-deferred which arg)) + ((eq which 'ok) arg) + (t ; (eq which 'ng) + (deferred:resignal arg))))))) + +(defun deferred:set-next (prev next) + "[internal] Connect deferred objects." + (setf (deferred-next prev) next) + (cond + ((eq 'ok (deferred-status prev)) + (setf (deferred-status prev) nil) + (let ((ret (deferred:exec-task + next 'ok (deferred-value prev)))) + (if (deferred-p ret) ret + next))) + ((eq 'ng (deferred-status prev)) + (setf (deferred-status prev) nil) + (let ((ret (deferred:exec-task next 'ng (deferred-value prev)))) + (if (deferred-p ret) ret + next))) + (t + next))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic functions for deferred objects + +(defun deferred:new (&optional callback) + "Create a deferred object." + (if callback + (make-deferred :callback callback) + (make-deferred))) + +(defun deferred:callback (d &optional arg) + "Start deferred chain with a callback message." + (deferred:exec-task d 'ok arg)) + +(defun deferred:errorback (d &optional arg) + "Start deferred chain with an errorback message." + (deferred:exec-task d 'ng arg)) + +(defun deferred:callback-post (d &optional arg) + "Add the deferred object to the execution queue." + (deferred:post-task d 'ok arg)) + +(defun deferred:errorback-post (d &optional arg) + "Add the deferred object to the execution queue." + (deferred:post-task d 'ng arg)) + +(defun deferred:cancel (d) + "Cancel all callbacks and deferred chain in the deferred object." + (deferred:message "CANCEL : %s" d) + (funcall (deferred-cancel d) d) + d) + +(defun deferred:status (d) + "Return a current status of the deferred object. The returned value means following: +`ok': the callback was called and waiting for next deferred. +`ng': the errorback was called and waiting for next deferred. + nil: The neither callback nor errorback was not called." + (deferred-status d)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic utility functions + +(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 'ng arg) + d)) + +(defun deferred:next (&optional callback arg) + "Create a deferred object and schedule executing. This function +is a short cut of following code: + (deferred:callback-post (deferred:new callback))." + (let ((d (if callback + (make-deferred :callback callback) + (make-deferred)))) + (deferred:callback-post d arg) + d)) + +(defun deferred:nextc (d callback) + "Create a deferred object with OK callback and connect it to the given deferred object." + (let ((nd (make-deferred :callback callback))) + (deferred:set-next d nd))) + +(defun deferred:error (d callback) + "Create a deferred object with errorback and connect it to the given deferred object." + (let ((nd (make-deferred :errorback callback))) + (deferred:set-next d nd))) + +(defun deferred:watch (d callback) + "Create a deferred object with watch task and connect it to the given deferred object. +The watch task CALLBACK can not affect deferred chains with +return values. This function is used in following purposes, +simulation of try-finally block in asynchronous tasks, progress +monitoring of tasks." + (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)) + (deferred:resignal e)))) + (let ((nd (make-deferred :callback normal :errorback err))) + (deferred:set-next d nd)))) + +(defun deferred:wait (msec) + "Return a deferred object scheduled at MSEC millisecond later." + (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" ) + (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" ) + (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" ) + (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" ) + (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)) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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) + (env process-environment) + (con-type process-connection-type) + (nd (deferred:new)) proc-buf proc) + (deferred:nextc d + (lambda (x) + (setq proc-buf (get-buffer-create buf-name)) + (condition-case err + (let ((default-directory pwd) + (process-environment env) + (process-connection-type con-type)) + (setq proc + (if (null (car args)) + (apply f proc-name buf-name command nil) + (apply f proc-name buf-name command args))) + (set-process-sentinel + proc + (lambda (proc event) + (cond + ((string-match "exited abnormally" event) + (let ((msg (if (buffer-live-p proc-buf) + (format "Process [%s] exited abnormally : %s" + command + (with-current-buffer proc-buf (buffer-string))) + (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 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 + ;; List of gloabl variables to preserve and restore before url-retrieve call + '(lexical-let ((url-global-variables '(url-request-data + url-request-method + url-request-extra-headers))) + + (defun deferred:url-retrieve (url &optional cbargs silent inhibit-cookies) + "A wrapper function for url-retrieve. The next deferred +object receives the buffer object that URL will load +into. Values of dynamically bound 'url-request-data', 'url-request-method' and +'url-request-extra-headers' are passed to url-retrieve call." + (lexical-let ((nd (deferred:new)) (url url) + (cbargs cbargs) (silent silent) (inhibit-cookies inhibit-cookies) buf + (local-values (mapcar (lambda (symbol) (symbol-value symbol)) url-global-variables))) + (deferred:next + (lambda (x) + (progv url-global-variables local-values + (condition-case err + (setq buf + (url-retrieve + url (lambda (xx) (deferred:post-task nd 'ok buf)) + cbargs silent inhibit-cookies)) + (error (deferred:post-task nd 'ng err))) + nil))) + (setf (deferred-cancel nd) + (lambda (x) + (when (buffer-live-p buf) + (kill-buffer buf)))) + nd)) + + (defun deferred:url-delete-header (buf) + (with-current-buffer buf + (let ((pos (url-http-symbol-value-in-buffer + 'url-http-end-of-headers buf))) + (when pos + (delete-region (point-min) (1+ pos))))) + buf) + + (defun deferred:url-delete-buffer (buf) + (when (and buf (buffer-live-p buf)) + (kill-buffer buf)) + nil) + + (defun deferred:url-get (url &optional params &rest args) + "Perform a HTTP GET method with `url-retrieve'. PARAMS is +a parameter list of (key . value) or key. ARGS will be appended +to deferred:url-retrieve args list. The next deferred +object receives the buffer object that URL will load into." + (when params + (setq url + (concat url "?" (deferred:url-param-serialize params)))) + (let ((d (deferred:$ + (apply 'deferred:url-retrieve url args) + (deferred:nextc it 'deferred:url-delete-header)))) + (deferred:set-next + d (deferred:new 'deferred:url-delete-buffer)) + d)) + + (defun deferred:url-post (url &optional params &rest args) + "Perform a HTTP POST method with `url-retrieve'. PARAMS is +a parameter list of (key . value) or key. ARGS will be appended +to deferred:url-retrieve args list. The next deferred +object receives the buffer object that URL will load into." + (let ((url-request-method "POST") + (url-request-extra-headers + (append url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded")))) + (url-request-data (deferred:url-param-serialize params))) + (let ((d (deferred:$ + (apply 'deferred:url-retrieve url args) + (deferred:nextc it 'deferred:url-delete-header)))) + (deferred:set-next + d (deferred:new 'deferred:url-delete-buffer)) + d))) + + (defun deferred:url-escape (val) + "[internal] Return a new string that is VAL URI-encoded." + (unless (stringp val) + (setq val (format "%s" val))) + (url-hexify-string + (encode-coding-string val 'utf-8))) + + (defun deferred:url-param-serialize (params) + "[internal] Serialize a list of (key . value) cons cells +into a query string." + (when params + (mapconcat + 'identity + (loop for p in params + collect + (cond + ((consp p) + (concat + (deferred:url-escape (car p)) "=" + (deferred:url-escape (cdr p)))) + (t + (deferred:url-escape p)))) + "&"))) + )) + + +(provide 'deferred) +;;; deferred.el ends here diff --git a/emacs.d/elpa/elpy-20140810.7/elpy/__init__.pyc b/emacs.d/elpa/elpy-20140810.7/elpy/__init__.pyc new file mode 100644 index 0000000000000000000000000000000000000000..0184fa72da33a430b60efe2fdae0c9556d2e8f13 GIT binary patch literal 779 zcmY*X!H&}~5KY^qAS1*NaF`2H4{h2a5C|c(T2UdP6!?Cu%iJjWYe!IW9HgB@kNQC5z#-8d^J*=~}R zXW8}aNy_?-{B6y&X`~8tsY6Rwr&v2n8++8=*@kV*h1i((L^_b9#+6J5=kH3QqtLaj z^O1V5qqfyOfI?zU+Zt7^R5!9>(Rz2(B?pRVxyMJgCG|Si+TK?^z>{5c3+0;DaMaGu zMd?(R_{bCz|BPO$;f5q|tUT&!xJrBnJ-s%DLX;qvI--4a${E_9$amHzvgtb{b%sgD zz~(R~qi>jk`zQoadpnFpLyQRsF~}KUxzQ2hs62xmfI{@?05M4c9srHDJRi8Bi=|$o z0+SPuxFo@eVNPE-N^JtU!(+BeTH2?XcTlOVNKA6yD#&~|-L#(0Ci3P)Kt)Lx_|Tce z3EIf@7A4^&_WsTJ3XHB*E&0Gcq<>+ZzsuKg0`Ke9<@ebcocI)`C@}Y;h+^=ul-hZO z&xi1cVl3ldY_wtCoHmu0OQ@2`oEC3Z>$j^9 k>s9`Kh?hm7t&T;JV;Ro?^XYb9pI^fdQ<&*^I+~9D0_3^y2mk;8 literal 0 HcmV?d00001 diff --git a/emacs.d/elpa/elpy-20140810.7/elpy/compat.pyc b/emacs.d/elpa/elpy-20140810.7/elpy/compat.pyc new file mode 100644 index 0000000000000000000000000000000000000000..970dbb6a6d14ca676bbd8beea68ea3c18763c77e GIT binary patch literal 1086 zcmb_a&2AGh5T4yMn-H~X#f1wJb3keibkiRsdO)b60?|uarQtv>tIh6g<91`O*0Z1$ z+~5It3SN*0fU%R7UbxkgKilK+H{)-n^LuOXbNP0f!FqILJ&|b(fgE5a7(gCE8Ne(6 z3g9|~ybm{Bs84}9Fx&7BT`0S-j9?Z)kVo)CUiLsg1M1)Ni0(XkYY!p596oaKz6xBl zyf7LMM@N{MWtFm;t5R``ITcDPRz}-+FqkgL5~ej_V=2dZi@YGL$ugP(-<6dZ4Bik` z|EC!!jYbnzWtx$2sy{Nu%6(tSgkd1SeSu4^mA*PV&z$9Up32^C2z(OipKY5mNx znECa};>`9$VD!;aZAbH(n9EdOY&{_+&_4^e|)eXzw+nNN{P5? z`LU3YwoOfmHk>qCWhSQ`#~%tnaF?P>z^C|JHte(H0KSJ%KXne~Q!&sTwLjAMf;rxd>|+I#G_E2%bI>>ZDXE_EIVD66#P zRA}&^7xFf5>zaz8&i2wiq literal 0 HcmV?d00001 diff --git a/emacs.d/elpa/elpy-20140810.7/elpy/jedibackend.pyc b/emacs.d/elpa/elpy-20140810.7/elpy/jedibackend.pyc new file mode 100644 index 0000000000000000000000000000000000000000..df4ec53e4f59e24fad24e4a08fa52886de5627d0 GIT binary patch literal 8213 zcmcgxTXP&o8SR<9NV}FTTkMwL7z( z?zODMdWllG6jg)=9`X?2iI-HRDsNQrLjD6kfImPLQ~@vK0nYh)R;$Dbm?{g)+uPIA z(>?w5`A(nj+sfbeHh1Ax}Lg*imUtTnm?>p)U}G# zE2>*ny_&jKQ(jV4x~|&jT~lu>wWZXLuZ^js&Wmf~DjAbXLnY%x{znFc5Bqqx-V zZv@M6YfWcKFfeJh64+H8d|xMN&`p<%xY(F&Hm|OxW=Ah=?&x%`*<7`@Z_drlt)zB! zusqw!dvi&AGfh_GuGPg{2SYZS>A&!Ae#XPpmKG@bExQNbobZBsjcp6D(*=CY0t$`g zV38=r9<+onE2^rbB9)p-s#2+!w)oF>2umyc8iQXQE_rB)RyQ^V3lH$`O0VD5J)K#% z>hMP|2CcZ;HNm<@B@6oK8su4Eb1_@_)Wy6t;6t%Z^Xyze<+^a?xW^TFA)^_7;CCRh7S>20UW;U7A-G0ns}D^K8^h8sAr?NiURxS`w(Zh_(FK@@nw>j%{) z-qceaTzabQtJl06aF-DX#QQjX7WcH!;;XZshYYf`$^p9LnE4SKdyGely({egFd4bZKEB|8=%=7M4`Mx-h?;hO`@#AZT5SWsxSxv z!;iSmSyTWTV5K9V0mwJuM(`Eq3J(cza1BO*AHj@U%3BaH(Z2Iy*LG~IP>TaK2gh55 zhw&}eAh+29@U?{R<+y9~3_Cfq(vqVE?4H3Mz&v*vEZTm#IovngXa%dmX8yLdxYGaG zTC`b}?&qvE;$Mfr0Ao4}5jnj)8FY0-vK1ta%o9G$j=P2;a_d(ZrJJ|p@#hvo_uMf6F*Zb@QzW>;d9GA@SLk#KBM%*6WaMYjYR;n|n^uHRC%~lpy;`mA zP5TpQse>)*V2dX1H^8=a{7w2~kh*uw+w0YwVBvbU1Oxp1>3CmyCLfdGzgF(>t*M8sm>0elS4oB9~|!Ee+WlZ`R_ zooGyoIikZ$oB2{c6bB61u^fdqlkhL5hLcM44vVa z<~JxxM~VYGK+I3K;5jaMc7bQm&WjS-0nYUxh1UTErDy#Ro#9gjp3L;A<=E)tWZ)h& z!5g~BU0c~(l1IoNt>)`4ue2UBmy+7q;9{Pgu<*OJpr?cNRi>KgZiYr`$|;hv>Oxdn zrGWTJgxp(DBxTI;9Bv3|@usr(TufwaT)3!A?&0-Dn|crTlgHRc_&AX~ehf!GxW0lG zI^y;&vJ18en(@|>oczMVV40;K2>uqE#EN>UkcU5tsIYgJWzC?nL$5zq-qlF=Y_V1tpY`4Ghpl6Blh zcvvO?zl@RpFDOQEaPTn4@v>I|${@*sMq~ES1Bb-YZI!1np1JS=T z6$$0e|f{2ha{ zPekUrC!tE%>9d_p2*c3y$DK`kr0Mg~P*fo@X7TyXetV_gaS!u#_AyP!`HoAR2HgdX z)16ek{px*4z7?h3_td*ey(7mh4k!k;6+sI%|kYf7C>rqx;KJ9|uZ?o-LZkp+`ODmko@BUF4_szP$| z)Y4+&j;;f=D#rDe*oykX%rU@hUc`?Cf8x>;;v9itgqr207K512*L5O^!xP9qGt4}Z zGLUjXE6)dUTFLpf7_^dntN1WMCchnE7v7T-lpAg54Pv)YMz9PcuW!l{7K4zL@+3r?P1aWfnD$@4uY!;(i zm!y&t_|+`sYh1){1WDP4r`#2$B-|tWaQOnJNtXw<>@kieP>rELkT-dG!Sy9TbWvov zB*&a1@|;J|SsJ1}$XZO!g%6=Q3{c3bAX6})xJ_zx&xEh@4&THniAdjSiIqBenuTa~ zoOU@zK<45&Zk9`_(6rlovbN5u5UEV$_Do=;!zDh$Nn{bGC0iK+$)(tkG07&fr}vIN zB!BoB#x<{@KsFu0+i_&aro4k75M;>wZy;YbS$-bD_k;NC_v`*tW7?~z9X%mfCj0|_ z1%cnRH-^7`{vm{c2VB?}Ucm4ncSQ_3`o)L8Fgi0**XGOosZ&BP7gbXh$xDtrO=|bf f1QL**cOmF=JPqVjt21HfPx$*Qhkw@C*EsxdtBS32 literal 0 HcmV?d00001 diff --git a/emacs.d/elpa/elpy-20140810.7/elpy/pydocutils.pyc b/emacs.d/elpa/elpy-20140810.7/elpy/pydocutils.pyc new file mode 100644 index 0000000000000000000000000000000000000000..6167486589da4fe40690f88569e7b736cde19f34 GIT binary patch literal 3331 zcmcImU2hvj6uq7vPta--3jA;0eyXyN+Ed@suXn$$aeGz4zR6=8pU4?95Ny8(S^P ze)9N#9gq0~O@Kc|5mDo?uc)D9-l52$u1gJwGd$3tiQs-rKu&oXoKS&Cn z6Yb?G`H|4+T{1Dta7J)Bas4#RA_G6kQ_KAO+8 zE%$rIgxirWbA*w$VJ|l2onBH-A&C91mSKMw^jg)KnKFJnZ3hWn^UG0aY`M2HwzBU> z18vH-SKij;zHf{Ucrdx!GKf`x2CTW;;>N+lpkBgbE}#Jd56%(-f#)6K@ZozR0DYw% zy3FLdq^Fi9NfK`T#F}qHyIWyZ)~+Yu%0 zTsEG_SGKbsg?7yTasEUMhX5Ebkf;x&By_>U6ZDP>1bZrTQJ`r~IC>fj<}4b@_8 zQnPsSY6ee9omO*BQ3)HE3CvRdZy*Gg*fS+;R?KEl=(&(N<1}b8T;hDEvk(V1K^%AD zMan@5doz@LK}so*seTs#fKCt&bd-E21k1Bn_zMuOBVQ;>o`O2G_kcN5iX!W4_=;A@fT~0hC*YΝZ0*KIZbnzrihQN z*Gbk@*f;E8KFxu2F_iE&(Bbet9xD<-LXjm%64_wr1t5eAyct+X6v_qEBH=?AoD4%b z1)48|!729`9${=~!q`|pZfQBbp#k68MD%d`-umWRbL-yin{|)LHUS%Fgb%HBYKbkr zZse}uBZhO9SFV}|ucaCR225+~9cLf-j1$+>awGM}V>yVP*EVZgpKR1_dTC6O`$3XO5pW zJmzmSuhv8}q~RL1vE*DU==1>Rx)$5)-bX-a-&kLt(_Pr)$| z_pi)J%yi_o^1rUW7`gg_>TIgQ1T;URNvmXeTqLukl~IaN8e4mQ8&2;p zcYVVO_ReEPE+HwO*_HH~rjrr5*(TDC1=HVado1IW=I9(wXgv;h{X}jAC2byqc=x8XuI< eKT%1QoO5d4nRn-K;^ed6k}6{MEw{K_T=*AiF~k%A literal 0 HcmV?d00001 diff --git a/emacs.d/elpa/elpy-20140810.7/elpy/ropebackend.pyc b/emacs.d/elpa/elpy-20140810.7/elpy/ropebackend.pyc new file mode 100644 index 0000000000000000000000000000000000000000..e71721c77edfe909a239c18e3dc971dbea827c6d GIT binary patch literal 9996 zcmcIqOLH69bv_M%4?v_yQE!bj!n_=4qJSDrGNX(qlhK2dC?3{U-B64^xQNmP-(Cz}8qT#?O630GyaR>Ct= z@az;kHwDj6!FAbeNQ4=VX}KU#P0XTnvC52mU*u5ayPL-)nq_5kNuoIgmdo`{a4xef zrY5}=>7A6`DG5$XG_S+Xh{4x&ot54>3C>7V*RJ#0enEP#NbjQbF3IMr5;e5zvP8!e zXiBtD?q-oKx|`R;T>jF_!6l++qjj8Ei&3oghok0J*x4~j)ZDXivfa#|n5Lf&O|u_w zWnngIHyZb!#CB?wv0oYVL8I{`&xaqZu4Z_(ZPUH1W4dX!ZQ6;+R~wD^SNL0xXRu~| z3T4yXwjfGsnU z1B1XaPz>Y(t*8Q(Kw@3C0RVT$WE;d-kQ~)TEssl%0bp~qFDraP%N2=EN_0xcoYoSI zd{&}!vJLS(uVXG~`ztIDW%+qU^1AdI(mN)-1#YQ_ZCoVnpH<}VJdc|M*#wMx31?d; z<4S%4MZBG)nTdkTIF7TH4EA<=IOCG6*6JCzKquKhRR0rd7MOG;lRe9o0x~!wah_o5*y>BgEZR1S@Sa-IvA!|9z>(0pN3Ij z^9a2*KgBLZd0}9?-o0+~2F4ThICEq&)jBx|WcP4n9{{-l#0}yk z&VwLdLIq-%2L%SOEk_GSx*$u_TrtM;^-Yd`tK^H~POdY5685dpru*5R@u^X?wiTjz z4z+>{6u#%C)dA~iVp?Pkty$CW`e#|=c0t>&Z2=H1>>8leKeZ;at6Q1L^M06YM`^O! zHiNKZ+tI4&4?`BC-?@J6o!`B7FLc zZ~WA~(_Yn6$tRa{k1F|8o{(-x%1&Lf52ykl{5=)Q^E4?`tw0Rxx$zfGC zC}4bAoO50AK<;nVQS~pQ$k~xPj1R;73DgGk^Z|I%DyIF597Kx3bnNAE-zqb5XppC4 zA@wQ5x`^K_U*JMXI50O{{9ko8r9+Ojo_RN{5`n}N*#956d<<~@1?9?BHGN(dU z8*87Wd;O@nMYGcHW84;vsA-y~CL6&%n`YWAOw8T9xgYoYY7F>(W=gf8>l6!IZGsTZ z2*xNKxJl8QL5lh?^;4^_x5z|F^E@6HpGrVA!Dlx=y?f{8{k352vo-&_!N%I{@2ub1 zP!cMo%SET?NfajO{!x(9zlyn)JmfN&TY$(cdYu|zaw#9}{RIHp5hWh&2j~U@K?a`J zWOSP}gj9fX5C-k^ErWBIB(|JjNHMl@WnQQ6SR?Rdi+g!J}=PH&*teY z!ZN?-pl5S(8Ae)bFtaoA9+Wb=FafOgdw*V$-T#IJQ`4<0ePA`Z@qw|OX$H6Gwy!!I zJw7FlyMZjAs9TZGyj^$#R0MoyT}$N*6;KKZjtkp)O&0*84O1KTkAmEm1pRQ^B<5h4 zeYAy&TJ>4aU*#^Se(YWs=Tl1)CUBWxZ(%gZ5b&tN78R^Ajems@52UKUgF#umrSEmp z$iRVv8Y^r|WCB;8u=%%dKK$hF!?g`HQ8o{=9P$&S-7d_EQ+w1W=AdJS&MMK|-wLC< zG`Vp%HrX02rJCGttD)Uc1L|67vhS*O*6q7SPRPasSEU92G);H*hFbT}qwb$$p}63Q z^U=`cls=nhPHQ*WPs%u4saLL`+qn|3^qt^?sd-dtTL1U?mTNM=Fx0dE4w{aF%=t-7 zoDDkxmGqQp{|=g+-SryY67=+nTEsfwMSK>}QuUT9GnEFc<+4|;jeTMArz!&4Ri_9h z8UTU}XBRedUb5Gf(NTvwI4td-V|!v$5v(Z1)|?HbXmOuW+EIVO*)S4ovh$6bXQDRr8@Z${KBWS=X)hM)CfyDc65ESYR zkqB*y66zD0jBZAaO2v5=4zt{!W8FU{q^tik2Wp|-A=~i`M3S=bzXNde0#-e;t|vPc$u2mo1K(iiv2AM!*wq;}S~c{70;O$( zydTbxG7pk#Fkl!sHeh48G+^DDTCYP|FVGp*3xS~%ntyOBgSt!7TUIikn9!Jvwhqq; z$fXi=+Ltt*s9^v1P*qZZ!Vv;4I{pNMXiRg}z5WfpN2d2bU_sB#|B%HWu=qn3B%@DN z;S*g`^e1ioTV;oiQ-xR3;YeuDBbT(F9OipywM`V_HL4WLQkyLodW>33#g*iz)}^{v z^6x@sCgf*OKXydmPJEgA4DqW{tM0%}Un3)6EIb2LlZsTlY`b{*Je&`*5b6-(s@#A? z!)+b?lpf%V@xhpRkV~lvEau@1eIu|#cHN_hBQ)2X0evGU^k~ui!IxU_IuwJB8GTEc z1}QYOz$XKvVxC3KG~ftmgoXj%PB+3QLnHh!EP=#BRnA@}Bkx}KYH+vcXtlwq9_kNq z6pY$%UK$RhT-rl=VhpbcYz{o9{B-H1_4%^$ISb7T6?q2gtSd1~bq_K#ND==tLevhJGtQg%jUx6D#yL5o z2*2P}yeM5fXt5#P0Yd)-?u5dK_~SIXJ_WyXBmziPQVL+Pmw!Z)CDtH)@Ew-C>yWxC z6z*w_vR9yXS8DJiP(KZL(VO$;r~HetN~T<@Onw1iB9nx`wbLqi95;Yj(K{7h;QXZu zzTsjBc=)P?8ACYu7_&Mqj3{D=zbLdYI6m=&s$0;0y0eG z(17kz5UAg*85n1n7+U&&#Nt~ld=?K_Y_o__OwOv%OUwgda-mMJjJs#&kol?9FVyGj z3-wp(bM?jgx%zAB$k96RQ7-%^0I;)QJX!^Wx`+WiIY$)>Cqdn`gN(6S_V?8LbQ_QZ zLfXQU4Gc%qd8kp^fmrQ;vk8xivFA2u8$4$lE^&T+0bT)K_<_FQ$@|W5xY=)D+1=OW z0j$A>nqhk%JM>MymmxKd?6(U#n8FA(zrovv?q1TNi&x|#Gz*d@{ZTU3T$?7yKnc$@TsTYo4> z3tS{=K?>>{HSO6VyOEpU*jfPJ@ zSnz#t@b2_tZ+&I4&&$_zZEyE;!S?~CDsqM{w>}&x^~Wa4Wq+;KgV@4N@9c!IUDP8q zVVYuhQS3aLa1&+s<088VEBjM%@6aOzB^>jqdrXH81AWb{$`&SeP|Ew8Q zJ)Fx!dxZIfJ{gMkGMgQZSdCu`H`E|^*dK6_zAkk$Bvol2Q#@OO)C=Q8- zbxi?l(wN*?Tp>-8A{Ndz;u7j#X56L|J(J|IzlJeKaq!|=?91yeVc$izWC0?KYzYs- zhfKl8hA5oaQs;snRrT5P%+%6~LY{fQQg-~UCjb8i5+_+@IyqmFwPbE0ayS* zjb6VTLZJh#_?A5QXIM*jKmw5C-o>L=Lzw^ZHzs*n%#YVHtm|yQ&hj;xTh5~%kY+5M zR^{F1C*h8{SLSUw$Y-8RRj|wUGCFVx6V3UeCNIw%S}KWgR`*rXfQOxhOWv9XpoU^U z%_68Y#44F8Vc3m=qi`17e!>~hcptG}p$#+m3b+~#b4`t^1o8?_&p#Z&<#RVuW#HtF zXZ5_AFLGQ*;`@J%;^m#!{{qvUWgF4|}D28*{*Xrh33>Fwg`0{_cv3wN!dK@$gT;jX(~ zcm;YhudiwA_+IuDrkpfS-CLY2JIZA!gGGjp;smo;ijogyCqDfejV{$Sb3cn<>?Hmp z7W*hv_fA&Bk27$m>26KvGq}3Ges6ReUHUr%6@L73f+zCTjNi0 zZ*x2BJi!kNXxk>iuimu;_w;8Rw}Gph?uv(K`icSa|B|o%6^k!ekR(S&a1BsDbo%Eb rbpqO0ZWf`y0<=Q$sVr0w1y;}eCnCV(3*Jh#K7;4@N{vzBnfYG>4S7so literal 0 HcmV?d00001 diff --git a/emacs.d/elpa/elpy-20140810.7/elpy/rpc.pyc b/emacs.d/elpa/elpy-20140810.7/elpy/rpc.pyc new file mode 100644 index 0000000000000000000000000000000000000000..bd5be763401b99fd89306dfe65fd11ff7c11e3ee GIT binary patch literal 5475 zcmb_gYi}FJ6`dtzN~C4Wb&)tunqsN~HI2%Y>^N@VrjJCh5htzUuADki(GsiOp}5j= zm)V&$C0P1W2PjYkMS-IKrTq{6HEq7P=iFIRl>0z{O45$zdGE}9oO@@Q|G3oor^+Ku7b}p#o zf-)`XZOwWYNo>2jNFIMh@t(HnXq*}S;r7Q{x5CGpx3cuWXlu%6rtEb(PlnTmo}^i( zOA{qJ$`d^)Q)hIR=Emw`;Fp^`E)tXIk#WN!(Q%YzmXkZBvEw4Q#)9IuG1`G@QpDBB z%dyqSS+`#Biw-aa~hBJ%Ki1K|N^FtH{ zqJ(r%LU51){sQ#{Ra?dhM3p~!*q+5QGal_&KU z{Dj()?69b^MB@n4-HWY~^L@YL=c{S5dSBmpYfZ0u&S=%Oejbg?Dh9?;8I3FkeziI% z3ij+qO=D!qAi*)93dO@xLZ%IJHO;+y~%KD-LoTno&7=QRpz)q?xN=Ype&2B z=KnR%X}E-BYI~G6T+rHR&rIpk>4wgY@2{^y9q+=T7(gY~OT`oYgo9K*2!b+Dw$H#8eV|+T07x^vkn+(xh%^yos>}+`ziXTxSvLfuDChAJ6 z(b)UbAgkVn=5 z7FD@HJcFVLd!k8b(K`{En0Ea{2B2u<7s(~{qM=Si>Fj};12z7Q+5^!Ab(B#QV1v8^ zfO(Cxo9YA&Bqx{DL0gr7X8m|UeTfAvm0y)jwKyA{B#pYT;pD%`DAE{oBC7${Cd{f4 zz`>v9e^Co?o`a4mZwJB2q6$*bSXBFMCP(*J>!@T&-8)&5?u*kMycTfmqB=%a)K>3; z7Ucpa9qBq{@)Qh~g~9K@pbZ91g>>z>%`=ln0-9iu2FhJl`zy5gWEtIU&-6c24b-O) z#dh~HwekyS0q! z3QwkAdWzU7@&0H0P}n$^7Z<8<28nVv{~2Qs`ae z{*pIM05GM}L{|8$N>G;RlJt4uI9@jDd_=~X(n^J)S)5-smwp9xIwGnoquA_5 z@xfO23U|OH-_aj`$@Er4E%b3S7)4Hk@t$!ZVMdstf$mb~cvXZ~IY!ud7$NHlUqdat z&f;|rkm-ZN*o=7>@xk4d;kP(Mww_Pl9L8NXeLUf*YGJsGsC$t~mMM$sv3{C_uW->f zSzJRQ+Zf0;C||$_?kDF8ZFCNQ?tZ*WCP|h~p)SN!D?i$a2#rbK;XTT&d`BH!7TlCXEO`2P6JXh3+J(Ihnu3~lRS*P^ zG4d(Crx10W9QQ#+?#EMClpC_~*L5Fo^%Ou}h6qb<$NdI>5NDPWiAJf-i;-ORr>lLa z7BM|3D-$xobl*VnkvZBeqB42J1fs0QE);jAQ*0v}HlqiJsq6C8BJFcEYJz|~OZ4H6 zJnjiQ$Xd19u;a_H)FSa}F@3j|08f=VDewrxX$7kO}Vdmd25Izy( z@oXXQ7kH9j-eSK(!MG;?$IG0H@>pJ6s8)GKNX$UqYv_=cB23-U^yLK!R*o1`JLR3j z!~1%R@S5SiJ&c~Ec!bHA{=Riw!%3@HQrRth7OUvhnANH zu>QPmd&2lnpyzKFF!VNl>xB9?`olXc-eMun$IYL=>C!xZk5BUC)>12ww=mCE;v$jH oM@??PXES2(;deR0_2<4TarSq;d;fR|90U?t4Tibp=Bv;D1!grauK)l5 literal 0 HcmV?d00001 diff --git a/emacs.d/elpa/elpy-20140810.7/elpy/server.pyc b/emacs.d/elpa/elpy-20140810.7/elpy/server.pyc new file mode 100644 index 0000000000000000000000000000000000000000..2b3f7e3621b019a8b21b588648c60456296b1ff7 GIT binary patch literal 8005 zcmcgxOLH7o6}~+)ddyh1u>qzQ36p={ZqOcE-tylfNf3QA~+vJtqZTHRNgmU_A; zeeXySWiP;~V#6amRIy{n4)**AegJ&mx!uzvIgWAFl%4d|?c3+R&iT%B zn*TZ4`E2msTBOQZx^fT)&~#8&$ul)|=9As{JHN0fIb`;uzu1+~*r#V?iT zdDt4`nWyfS)N?|8OsyX~Nd4D}`j}A1^GeUDO`M~xK2_?WQa@Z@RB?wd>r1@RYWD~) z`gb(n)3%?-eli%QdZ05K+9c16znK@l?Q8#LI^6efuYS04DfsBRZ*;M%i{(ydt)GA< zNp(HZ2>n2oGrs<0m={*Z{>HwHA6~-0Wjp;ai&Jg%;~m9B^T*wbjXwCxS|<2>p`IWH!6>NfcKC>kCH*IAX@Sjzo7 z;V89k{w!WOD=gp1scju6~#9j+qkf3oju-V7IRjow|#W3o9V=NuQWh`bqOmQ7BMFF;)y3(bHL~Ld> z)I}h#^BC*(k}R>ko^6pV&$OLGr;^bE`okjM2F7|to|ob!DG;^U#a|_jc?Z4AKLFOv z<&8pHn}*p|oM)Gp^&pJQa(o%=2-)mk`sS5auU>iM)ho-d%lqY0K>!4v=WBQjPp7<- zUfYX!X})sL5Am4S(BSg8={D{UWO(XfQ$3hb_iC-5Hc44PYmFa`iURtc?)zC@so+H)_Z=0P zAL~tO#PUj)XBIX>r$TFspo4*+jYh-}kgJxLa#9!4a<+(pCy?(ud(!3INjhbIiw5>0 z@S<1p;bm-OC051V#c-G>1La7B$3Bo|^C(ZjYSA0Ae=jd~l5A^2AdU+>lrS<_LT}ofArGjnI_l?F z&^O#p%|-mfhxYF}9`i3W4uof^dyuQAiZ^Abq0YiO?KJp~Q79=f3xyT6?KM?q6vSO5 zW9pVrCmh`dcn?wEl(m2Un6)m*T7P=XT-ZKm6PhZK?YCh=mD*{m;vce6Q*Fg%kwuInU%UPqfIF+n7;(p(4mKSvb(5lujdP zc=Dn1JLpc)ve-(Vv~}Oc(&o$Dz&qMF<2~o`nRQR2-DrB}yol%KLnReCzkrSt2rLOW z1esg3FuY)AQ$3u4Mo{eySASnyu`X0Cn+(T+!R9C{eYN|ZZ*CfGC!lQ?F`KxfGcIR4 za}u1y7cn80#)RKZJ}M&JIn+uj3FuLUfbFAxy`ZnPz{m0aFo@^e`LAtT7u8MKg|* zUjaqUy5OsL4JhNl=LbB~WD|YbDxR86l^vn*1YbPyA$-BBm6*DLkENA85FiLILYPgx zo8%({x8z(ALdcqTlklRv9_339iyB+N%C0zV;gBtd88F;t>4) z({bnl&sqDSG>;@Ee_95KuW~%3!>WMzBZ=CnRu?grX+IkcHgs`slC|e>g3n=Xb&|(( zHuySbPMe=EVa*VaL)`4blN9rdEZS|XQ(3g?I#f?Od_*lYsmwpB?5EaC5v$*#^W z3gW7XAtLfo7VAQYmKmmJxdlx=9LJ8S-qoo;$m0=HX3nVWBw$gdPB0TLJw2yw$c^E@|zq|Vk%^IfD@e| z*a~UbqAYWy2+|nc-WsqzbF(PWQctCKV?@X4KGpGAVv@|*FpIRTv9Zsjhw_Ydl*d{^ zMdw#J=-6i&7h`va@M)uO(m%#e*xM>M;0XRw4nc@J;0>M>@#mqmk z@Z)Vpfdo6UIr;6EdBOzb#CMCw-b;|(Z)n!qfF}e)u^vLUGA;A>`pBeVHWGWGhFUlr zrb!giG9jR(;~M5kX8qN*cY`%oT631mRptu4MVGgs?Vi@z7_c?<&6OJyN0U;UD}v4A zhSfdHMP3&v6D^l7fJsvwv!F1(sDY6Scf%y**<2BaF(V5p!M8a55*kTwf^w3iWcCz> znIu$8^{T{*f)wOQ%^_f^G)v*5V-WY z*o#5%6xc&Xi>w+op|@EWe1N1ImJWaf6vb51l#T&8TLSVIbYh~If5C2#01~Du+hQhC zuX4_I@n;U;D-c%5T3i((szwenPTjmxD~ z$4JN`ja%VO^rnp~!iKo2SoM3n8*WK!=CHJYVq$5_s6c$gmNB|z=pqRzJfSP9qF4j> zN^f~pfC7gJ6DD~p4HhypI9umHfv<<22U`bxm8hXk(s_v z7;cu~BIIhhh?t1#2M6~XL0OHg3XxJ$p?66>L$z*2{J2Dl;`#casY{V>W9@*^#xqNS zx#OSl7&>0nTJTPIXBus9rORAX>{qYHXb**GQuKN*YQrl5*rT)R^`t=T!eH9BfIdxX z5CJpn;6*ksv0*$Pyv&9^HMqd$Dw}I;-eSW8)i9LaRKh%|tn*;TM>9J!>$PXvop!r@ zvOOpNwb?GT+b0$l+e;B7B?U!V8^I&YlHd`o0MMKy09Su*qd?}_GI;a6UmsTw zfJ@XDfkP190Up19m#s5!KqXvpv8VP=v*wH{AI7-?M!h>9@6ltUy$ic|7n4c^-^01q zDsv-0TICzta8U@?B^QqJ%%Tup)pg@VnU{EY#9$N|g{ zlXq}whV+lnYy6}IV@XO$4tDfDY906q4(?Od;8*!lW~j2}UOzXmu;rosJ$QK}1Gvn{ z=u!=_8K=@dj~B#AZ86gRZkVF25?pQ><7YS6;cycH1~gP(9PcgrnSMS(+=>{)5ypOw zP!N7SjLYqu_nn8Zbq1Y<6R0EA6-(1~cneo=y-aw}c=4b>gi=W^?+7C@>2MSA-!L9R zkh{pU(1U!}m0Lxpcu>d;C_~k-)`aOO0kikN;W5-xbz~7gB{aR~y;BG%n=r#oPkuTJ zZs23^T{a)Ec?FG>K*jG#lsd9WY9u=oBjFt4Fba5Tv0% +;; Version: 0.1.1 +;; Keywords: lisp, rpc +;; Package-Requires: ((concurrent "0.3.1") (ctable "0.1.2")) +;; 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 . + +;;; 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*") + +(defvar epc:mngr) + +;;(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 150 "Asynchronous timeout time. (msec)") +(defvar epc:accept-process-timeout-count 100 " Startup function waits (`epc:accept-process-timeout' * `epc:accept-process-timeout-count') msec for the external process getting ready.") + +(put 'epc-error 'error-conditions '(error epc-error)) +(put 'epc-error 'error-message "EPC Error") + +(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:start-epc-deferred (server-prog server-args) + "Deferred version of `epc:start-epc'" + (deferred:nextc (epc:start-server-deferred server-prog server-args) + #'epc:init-epc-layer)) + +(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 "^[ \n\r]*[0-9]+[ \n\r]*$" 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 (< epc:accept-process-timeout-count cont) ; timeout 15 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:start-server-deferred (server-prog server-args) + "[internal] Same as `epc:start-server' but start the server asynchronously." + (lexical-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)) + (mngr (make-epc:manager + :server-process process + :commands (cons server-prog server-args) + :title (mapconcat 'identity (cons server-prog server-args) " "))) + (cont 1) port) + (set-process-query-on-exit-flag process nil) + (deferred:$ + (deferred:next + (deferred:lambda (_) + (accept-process-output process 0 nil 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 (< epc:accept-process-timeout-count cont) + ;; timeout 15 seconds + (error "Timeout server response.")) + (deferred:nextc (deferred:wait epc:accept-process-timeout) + self)))))) + (deferred:nextc it + (lambda (_) + (setf (epc:manager-port mngr) port) + (setf (epc:manager-connection mngr) (epc:connect "localhost" port)) + mngr))))) + +(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 "" :align 'left) + (make-ctbl:cmodel :title "" :align 'center) + (make-ctbl:cmodel :title "" :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) "") + (or (nth 2 m) "")))) + (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" err)))))))) + +(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 diff --git a/emacs.d/elpa/epc-20140609.2234/epcs.el b/emacs.d/elpa/epc-20140609.2234/epcs.el new file mode 100644 index 0000000..b601ff2 --- /dev/null +++ b/emacs.d/elpa/epc-20140609.2234/epcs.el @@ -0,0 +1,160 @@ +;;; epcs.el --- EPC Server + +;; Copyright (C) 2011,2012,2013 Masashi Sakurai + +;; Author: Masashi Sakurai +;; Keywords: lisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'epc) + +(defvar epcs:client-processes nil + "[internal] A list of ([process object] . [`epc:manager' instance]). +When the server process accepts the client connection, the +`epc:manager' instance is created and stored in this variable +`epcs:client-processes'. This variable is used for the management +purpose.") + +;; epcs:server +;; name : process name (string) ex: "EPC Server 1" +;; process : server process object +;; port : port number +;; connect-function : initialize function for `epc:manager' instances +(defstruct epcs:server name process port connect-function) + +(defvar epcs:server-processes nil + "[internal] A list of ([process object] . [`epcs:server' instance]). +This variable is used for the management purpose.") + +(defun epcs:server-start (connect-function &optional port) + "Start TCP Server and return the main process object." + (lexical-let* + ((connect-function connect-function) + (name (format "EPC Server %s" (epc:uid))) + (buf (epc:make-procbuf (format "*%s*" name))) + (main-process + (make-network-process + :name name + :buffer buf + :family 'ipv4 :server t :nowait t + :host "127.0.0.1" :service (or port t) + :sentinel + (lambda (process message) + (epcs:sentinel process message connect-function))))) + (unless port + ;; notify port number to the parent process via STDOUT. + (message "%s\n" (process-contact main-process :service))) + (push (cons main-process + (make-epcs:server + :name name :process main-process + :port (process-contact main-process :service) + :connect-function connect-function)) + epcs:server-processes) + main-process)) + +(defun epcs:server-stop (process) + "Stop the TCP server process." + (cond + ((and process + (assq process epcs:server-processes)) + (epc:log "EPCS: Shutdown Server: %S" process) + (let ((buf (process-buffer process))) + (delete-process process) + (kill-buffer buf)) + (setq epcs:server-processes + (assq-delete-all process epcs:server-processes))) + (t (error "Not found in the server process list. [%S]" process)))) + +(defun epcs:get-manager-by-process (proc) + "[internal] Return the epc:manager instance for the PROC." + (loop for (pp . mngr) in epcs:client-processes + if (eql pp proc) + do (return mngr) + finally return nil)) + +(defun epcs:kill-all-processes () + "Kill all child processes for debug purpose." + (interactive) + (loop for (proc . mngr) in epcs:client-processes + do (ignore-errors + (delete-process proc) + (kill-buffer (process-buffer proc))))) + +(defun epcs:accept (process) + "[internal] Initialize the process and return epc:manager object." + (epc:log "EPCS: >> Connection accept: %S" process) + (lexical-let* ((connection-id (epc:uid)) + (connection-name (format "epc con %s" connection-id)) + (channel (cc:signal-channel connection-name)) + (connection (make-epc:connection + :name connection-name + :process process + :buffer (process-buffer process) + :channel channel))) + (epc:log "EPCS: >> Connection establish") + (set-process-coding-system process 'binary 'binary) + (set-process-filter process + (lambda (p m) + (epc:process-filter connection p m))) + (set-process-sentinel process + (lambda (p e) + (epc:process-sentinel connection p e))) + (make-epc:manager :server-process process :port t + :connection connection))) + +(defun epcs:sentinel (process message connect-function) + "[internal] Process sentinel handler for the server process." + (epc:log "EPCS: SENTINEL: %S %S" process message) + (let ((mngr (epcs:get-manager-by-process process))) + (cond + ;; new connection + ((and (string-match "open" message) (null mngr)) + (condition-case err + (let ((mngr (epcs:accept process))) + (push (cons process mngr) epcs:client-processes) + (epc:init-epc-layer mngr) + (when connect-function (funcall connect-function mngr)) + mngr) + ('error + (epc:log "EPCS: Protocol error: %S" err) + (epc:log "EPCS: ABORT %S" process) + (delete-process process)))) + ;; ignore + ((null mngr) nil ) + ;; disconnect + (t + (let ((pair (assq process epcs:client-processes)) d) + (when pair + (epc:log "EPCS: DISCONNECT %S" process) + (epc:stop-epc (cdr pair)) + (setq epcs:client-processes + (assq-delete-all process epcs:client-processes)) + )) + nil)))) + + +;; Management GUI + +;; todo... + +(provide 'epcs) +;;; epcs.el ends here diff --git a/emacs.d/elpa/jedi-20140321.1323/Makefile b/emacs.d/elpa/jedi-20140321.1323/Makefile new file mode 100644 index 0000000..8499d32 --- /dev/null +++ b/emacs.d/elpa/jedi-20140321.1323/Makefile @@ -0,0 +1,201 @@ +ENV = env + +VIRTUALENV_SYSTEM_SITE_PACKAGES ?= true +VIRTUALENV = \ + VIRTUALENV_SYSTEM_SITE_PACKAGES=$(VIRTUALENV_SYSTEM_SITE_PACKAGES) \ + virtualenv --python=$(PYTHON) +PIP_INSTALL = $(ENV)/$(BINDIR)/pip install +JEDI_DEV_URL = https://github.com/davidhalter/jedi/archive/dev.zip + +PYTHON ?= python +CASK ?= cask +export EMACS ?= emacs + +BINDIR ?= bin + +ELPA_DIR = \ + .cask/$(shell ${EMACS} -Q --batch --eval '(princ emacs-version)')/elpa +# See: cask-elpa-dir + +VIRTUAL_EMACS = ${CASK} exec ${EMACS} -Q \ +--eval "(setq python-environment--verbose t)" \ +--eval "(setq jedi:environment-root \"$(PWD)/$(ENV)\")" + +.PHONY : test test-1 tryout clean-elpa requirements env clean-env clean \ + print-deps travis-ci doc + +TEST_DEPS = elpa env +test: ${TEST_DEPS} + ${MAKE} test-1 + +test-1: + ${VIRTUAL_EMACS} -batch \ + -L . -l test-jedi.el -f ert-run-tests-batch-and-exit + tox + +compile: elpa clean-elc + ${VIRTUAL_EMACS} -batch \ + -L . -f batch-byte-compile *.el + +clean-elc: + rm -rf *.elc + +tryout: compile env + ${VIRTUAL_EMACS} -L . -l tryout-jedi.el + +doc: elpa + make -C doc html + +ensure-git: + test -d .git # Running task that can be run only in git repository + +elpa: ${ELPA_DIR} +${ELPA_DIR}: Cask + ${CASK} install + test -d $@ + touch $@ + + +clean-elpa: + rm -rf ${ELPA_DIR} + +requirements: + @echo "**************************************************************" + @echo " ERROR: \"make requirements\" is obsolete!" + @echo " Please run \"M-x jedi:install-server\" inside of your Emacs." + @echo " * If you are using el-get, please update it first." + @echo " See also: https://github.com/dimitri/el-get/pull/1603" + @echo "**************************************************************" + @exit 1 + +install-jedi-dev: + ${PIP_INSTALL} --upgrade ${JEDI_DEV_URL} + +env: $(ENV)/$(BINDIR)/jediepcserver +$(ENV)/$(BINDIR)/jediepcserver: ${ELPA_DIR} jediepcserver.py setup.py + ${VIRTUAL_EMACS} -batch -l jedi.el -f "jedi:install-server-block" + test -f $@ + +clean-env: + rm -rf $(ENV) + +clean-el: clean-elpa clean-elc +clean: clean-env clean-el + rm -rf .cask + +print-deps: elpa env + @echo "----------------------- Dependencies -----------------------" + $(EMACS) --version + ${VIRTUAL_EMACS} -batch -l jedi.el -f jedi:print-jedi-version + ls -d $(ENV)/*/python*/site-packages/*egg-info + @echo "------------------------------------------------------------" + +before-test: ${TEST_DEPS} + tox --notest + +travis-ci: print-deps test + test ! -d ~/.emacs.d/.python-environments + + + +# Run test against Emacs listed in ${EMACS_LIST}. +# This is for running tests for multiple Emacs versions. +# This is not used in Travis CI. Usage:: +# +# make EMACS_LIST="emacs emacs-snapshot emacs23" test-all +# +# See: http://stackoverflow.com/a/12110773/727827 +# +# Use ${MET_MAKEFLAGS} to do the tests in parallel. +# +# MET_MAKEFLAGS=-j4 + +JOBS := $(addprefix job-,${EMACS_LIST}) +.PHONY: ${JOBS} + +${JOBS}: job-%: + ${MAKE} EMACS=$* clean-elc elpa + ${MAKE} EMACS=$* ${MET_MAKEFLAGS} test-1 + +test-all: env ${JOBS} + + + +### Packaging +# +# Create dist/${PACKAGE}-${VERSION}.tar.gz ready for distribution. +# +# See: (info "(elisp) Multi-file Packages") +PACKAGE = jedi +VERSION = $(shell grep ';; Version:' jedi.el | sed 's/^.* \([0-9].*\)$$/\1/') +DIST_FILES = jedi-pkg.el jedi.el jediepcserver.py \ + Makefile tryout-jedi.el + +.PHONY: dist ${PACKAGE}-${VERSION}.tar.gz ${PACKAGE}-${VERSION} \ + clean-dist clean-dist-all + +dist: clean-dist + ${MAKE} dist-1 + +dist-1: dist/${PACKAGE}-${VERSION}.tar dist/${PACKAGE}-${VERSION}.tar.gz + +dist/${PACKAGE}-${VERSION}.tar: ${PACKAGE}-${VERSION}.tar +${PACKAGE}-${VERSION}.tar: ${PACKAGE}-${VERSION} + tar --directory dist -cvf dist/$@ $< + +dist/${PACKAGE}-${VERSION}.tar.gz: ${PACKAGE}-${VERSION}.tar.gz +${PACKAGE}-${VERSION}.tar.gz: ${PACKAGE}-${VERSION} + tar --directory dist -cvzf dist/$@ $< + +${PACKAGE}-${VERSION}: dist/${PACKAGE}-${VERSION} +dist/${PACKAGE}-${VERSION}: + mkdir -p $@ + cp -v ${DIST_FILES} $@ + +clean-dist: + rm -rf dist/${PACKAGE}-${VERSION}* + +clean-dist-all: + rm -rf dist + + + +### Package installation +PACKAGE_USER_DIR = +TEST_PACKAGE_DIR = dist/test + +install-dist: + test -d '${PACKAGE_USER_DIR}' + ${EMACS} --batch -Q \ + -l package \ + --eval " \ + (add-to-list 'package-archives \ + '(\"marmalade\" . \"http://marmalade-repo.org/packages/\") t)" \ + --eval '(setq package-user-dir "${PWD}/${PACKAGE_USER_DIR}")' \ + --eval '(package-list-packages)' \ + --eval '(package-install-file "${PWD}/dist/${PACKAGE}-${VERSION}.tar")' + +test-install: dist/${PACKAGE}-${VERSION}.tar + rm -rf ${TEST_PACKAGE_DIR} + mkdir -p ${TEST_PACKAGE_DIR} + ${MAKE} install-dist PACKAGE_USER_DIR=${TEST_PACKAGE_DIR} + +test-install-requirement: test-install + ${MAKE} --directory ${TEST_PACKAGE_DIR}/${PACKAGE}-${VERSION} \ + requirements + + + +### GH pages +MAKE_GH_PAGES = $(MAKE) --directory doc --file gh-pages.mk + +gh-pages-latest: + $(MAKE_GH_PAGES) + +# Publish released documentation. This task can be run only when the +# current revision has tag (i.e., released). +gh-pages-released: + # Make sure it's on tag + git describe --tags --dirty | grep -v - + # Run doc/gh-pages.mk + $(MAKE_GH_PAGES) DOC_VER=released diff --git a/emacs.d/elpa/jedi-20140321.1323/jedi-autoloads.el b/emacs.d/elpa/jedi-20140321.1323/jedi-autoloads.el new file mode 100644 index 0000000..b358ba1 --- /dev/null +++ b/emacs.d/elpa/jedi-20140321.1323/jedi-autoloads.el @@ -0,0 +1,125 @@ +;;; jedi-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "jedi" "jedi.el" (21571 44958 0 0)) +;;; Generated autoloads from jedi.el + +(autoload 'jedi:start-dedicated-server "jedi" "\ +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'. + +\(fn COMMAND)" t nil) + +(autoload 'jedi:complete "jedi" "\ +Complete code at point. + +\(fn &key (expand ac-expand-on-auto-complete))" t nil) + +(autoload 'jedi:ac-setup "jedi" "\ +Add Jedi AC sources to `ac-sources'. + +If auto-completion is all you need, you can call this function instead +of `jedi:setup', like this:: + + (add-hook 'python-mode-hook 'jedi:ac-setup) + +Note that this function calls `auto-complete-mode' if it is not +already enabled, for people who don't call `global-auto-complete-mode' +in their Emacs configuration. + +\(fn)" t nil) + +(autoload 'helm-jedi-related-names "jedi" "\ +Find related names of the object at point using `helm' interface. + +\(fn)" t nil) + +(autoload 'anything-jedi-related-names "jedi" "\ +Find related names of the object at point using `anything' interface. + +\(fn)" t nil) + +(autoload 'jedi:setup "jedi" "\ +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. + +\(fn)" t nil) + +(autoload 'jedi:install-server "jedi" "\ +This command installs Jedi server script jediepcserver.py in a +Python environment dedicated to Emacs. By default, the +environment is at ``~/.emacs.d/.python-environments/default/``. +This environment is automatically created by ``virtualenv`` if it +does not exist. + +Run this command (i.e., type ``M-x jedi:install-server RET``) +whenever Jedi.el shows a message to do so. It is a good idea to +run this every time after you update Jedi.el to sync version of +Python modules used by Jedi.el and Jedi.el itself. + +You can modify the location of the environment by changing +`jedi:environment-root' and/or `python-environment-directory'. More +specifically, Jedi.el will install Python modules under the directory +``PYTHON-ENVIRONMENT-DIRECTORY/JEDI:ENVIRONMENT-ROOT``. Note that you +need command line program ``virtualenv``. If you have the command in +an unusual location, use `python-environment-virtualenv' to specify the +location. + +.. NOTE:: jediepcserver.py is installed in a virtual environment but it + does not mean Jedi.el cannot recognize the modules in virtual + environment you are using for your Python development. Jedi + EPC server recognize the virtualenv it is in (i.e., the + environment variable ``VIRTUAL_ENV`` in your Emacs) and then + add modules in that environment to its ``sys.path``. You can + also add ``--virtual-env PATH/TO/ENV`` to `jedi:server-args' + to include modules of virtual environment even you launch + Emacs outside of the virtual environment. + +.. NOTE:: It is highly recommended to use this command to install + Python modules for Jedi.el. You still can install Python + modules used by Jedi.el manually. However, you are then + responsible for keeping Jedi.el and Python modules compatible. + +See also: + +- https://github.com/tkf/emacs-jedi/pull/72 +- https://github.com/tkf/emacs-jedi/issues/140#issuecomment-37358527 + +\(fn)" t nil) + +(autoload 'jedi:install-server-block "jedi" "\ +Blocking version `jedi:install-server'. + +\(fn)" nil nil) + +;;;*** + +;;;### (autoloads nil nil ("jedi-pkg.el") (21571 44958 323059 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; jedi-autoloads.el ends here diff --git a/emacs.d/elpa/jedi-20140321.1323/jedi-pkg.el b/emacs.d/elpa/jedi-20140321.1323/jedi-pkg.el new file mode 100644 index 0000000..8a82be7 --- /dev/null +++ b/emacs.d/elpa/jedi-20140321.1323/jedi-pkg.el @@ -0,0 +1,7 @@ +(define-package "jedi" "20140321.1323" "Python auto-completion for Emacs" + '((epc "0.1.0") + (auto-complete "1.4") + (python-environment "0.0.2"))) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs.d/elpa/jedi-20140321.1323/jedi.el b/emacs.d/elpa/jedi-20140321.1323/jedi.el new file mode 100644 index 0000000..3cba7bd --- /dev/null +++ b/emacs.d/elpa/jedi-20140321.1323/jedi.el @@ -0,0 +1,1352 @@ +;;; jedi.el --- a Python auto-completion for Emacs + +;; Copyright (C) 2012 Takafumi Arakaki + +;; Author: Takafumi Arakaki +;; Package-Requires: ((epc "0.1.0") (auto-complete "1.4") (python-environment "0.0.2")) +;; Version: 0.2.0alpha2 + +;; 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 . + +;;; Commentary: + +;; + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'ring) + +(require 'epc) +(require 'auto-complete) +(require 'python-environment) +(declare-function pos-tip-show "pos-tip") + + +(defgroup jedi nil + "Auto-completion for Python." + :group 'completion + :prefix "jedi:") + +(defconst jedi:version "0.2.0alpha2") + +(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:environment-root nil + "Name of Python environment to use. +If it is nil, `python-environment-default-root-name' is used. + +You can specify a full path instead of a name (relative path). +In that case, `python-environment-directory' is ignored and +Python virtual environment is created at the specified path." + :group 'jedi) + +(defcustom jedi:environment-virtualenv nil + "``virtualenv`` command to use. A list of string. +If it is nil, `python-environment-virtualenv' is used instead. + +You must set non-`nil' value to `jedi:environment-root' in order +to make this setting work." + :group 'jedi) + +(defun jedi:-env-server-command () + (let* ((getbin (lambda (x) (python-environment-bin x jedi:environment-root))) + (script (or (funcall getbin "jediepcserver") + (funcall getbin "jediepcserver.py")))) + (when script + (list script)))) + +(defcustom jedi:server-command + (or (jedi:-env-server-command) + (list "python" jedi:server-script)) + "Command used to run Jedi server. + +.. NOTE:: + + If you used `jedi:install-server' (recommended) to install + Python server jediepcserver.py, you don't need to mess around + with jediepcserver.py. Jedi.el handles everything + automatically. + +If you install Python server jediepcserver.py using +`jedi:install-server' command, `jedi:server-command' should be +automatically set to:: + + '(\"~/.emacs.d/.python-environments/default/bin/jediepcserver.py\") + +Otherwise, it is set to:: + + '(\"python\" \"JEDI:SOURCE-DIR/jediepcserver.py\") + +.. NOTE:: If you installed jediepcserver.py manually, then you + have to set `jedi:server-command' appropriately. + + If you can run ``jediepcserver.py --help`` in your shell, then + you can simply set:: + + (setq jedi:server-command '(\"jediepcserver.py\")) + + Otherwise, you need to find where you installed + jediepcserver.py then set the path directly:: + + (setq jedi:server-command '(\"PATH/TO/jediepcserver.py\")) + +If you want to use a specific version of Python, setup +`jedi:environment-virtualenv' variable appropriately and +reinstall jediepcserver.py. + +If you want to pass some arguments to the Jedi server command, +use `jedi:server-args' instead of appending them +`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 the +following. Note that actual environment variable ``VIRTUAL_ENV`` +is treated automatically so you don't need to pass it. 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:imenu-create-index-function 'jedi:create-nested-imenu-index + "`imenu-create-index-function' for Jedi.el. +It must be a function that takes no argument and return an object +described in `imenu--index-alist'. +This can be set to `jedi:create-flat-imenu-index'. +Default is `jedi:create-nested-imenu-index'." + :group 'jedi) + +(make-obsolete-variable 'jedi:setup-keys nil "0.1.3") +(defcustom jedi:setup-keys nil + "Setup recommended keybinds. + +.. warning:: Use of this value is obsolete now. As of 0.1.3, + jedi.el has default keybinds, which are different than these. See also + `jedi-mode'. + +.. admonition:: Default keybinds + + ```` : = `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' + Show the documentation 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 "") + "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:key-goto-definition-pop-marker (kbd "C-,") + "Keybind for command `jedi:goto-definition-pop-marker'." + :group 'jedi) + +(defcustom jedi:use-shortcuts nil + "If non-`nil', enable the following shortcuts: + +| ``M-.`` `jedi:goto-definition' +| ``M-,`` `jedi:goto-definition-pop-marker' +" + :group 'jedi) + +(defcustom jedi:import-python-el-settings t + "Automatically import setting from python.el variables." + :group 'jedi) + +(defcustom jedi:goto-definition-marker-ring-length 16 + "Length of marker ring to store `jedi:goto-definition' call positions" + :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)) + (when jedi:use-shortcuts + (define-key map (kbd "M-.") 'jedi:goto-definition) + (define-key map (kbd "M-,") 'jedi:goto-definition-pop-marker)) + (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:imenu-create-index-function)) + (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))) + +;; Define keybinds. +;; See: https://github.com/tkf/emacs-jedi/issues/47 +(let ((map jedi-mode-map)) + (define-key map (kbd "") 'jedi:complete) + (define-key map (kbd "C-c ?") 'jedi:show-doc) + (define-key map (kbd "C-c .") 'jedi:goto-definition) + (define-key map (kbd "C-c ,") 'jedi:goto-definition-pop-marker) + (let ((command (cond + ((featurep 'helm) 'helm-jedi-related-names) + ((featurep 'anything) 'anything-jedi-related-names) + ((locate-library "helm") 'helm-jedi-related-names) + ((locate-library "anything") 'anything-jedi-related-names)))) + (when command + (define-key map (kbd "C-c /") command)))) + +(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) + (define-key map jedi:key-goto-definition-pop-marker + 'jedi:goto-definition-pop-marker) + (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))))) + +(defmacro jedi:-with-run-on-error (body &rest run-on-error) + (declare (indent 1)) + `(let ((something-happened t)) + (unwind-protect + (prog1 ,body + (setq something-happened nil)) + (when something-happened + ,@run-on-error)))) + +(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 (jedi:-with-run-on-error + (epc:start-epc server-prog server-args) + (display-warning 'jedi "\ +Failed to start Jedi EPC server. +*** You may need to run \"M-x jedi:install-server\". *** +This could solve the problem especially if you haven't run the command yet +since Jedi.el installation or update and if the server complains about +Python module imports." :error)))) + (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 "/") + (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:-buffer-file-name () + "Return `buffer-file-name' without text properties. +See: https://github.com/tkf/emacs-jedi/issues/54" + (when (stringp buffer-file-name) + (substring-no-properties buffer-file-name))) + +(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 (jedi:-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)) + (ac-start :triggered 'command)))))) +;; Calling `auto-complete' or `ac-update-greedy' instead of `ac-start' +;; here did not work. + +(defun jedi:dot-complete () + "Insert dot and complete code at point." + (interactive) + (insert ".") + (unless (or (ac-cursor-on-diable-face-p) + ;; don't complete if the dot is immediately after int literal + (looking-back "\\(\\`\\|[^._[:alnum:]]\\)[0-9]+\\.")) + (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'. + +If auto-completion is all you need, you can call this function instead +of `jedi:setup', like this:: + + (add-hook 'python-mode-hook 'jedi:ac-setup) + +Note that this function calls `auto-complete-mode' if it is not +already enabled, for people who don't call `global-auto-complete-mode' +in their Emacs configuration." + (interactive) + (add-to-list 'ac-sources 'ac-source-jedi-direct) + (unless auto-complete-mode + (auto-complete-mode))) + + +;;; 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) +(defvar jedi:goto-definition--marker-ring + (make-ring jedi:goto-definition-marker-ring-length) + "Marker ring that stores `jedi:goto-definition' call positions") + +(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-push-marker () + "Push point onto goto-definition marker ring." + (ring-insert jedi:goto-definition--marker-ring (point-marker))) + +(defun jedi:goto-definition-pop-marker () + "Goto the last point where `jedi:goto-definition' was called." + (interactive) + (if (ring-empty-p jedi:goto-definition--marker-ring) + (error "Jedi marker ring is empty, can't pop") + (let ((marker (ring-remove jedi:goto-definition--marker-ring 0))) + (switch-to-buffer (or (marker-buffer marker) + (error "Buffer has been deleted"))) + (goto-char (marker-position marker)) + ;; Cleanup the marker so as to avoid them piling up. + (set-marker marker nil nil)))) + +(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 + (jedi:goto-definition-push-marker) + (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)) + (jedi:-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:defined-names--sync () + (unless jedi:defined-names--cache + (epc:sync (jedi:get-epc) (jedi:defined-names--singleton-deferred))) + jedi:defined-names--cache) + +(defun jedi:after-change-handler (&rest _) + (unless (or (ac-menu-live-p) (ac-inline-live-p)) + (jedi:defined-names--singleton-deferred))) + +(defun jedi:imenu-make-marker (def) + (destructuring-bind (&key line_nr column &allow-other-keys) def + (save-excursion (jedi:goto--line-column line_nr column) + (point-marker)))) + +(defun jedi:create-nested-imenu-index--item (def) + (cons (plist-get def :name) (jedi:imenu-make-marker def))) + +(defun jedi:create-nested-imenu-index () + "`imenu-create-index-function' for Jedi.el. +See also `jedi:imenu-create-index-function'." + (when (called-interactively-p 'interactive) (jedi:defined-names--sync)) + (jedi:create-nested-imenu-index-1)) + +(defun jedi:create-nested-imenu-index-1 (&optional items) + (loop for (def . subdefs) in (or items jedi:defined-names--cache) + if subdefs + collect (append + (list (plist-get def :local_name) + (jedi:create-nested-imenu-index--item def)) + (jedi:create-nested-imenu-index-1 subdefs)) + else + collect (jedi:create-nested-imenu-index--item def))) + +(defun jedi:create-flat-imenu-index () + "`imenu-create-index-function' for Jedi.el to create flatten index. +See also `jedi:imenu-create-index-function'." + (when (called-interactively-p 'interactive) (jedi:defined-names--sync)) + (jedi:create-flat-imenu-index-1)) + +(defun jedi:create-flat-imenu-index-1 (&optional items) + (loop for (def . subdefs) in (or items jedi:defined-names--cache) + collect (cons (plist-get def :local_name) (jedi:imenu-make-marker def)) + when subdefs + append (jedi:create-flat-imenu-index-1 subdefs))) + + +;;; Meta info + +(defun jedi:show-setup-info () + "Show installation and configuration info in a buffer. +Paste the result of this function when asking question or +reporting bug. This command also tries to detect errors when +communicating with Jedi EPC server. If you have some problem you +may find some information about communication error." + (interactive) + (let (epc get-epc-error version-reply) + (condition-case err + (setq epc (jedi:get-epc)) + (error (setq get-epc-error err))) + (when epc + (setq version-reply + (condition-case err + (epc:sync + epc + (deferred:$ + (deferred:timeout 500 + '(:timeout nil) + (epc:call-deferred epc 'get_jedi_version nil)) + (deferred:error it + (lambda (err) `(:error ,err))))) + (error `(:sync-error ,err))))) + (let ((standard-output (get-buffer-create "*jedi:show-setup-info*"))) + (with-current-buffer standard-output + (emacs-lisp-mode) + (erase-buffer) + (insert ";; Emacs Lisp version:\n") + (pp `(:emacs-version ,emacs-version + :jedi-version ,jedi:version + :python-environment-version ,python-environment-version)) + (insert ";; Python version:\n") + (pp version-reply) + (when get-epc-error + (insert "\n;; EPC error:\n") + (pp `(:get-epc-error ,get-epc-error))) + (insert ";; Command line:\n") + (pp `(:virtualenv + ,(executable-find (car python-environment-virtualenv)) + :virtualenv-version + ,(ignore-errors (jedi:-virtualenv-version)))) + (insert ";; Customization:\n") + (pp (jedi:-list-customization)) + (display-buffer standard-output))))) + +(defun jedi:-list-defcustoms () + (loop for sym being the symbols + for name = (symbol-name sym) + when (and (or (string-prefix-p "jedi:" name) + (string-prefix-p "python-environment-" name)) + (custom-variable-p sym)) + collect sym)) + +(defun jedi:-list-customization () + (loop for sym in (sort (jedi:-list-defcustoms) + (lambda (x y) + (string< (symbol-name x) + (symbol-name y)))) + collect (cons sym (symbol-value sym)))) + +(defun jedi:-virtualenv-version () + "Return output of virtualenv --version" + (with-temp-buffer + (erase-buffer) + (call-process (executable-find (car python-environment-virtualenv)) + nil t nil + "--version") + (buffer-string))) + +(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-version-info () + "Show version info of Python modules used by the server. +Paste the result of this function in bug report." + (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 `(:emacs-version ,emacs-version :jedi-version ,jedi:version)) + (pp reply) + (display-buffer standard-output)))))) + +(define-obsolete-function-alias + 'jedi:show-jedi-version 'jedi:show-version-info "0.1.3") + +(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)) + + +;;; Virtualenv setup +(defvar jedi:install-server--command + `("pip" "install" "--upgrade" ,(convert-standard-filename jedi:source-dir))) + +;;;###autoload +(defun jedi:install-server () + "This command installs Jedi server script jediepcserver.py in a +Python environment dedicated to Emacs. By default, the +environment is at ``~/.emacs.d/.python-environments/default/``. +This environment is automatically created by ``virtualenv`` if it +does not exist. + +Run this command (i.e., type ``M-x jedi:install-server RET``) +whenever Jedi.el shows a message to do so. It is a good idea to +run this every time after you update Jedi.el to sync version of +Python modules used by Jedi.el and Jedi.el itself. + +You can modify the location of the environment by changing +`jedi:environment-root' and/or `python-environment-directory'. More +specifically, Jedi.el will install Python modules under the directory +``PYTHON-ENVIRONMENT-DIRECTORY/JEDI:ENVIRONMENT-ROOT``. Note that you +need command line program ``virtualenv``. If you have the command in +an unusual location, use `python-environment-virtualenv' to specify the +location. + +.. NOTE:: jediepcserver.py is installed in a virtual environment but it + does not mean Jedi.el cannot recognize the modules in virtual + environment you are using for your Python development. Jedi + EPC server recognize the virtualenv it is in (i.e., the + environment variable ``VIRTUAL_ENV`` in your Emacs) and then + add modules in that environment to its ``sys.path``. You can + also add ``--virtual-env PATH/TO/ENV`` to `jedi:server-args' + to include modules of virtual environment even you launch + Emacs outside of the virtual environment. + +.. NOTE:: It is highly recommended to use this command to install + Python modules for Jedi.el. You still can install Python + modules used by Jedi.el manually. However, you are then + responsible for keeping Jedi.el and Python modules compatible. + +See also: + +- https://github.com/tkf/emacs-jedi/pull/72 +- https://github.com/tkf/emacs-jedi/issues/140#issuecomment-37358527" + (interactive) + (deferred:$ + (python-environment-run jedi:install-server--command + jedi:environment-root + jedi:environment-virtualenv) + (deferred:watch it + (lambda (_) + (setq-default jedi:server-command (jedi:-env-server-command)))))) + +;;;###autoload +(defun jedi:install-server-block () + "Blocking version `jedi:install-server'." + (prog1 + (python-environment-run-block jedi:install-server--command + jedi:environment-root + jedi:environment-virtualenv) + (setq-default jedi:server-command (jedi:-env-server-command)))) + +(defcustom jedi:install-python-jedi-dev-command + '("pip" "install" "--upgrade" + "git+https://github.com/davidhalter/jedi.git@dev#egg=jedi") + "Pip command to be used for `jedi:install-python-jedi-dev'." + :group 'jedi) + +(defun jedi:install-python-jedi-dev () + "Install developmental version of Python-Jedi from GitHub." + (interactive) + (deferred:$ + (python-environment-run jedi:install-python-jedi-dev-command + jedi:environment-root + jedi:environment-virtualenv) + (deferred:watch it + (lambda (_) + (message "\ +Now restart EPC servers. Then you are ready to go with Jedi-dev!"))))) + + +;;; Debugging + +(defun jedi:pop-to-epc-buffer () + "Open the buffer associated with EPC server process. +Use this command to see the output (e.g., traceback) of the server process." + (interactive) + (pop-to-buffer (process-buffer (epc:manager-server-process jedi:epc)))) + +(defun jedi:toggle-log-traceback () + "Toggle on/off traceback logging for EPC server for the current buffer. +When there is an error during traceback logging is enabled, traceback +is printed in the EPC buffer. You can use `jedi:pop-to-epc-buffer' to +open that buffer. + +You can also pass ``--log-traceback`` option to jediepcserver.py +to start server with traceback logging turned on. This is useful when +there is a problem in communication (thus this command does not work). +You can use `jedi:start-dedicated-server' to restart EPC server for the +current buffer with specific arguments." + (interactive) + (deferred:$ + (epc:call-deferred (jedi:get-epc) 'toggle_log_traceback nil) + (deferred:nextc it + (lambda (flag) + (message "Traceback logging is %s" (if flag "enabled" "disabled")))))) + +(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-command--backup nil + 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 diff --git a/emacs.d/elpa/jedi-20140321.1323/jediepcserver.py b/emacs.d/elpa/jedi-20140321.1323/jediepcserver.py new file mode 100755 index 0000000..69af58f --- /dev/null +++ b/emacs.d/elpa/jedi-20140321.1323/jediepcserver.py @@ -0,0 +1,314 @@ +#!/usr/bin/env python + +""" +Jedi EPC server. + +Copyright (C) 2012 Takafumi Arakaki + +Author: Takafumi Arakaki + +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 . + +""" + +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, parent=None): + """ + Fetch interesting defined names in sub-scopes under `definition`. + + :type names: jedi.api_classes.Definition + + """ + d = definition_to_dict(definition) + try: + d['local_name'] = parent['local_name'] + '.' + d['name'] + except (AttributeError, TypeError): + d['local_name'] = d['name'] + if definition.type == 'class': + ds = definition.defined_names() + return [d] + [get_names_recursively(c, d) for c in 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, + log_traceback=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) + + @server.register_function + def toggle_log_traceback(): + server.log_traceback = not server.log_traceback + return server.log_traceback + + 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() + + # This is not supported Python-EPC API, but I am using this for + # backward compatibility for Python-EPC < 0.0.4. In the future, + # it should be passed to the constructor. + server.log_traceback = bool(log_traceback) + + if log: + 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.api + + +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( + '--log-traceback', action='store_true', default=False, + help='Include traceback in logging output.') + 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() diff --git a/emacs.d/elpa/jedi-20140321.1323/setup.py b/emacs.d/elpa/jedi-20140321.1323/setup.py new file mode 100644 index 0000000..b450558 --- /dev/null +++ b/emacs.d/elpa/jedi-20140321.1323/setup.py @@ -0,0 +1,25 @@ +try: + from setuptools import setup + args = {} +except ImportError: + from distutils.core import setup + args = dict(scripts=['jediepcserver.py']) + print("""\ +*** WARNING: setuptools is not found. Using distutils... +It is highly recommended to install Jedi.el via M-x jedi:install-server. +Note: If you are using Windows, then Jedi.el will not work with distutils. +""") + +setup( + name='jediepcserver', + py_modules=['jediepcserver'], + install_requires=[ + "jedi>=0.7.0", + "epc>=0.0.4", + "argparse", + ], + entry_points={ + 'console_scripts': ['jediepcserver = jediepcserver:main'], + }, + **args +) diff --git a/emacs.d/elpa/python-environment-20140321.1116/python-environment-autoloads.el b/emacs.d/elpa/python-environment-20140321.1116/python-environment-autoloads.el new file mode 100644 index 0000000..8f6c7f5 --- /dev/null +++ b/emacs.d/elpa/python-environment-20140321.1116/python-environment-autoloads.el @@ -0,0 +1,16 @@ +;;; python-environment-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil nil ("python-environment-pkg.el" "python-environment.el" +;;;;;; "test-python-environment.el") (21571 44955 482681 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; python-environment-autoloads.el ends here diff --git a/emacs.d/elpa/python-environment-20140321.1116/python-environment-pkg.el b/emacs.d/elpa/python-environment-20140321.1116/python-environment-pkg.el new file mode 100644 index 0000000..038812f --- /dev/null +++ b/emacs.d/elpa/python-environment-20140321.1116/python-environment-pkg.el @@ -0,0 +1,7 @@ +(define-package "python-environment" "20140321.1116" "virtualenv API for Emacs Lisp" + '((deferred "0.3.1")) + :keywords + '("applications" "tools")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs.d/elpa/python-environment-20140321.1116/python-environment.el b/emacs.d/elpa/python-environment-20140321.1116/python-environment.el new file mode 100644 index 0000000..f2e4afe --- /dev/null +++ b/emacs.d/elpa/python-environment-20140321.1116/python-environment.el @@ -0,0 +1,246 @@ +;;; python-environment.el --- virtualenv API for Emacs Lisp + +;; Copyright (C) 2013 Takafumi Arakaki + +;; Author: Takafumi Arakaki +;; Keywords: applications, tools +;; Version: 0.0.2alpha0 +;; Package-Requires: ((deferred "0.3.1")) + +;; This file is NOT part of GNU Emacs. + +;; python-environment.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. + +;; python-environment.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 python-environment.el. +;; If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'deferred) + +(defconst python-environment-version "0.0.2alpha0") + +(defcustom python-environment-directory + (locate-user-emacs-file ".python-environments") + "Path to directory to store all Python virtual environments. A string. + +If you want to change the location to, say ``~/.python-environments``, +then set it like this in your Emacs setup file:: + + (setq python-environment-directory \"~/.python-environments\")" + :group 'python-environment) + +(defcustom python-environment-default-root-name "default" + "Default Python virtual environment name. A string. + +This is a name of directory relative to `python-environment-directory' +where default virtual environment locates. +Thus, typically the default virtual environment path is +``~/.emacs.d/.python-environments/default``." + :group 'python-environment) + +(defcustom python-environment-virtualenv + (list "virtualenv" "--system-site-packages" "--quiet") + ;; --quiet is required for Windows. Without it, virtualenv raises + ;; UnicodeEncodeError + ;; See: https://github.com/tkf/emacs-jedi/issues/148#issuecomment-38290546 + "``virtualenv`` command to use, including command options. List of strings. + +For example, if you want to use specific Python executable (to +specify Python version), append ``--python`` option like this:: + + (setq python-environment-virtualenv + (append python-environment-virtualenv + '(\"--python\" \"PATH/TO/bin/python\"))) + +I added ``--system-site-packages`` as default, but this is not +mandatory. If you don't like it, removing does not break +anything (well, theoretically). For reason why it is default, +see discussion here: +https://github.com/tkf/emacs-python-environment/issues/3" + :group 'python-environment) + +(defvar python-environment--verbose nil) + +(defun python-environment--deferred-process (msg command) + (message "%s..." msg) + (deferred:$ + (apply #'deferred:process command) + (deferred:watch it + (apply-partially + (lambda (msg output) + (message "%s...Done" msg) + (when python-environment--verbose + (message output))) + msg)))) + +(defun python-environment--blocking-process (msg command) + (message "%s (SYNC)..." msg) + (let (exit-code output) + (with-temp-buffer + (setq exit-code + (apply #'call-process (car command) + nil ; INFILE (no input) + t ; BUFFER (output to this buffer) + nil ; DISPLAY (no refresh is needed) + (cdr command))) + (setq output (buffer-string))) + (when (or python-environment--verbose + (not (= exit-code 0))) + (message output)) + (message "%s (SYNC)...Done" msg) + (unless (= exit-code 0) + (error "Command %S exits with error code %S." command exit-code)))) + + +(defun python-environment-root-path (&optional root) + (expand-file-name (or root python-environment-default-root-name) + python-environment-directory)) + +(defun python-environment--make-with-runner (proc-runner root virtualenv) + (let ((path (convert-standard-filename + (python-environment-root-path root))) + (virtualenv (append (or virtualenv python-environment-virtualenv) + (when python-environment--verbose + (list "--verbose"))))) + (unless (executable-find (car virtualenv)) + (error "Program named %S does not exist." (car virtualenv))) + (funcall proc-runner + (format "Making virtualenv at %s" path) + (append virtualenv (list path))))) + +(defun python-environment-make (&optional root virtualenv) + "Make virtual environment at ROOT asynchronously. + +This function does not wait until ``virtualenv`` finishes. +Instead, it returns a deferred object [#]_. So, if you want to +do some operation after the ``virtualenv`` command finishes, do +something like this:: + + (deferred:$ + (python-environment-make) + (deferred:nextc it (lambda (output) DO-SOMETHING-HERE))) + +If ROOT is specified, it is used instead of +`python-environment-default-root-name'. ROOT can be a relative +path from `python-environment-virtualenv' or an absolute path. + +If VIRTUALENV (list of string) is specified, it is used instead of +`python-environment-virtualenv'. + +.. [#] https://github.com/kiwanami/emacs-deferred" + (python-environment--make-with-runner + #'python-environment--deferred-process + root virtualenv)) + +(defun python-environment-make-block (&optional root virtualenv) + "Blocking version of `python-environment-make'. +I recommend NOT to use this function in interactive commands. +For reason, see `python-environment-run-block'" + (python-environment--make-with-runner + #'python-environment--blocking-process + root virtualenv)) + +(defun python-environment-exists-p (&optional root) + "Return non-`nil' if virtualenv at ROOT exists. +See `python-environment-make' for how ROOT is interpreted." + (let ((bin (python-environment-bin "python" root))) + (and bin (file-exists-p bin)))) + +(defun python-environment--existing (root &rest paths) + (when paths + (let ((full-path (expand-file-name (car paths) + (python-environment-root-path root)))) + (if (file-exists-p full-path) + full-path + (apply #'python-environment--existing root (cdr paths)))))) + +(defun python-environment-bin (path &optional root) + "Return full path to \"ROOT/bin/PATH\" or \"ROOT/Scripts/PATH\" if exists. +``Scripts`` is used instead of ``bin`` in typical Windows case. +In Windows, path with extension \".ext\" may be returned. +See `python-environment-make' for how ROOT is interpreted." + (python-environment--existing root + (concat "bin/" path) + (concat "Scripts/" path) + (concat "Scripts/" path ".exe"))) + +(defun python-environment-lib (path &optional root) + "Return full path to \"ROOT/lib/PATH\" or \"ROOT/Lib/PATH\" if exists. +``Lib`` is used instead of ``lib`` in typical Windows case. +See `python-environment-make' for how ROOT is interpreted." + (python-environment--existing root + (concat "lib/" path) + (concat "Lib/" path))) + +(defun python-environment--run-with-runner (proc-runner command root) + (funcall proc-runner + (format "Running: %s" (mapconcat 'identity command " ")) + (cons (python-environment-bin (car command) root) + (cdr command)))) + +(defun python-environment--run-1 (&optional command root) + (python-environment--run-with-runner + #'python-environment--deferred-process + command root)) + +(defun python-environment--run-block-1 (command root) + (python-environment--run-with-runner + #'python-environment--blocking-process + command root)) + +(defun python-environment-run (command &optional root virtualenv) + "Run COMMAND installed in Python virtualenv located at ROOT +asynchronously. + +Instead of waiting for COMMAND to finish, a deferred object [#]_ +is returned so that you can chain operations. + +See `python-environment-make' for how ROOT and VIRTUALENV are +interpreted and how to work with deferred object. + +Use `python-environment-run-block' if you want to wait until +the command exit (NOT recommended in interactive command). + +.. [#] https://github.com/kiwanami/emacs-deferred" + (if (python-environment-exists-p root) + (python-environment--run-1 command root) + (deferred:$ + (python-environment-make root virtualenv) + (deferred:nextc it + (apply-partially + (lambda (command root _) + (python-environment--run-1 command root)) + command root))))) + +(defun python-environment-run-block (command &optional root virtualenv) + "Blocking version of `python-environment-run'. +I recommend NOT to use this function in interactive commands. +Emacs users have more important things to than waiting for some +command to finish." + (unless (python-environment-exists-p root) + (python-environment-make-block root virtualenv)) + (python-environment--run-block-1 command root)) + +(provide 'python-environment) + +;; Local Variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; python-environment.el ends here diff --git a/emacs.d/elpa/python-environment-20140321.1116/test-python-environment.el b/emacs.d/elpa/python-environment-20140321.1116/test-python-environment.el new file mode 100644 index 0000000..e6638ca --- /dev/null +++ b/emacs.d/elpa/python-environment-20140321.1116/test-python-environment.el @@ -0,0 +1,209 @@ +;;; test-python-environment.el --- Tests for python-environment.el + +;; Copyright (C) 2013 Takafumi Arakaki + +;; Author: Takafumi Arakaki + +;; This file is NOT part of GNU Emacs. + +;; test-python-environment.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-python-environment.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-python-environment.el. +;; If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'python-environment) + +(defmacro pye-test-with-temp-env (&rest body) + (declare (debug (&rest form)) + (indent 0)) + (let ((path (make-symbol "path"))) + `(let* ((,path (make-temp-file "pye-test-" t)) + (python-environment-directory ,path)) + (unwind-protect + (progn ,@body) + (delete-directory ,path t))))) + +(defmacro pye-deftest (name args &rest body) + "Customized `ert-deftest'. Bind `python-environment-directory' to a +temporary directory while executing BODY." + (declare (debug (&define :name test + name sexp [&optional stringp] + [&rest keywordp sexp] def-body)) + (doc-string 3) + (indent 2)) + `(ert-deftest ,name ,args + (pye-test-with-temp-env + ,@body))) + +(defmacro pye-with-mixed-environment (environment &rest body) + "Mix-in ENVIRONMENT to `process-environment' while executing `BODY'. +ENVIRONMENT is a list whose element is arguments (i.e., list) to `setenv'." + (declare (debug (sexp &rest form)) + (indent 1)) + `(let ((process-environment (mapcar #'identity process-environment))) + (mapc (lambda (env) (apply #'setenv env)) ,environment) + ,@body)) + +(defun pye-eval-in-subprocess (sexp &optional environment) + "Evaluate SEXP in Emacs launched as subprocess. Additional environment +variable can be given as ENVIRONMENT (see `pye-with-mixed-environment')." + (let ((default-directory (expand-file-name default-directory))) + ;; Resolution of "~/" will be affected by `environment' if it + ;; includes "$HOME". So expand it before + ;; `pye-with-mixed-environment' to avoid the confusion. + (pye-with-mixed-environment environment + (let ((print-length nil) + (print-level nil)) + (with-temp-buffer + (let ((code (call-process + (concat invocation-directory invocation-name) + nil t nil + "-Q" "--batch" + "--eval" (format "(setq load-path (cons %S '%S))" + default-directory load-path) + "--load" (locate-library "test-python-environment") + "--eval" (format "%S" sexp)))) + (unless (eq code 0) + (error "Subprocess terminated with code %S.\nOutput:\n%s" + code (buffer-string))))))))) + +(defmacro pye-test-with-capture-message (&rest form) + (declare (debug (&rest form)) + (indent 0)) + `(let ((start (make-marker)) + (message-buffer (get-buffer "*Messages*"))) + (with-current-buffer message-buffer + (set-marker start (point-max))) + (progn ,@form) + (with-current-buffer message-buffer + (buffer-substring start (point-max))))) + +(ert-deftest pye-test-test-with-capture-message () + (should (equal (pye-test-with-capture-message + (message "test-1") + (message "test-2")) + "test-1\ntest-2\n"))) + +(defun pye-test-proc-runner-output-message (proc-runner desired-output) + (let* ((command '("echo" "DUMMY-ECHO-MESSAGE")) + (python-environment--verbose t) + (message-output + (pye-test-with-capture-message + (funcall proc-runner "DUMMY-MESSAGE" command)))) + (should (equal message-output desired-output)))) + +(ert-deftest pye-test-deferred-process-output-message () + (pye-test-proc-runner-output-message + (lambda (msg command) + (deferred:sync! (python-environment--deferred-process msg command))) "\ +DUMMY-MESSAGE...Done +DUMMY-ECHO-MESSAGE + +")) + +(ert-deftest pye-test-blocking-process-output-message () + (pye-test-proc-runner-output-message + #'python-environment--blocking-process "\ +DUMMY-MESSAGE (SYNC)... +DUMMY-ECHO-MESSAGE + +DUMMY-MESSAGE (SYNC)...Done +")) + +(defun pye-test-deferred-process-should-error () + (let (err) + (deferred:sync! + (deferred:error + (python-environment--deferred-process + "DUMMY-MESSAGE" + '("false")) + (lambda (got) (setq err got)))) + (should err))) + +(ert-deftest pye-test-deferred-process-error-without-verbose () + (let ((python-environment--verbose nil)) + (pye-test-deferred-process-should-error))) + +(ert-deftest pye-test-deferred-process-noerror-without-verbose () + (let ((python-environment--verbose nil)) + (deferred:sync! + (python-environment--deferred-process "DUMMY-MESSAGE" '("true"))))) + +(ert-deftest pye-test-blocking-process-error-without-verbose () + (let ((python-environment--verbose nil)) + (should-error + (python-environment--blocking-process "DUMMY-MESSAGE" '("false"))))) + +(ert-deftest pye-test-blocking-process-noerror-without-verbose () + (let ((python-environment--verbose nil)) + (python-environment--blocking-process "DUMMY-MESSAGE" '("true")))) + +(ert-deftest pye-test-deferred-process-error-with-verbose () + (let ((python-environment--verbose t)) + (pye-test-deferred-process-should-error))) + +(ert-deftest pye-test-deferred-process-noerror-with-verbose () + (let ((python-environment--verbose t)) + (deferred:sync! + (python-environment--deferred-process "DUMMY-MESSAGE" '("true"))))) + +(ert-deftest pye-test-blocking-process-error-with-verbose () + (let ((python-environment--verbose t)) + (should-error + (python-environment--blocking-process "DUMMY-MESSAGE" '("false"))))) + +(ert-deftest pye-test-blocking-process-noerror-with-verbose () + (let ((python-environment--verbose t)) + (python-environment--blocking-process "DUMMY-MESSAGE" '("true")))) + +(pye-deftest pye-test-make-environment-with-non-existing-command () + (should-error (python-environment-make nil '("non-existing-command")))) + +(pye-deftest pye-test-make-environment () + (deferred:sync! (python-environment-make))) + +(pye-deftest pye-test-run () + (deferred:sync! (python-environment-run '("python" "--version")))) + +(pye-deftest pye-test-run-block () + (python-environment-run-block '("python" "--version"))) + +(pye-deftest pye-test-block-error () + (should-error (python-environment-run-block '("python" "-c" "1/0")))) + +(ert-deftest pye-test-eval-in-subprocess () + (pye-eval-in-subprocess '(+ 1 2)) + (should-error (pye-eval-in-subprocess '(error "some error")))) + +(pye-deftest pye-test-bare-make-environment () + (let ((tmp-home python-environment-directory)) + (pye-eval-in-subprocess '(deferred:sync! (python-environment-make)) + `(("HOME" ,tmp-home))) + (should (file-directory-p (expand-file-name + ".emacs.d/.python-environments/default" + tmp-home))))) + +(provide 'test-python-environment) + +;; Local Variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; test-python-environment.el ends here