emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/crdt b421e4e679 10/44: Merge branch 'fix' into developm


From: ELPA Syncer
Subject: [elpa] externals/crdt b421e4e679 10/44: Merge branch 'fix' into development
Date: Sat, 2 Jul 2022 22:57:32 -0400 (EDT)

branch: externals/crdt
commit b421e4e679740f85d7a6497c5f57a9ba315001c6
Merge: 1dfa6f7c30 94b0c488b5
Author: Qiantan Hong <qhong@mit.edu>
Commit: Qiantan Hong <qhong@mit.edu>

    Merge branch 'fix' into development
---
 HACKING.org |   2 +-
 crdt.el     | 281 ++++++++++++++++++++++++++++++++++--------------------------
 2 files changed, 162 insertions(+), 121 deletions(-)

diff --git a/HACKING.org b/HACKING.org
index 4d55d201c5..4f19ff9ed0 100644
--- a/HACKING.org
+++ b/HACKING.org
@@ -72,7 +72,7 @@ Every message takes the form =(type . body)=
   - Login
     + hello ::
       This message is sent from client to server, when a client connect to the 
server.
-      body takes the form =(client-name &optional response)=
+      body takes the form =(client-name protocol-version &optional response)=
 
     + leave ::
       This message is sometime sent from client to server to indicate 
