[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/crdt 8996748: Squashed commit of the following:
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/crdt 8996748: Squashed commit of the following: |
|
Date: |
Sat, 25 Sep 2021 21:57:07 -0400 (EDT) |
branch: externals/crdt
commit 899674890b763a078ffeb0acc73c4bd5c7ad3479
Author: Qiantan Hong <qhong@mit.edu>
Commit: Qiantan Hong <qhong@mit.edu>
Squashed commit of the following:
commit 4b86674f99675ba9ea75f0674ee15690276bb698
Author: Qiantan Hong <qhong@mit.edu>
Date: Sat Sep 25 11:48:43 2021 -0700
more sensible version message
commit 270a4099bba87036da8ebe6d400baa101e9224a2
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 23:17:15 2021 -0700
return -> cl-return
commit 709059ff5e0846f2c8f44b479e6083c6d0128dc8
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 22:54:09 2021 -0700
fix disconnect warn condition
commit 102498e84f928ec9041682d832f6b42091417a98
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 22:51:48 2021 -0700
remove tramp for now, keep it simple
commit 94b0c488b5c56c6544d722e1dec49737cd9f01df
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 21:07:13 2021 -0700
bump version number
commit fae016ba25b9118eed12183a4e705a2b938b9e5a
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 21:06:19 2021 -0700
Preliminary url support
commit 38fdfc55575f906fcf1f0a8eb9180bce2cd79d17
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 20:18:57 2021 -0700
semver, and various fixes
commit 97427622b1c351aaac02c03fba7330dce294fd4c
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 16:29:12 2021 -0700
fix bug in crdt--stop-session interactive spec
commit d46be72920ffe9c33ac941e4023fadaa4c399b75
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 16:26:44 2021 -0700
remove base64 mangling and fix a stupid bug
IDK why base64 was there.
stupid bug: typo overlay-mode should be overlay-move
commit 1347c678c3a05ce649a659d9237ffe5c05819583
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 15:19:50 2021 -0700
Use some warning instead of message
commit 5d90bf0ce2c74a6a548465d275df70b409258a46
Author: Qiantan Hong <qhong@mit.edu>
Date: Fri Sep 24 12:33:42 2021 -0700
generate uninteresting process buffers instead
---
HACKING.org | 2 +-
crdt.el | 186 +++++++++++++++++++++++++++++++++---------------------------
2 files changed, 104 insertions(+), 84 deletions(-)
diff --git a/HACKING.org b/HACKING.org
index 9bcd78a..af7c203 100644
--- a/HACKING.org
+++ b/HACKING.org
@@ -56,7 +56,7 @@ and second last two bytes represent site ID.
- 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 3ad436c..eb13295 100644
--- a/crdt.el
+++ b/crdt.el
@@ -6,7 +6,7 @@
;; Maintainer: Qiantan Hong <qhong@alum.mit.edu>
;; URL: https://code.librehq.com/qhong/crdt.el
;; Keywords: collaboration crdt
-;; Version: 0.2.4
+;; Version: 0.2.5
;; This file is part of GNU Emacs.
@@ -35,6 +35,14 @@
(require 'url)
(require 'color)
+(defconst crdt-version "0.2.5")
+(defconst crdt-protocol-version "0.2.5")
+
+(defun crdt-version ()
+ "Show the crdt.el version."
+ (interactive)
+ (message "crdt.el version %s" crdt-version))
+
(defgroup crdt nil
"Collaborative editing using Conflict-free Replicated Data Types."
:prefix "crdt-"
@@ -48,6 +56,10 @@
"Default display name."
:type 'string)
+(defcustom crdt-default-session-name (format "%s_session" (user-login-name))
+ "Default session name."
+ :type 'string)
+
(defcustom crdt-ask-for-password t
"Ask for server password everytime a CRDT server is to be started."
:type 'boolean)
@@ -111,8 +123,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
@@ -486,16 +497,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.
@@ -543,7 +551,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 (generate-new-buffer (format "%s<%s>" ,name
(crdt--session-name crdt--session))))
(puthash ,name crdt-buffer (crdt--session-buffer-table crdt--session))
(let ((session crdt--session))
(with-current-buffer crdt-buffer
@@ -927,10 +935,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.
@@ -974,7 +978,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
- ,(base64-encode-string virtual-id) ,beg
+ ,virtual-id ,beg
,(crdt--buffer-substring beg merge-end))
resulting-commands))
(cl-incf left-offset (- merge-end beg))
@@ -987,7 +991,7 @@ Returns a list of (insert type) messages to be sent."
(crdt--session-local-id
crdt--session))))
(put-text-property beg block-end 'crdt-id (cons new-id t))
(push `(insert ,crdt--buffer-network-name
- ,(base64-encode-string new-id) ,beg
+ ,new-id ,beg
,(crdt--buffer-substring beg block-end))
resulting-commands)
(setq beg block-end)
@@ -1253,10 +1257,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.
@@ -1280,8 +1282,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))
@@ -1296,8 +1298,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))
@@ -1307,9 +1308,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.
@@ -1435,11 +1435,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."
@@ -1466,13 +1466,12 @@ CRDT--PROCESS should be bound to The network process
for the client connection."
(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)))))
+ region-beg)))
(process-send-string crdt--process
(crdt--format-message
`(cursor ,crdt--buffer-network-name
,site-id
- ,point ,point-id-base64
,mark ,mark-id-base64))))))
+ ,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)))
@@ -1544,24 +1543,22 @@ CRDT--PROCESS should be bound to The network process
for the client connection."
(define-crdt-message-handler insert (buffer-name crdt-id position-hint content)
(crdt--with-buffer-name buffer-name
(crdt--with-recover
- (crdt--remote-insert (base64-decode-string crdt-id) position-hint
content)))
+ (crdt--remote-insert crdt-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 site-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 site-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 site-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)
@@ -1605,9 +1602,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)
@@ -1625,8 +1632,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
@@ -1653,7 +1666,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 (site-id display-name &optional host
service)
@@ -1690,7 +1703,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)
@@ -1715,7 +1728,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)
@@ -1727,7 +1744,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)
@@ -1808,7 +1825,12 @@ of the current buffer."
(when (and crdt-mode crdt--session)
(error "Current buffer is already shared in a CRDT session"))
(list (let* ((session-names (crdt--get-session-names t))
- (default-name (concat crdt-default-name ":" (buffer-name
(current-buffer))))
+ (default-name (if (member crdt-default-session-name
session-names)
+ (cl-loop for i from 1
+ for name = (concat
crdt-default-session-name "_" (number-to-string i))
+ unless (member name session-names)
+ do (cl-return name))
+ crdt-default-session-name))
(session-name (if session-names
(completing-read "Choose a server session
(create if not exist): "
session-names)
@@ -1886,7 +1908,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))
@@ -1919,26 +1941,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 this-command '(crdt-disconnect crdt-stop-session
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
@@ -1960,7 +1978,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)
@@ -1989,7 +2007,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
@@ -2005,8 +2023,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")
@@ -2099,12 +2119,12 @@ Join with DISPLAY-NAME."
(define-crdt-message-handler overlay-add
(buffer-name site-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 site-id logical-clock))
@@ -2128,16 +2148,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-mode
+(define-crdt-message-handler overlay-move
(buffer-name site-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 site-id logical-clock))
@@ -2146,8 +2166,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))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/crdt 8996748: Squashed commit of the following:,
ELPA Syncer <=