[elpa] externals/crdt 432b5f8 04/80: two bug fixes for CRDT algorithm

[ELPA Syncer]

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

    two bug fixes for CRDT algorithm
---
 crdt.el | 73 ++++++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 38 insertions(+), 35 deletions(-)

diff --git a/crdt.el b/crdt.el
index 3f34480..761c676 100644
--- a/crdt.el
+++ b/crdt.el
@@ -27,7 +27,7 @@
 ;;   Text-based version
 ;;   (it should be easy to migrate to a binary version.  Using text for better 
debugging for now)
 ;;   Every message takes the form (type . body)
-;;   type can be: insert hello cursor challenge sync
+;;   type can be: insert delete cursor hello challenge sync
 ;;   - insert
 ;;     body takes the form (crdt-id position-hint content)
 ;;     - position-hint is the buffer position where the operation happens at 
the site
@@ -125,8 +125,8 @@
 ;; For base IDs, last two bytes are always representing site ID
 ;; Stored strings are BASE-ID:OFFSETs. So the last two bytes represent offset,
 ;; and second last two bytes represent site ID
-(defconst crdt--max-value (lsh 1 16))
-;; (defconst crdt--max-value 16)
+;; (defconst crdt--max-value (lsh 1 16))
+(defconst crdt--max-value 16)
 ;; for debug
 (defconst crdt--low-byte-mask 255)
 (defsubst crdt--get-two-bytes (string index)
@@ -354,6 +354,7 @@ Returns a list of (insert type) messages to be sent."
                (push `(insert ,(base64-encode-string virtual-id) ,beg
                               ,(buffer-substring-no-properties beg merge-end))
                      resulting-commands))
+             (cl-incf left-offset (- merge-end beg))
              (setq beg merge-end)))))
      (while (< beg end)
        (let ((block-end (min end (+ crdt--max-value beg))))
@@ -424,15 +425,15 @@ Returns a list of (insert type) messages to be sent."
   (let ((outer-end end))
     (crdt--with-insertion-information
      (beg 0 nil crdt--changed-string nil (length crdt--changed-string))
-     (if (crdt--split-maybe)
-         (let* ((not-end (< outer-end (point-max)))
-                (ending-id (when not-end (crdt--get-starting-id outer-end))))
-           (when (and not-end (eq starting-id (crdt--get-starting-id 
outer-end)))
-             (crdt--set-id outer-end (crdt--id-replace-offset starting-id (+ 1 
left-offset (length crdt--changed-string))))
-             t))
-       (crdt--with-insertion-information
-        ((length crdt--changed-string) outer-end crdt--changed-string nil 0 
nil)
-        (crdt--split-maybe)))))
+     (when (crdt--split-maybe)
+       (let* ((not-end (< outer-end (point-max)))
+              (ending-id (when not-end (crdt--get-starting-id outer-end))))
+         (when (and not-end (eq starting-id (crdt--get-starting-id outer-end)))
+           (crdt--set-id outer-end (crdt--id-replace-offset starting-id (+ 1 
left-offset (length crdt--changed-string))))))
+       ))
+    (crdt--with-insertion-information
+     ((length crdt--changed-string) outer-end crdt--changed-string nil 0 nil)
+     (crdt--split-maybe)))
   ;; (crdt--verify-buffer)
   `(delete ,beg ,@ (crdt--dump-ids 0 (length crdt--changed-string) 
crdt--changed-string t)))
 (defun crdt--remote-delete (position-hint id-pairs)
@@ -450,9 +451,10 @@ Returns a list of (insert type) messages to be sent."
              (setq length 0))
             ((-1)
              (let* ((starting-id (crdt--get-starting-id (point)))
+                    (eob (crdt--end-of-block-p (point)))
                     (left-offset (crdt--get-id-offset starting-id (point))))
                (delete-char length)
-               (crdt--set-id (point) (crdt--id-replace-offset starting-id (+ 
left-offset length))))
+               (crdt--set-id (point) (crdt--id-replace-offset starting-id (+ 
left-offset length)) eob))
              (setq length 0)))))
       ;; (crdt--verify-buffer)
       )))