disconnection, 
diff --git a/crdt.el b/crdt.el
index 2a4a8e2df1..5e91c9a3fb 100644
--- a/crdt.el
+++ b/crdt.el
@@ -35,6 +35,15 @@
 (require 'url)
 (require 'color)
 (require 'forms)
+(require 'tramp)
+
+(defconst crdt-version "0.3.0")
+(defconst crdt-protocol-version "0.3.0")
+
+(defun crdt-version ()
+  "Show the crdt.el version."
+  (interactive)
+  (message crdt-version))
 
 (defgroup crdt nil
   "Collaborative editing using Conflict-free Replicated Data Types."
@@ -104,8 +113,7 @@
   "Move pseudo marked region overlay OV to mark between POS and MARK."
   (move-overlay ov (min pos mark) (max pos mark)))
 
-
-;; CRDT ID utils
+;;; CRDT ID utils
 ;; CRDT IDs are represented by unibyte strings (for efficient comparison)
 ;; Every two bytes represent a big endian encoded integer
 ;; For base IDs, last two bytes are always representing site ID
@@ -484,16 +492,13 @@ NAME is included in the report."
   `(condition-case err
        (progn ,@ body)
      (error
-      (ding)
-      (message "Error happens inside %s. This should never happen, please file 
a report to crdt.el maintainers." ',name)
-      (message " Error: %s" err)
+      (warn "CRDT mode exited in buffer %s because of error %s inside %s."
+            (current-buffer) err ',name)
       (if (crdt--server-p)
-          (progn
-            (message "Stop sharing the buffer because of error.")
-            (crdt-stop-share-buffer))
-        (progn
-          (message "Killing the buffer because of error.")
-          (kill-buffer))))))
+          (crdt-stop-share-buffer)
+        (remhash crdt--buffer-network-name (crdt--session-buffer-table 
crdt--session))
+        (crdt--refresh-buffers-maybe)
+        (crdt-mode -1)))))
 
 (defun crdt--recover (&optional err)
   "Try to recover from a synchronization failure.
@@ -541,7 +546,7 @@ after synchronization is completed."
          (with-current-buffer crdt-buffer
            ,@body)
        (unless (process-contact (crdt--session-network-process crdt--session) 
:server)
-         (setq crdt-buffer (generate-new-buffer (format "crdt - %s" ,name)))
+         (setq crdt-buffer (create-file-buffer (concat (crdt--tramp-prefix 
crdt--session) ,name)))
          (puthash ,name crdt-buffer (crdt--session-buffer-table crdt--session))
          (let ((session crdt--session))
            (with-current-buffer crdt-buffer
@@ -923,10 +928,6 @@ It informs other peers that the buffer is killed."
 
 ;;; CRDT insert/delete
 
-(defsubst crdt--base64-encode-maybe (str)
-  "Base64 encode STR if it's a string, or return NIL if STR is NIL."
-  (when str (base64-encode-string str)))
-
 (defsubst crdt--text-property-assimilate
     (template template-beg template-end beg prop &optional object)
   "Make PROP after BEG in OBJECT the same as part of TEMPLATE.
@@ -962,7 +963,7 @@ Returns a list of (insert type) messages to be sent."
       (crdt--with-insertion-information (beg end)
         (unless (crdt--split-maybe)
          (when (and not-begin
-                     (eq (crdt--id-site starting-id) crdt--site-id)
+                     (eq (crdt--id-site starting-id) (crdt--session-local-id 
crdt--session))
                      (crdt--end-of-block-p left-pos))
             ;; merge crdt id block
             (let* ((max-offset crdt--max-value)
@@ -972,7 +973,7 @@ Returns a list of (insert type) messages to be sent."
                 (let ((virtual-id (substring starting-id)))
                  (crdt--set-id-offset virtual-id (1+ left-offset))
                  (push `(insert ,crdt--buffer-network-name ,user-id
-                                 ,(base64-encode-string virtual-id) ,beg
+                                 ,virtual-id ,beg
                                  ,(crdt--buffer-substring beg merge-end))
                         resulting-commands))
                 (cl-incf left-offset (- merge-end beg))
@@ -982,10 +983,10 @@ Returns a list of (insert type) messages to be sent."
             (let* ((ending-id (if not-end (crdt--get-starting-id end) ""))
                    (new-id (crdt--generate-id starting-id left-offset
                                               ending-id (if not-end 
(crdt--id-offset ending-id) 0)
-                                              crdt--site-id)))
+                                              (crdt--session-local-id 
crdt--session))))
               (put-text-property beg block-end 'crdt-id (cons new-id t))
               (push `(insert ,crdt--buffer-network-name ,user-id
-                             ,(base64-encode-string new-id) ,beg
+                             ,new-id ,beg
                              ,(crdt--buffer-substring beg block-end))
                     resulting-commands)
               (setq beg block-end)
@@ -1252,10 +1253,8 @@ Always return a message otherwise."
       (setq crdt--last-mark mark)
       (save-restriction
         (widen)
-        (let ((point-id-base64 (base64-encode-string (crdt--get-id point)))
-              (mark-id-base64 (when mark (base64-encode-string (crdt--get-id 
mark)))))
-          `(cursor ,crdt--buffer-network-name ,(crdt--session-local-id 
crdt--session)
-                   ,point ,point-id-base64 ,mark ,mark-id-base64))))))
+        `(cursor ,crdt--buffer-network-name ,(crdt--session-local-id 
crdt--session)
+                 ,point ,(crdt--get-id point) ,mark ,(when mark (crdt--get-id 
mark)))))))
 
 (defun crdt--post-command ()
   "Post command hook used by CRDT-MODE.
@@ -1279,8 +1278,8 @@ Send message to other peers about any changes."
 
 (defun crdt--dump-ids (beg end object &optional omit-end-of-block-p 
include-content)
   "Serialize all CRDT IDs in OBJECT from BEG to END into a list.
-The list contains CONSes of the form (LENGTH CRDT-ID-BASE64 END-OF-BLOCK-P),
-or (LENGTH CRDT-ID-BASE64) if OMIT-END-OF-BLOCK-P is non-NIL,
+The list contains CONSes of the form (LENGTH CRDT-ID END-OF-BLOCK-P),
+or (LENGTH CRDT-ID) if OMIT-END-OF-BLOCK-P is non-NIL,
 in the order that they appears in the document.
 If INCLUDE-CONTENT is non-NIL, the list contains STRING instead of LENGTH."
   (let (ids (pos end))
@@ -1295,8 +1294,7 @@ If INCLUDE-CONTENT is non-NIL, the list contains STRING 
instead of LENGTH."
                                 (t (substring object prev-pos pos)))
                         (- pos prev-pos))
                       (cl-destructuring-bind (id . eob) 
(crdt--get-crdt-id-pair prev-pos object)
-                        (let ((id-base64 (base64-encode-string id)))
-                          (if omit-end-of-block-p (list id-base64) (list 
id-base64 eob)))))
+                        (if omit-end-of-block-p (list id) (list id eob))))
                 ids))
         (setq pos prev-pos)))
     ids))
@@ -1306,9 +1304,8 @@ If INCLUDE-CONTENT is non-NIL, the list contains STRING 
instead of LENGTH."
 into current buffer."
   (goto-char (point-min))
   (dolist (id-item ids)
-    (cl-destructuring-bind (content id-base64 eob) id-item
-      (insert (propertize content 'crdt-id
-                          (cons (base64-decode-string id-base64) eob))))))
+    (cl-destructuring-bind (content id eob) id-item
+      (insert (propertize content 'crdt-id (cons id eob))))))
 
 (defun crdt--verify-buffer ()
   "Debug helper function.
@@ -1434,11 +1431,11 @@ The overlay is FRONT-ADVANCE and REAR-ADVANCE, and lies 
between BEG and END."
   `(overlay-add ,crdt--buffer-network-name ,id ,clock
                 ,species ,front-advance ,rear-advance
                 ,beg ,(if front-advance
-                          (base64-encode-string (crdt--get-id beg))
-                        (crdt--base64-encode-maybe (crdt--get-id (1- beg))))
+                          (crdt--get-id beg)
+                        (crdt--get-id (1- beg)))
                 ,end ,(if rear-advance
-                          (base64-encode-string (crdt--get-id end))
-                        (crdt--base64-encode-maybe (crdt--get-id (1- end))))))
+                          (crdt--get-id end)
+                        (crdt--get-id (1- end)))))
 
 (defsubst crdt--generate-challenge ()
   "Generate a challenge string for authentication."
@@ -1455,47 +1452,46 @@ CRDT--PROCESS should be bound to the network process 
for the client connection."
                             `(sync
                               ,crdt--buffer-network-name
                               ,@ (crdt--dump-ids (point-min) (point-max) nil 
nil t))))
-     (process-send-string crdt--process (crdt--format-message `(ready 
,crdt--buffer-network-name ,major-mode)))
-
-     ;; synchronize cursor
-     (maphash (lambda (user-id ov-pair)
-                (cl-destructuring-bind (cursor-ov . region-ov) ov-pair
-                  (let* ((point (overlay-start cursor-ov))
-                         (region-beg (overlay-start region-ov))
-                         (region-end (overlay-end region-ov))
-                         (mark (if (eq point region-beg)
-                                   (unless (eq point region-end) region-end)
-                                 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 crdt--process
-                                         (crdt--format-message
-                                          `(cursor ,crdt--buffer-network-name 
,user-id
-                                                   ,point ,point-id-base64 
,mark ,mark-id-base64))))))
-              crdt--pseudo-cursor-table)
-     (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
-                   crdt--process
-                   (crdt--format-message (crdt--overlay-add-message
-                                          (car k) (cdr k)
-                                          (crdt--overlay-metadata-species meta)
-                                          
(crdt--overlay-metadata-front-advance meta)
-                                          (crdt--overlay-metadata-rear-advance 
meta)
-                                          (overlay-start ov)
-                                          (overlay-end ov))))
-                  (cl-loop for (prop value) on (crdt--overlay-metadata-plist 
meta) by #'cddr
-                        do (process-send-string
-                            crdt--process
-                            (crdt--format-message `(overlay-put 
,crdt--buffer-network-name
-                                                                ,(car k) ,(cdr 
k) ,prop ,value))))))
-              crdt--overlay-table)
-
-     (crdt--send-process-mark-maybe nil)
-     (crdt--send-variables-maybe nil))))
+      (process-send-string crdt--process (crdt--format-message `(ready 
,crdt--buffer-network-name ,major-mode)))
+
+      ;; synchronize cursor
+      (maphash (lambda (user-id ov-pair)
+                 (cl-destructuring-bind (cursor-ov . region-ov) ov-pair
+                   (let* ((point (overlay-start cursor-ov))
+                          (region-beg (overlay-start region-ov))
+                          (region-end (overlay-end region-ov))
+                          (mark (if (eq point region-beg)
+                                    (unless (eq point region-end) region-end)
+                                  region-beg)))
+                     (process-send-string crdt--process
+                                          (crdt--format-message
+                                           `(cursor ,crdt--buffer-network-name 
,user-id
+                                                    ,point ,(crdt--get-id 
point)
+                                                    ,mark ,(crdt--get-id 
mark)))))))
+               crdt--pseudo-cursor-table)
+      (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
+                    crdt--process
+                    (crdt--format-message (crdt--overlay-add-message
+                                           (car k) (cdr k)
+                                           (crdt--overlay-metadata-species 
meta)
+                                           
(crdt--overlay-metadata-front-advance meta)
+                                           
(crdt--overlay-metadata-rear-advance meta)
+                                           (overlay-start ov)
+                                           (overlay-end ov))))
+                   (cl-loop for (prop value) on (crdt--overlay-metadata-plist 
meta) by #'cddr
+                         do (process-send-string
+                             crdt--process
+                             (crdt--format-message `(overlay-put 
,crdt--buffer-network-name
+                                                                 ,(car k) 
,(cdr k) ,prop ,value))))))
+               crdt--overlay-table)
+
+      (crdt--send-process-mark-maybe nil)
+      (crdt--send-variables-maybe nil))))
 
 (defun crdt--greet-client ()
   "Send initial information when a client connects.
@@ -1543,24 +1539,22 @@ CRDT--PROCESS should be bound to The network process 
for the client connection."
 (define-crdt-message-handler insert (buffer-name user-id crdt-id position-hint 
content)
   (crdt--with-buffer-name buffer-name
     (crdt--with-recover
-        (crdt--remote-insert (base64-decode-string crdt-id) user-id 
position-hint content)))
+        (crdt--remote-insert crdt-id user-id position-hint content)))
   (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
 
-(define-crdt-message-handler delete (buffer-name position-hint . 
id-base64-pairs)
-  (mapc (lambda (p) (rplaca (cdr p) (base64-decode-string (cadr p)))) 
id-base64-pairs)
+(define-crdt-message-handler delete (buffer-name position-hint . id-pairs)
+  (mapc (lambda (p) (rplaca (cdr p) (cadr p))) id-pairs)
   (crdt--with-buffer-name buffer-name
     (crdt--with-recover
-        (crdt--remote-delete position-hint id-base64-pairs)))
+        (crdt--remote-delete position-hint id-pairs)))
   (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
 
 (define-crdt-message-handler cursor
     (buffer-name user-id point-position-hint point-crdt-id mark-position-hint 
mark-crdt-id)
   (crdt--with-buffer-name buffer-name
     (crdt--with-recover
-        (crdt--remote-cursor user-id point-position-hint
-                             (and point-crdt-id (base64-decode-string 
point-crdt-id))
-                             mark-position-hint
-                             (and mark-crdt-id (base64-decode-string 
mark-crdt-id)))))
+        (crdt--remote-cursor user-id point-position-hint point-crdt-id
+                             mark-position-hint mark-crdt-id)))
   (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
 
 (define-crdt-message-handler get (buffer-name)
@@ -1604,9 +1598,19 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
 
 (define-crdt-message-handler error (buffer-name &rest err)
   (unless (crdt--server-p)
-    (crdt--with-buffer-name buffer-name
-      (message "Server side error %s." err)
-      (crdt--recover))))
+    (if buffer-name
+        (crdt--with-buffer-name buffer-name
+          (message "Server side error %s." err)
+          (crdt--recover))
+      (cl-block nil
+        (message "Server side error %s." err)
+        (when (eq (car err) 'version)
+          (if (version< crdt-protocol-version (cadr err))
+              (warn "Server uses newer crdt.el protocol (%s>%s). Please update 
your crdt.el to connect."
+                    (cadr err) crdt-protocol-version)
+            (warn "Server uses older crdt.el protocol (%s<%s). Please ask to 
update server."
+                  (cadr err) crdt-protocol-version)))
+        (crdt-disconnect)))))
 
 (define-crdt-message-handler add (&rest buffer-names)
   (dolist (buffer-name buffer-names)
@@ -1624,8 +1628,14 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
             (with-current-buffer buffer
               (crdt-mode 0)
               (setq crdt--session nil))))))
-   (message "Server stopped sharing %s."
-            (mapconcat #'identity buffer-names ", "))
+    (let ((notify-names
+           (cl-remove-if-not
+            (lambda (buffer-name)
+              (gethash buffer-name (crdt--session-buffer-table crdt--session)))
+            buffer-names)))
+      (when notify-names
+        (warn "Server stopped sharing %s."
+              (mapconcat #'identity buffer-names ", "))))
    (let ((crdt--session saved-session))
      (crdt--broadcast-maybe crdt--message-string
                             (when crdt--process
@@ -1652,7 +1662,7 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
                              (process-contact (crdt--session-network-process 
crdt--session) :host)
                              (process-contact (crdt--session-network-process 
crdt--session) :service)))))
       (crdt--broadcast-maybe (crdt--format-message
-                              `(hello ,(crdt--session-local-name crdt--session)
+                              `(hello ,(crdt--session-local-name 
crdt--session) ,crdt-protocol-version
                                       ,(gnutls-hash-mac 'SHA1 password 
hash)))))))
 
 (define-crdt-message-handler contact (user-id display-name &optional host 
service)
@@ -1689,7 +1699,7 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
 Handle received STRING from PROCESS."
   (unless (and (process-buffer process)
                (buffer-live-p (process-buffer process)))
-    (set-process-buffer process (generate-new-buffer "*crdt-server*"))
+    (set-process-buffer process (generate-new-buffer " *crdt-server*"))
     (with-current-buffer (process-buffer process)
       (set-marker (process-mark process) 1)))
   (with-current-buffer (process-buffer process)
@@ -1714,7 +1724,11 @@ Handle received STRING from PROCESS."
                     (crdt-process-message message string))
                 (cl-block nil
                   (when (eq (car message) 'hello)
-                    (cl-destructuring-bind (name &optional response) (cdr 
message)
+                    (cl-destructuring-bind (name protocol-version &optional 
response) (cdr message)
+                      (when (version< protocol-version crdt-protocol-version)
+                        (process-send-string process
+                                             (crdt--format-message `(error nil 
version ,crdt-protocol-version)))
+                        (cl-return))
                       (when (or (not (process-get process 'password)) ; server 
password is empty
                                 (and response (string-equal response 
(process-get process 'challenge))))
                         (process-put process 'authenticated t)
@@ -1726,7 +1740,7 @@ Handle received STRING from PROCESS."
                                  (gnutls-hash-mac 'SHA1 (substring 
(process-get process 'password)) challenge))
                     (process-send-string process (crdt--format-message 
`(challenge ,challenge))))))
             ((crdt-unrecognized-message invalid-read-syntax)
-             (message "%s error when processing message %s from %s:%s, 
disconnecting." err message
+             (warn "%s error when processing message %s from %s:%s, 
disconnecting." err message
                       (process-contact process :host) (process-contact process 
:service))
              (if (crdt--server-p)
                  (delete-process process)
@@ -1934,7 +1948,7 @@ of the current buffer."
          (apply #'crdt-new-session
                 (crdt--read-settings
                  (format "*Settings for %s*" session-name)
-                 `(("Port: " "6530" ,(crdt--settings-make-ensure-type 
'numberp))
+                 `(("Port: " (number-to-string port) 
,(crdt--settings-make-ensure-type 'numberp))
                    ("Session Name: " ,session-name 
,(crdt--settings-make-ensure-nonempty session-name))
                    ("Password: " "")
                    ("Display Name: " ,crdt-default-name)
@@ -2001,7 +2015,7 @@ Setup up the server with PASSWORD and assign this Emacs 
DISPLAY-NAME."
 
 (defun crdt--stop-session (session)
   "Kill the CRDT SESSION."
-  (interactive (crdt--read-session-maybe 'server))
+  (interactive (list (crdt--read-session-maybe 'server)))
   (when (if (and crdt-confirm-disconnect
                  (crdt--server-p session)
                  (crdt--session-network-clients session))
@@ -2034,26 +2048,22 @@ Setup up the server with PASSWORD and assign this Emacs 
DISPLAY-NAME."
         (kill-buffer process-buffer))
       (when (and proxy-process (process-live-p proxy-process))
         (interrupt-process proxy-process)))
-    (message "Disconnected.")))
+    (unless (memq last-command '(crdt-disconnect crdt-stop-session))
+      (warn "CRDT session %s disconnected." (crdt--session-name session)))))
 
 (defun crdt-stop-session (&optional session)
   "Stop sharing the SESSION.
 If SESSION is nil, stop sharing the current session."
   (interactive
    (list (crdt--read-session-maybe 'server)))
-  (crdt--stop-session session))
+  (crdt--stop-session (or session crdt--session)))
 
-(defun crdt-copy-url (&optional session-name)
-  "Copy the url for the session with SESSION-NAME.
+(defun crdt-copy-url (&optional session)
+  "Copy the url for the SESSION.
 Currently this only work if a tuntox proxy is used."
   (interactive
-   (list (completing-read "Choose a server session: "
-                          (crdt--get-session-names t) nil t
-                          (when (and crdt--session (crdt--server-p))
-                            (crdt--session-name crdt--session)))))
-  (let* ((session (if session-name
-                     (crdt--get-session session-name)
-                    crdt--session))
+   (list (crdt--read-session-maybe 'server)))
+  (let* ((session (or session crdt--session))
          (network-process (crdt--session-network-process session))
          (tuntox-process (process-get network-process 'tuntox-process)))
     (if tuntox-process
@@ -2075,7 +2085,7 @@ Currently this only work if a tuntox proxy is used."
 If SESSION is nil, disconnect from the current session."
   (interactive
    (list (crdt--read-session-maybe 'client)))
-  (crdt--stop-session session))
+  (crdt--stop-session (or session crdt--session)))
 
 (defvar crdt-connect-url-history nil)
 
@@ -2107,7 +2117,7 @@ Join with DISPLAY-NAME."
     (cl-macrolet ((start-session (&body body)
                     `(let* ((network-process (make-network-process
                                               :name "CRDT Client"
-                                              :buffer (generate-new-buffer 
"*crdt-client*")
+                                              :buffer (generate-new-buffer " 
*crdt-client*")
                                               :host address
                                               :service port
                                               :filter #'crdt--network-filter
@@ -2123,8 +2133,10 @@ Join with DISPLAY-NAME."
                       (process-put network-process 'crdt-session new-session)
                       (push new-session crdt--session-list)
                       ,@body
-                      (process-send-string network-process
-                       (crdt--format-message `(hello 
,(crdt--session-local-name new-session))))
+                      (process-send-string
+                       network-process
+                       (crdt--format-message
+                        `(hello ,(crdt--session-local-name new-session) 
,crdt-protocol-version)))
                       (let ((crdt--session new-session))
                         (crdt-list-buffers)))))
       (cond ((equal url-type "tcp")
@@ -2217,12 +2229,12 @@ Join with DISPLAY-NAME."
 
 (define-crdt-message-handler overlay-add
     (buffer-name user-id logical-clock species
-               front-advance rear-advance start-hint start-id-base64 end-hint 
end-id-base64)
+                 front-advance rear-advance start-hint start-id end-hint 
end-id)
   (crdt--with-buffer-name buffer-name
     (crdt--with-recover
         (let* ((crdt--track-overlay-species nil)
-               (start (crdt--find-id (base64-decode-string start-id-base64) 
start-hint front-advance))
-               (end (crdt--find-id (base64-decode-string end-id-base64) 
end-hint rear-advance))
+               (start (crdt--find-id start-id start-hint front-advance))
+               (end (crdt--find-id end-id end-hint rear-advance))
                (new-overlay
                 (make-overlay start end nil front-advance rear-advance))
                (key (cons user-id logical-clock))
@@ -2246,16 +2258,16 @@ Join with DISPLAY-NAME."
              (crdt--format-message
               `(overlay-move ,crdt--buffer-network-name ,(car key) ,(cdr key)
                              ,beg ,(if front-advance
-                                       (base64-encode-string (crdt--get-id 
beg))
-                                     (crdt--base64-encode-maybe (crdt--get-id 
(1- beg))))
+                                       (crdt--get-id beg)
+                                     (crdt--get-id (1- beg)))
                              ,end ,(if rear-advance
-                                       (base64-encode-string (crdt--get-id 
end))
-                                     (crdt--base64-encode-maybe (crdt--get-id 
(1- end))))))))))))
+                                       (crdt--get-id end)
+                                     (crdt--get-id (1- end)))))))))))
   (apply orig-fun ov beg end args))
 
 (define-crdt-message-handler overlay-move
     (buffer-name user-id logical-clock
-                 start-hint start-id-base64 end-hint end-id-base64)
+                 start-hint start-id end-hint end-id)
   (crdt--with-buffer-name buffer-name
     (crdt--with-recover
         (let* ((key (cons user-id logical-clock))
@@ -2264,8 +2276,8 @@ Join with DISPLAY-NAME."
             (let* ((meta (overlay-get ov 'crdt-meta))
                    (front-advance (crdt--overlay-metadata-front-advance meta))
                    (rear-advance (crdt--overlay-metadata-rear-advance meta))
-                   (start (crdt--find-id (base64-decode-string 
start-id-base64) start-hint front-advance))
-                   (end (crdt--find-id (base64-decode-string end-id-base64) 
end-hint rear-advance)))
+                   (start (crdt--find-id start-id start-hint front-advance))
+                   (end (crdt--find-id end-id end-hint rear-advance)))
               (let ((crdt--inhibit-overlay-advices t))
                 (move-overlay ov start end)))))))
   (crdt--broadcast-maybe crdt--message-string nil))
@@ -2794,6 +2806,35 @@ Use CRDT--UNINSTALL-PROCESS-ADVICES to disable those 
advices for the rescue."
   (crdt--with-buffer-name buffer-name
     (process-send-string (get-buffer-process (current-buffer)) string)))
 
+;;; URL and TRAMP
+
+(defsubst tramp-crdt-file-name-p (filename)
+  "Check if it's a FILENAME for crdt.el."
+  (and (tramp-tramp-file-p filename)
+       (string= (tramp-file-name-method (tramp-dissect-file-name filename)) 
"crdt")))
+
+(defconst tramp-crdt-file-name-handler-alist '()
+  "Alist of handler functions for Tramp crdt.el method.
+Operations not mentioned here will be handled by the default Emacs 
primitives.")
+
+(defun tramp-crdt-file-name-handler (operation &rest args)
+  "Invoke the crdt.el handler for OPERATION and ARGS.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+  (if-let ((fn (assoc operation tramp-crdt-file-name-handler-alist)))
+      (save-match-data (apply (cdr fn) args))
+    (tramp-run-real-handler operation args)))
+
+(tramp-register-foreign-file-name-handler #'tramp-crdt-file-name-p 
#'tramp-crdt-file-name-handler)
+(add-to-list 'tramp-methods '("crdt"))
+
+(defun crdt--tramp-prefix (session)
+  "Compute TRAMP filename prefix for SESSION."
+  (let ((contact (process-contact (crdt--session-network-process session))))
+    (let ((ipv6-p (string-match-p ":" (car contact)))) ;; poor man's ipv6 test
+      (concat "/crdt:" (when ipv6-p "[") (car contact) (when ipv6-p "]")
+              (if (= (cadr contact) 6530) nil (format "#%s" (cdr contact))) 
":/"))))
+
 ;;; Built-in package integrations
 
 ;;;; Org



reply via email to

[Prev in Thread] Current Thread [Next in Thread]