[elpa] externals/crdt 605d8fa 07/18: initial experiment of xscheme.el integration

[ELPA Syncer]

branch: externals/crdt
commit 605d8fa10092c39cde2a7b880f168e224de5d1c2
Author: Qiantan Hong <qhong@mit.edu>
Commit: Qiantan Hong <qhong@mit.edu>

    initial experiment of xscheme.el integration
---
 HACKING.org |  59 ++++++++++++++++++++++++++++++++-
 crdt.el     | 108 ++++++++++++++++++++++++++++++++++++++----------------------
 2 files changed, 126 insertions(+), 41 deletions(-)

diff --git a/HACKING.org b/HACKING.org
index f8e5b12..2ed748b 100644
--- a/HACKING.org
+++ b/HACKING.org
@@ -160,7 +160,58 @@ By implementing synchronization primitives for all 
components in a buffer,
 pretty much everything can be made collaborative.
 Synchronize arbitrary buffer-local-variable reasonably is hard, but user 
annotations can help.
 
-** TODO task list
+** How to implement collaboration support to an package
+
+~crdt.el~ provides two sets of facilities for adding collaboration support, a 
command-based one and a state-based one. 
+Package hackers are free to combine them to provide desired behavior.
+
+*** Command-based collaboration
+
+This is a simple method to add collaboration support. 
+After registering a command with =crdt-register-remote-command=, 
+an =:around= advice is added such that when a client invoke this command,
+an request is sent to the server instead of running the command locally.
+
+Hackers must make sure that they declare what sets of buffer state the command 
uses 
+to fully preserve user intent.
+
+Although relatively simple, collaboration command implemented using this method
+must go through a round trip to the server and will incur latency.
+
+**** Why we need used-state-set annotations
+
+Suppose Alyssa P. Hacker does =(crdt-register-remote-command 'eval-last-sexp)=,
+but didn't declare that =eval-last-sexp= uses content of the buffer.
+Now the hackers are conspiring in an ~crdt.el~ session. 
+Ben Bitdiddle places cursor after =(+ 1 1)= and run =eval-last-sexp=.
+However, the moment Ben Bitdiddle's request arrives at the server, 
+Cy D. Fect has changed =(+ 1 1)= to =(+ 1 2)= (their message arrives first!).
+Now the server does what it sees and return =3=, instead of =2=.
+
+The correct solution is to let the server roll-back to the state when Ben 
Bitdiddle invoked the command.
+It is relatively expensive thus we don't want to do this for every command,
+thus we require package hackers to annotate explicitly.
+
+/The above mechanism haven't been implemented yet!/ 
+But adding annotations now will help adding it in the future.
+To implement this mechanism we need to add lamport timestamp to every messages 
+(which may corresponds to mutation of interesting states),
+and send a vector clock in =command= messages which depend on buffer content.
+
+*** State-based collaboration
+
+We can also synchronize the underlying state of the packages 
+rather than proxying user-level commands.
+If there're good CRDT candidates to be used for the state 
+(hackers need to understand what concurrency semantics their state need to 
have!),
+then the commands can have real-time effect without needing to be acknowledged 
from the server.
+
+=crdt-org-sync-overlay-mode= is an example of this approach.
+
+Overall, this method is much more complicated than command-base method. 
+Development of the facility is still on-going.
+
+** TODO Task list for ~crdt.el~ facility
    - [X] synchronize buffer text (insert/delete)
    - [X] synchronize overlays
    - [-] synchronize major/minor modes
@@ -172,6 +223,12 @@ Synchronize arbitrary buffer-local-variable reasonably is 
hard, but user annotat
      + [ ] a library of CRDTs
    - [ ] synchronize text properties (any use case for this?)
    - [ ] synchronize markers (any use case for this?)
+   - [-] remote command
+     + [X] basic remote command (only possibly use =(point)=)
+     + [ ] command that uses region
+     + [ ] correctly handle command that uses buffer content
+     + [ ] handle arbitrary =interactive= form (firstly, what's the right 
thing to do?)
+   - [-] remote buffer process
 
 * TODO Cross-editor support
 
diff --git a/crdt.el b/crdt.el
index ab71a1b..1c0afe5 100644
--- a/crdt.el
+++ b/crdt.el
@@ -1168,9 +1168,9 @@ The symbol CRDT-EVAL is used as an special marker in the 
encoding
 and the behavior is undefined if OBJECT itself contains this symbol."
   (cl-typecase object
     ((or symbol string number character) object)
-    (cons (cons (crdt--ensure-readable (car object)) (crdt--ensure-readable 
(cdr object))))
+    (cons (cons (crdt--readable-encode (car object)) (crdt--readable-encode 
(cdr object))))
     (buffer (list 'crdt-eval 'buffer
-                  (buffer-local-value 'crdt--buffer-network-name buffer)))
+                  (buffer-local-value 'crdt--buffer-network-name object)))
     (t (list 'crdt-eval 'unreadable
              (prin1-to-string object)))))
 
@@ -1225,18 +1225,18 @@ The overlay is FRONT-ADVANCE and REAR-ADVANCE, and lies 
between BEG and END."
   "Generate a challenge string for authentication."
   (apply #'unibyte-string (cl-loop for i below 32 collect (random 256))))
 
-(defsubst crdt--sync-buffer-to-client (buffer process)
+(defsubst crdt--sync-buffer-to-client (buffer)
   "Send messages to a client about the full state of BUFFER.
-The network process for the client connection is PROCESS."
+CRDT--PROCESS should be bound to The network process for the client 
connection."
   (with-current-buffer buffer
     (save-restriction
       (widen)
-      (process-send-string process
+      (process-send-string crdt--process
                            (crdt--format-message
                             `(sync
                               ,crdt--buffer-network-name
                               ,@ (crdt--dump-ids (point-min) (point-max) nil 
nil t))))
-     (process-send-string process (crdt--format-message `(ready 
,crdt--buffer-network-name ,major-mode)))
+     (process-send-string crdt--process (crdt--format-message `(ready 
,crdt--buffer-network-name ,major-mode)))
 
      ;; synchronize cursor
      (maphash (lambda (site-id ov-pair)
@@ -1249,18 +1249,18 @@ The network process for the client connection is 
PROCESS."
                                  region-beg))
                          (point-id-base64 (base64-encode-string (crdt--get-id 
point)))
                          (mark-id-base64 (when mark (base64-encode-string 
(crdt--get-id mark)))))
-                    (process-send-string process
+                    (process-send-string crdt--process
                                          (crdt--format-message
                                           `(cursor ,crdt--buffer-network-name 
,site-id
                                                    ,point ,point-id-base64 
,mark ,mark-id-base64))))))
               crdt--pseudo-cursor-table)
-     (process-send-string process (crdt--format-message (crdt--local-cursor 
nil)))
+     (process-send-string crdt--process (crdt--format-message 
(crdt--local-cursor nil)))
 
      ;; synchronize tracked overlay
      (maphash (lambda (k ov)
                 (let ((meta (overlay-get ov 'crdt-meta)))
                   (process-send-string
-                   process
+                   crdt--process
                    (crdt--format-message (crdt--overlay-add-message
                                           (car k) (cdr k)
                                           (crdt--overlay-metadata-species meta)
@@ -1270,7 +1270,7 @@ The network process for the client connection is PROCESS."
                                           (overlay-end ov))))
                   (cl-loop for (prop value) on (crdt--overlay-metadata-plist 
meta) by #'cddr
                         do (process-send-string
-                            process
+                            crdt--process
                             (crdt--format-message `(overlay-put 
,crdt--buffer-network-name
                                                                 ,(car k) ,(cdr 
k) ,prop ,value))))))
               crdt--overlay-table)
@@ -1279,53 +1279,52 @@ The network process for the client connection is 
PROCESS."
      (let ((buffer-process (get-buffer-process buffer)))
        (when buffer-process
          (let ((mark-pos (marker-position (process-mark buffer-process))))
-           (process-send-string process
+           (process-send-string crdt--process
                                 (crdt--format-message
                                  `(process-mark ,crdt--buffer-network-name
                                                 ,(crdt--get-id mark-pos) 
,mark-pos)))))))))
 
-(defun crdt--greet-client (process)
+(defun crdt--greet-client ()
   "Send initial information when a client connects.
 Those information include the assigned SITE-ID, buffer list,
 and contact data of other users.
-The network process for the client connection is PROCESS."
-  (let ((crdt--session (process-get process 'crdt-session)))
-    (cl-pushnew process (crdt--session-network-clients crdt--session))
-    (let ((client-id (process-get process 'client-id)))
+CRDT--PROCESS should be bound to The network process for the client 
connection."
+  (let ((crdt--session (process-get crdt--process 'crdt-session)))
+    (cl-pushnew crdt--process (crdt--session-network-clients crdt--session))
+    (let ((client-id (process-get crdt--process 'client-id)))
       (unless client-id
         (unless (< (crdt--session-next-client-id crdt--session) 
crdt--max-value)
           (error "Used up client IDs.  Need to implement allocation 
algorithm"))
-        (process-put process 'client-id (crdt--session-next-client-id 
crdt--session))
+        (process-put crdt--process 'client-id (crdt--session-next-client-id 
crdt--session))
         (setq client-id (crdt--session-next-client-id crdt--session))
-        (process-send-string process (crdt--format-message
+        (process-send-string crdt--process (crdt--format-message
                                       `(login ,client-id
                                               ,(crdt--session-name 
crdt--session))))
         (cl-incf (crdt--session-next-client-id crdt--session)))
-      (process-send-string process (crdt--format-message
+      (process-send-string crdt--process (crdt--format-message
                                     (cons 'add (hash-table-keys 
(crdt--session-buffer-table crdt--session)))))
       ;; synchronize contact
       (maphash (lambda (k v)
-                 (process-send-string process
+                 (process-send-string crdt--process
                                       (crdt--format-message
                                        `(contact ,k 
,(crdt--contact-metadata-display-name v)
                                                  ,(crdt--contact-metadata-host 
v)
                                                  
,(crdt--contact-metadata-service v))))
-                 (process-send-string process
+                 (process-send-string crdt--process
                                       (crdt--format-message
                                        `(focus ,k 
,(crdt--contact-metadata-focused-buffer-name v)))))
                (crdt--session-contact-table crdt--session))
-      (process-send-string process
+      (process-send-string crdt--process
                            (crdt--format-message
                             `(contact ,(crdt--session-local-id crdt--session)
                                       ,(crdt--session-local-name 
crdt--session))))
-      (process-send-string process
+      (process-send-string crdt--process
                            (crdt--format-message
                             `(focus ,(crdt--session-local-id crdt--session)
                                     ,(crdt--session-focused-buffer-name 
crdt--session))))
-      (let ((contact-message `(contact ,client-id ,(process-get process 
'client-name)
-                                       ,(process-contact process :host)
-                                       ,(process-contact process :service)))
-            (crdt--process process))
+      (let ((contact-message `(contact ,client-id ,(process-get crdt--process 
'client-name)
+                                       ,(process-contact crdt--process :host)
+                                       ,(process-contact crdt--process 
:service))))
         (crdt-process-message-1 contact-message)))))
 
 (cl-defgeneric crdt-process-message (message string) "Handle MESSAGE read from 
STRING.
@@ -1368,7 +1367,7 @@ when we need to broadcast it.")
   (cl-destructuring-bind (buffer-name) (cdr message)
     (let ((buffer (gethash buffer-name (crdt--session-buffer-table 
crdt--session))))
       (if (and buffer (buffer-live-p buffer))
-          (crdt--sync-buffer-to-client buffer crdt--process)
+          (crdt--sync-buffer-to-client buffer)
         (process-send-string crdt--process (crdt--format-message `(remove 
,buffer-name)))))))
 
 (cl-defmethod crdt-process-message ((message (head sync)) _string)
@@ -1501,7 +1500,7 @@ Handle received STRING from PROCESS."
       (insert string)
       (set-marker (process-mark process) (point))
       (goto-char (point-min))
-      (let (message string start)
+      (let (message string start (crdt--process process))
         (while (setq start (point)
                      message (ignore-errors (read (current-buffer))))
           (when crdt--log-network-traffic
@@ -1509,8 +1508,7 @@ Handle received STRING from PROCESS."
           (setq string (buffer-substring-no-properties start (point)))
           (condition-case err
               (if (or (not (crdt--server-p)) (process-get process 
'authenticated))
-                  (let ((crdt--inhibit-update t)
-                        (crdt--process process))
+                  (let ((crdt--inhibit-update t))
                     (crdt-process-message message string))
                 (cl-block nil
                   (when (eq (car message) 'hello)
@@ -1519,7 +1517,7 @@ Handle received STRING from PROCESS."
                                 (and response (string-equal response 
(process-get process 'challenge))))
                         (process-put process 'authenticated t)
                         (process-put process 'client-name name)
-                        (crdt--greet-client process)
+                        (crdt--greet-client)
                         (cl-return))))
                   (let ((challenge (crdt--generate-challenge)))
                     (process-put process 'challenge
@@ -1961,7 +1959,7 @@ Join with DISPLAY-NAME."
                                      (crdt--base64-encode-maybe (crdt--get-id 
(1- end))))))))))))
   (apply orig-fun ov beg end args))
 
-(cl-defmethod crdt-process-message ((message (head overlay-move)) _process)
+(cl-defmethod crdt-process-message ((message (head overlay-move)) string)
   (cl-destructuring-bind (buffer-name site-id logical-clock
                                       start-hint start-id-base64 end-hint 
end-id-base64)
       (cdr message)
@@ -2070,15 +2068,17 @@ Join with DISPLAY-NAME."
     (crdt--with-buffer-name buffer-name
       (save-excursion
         (goto-char (overlay-start (car (gethash site-id 
crdt--pseudo-cursor-table))))
-        (let ((return-message
-               (if (get command-symbol 'crdt-allow-remote-call)
-                   (condition-case err
-                       (list t (apply command-symbol (mapcar 
#'crdt--readable-decode args)))
-                     (error (list nil (car err) (crdt--readable-encode (cdr 
err)))))
-                 (list nil 'crdt-access-denied))))
+        (let* ((crdt--inhibit-update nil)
+               (return-message
+                (if (get command-symbol 'crdt-allow-remote-call)
+                    (condition-case err
+                        (list t
+                              (apply command-symbol (mapcar 
#'crdt--readable-decode args)))
+                      (error (list nil (car err) (crdt--readable-encode (cdr 
err)))))
+                  (list nil 'crdt-access-denied))))
           (process-send-string crdt--process (crdt--format-message `(return 
,site-id ,logical-clock ,@return-message))))))))
 
-(cl-defmethod crdt-process-message ((message (head return)) _string)
+(cl-defmethod crdt-process-message ((_message (head return)) _string)
   nil)
 
 (defun crdt-make-remote-command-advice (function-symbol)
@@ -2100,6 +2100,34 @@ Join with DISPLAY-NAME."
   (cl-remprop command-symbol 'crdt-allow-remote-call)
   (advice-remove command-symbol 'crdt-remote-command-advice))
 
+(defun crdt-register-remote-commands (command-entries)
+  (dolist (entry command-entries)
+    (apply #'crdt-register-remote-command entry)))
+
+(defun crdt-unregister-remote-commands (command-entries)
+  (dolist (entry command-entries)
+    (crdt-unregister-remote-command (car entry))))
+
+;;; Built-in package integrations
+
+;; xscheme.el
+(defvar xscheme-crdt-command-entries
+  '(;; (xscheme-send-region)
+    (xscheme-send-definition)
+    (xscheme-send-previous-expression)
+    (xscheme-send-next-expression)
+    (xscheme-send-current-line)
+    (xscheme-send-buffer)
+    (xscheme-send-char)
+    (xscheme-delete-output)
+    (xscheme-send-breakpoint-interrupt)
+    (xscheme-send-proceed)
+    (xscheme-send-control-g-interrupt)
+    (xscheme-send-control-u-interrupt)
+    (xscheme-send-control-x-interrupt)
+    (scheme-debugger-self-insert)))
+(crdt-register-remote-commands xscheme-crdt-command-entries)
+
 ;;; pseudo process
 
 (cl-defstruct (crdt--pseudo-process (:constructor crdt--make-pseudo-process))