@@ -490,26 +492,27 @@ Returns a list of (insert type) messages to be sent."
       (1- (crdt--find-id id hint))
     (point-max)))
 (defun crdt--remote-cursor (site-id point-position-hint point-crdt-id 
mark-position-hint mark-crdt-id)
-  (let ((ov-pair (gethash site-id crdt--overlay-table)))
-    (if point-crdt-id
-        (let* ((point (crdt--id-to-pos point-crdt-id point-position-hint))
-               (mark (if mark-crdt-id
-                         (crdt--id-to-pos mark-crdt-id mark-position-hint)
-                       point)))
-          (unless ov-pair
-            (let ((new-cursor (make-overlay 1 1))
-                  (new-region (make-overlay 1 1)))
-              (overlay-put new-cursor 'face `(:background 
,(crdt--get-cursor-color site-id)))
-              (overlay-put new-cursor 'category 'crdt-pseudo-cursor)
-              (overlay-put new-region 'face `(:background 
,(crdt--get-region-color site-id) :extend t))
-              (setq ov-pair (puthash site-id (cons new-cursor new-region)
-                                     crdt--overlay-table))))
-          (crdt--move-cursor (car ov-pair) point)
-          (crdt--move-region (cdr ov-pair) point mark))
-      (when ov-pair
-        (remhash site-id crdt--overlay-table)
-        (delete-overlay (car ov-pair))
-        (delete-overlay (cdr ov-pair))))))
+  (when site-id
+    (let ((ov-pair (gethash site-id crdt--overlay-table)))
+      (if point-crdt-id
+          (let* ((point (crdt--id-to-pos point-crdt-id point-position-hint))
+                 (mark (if mark-crdt-id
+                           (crdt--id-to-pos mark-crdt-id mark-position-hint)
+                         point)))
+            (unless ov-pair
+              (let ((new-cursor (make-overlay 1 1))
+                    (new-region (make-overlay 1 1)))
+                (overlay-put new-cursor 'face `(:background 
,(crdt--get-cursor-color site-id)))
+                (overlay-put new-cursor 'category 'crdt-pseudo-cursor)
+                (overlay-put new-region 'face `(:background 
,(crdt--get-region-color site-id) :extend t))
+                (setq ov-pair (puthash site-id (cons new-cursor new-region)
+                                       crdt--overlay-table))))
+            (crdt--move-cursor (car ov-pair) point)
+            (crdt--move-region (cdr ov-pair) point mark))
+        (when ov-pair
+          (remhash site-id crdt--overlay-table)
+          (delete-overlay (car ov-pair))
+          (delete-overlay (cdr ov-pair)))))))
 
 (cl-defun crdt--local-cursor (&optional (lazy t))
   (let ((point (point))
@@ -585,7 +588,7 @@ If CRDT--NETWORK-PROCESS is a server process, broadcast 
MESSAGE-STRING
 to clients except the one of which CLIENT-ID property is EQ to WITHOUT.
 If CRDT--NETWORK-PROCESS is a server process, send MESSAGE-STRING
 to server unless WITHOUT is NIL."
-  ;; (message message-string)
+  ;; (message "Send %s" message-string)
   (if (process-contact crdt--network-process :server)
       (dolist (client crdt--network-clients)
         (when (and (eq (process-status client) 'open)
@@ -705,7 +708,7 @@ to server unless WITHOUT is NIL."
         (goto-char (point-min))
         (let (message)
           (while (setq message (ignore-errors (read (current-buffer))))
-            (print message)
+            ;; (print message)
             (with-current-buffer (process-get process 'crdt-buffer)
               (save-excursion
                 (widen)