diff --git a/matrix-api-r0.3.0.el b/matrix-api-r0.3.0.el index 5d8c1d7..43c0d78 100644 --- a/matrix-api-r0.3.0.el +++ b/matrix-api-r0.3.0.el @@ -1,3 +1,6 @@ +;; -*- lexical-binding: t; -*- + + ;; Here is a playground for implementing the latest version of the ;; API, r0.3.0. Confusingly, "v1" of the API is older and more ;; primitive than "r0". Apparently the API was not considered @@ -28,15 +31,24 @@ ;; Local (require 'matrix-macros) +(require 'matrix-helpers) ;;;; Variables +(defvar matrix-log nil + "Enable logging to `matrix-log-buffer'. +NOTE: This can log sensitive data, such as passwords and access +tokens. Logs should be sanitized before sharing.") + (defvar matrix-log-buffer "*matrix-log*" "Name of buffer used by `matrix-log'.") (defvar matrix-synchronous nil "When non-nil, run `matrix-request' requests synchronously.") +(defvar matrix-warn-unimplemented nil + "Give warnings for unimplemented event handlers.") + ;;;; Macros (defmacro matrix-defclass (name superclasses slots &rest options-and-doc) @@ -58,14 +70,15 @@ method)." ;; Add nil initforms (cl-loop for (slot . attrs) in slots unless (plist-get attrs :initform) + ;; FIXME: Doesn't work if there are no attrs at all. do (nconc attrs (list :initform nil))) `(progn (defclass ,name ,superclasses ,slots ,@options-and-doc) (when (> (length ',slot-inits) 0) (cl-defmethod initialize-instance :after ((this ,name) &rest _) - ,docstring - (with-slots ,slot-names this - ,@slot-inits)))))) + ,docstring + (with-slots ,slot-names this + ,@slot-inits)))))) (cl-defmacro matrix-defcallback (name type docstring &key slots body) "Define callback function NAME on TYPE with DOCSTRING and BODY. @@ -76,43 +89,66 @@ TYPE without any `matrix-' prefix. The method's name will be automatically with `with-slots'. Keyword arguments DATA, ERROR-THROWN, SYMBOL-STATUS, and RESPONSE are defined automatically, and other keys are allowed." - (declare (indent defun)) + (declare (indent defun) (debug (symbolp symbolp stringp ":slots" form ":body" form))) (let ((name (intern (concat "matrix-" (symbol-name name) "-callback"))) (instance (intern (nth 1 (s-match (rx "matrix-" (group (1+ anything))) (symbol-name type)))))) - `(cl-defmethod ,name ((,instance ,type) &key data error-thrown symbol-status response + `(cl-defmethod ,name ((,instance ,type) &key cbargs status headers data + error url query ; Used primarily for error handling &allow-other-keys) + ,docstring (with-slots ,slots ,instance ,body)))) +;;;; Functions + +(defun funcall-when (fn &rest args) + "If FN is a function, return result of applying ARGS to it, otherwise nil." + (let ((fn (intern-soft fn))) + (when (functionp fn) + (apply fn args)))) + +(defmacro apply-if-fn (fn-name args else) + "If FN-NAME is a function, return result of applying ARGS to it, otherwise eval ELSE form. +FN-NAME should be a string, and is available in the ELSE form as `fn-name'." + (declare (debug (form listp form))) + ;; FIXME: Probably use with-gensyms* here. + `(let ((fn-name ,fn-name) + (fn (intern-soft ,fn-name))) + (if (functionp fn) + (apply fn ,args) + ,else))) +(put 'apply-if-fn 'lisp-indent-function 2) + ;;;; Classes (matrix-defclass matrix-session () ((user :initarg :user :type string + :instance-initform (progn + (unless (s-starts-with? "@" user) + ;; Prepend "@" + (setq user (concat "@" user))) + (unless (string-match-p ":" user) + ;; Server not given: assume matrix.org + (setq user (concat user ":matrix.org")) + (message "Assuming server is matrix.org")) + user) :documentation "The fully qualified user ID, e.g. @user:matrix.org.") (server :initarg :server - :instance-initform (nth 2 (s-match (rx "@" (group (1+ (not (any ":")))) - ":" (group (1+ anything))) - user)) - :type string - :documentation "FQDN of server, e.g. \"matrix.org\" for the official homeserver. Derived automatically from USER.") + :instance-initform (or server + (nth 2 (s-match (rx "@" (group (1+ (not (any ":")))) + ":" (group (1+ anything))) + user))) + :documentation "FQDN of server, e.g. \"matrix.org\" for the official homeserver. Derived automatically from USER when not explicitly set.") (api-url-prefix :type string :instance-initform (concat "https://" server "/_matrix/client/r0/") :documentation "URL prefix for API requests. Derived automatically from server-name and built-in API version.") (device-id :initarg :device-id - ;; FIXME: Does the initform work for this? When this - ;; file gets byte-compiled, does it get hard-coded in - ;; the class definition? Does this need to be in an - ;; instance-initform instead? :initform (md5 (concat "matrix-client.el" (system-name))) :documentation "ID of the client device.") (initial-device-display-name :initarg :initial-device-display-name - ;; FIXME: Does the initform work for this? When this - ;; file gets byte-compiled, does it get hard-coded in - ;; the class definition? Does this need to be in an - ;; instance-initform instead? :initform (concat "matrix-client.el @ " (system-name)) :type string :documentation "A display name to assign to the newly-created device. Ignored if device_id corresponds to a known device.") @@ -120,8 +156,26 @@ automatically, and other keys are allowed." :documentation "API access_token.") (txn-id :initarg :txn-id :initform 0 + ;; Initialize to a random number. This may avoid a potential problem like: + + ;; 1. User connects. + ;; 2. User sends one message with txn-id 0. + ;; 3. Client crashes (Emacs is killed, whatever), txn-id is not saved to disk. + ;; 4. User restarts Emacs and connects. + ;; 5. User sends another message with txn-id 0. + + ;; If this happens within 30 minutes (see links below), I guess it's possible that the + ;; server would reject it as a duplicate txn. + :instance-initform (random 100000) :type integer - :documentation "Transaction ID. Defaults to 0 and should be automatically incremented for each request.") + ;; NOTE: According to , the + ;; transaction ID should be scoped to the access token, so we should preserve it with the + ;; token. However, if the client crashes and fails to save the TID, and then reuses it + ;; in the future...what happens? The server seems to accept messages with already-used + ;; TIDs. Maybe it has some kind of heuristic... I found these: + ;; and + ;; . + :documentation "Transaction ID. Defaults to 0 and should be automatically incremented for each request. According to the API, the scope of the transaction ID is an access token, so this should be preserved with the access token.") (rooms :initarg :rooms :type list :documentation "List of room objects user has joined.") @@ -131,7 +185,22 @@ automatically, and other keys are allowed." :type hash-table :documentation "Hash table of user IDs whose presence this user wants to follow.") (next-batch :type string - :documentation "The batch token to supply in the since param of the next /sync request.")) + :documentation "The batch token to supply in the since param of the next /sync request.") + ;; FIXME: After fixing bug in macro, let this be simply (initial-sync-p) + (initial-sync-p :initarg :initial-sync-p) + (sync-retry-delay :initform 0 + :initarg :sync-retry-delay + :type integer + :documentation "When a /sync request fails, wait this long before syncing again. +The sync error handler should increase this for consecutive errors, up to a maximum, and the success handler should reset it to 0.") + (disconnect :initform nil + :documentation "Set to non-nil to cancel further /sync requests.") + (pending-syncs :initarg :pending-syncs + :type list + :initform nil + :documentation "List of response buffers for pending /sync requests. This should generally be a list of zero or one buffers. This is used to cancel pending /sync requests when the user disconnects.") + (extra :initarg :extra + :documentation "Reserved for users of the library, who may store whatever they want here.")) :allow-nil-initform t) ;;;;; Room @@ -142,47 +211,87 @@ automatically, and other keys are allowed." (id :documentation "Fully-qualified room ID." :initarg :id :type string) + (avatar :initarg :avatar + :documentation "A string containing the room avatar image in its text properties.") + (typers :initarg :typers) + (name :initarg :name + :type string) + (topic :initarg :topic + :type string) + (aliases :initarg :aliases) (members :documentation "List of room members, as user objects." :type list) (state :documentation "Updates to the state, between the time indicated by the since parameter, and the start of the timeline (or all state up to the start of the timeline, if since is not given, or full_state is true).") + (state-new :documentation "List of new state events. Clients should clear this list by calling `matrix-clear-state'.") (timeline :documentation "List of timeline events." :type list) + (timeline-new :documentation "List of new timeline events. Clients may clear this list by calling `matrix-clear-timeline'." + :type list) + (timeline-event-ids :documentation "Hash table of event IDs already stored in the timeline. Used for deduplication." + :initform (ht)) (prev-batch :documentation "A token that can be supplied to to the from parameter of the rooms/{roomId}/messages endpoint.") (last-full-sync :documentation "The oldest \"since\" token for which the room has been synced completely.") (ephemeral :documentation "The ephemeral events in the room that aren't recorded in the timeline or state of the room. e.g. typing.") (account-data :documentation "The private data that this user has attached to this room.") - (unread-notifications :documentation "Counts of unread notifications for this room.")) + (unread-notifications :documentation "Counts of unread notifications for this room.") + (hook :initarg :hook + :documentation "List of functions called when room is updated. Function is called with one argument, this room object.") + (end-token :initarg :end-token + :initform nil + :documentation "The most recent event-id in a room, used to push read-receipts to the server.") + (extra :initarg :extra + ;; FIXME: Need clean way to do this. + :initform (matrix-room-extra) + :documentation "Reserved for users of the library, who may store whatever they want here.")) :allow-nil-initform t) +(cl-defmethod matrix-user-displayname ((room matrix-room) user-id) + "Return display name for USER-ID in ROOM." + (pcase-let* (((eieio members) room) + (displayname (a-get* members user-id 'displayname))) + (or displayname user-id))) + ;;;; Functions -(defun matrix-log (message &rest args) +(defun matrix-log (&rest args) "Log MESSAGE with ARGS to Matrix log buffer and return non-nil. MESSAGE and ARGS should be a string and list of strings for `format'." - (with-current-buffer (get-buffer-create matrix-log-buffer) - (insert (apply #'format message args) "\n") - ;; Returning t is more convenient than nil, which is returned by `message'. - t)) - -(defun matrix-warn (message &rest args) - "Log MESSAGE with ARGS to Matrix log buffer and signal warning with same MESSAGE. -MESSAGE and ARGS should be a string and list of strings for -`format'." - (apply #'matrix-log message args) - (apply #'warn message args)) + (when matrix-log + (when (stringp (car args)) + (setq args (a-list 'message args))) + (map-put args 'timestamp (format-time-string "%Y-%m-%d %H:%M:%S")) + (with-current-buffer (get-buffer-create matrix-log-buffer) + (save-excursion + (goto-char (point-max)) + (insert (pp-to-string args) "\n")))) + ;; Returning t is more convenient than nil, which is returned by `message'. + t) + +(defun matrix-error (&rest args) + "Log ARGS to Matrix log buffer and signal error." + ;; FIXME: Improve this and the docstring. + (apply #'matrix-log args) + (display-warning 'matrix-client (pp-to-string args) :error)) + +(defun matrix-unimplemented (&rest args) + (when matrix-warn-unimplemented + (apply #'matrix-log args))) (defun matrix-get (&rest args) "Call `matrix-request' with ARGS for a \"GET\" request." + (declare (indent defun)) (apply #'matrix-request args )) (defun matrix-post (&rest args) "Call `matrix-request' with ARGS for a \"POST\" request." + (declare (indent defun)) (nconc args (list :method 'post)) (apply #'matrix-request args)) (defun matrix-put (&rest args) "Call `matrix-request' with ARGS for a \"PUT\" request." + (declare (indent defun)) (nconc args (list :method 'put)) (apply #'matrix-request args)) @@ -190,86 +299,174 @@ MESSAGE and ARGS should be a string and list of strings for ;;;;; Request -(cl-defmethod matrix-request ((session matrix-session) endpoint data callback - &optional &key (method 'get) (error-callback #'matrix-request-error-callback) - complete-callback timeout) +(cl-defmethod matrix-request ((session matrix-session) endpoint &key data success + raw-data (content-type "application/json") + (method "GET") (error #'matrix-request-error-callback) timeout + (query-on-exit t)) "Make request to ENDPOINT on SESSION with DATA and call CALLBACK on success. -Request is made asynchronously. METHOD should be a symbol, -`get' (the default) or `post'. ENDPOINT may be a string or -symbol and should represent the final part of the API +Request is made asynchronously. METHOD should be a symbol or +string, `get' (the default) or `post' (it will be upcased). ENDPOINT may be a string +or symbol and should represent the final part of the API URL (e.g. for \"/_matrix/client/r0/login\", it should be \"login\". DATA should be an alist which will be automatically encoded to JSON. CALLBACK should be a method specialized on -`matrix-session', whose subsequent arguments are defined in +`matrix-session', FIXME whose subsequent arguments are defined in accordance with the `request' package's API. ERROR-CALLBACK, if set, will be called if the request fails." - - ;; TODO: Add general completion callback that retries requests if they timeout. e.g. if a - ;; message-send request times out, we should retry it at least once, and then give an error. - ;; We should check the API docs to see if there's a recommended timeout value for requests - ;; like that. - - ;; TODO: Use request's :status-code argument to handle error responses more precisely. - - (with-slots (api-url-prefix access-token) session + (declare (indent defun)) + (with-slots (api-url-prefix access-token txn-id) session + (let* ((url (url-encode-url + ;; MAYBE: Come up with a nicer way to use alternate API URL prefixes. + (if (and (stringp endpoint) + (s-prefix? "http" endpoint)) + endpoint + (concat api-url-prefix (cl-typecase endpoint + (string endpoint) + (symbol (symbol-name endpoint))))))) + ;; FIXME: Maybe don't send/increment txn-id for every + ;; request, but only those that require it. But it's + ;; simpler to do it here, because we can't forget. + ;; (data (map-put data 'txn-id (incf txn-id))) + (data (map-filter + ;; Remove keys with null values + ;; TODO: Benchmark this against cl-loop. + (lambda (k v) + v) + data)) + (success (cl-typecase success + ;; If success is a symbol, apply session to + ;; it. If it's an already-partially-applied + ;; function, use it as-is. + ;; FIXME: Add to docstring. + (symbol (apply-partially success session)) + (t success))) + (error (cl-typecase error + ;; If error is a symbol, apply session to + ;; it. If it's an already-partially-applied + ;; function, use it as-is. + ;; FIXME: Add to docstring. + (symbol (apply-partially error session)) + (t error))) + (method (upcase (cl-typecase method + (string method) + (symbol (symbol-name method)))))) + ;; NOTE: This can log sensitive data in the `data' var, e.g. passwords and access tokens + (matrix-log (a-list 'event 'matrix-request + 'url url + 'method method + 'data data + 'timeout timeout)) + (pcase method + ("GET" (matrix-url-with-retrieve-async url + :query-on-exit query-on-exit + :silent t + :inhibit-cookies t + :extra-headers (a-list "Authorization" (concat "Bearer " access-token)) + :query data + :parser #'json-read + :success success + :error error + :timeout timeout)) + ((or "POST" "PUT") (matrix-url-with-retrieve-async url + :query-on-exit query-on-exit + :silent t + :inhibit-cookies t + :method method + :extra-headers (a-list "Content-Type" content-type + "Authorization" (concat "Bearer " access-token)) + :data (or raw-data (json-encode data)) + :parser #'json-read + :success success + :error error + :timeout timeout)))))) + +(cl-defmethod matrix-request-request ((session matrix-session) endpoint &key data success + raw-data (content-type "application/json") + (method "GET") (error #'matrix-request-error-callback) timeout + (query-on-exit t)) + "Using `request', make request to ENDPOINT on SESSION with DATA and call CALLBACK on success. +Request is made asynchronously. METHOD should be a symbol or +string, `get' (the default) or `post' (it will be upcased). ENDPOINT may be a string +or symbol and should represent the final part of the API +URL (e.g. for \"/_matrix/client/r0/login\", it should be +\"login\". DATA should be an alist which will be automatically +encoded to JSON. CALLBACK should be a method specialized on +`matrix-session', FIXME whose subsequent arguments are defined in +accordance with the `request' package's API. ERROR-CALLBACK, if +set, will be called if the request fails." + ;; NOTE: This is necessary because of the crazy bugs in url.el and request.el. We can't just use + ;; one, we have to use both. This is a copy of `matrix-request' that only changes the + ;; `matrix-url-with-retrieve-async' calls to `request' calls. This will do for now. Later we can + ;; figure out a DRYer way. + (declare (indent defun)) + (with-slots (api-url-prefix access-token txn-id) session (let* ((url (url-encode-url - (concat api-url-prefix (cl-typecase endpoint - (string endpoint) - (symbol (symbol-name endpoint)))))) + ;; MAYBE: Come up with a nicer way to use alternate API URL prefixes. + (if (and (stringp endpoint) + (s-prefix? "http" endpoint)) + endpoint + (concat api-url-prefix (cl-typecase endpoint + (string endpoint) + (symbol (symbol-name endpoint))))))) + ;; FIXME: Maybe don't send/increment txn-id for every + ;; request, but only those that require it. But it's + ;; simpler to do it here, because we can't forget. + ;; (data (map-put data 'txn-id (incf txn-id))) (data (map-filter ;; Remove keys with null values + ;; TODO: Benchmark this against cl-loop. (lambda (k v) v) data)) - (callback (cl-typecase callback - ;; If callback is a symbol, apply session to - ;; it. If it's an already-partially-applied - ;; function, use it as-is. - ;; FIXME: Add to docstring. - (symbolp (apply-partially callback session)) - (t callback))) - (complete-callback (pcase complete-callback - ;; If complete-callback is a symbol, apply session to - ;; it. If it's an already-partially-applied - ;; function, use it as-is. - ;; FIXME: Add to docstring. - (`nil nil) - ((pred symbolp) (apply-partially complete-callback session)) - (_ complete-callback))) - (method (upcase (symbol-name method))) - (request-log-level 'debug)) - (matrix-log "REQUEST: %s" (a-list 'url url - 'method method - 'data data - 'callback callback - 'timeout timeout)) + (success (cl-typecase success + ;; If success is a symbol, apply session to + ;; it. If it's an already-partially-applied + ;; function, use it as-is. + ;; FIXME: Add to docstring. + (symbol (apply-partially success session)) + (t success))) + (error (cl-typecase error + ;; If error is a symbol, apply session to + ;; it. If it's an already-partially-applied + ;; function, use it as-is. + ;; FIXME: Add to docstring. + (symbol (apply-partially error session)) + (t error))) + (method (upcase (cl-typecase method + (string method) + (symbol (symbol-name method)))))) + ;; NOTE: This can log sensitive data in the `data' var, e.g. passwords and access tokens + (matrix-log (a-list 'event 'matrix-request + 'url url + 'method method + 'data data + 'timeout timeout)) (pcase method ("GET" (request url - :type method - :headers (a-list 'Authorization (format "Bearer %s" access-token)) + :headers (a-list "Authorization" (concat "Bearer " access-token)) :params data :parser #'json-read - :success callback - :error (apply-partially error-callback session) - :complete complete-callback - :timeout timeout - :sync matrix-synchronous)) + :success success + :error error + :timeout timeout)) ((or "POST" "PUT") (request url :type method - :headers (a-list 'Content-Type "application/json" - 'Authorization (format "Bearer %s" access-token)) - :data (json-encode data) + :headers (a-list "Content-Type" content-type + "Authorization" (concat "Bearer " access-token)) + :data (or raw-data (json-encode data)) :parser #'json-read - :success callback - :error (apply-partially error-callback session) - :complete complete-callback - :timeout timeout - :sync matrix-synchronous)))))) + :success success + :error error + :timeout timeout)))))) (matrix-defcallback request-error matrix-session "Callback function for request error." :slots (user) - :body (matrix-warn "REQUEST ERROR: %s: %s" user data)) + :body (matrix-error (a-list 'event 'matrix-request-error-callback + 'error error + 'url url + 'query query + 'data data))) ;;;;; Login/logout @@ -277,33 +474,54 @@ set, will be called if the request fails." "Log in to SESSION with PASSWORD. Session should already have its USER slot set, and optionally its DEVICE-ID and INITIAL-DEVICE-DISPLAY-NAME." - (with-slots (user device-id initial-device-display-name) session - (matrix-post session 'login (a-list 'type "m.login.password" - 'user user - 'password password - 'device_id device-id - 'initial_device_display_name initial-device-display-name) - #'matrix-login-callback))) + (with-slots (user device-id initial-device-display-name initial-sync-p) session + (setq initial-sync-p t) + (matrix-post session 'login + :data (a-list 'type "m.login.password" + 'user user + 'password password + 'device_id device-id + 'initial_device_display_name initial-device-display-name) + :success #'matrix-login-callback + :error #'matrix-login-error-callback))) (matrix-defcallback login matrix-session "Callback function for successful login. Set access_token and device_id in session." :slots (access-token device-id) :body (pcase-let* (((map access_token device_id) data)) + (matrix-log (a-list 'event 'matrix-login-callback)) (setq access-token access_token - device-id device_id))) + device-id device_id) + (run-hook-with-args 'matrix-login-hook session))) + +(matrix-defcallback login-error matrix-session + "Callback function for unsuccessful login." + :body (progn + (matrix-log (a-list 'event 'matrix-login-error-callback + 'error error + 'url url + 'query query + 'data data)) + (setq error (pcase error + (`(error http 403) "403 Unauthorized (probably invalid username or password)") + (_ _))) + (matrix-error (format$ "Login failed. Error: $error")))) (cl-defmethod matrix-logout ((session matrix-session)) "Log out of SESSION." (with-slots (user device-id initial-device-display-name) session - (matrix-post session 'logout nil - #'matrix-logout-callback))) + (matrix-post session 'logout + :success #'matrix-logout-callback))) (matrix-defcallback logout matrix-session "Callback function for successful logout. Unset access_token and device_id in session." :slots (access-token device-id) - ;; TODO: Do we need to set the device_id to nill? + ;; TODO: Do we need to set the device_id to nil? + + ;; FIXME: This doesn't stop outstanding polls, so when one returns, + ;; it will raise a warning since the access token is now nil. :body (setq access-token nil device-id nil)) @@ -358,48 +576,78 @@ requests, and we make a new request." ;; beginning of the room, in which case I guess the start/end tokens from /messages will be ;; the same...? Or we'll receive fewer messages than the limit...? - (with-slots (access-token next-batch) session - (matrix-get session 'sync (a-list 'since next-batch - 'full_state full-state - 'set_presence set-presence - ;; Convert timeout to milliseconds - 'timeout (* timeout 1000)) - #'matrix-sync-callback - :complete-callback #'matrix-sync-complete-callback - ;; Add 5 seconds to timeout to give server a bit of grace period before we - ;; consider it unresponsive. - :timeout (+ timeout 5)))) + (with-slots (access-token next-batch pending-syncs disconnect) session + (matrix-log (a-list 'event 'matrix-sync + 'next-batch next-batch + 'timeout timeout)) + (cl-case disconnect + ;; FIXME: This seems a bit inelegant, but it may be the best way to stop syncs from continuing + ;; after the user has decided to disconnect. + ('t (matrix-log (a-list 'event 'matrix-sync + 'disconnect disconnect))) + ('nil (unless access-token + ;; FIXME: This should never happen. If it does, maybe we should handle it differently. + (error "Missing access token for session")) + (when-let ((response-buffer (matrix-get session 'sync + :data (a-list 'since next-batch + 'full_state full-state + 'set_presence set-presence + ;; Convert timeout to milliseconds + 'timeout (* timeout 1000)) + :success #'matrix-sync-callback + :error #'matrix-sync-error-callback + ;; Add 5 seconds to timeout to give server a bit of grace period before we + ;; consider it unresponsive. + ;; MAYBE: Increase grace period substantially, maybe up to 60 seconds. + :timeout (+ timeout 5) + ;; Don't prompt the user if Emacs is exited while a /sync is waiting + :query-on-exit nil))) + (push response-buffer pending-syncs)))))) (matrix-defcallback sync matrix-session "Callback function for successful sync request." ;; https://matrix.org/docs/spec/client_server/r0.3.0.html#id167 - :slots (rooms next-batch) - :body (cl-loop for param in '(rooms presence account_data to_device device_lists) - for method = (intern (concat "matrix-sync-" (symbol-name param))) - ;; Assume that methods called will signal errors if anything goes wrong, so - ;; ignore return values. - do (if (functionp method) - (funcall method session (a-get data param)) - (matrix-warn "Unimplemented method: %s" method)) - finally do (setq next-batch (a-get data 'next_batch)))) - -(matrix-defcallback sync-complete matrix-session - "Completion callback function for sync requests. -If sync was successful or timed-out, make a new sync request. If -SESSION has no access token, consider the session logged-out." - :slots (access-token) - :body (pcase symbol-status - ((or 'success 'timeout) - (matrix-log "SYNC COMPLETE: %s. Making new sync request..." symbol-status) - (unless matrix-synchronous - ;; Call self again to wait for more data. But don't do this if - ;; `matrix-synchronous' is set, which would cause an infinite - ;; loop. It should only be set when testing, in which case we - ;; sync manually. - (when access-token - (matrix-sync session)))) - (_ (matrix-warn "SYNC FAILED: %s NOT STARTING NEW SYNC REQUEST. API SHOULD BE CONSIDERED DISCONNECTED." - (upcase (symbol-name symbol-status)))))) + :slots (rooms next-batch initial-sync-p sync-retry-delay pending-syncs) + :body (progn + (matrix-log (a-list 'type 'matrix-sync-callback + 'headers headers + + 'data data)) + (cl-loop for param in '(rooms presence account_data to_device device_lists) + ;; Assume that methods called will signal errors if anything goes wrong, so + ;; ignore return values. + do (apply-if-fn (concat "matrix-sync-" (symbol-name param)) + (list session (a-get data param)) + (matrix-unimplemented (format$ "Unimplemented API method: $fn-name")))) + (when initial-sync-p + ;; After initial sync timelines are processed, we run the room metadata hook to set the + ;; room buffer names (which we do not do during processing of timelines during initial + ;; sync, because doing so for every user "join" event is very slow. + + ;; FIXME: This violates separation of API and client code. There should be an + ;; after-initial-sync hook on the client side for this. + (dolist (room rooms) + (matrix-client-ng-rename-buffer room))) + (setq initial-sync-p nil + next-batch (a-get data 'next_batch) + sync-retry-delay 0) + (setq pending-syncs (delete (current-buffer) pending-syncs)) + (matrix-log "Sync callback complete. Calling sync again...") + (matrix-sync session))) + +(matrix-defcallback sync-error matrix-session + "Callback function for sync request error." + :slots (rooms next-batch initial-sync-p sync-retry-delay disconnect) + :body (cl-case disconnect + ('t (matrix-log (a-list 'event 'matrix-sync-error-callback + 'disconnect disconnect))) + ('nil (matrix-log (a-list 'event 'matrix-sync-error-callback + 'error error + 'data data + 'sync-retry-delay sync-retry-delay)) + (setq sync-retry-delay (cond ((>= sync-retry-delay 60) 60) + (t (* sync-retry-delay 2)))) + (matrix-sync session)))) (cl-defmethod matrix-sync-presence ((session matrix-session) state-changes) "Process presence STATE-CHANGES." @@ -418,86 +666,166 @@ SESSION has no access token, consider the session logged-out." "Process ROOMS from sync response on SESSION." ;; https://matrix.org/docs/spec/client_server/r0.3.0.html#id167 (cl-loop for room in rooms - always (pcase room - (`(join . ,_) (matrix-sync-join session room)) - (`(invite . ,_) (matrix-log "Would process room invites: %s" room)) - (`(leave . ,_) (matrix-log "Would process room leaves: %s" room))))) + do (progn + (pcase room + (`(join . ,_) (matrix-sync-join session room)) + (`(invite . ,_) (matrix-unimplemented (format$ "Would process room invites: $room"))) + (`(leave . ,_) (matrix-unimplemented (format$ "Would process room leaves: %s" room))))))) (cl-defmethod matrix-sync-join ((session matrix-session) join) "Sync JOIN, a list of joined rooms, on SESSION." ;; https://matrix.org/docs/spec/client_server/r0.3.0.html#id167 (with-slots (rooms) session (cl-loop for it in (cdr join) - always (pcase-let* ((`(,joined-room-id . ,joined-room) it) - ;; Room IDs are decoded from JSON as symbols, so we convert to strings. - (room-id (symbol-name joined-room-id)) - (params '(state timeline ephemeral account_data unread_notifications)) - (room (or (--first (equal (oref it id) room-id) - rooms) - ;; Make and return new room - (car (push (matrix-room :session session - :id room-id) - rooms))))) - (cl-loop for param in params - for method = (intern (concat "matrix-sync-" (symbol-name param))) - do (if (functionp method) - ;; If the event array is empty, the function will be - ;; called anyway, so ignore its return value. - (funcall method room (a-get joined-room param)) - ;; `warn' seems to return non-nil. Convenient. - (matrix-warn "Unimplemented method: %s" method-name)) - ;; Always return t for now, so that we think the sync succeeded - ;; and we can set next_batch in `matrix-sync-callback'. - finally return t))))) - -(cl-defmethod matrix-sync-state ((room matrix-room) state) - "Sync STATE in ROOM." - (with-slots (state) room - (pcase-let (((map events) state)) + do (pcase-let* ((`(,joined-room-id . ,joined-room) it) + ;; Room IDs are decoded from JSON as symbols, so we convert to strings. + (room-id (symbol-name joined-room-id)) + (params '(state timeline ephemeral account_data unread_notifications)) + (room (or (--first (equal (oref it id) room-id) + rooms) + ;; Make and return new room + (car (push (matrix-room :session session + :id room-id) + rooms)))) + (prev-batch (a-get* joined-room 'timeline 'prev_batch))) + (cl-loop for param in params + ;; If the event array is empty, the function will be + ;; called anyway, so ignore its return value. + do (apply-if-fn (concat "matrix-sync-" (symbol-name param)) + (list room (a-get joined-room param)) + (matrix-unimplemented (format$ "Unimplemented API method: $fn-name"))) + ;; Always return t for now, so that we think the sync succeeded + ;; and we can set next_batch in `matrix-sync-callback'. + finally return t) + ;; Run client hooks + (run-hook-with-args 'matrix-room-update-hook room) + ;; FIXME: Shouldn't matter if we return t anymore. + t)))) + +(cl-defmethod matrix-sync-state ((room matrix-room) data) + "Process state DATA in ROOM." + (with-slots (state state-new) room + (pcase-let (((map events) data)) ;; events is an array, not a list, so we can't use --each. (seq-doseq (event events) - (push event state))))) + (push event state) + (push event state-new) + (matrix-event room event))))) + +;; (defvar matrix-sync-timeline-hook nil +;; "List of functions called for new timeline events. +;; Each function is called with ROOM and EVENT.") (cl-defmethod matrix-sync-timeline ((room matrix-room) data) "Sync timeline DATA in ROOM." - (with-slots* (((id session timeline prev-batch last-full-sync) room) + (with-slots* (((id session timeline timeline-new timeline-event-ids prev-batch last-full-sync) room) ((next-batch) session)) (pcase-let (((map events limited prev_batch) data)) + (matrix-log (a-list 'event 'matrix-sync-timeline + 'room-id id + 'prev-batch prev-batch + 'last-full-sync last-full-sync + 'data data)) (seq-doseq (event events) - (push event timeline)) + (let ((id (a-get event 'event_id))) + (unless (ht-get timeline-event-ids id) + (ht-set timeline-event-ids id t) + (push event timeline) + (push event timeline-new) + ;; Run API handler for event. + (matrix-event room event)))) + ;; Reverse new events so that they are processed in chronological order. + ;; MAYBE: Do this in client code rather than here. + (setq timeline-new (nreverse timeline-new)) (setq prev-batch prev_batch) - (if (and limited last-full-sync) + (if (and (not (equal limited :json-false)) + last-full-sync) ;; Timeline is limited and we have a token to fill to: fill the gap. If ;; `last-full-sync' is nil, this should mean that we are doing an initial sync, and ;; since we have no previous "since" token to fetch up to, we do not bother to fetch ;; more messages, even if the timeline is limited. ;; MAYBE: Add setting for minimum number of events/messages to initially fetch. (progn - (matrix-warn "ROOM %s TIMELINE WAS LIMITED: %s. Trying to fill gap..." id data) + (matrix-log "Limited timeline. Calling `matrix-messages'...") (matrix-messages room)) ;; Timeline is not limited: save the not-yet-updated next-batch token. If the next ;; timeline is limited, we use this token to know when we have filled the timeline gap. - (matrix-log "ROOM %s FULLY SYNCED." id) + (matrix-log "Room fully synced.") (setq last-full-sync next-batch))))) -(cl-defmethod matrix-messages ((room matrix-room) - &key (direction "b") (limit 100)) +(cl-defmethod matrix-event ((room matrix-room) event) + "Process EVENT in ROOM." + (pcase-let* (((map type) event)) + (apply-if-fn (concat "matrix-event-" type) + (list room event) + (matrix-unimplemented (format$ "Unimplemented API handler for event $type in room %s." (oref room id)))))) + +(cl-defmethod matrix-event-m.room.member ((room matrix-room) event) + "Process m.room.member EVENT in ROOM." + (with-slots (members id) room + (pcase-let* (((map ('state_key user-id) content) event) + ((map membership displayname avatar_url) content)) + (pcase membership + ;; TODO: Support all membership changes: invite, join, knock, leave, ban. + ("join" (map-put members user-id (a-list 'displayname displayname + 'avatar-url avatar_url))) + ("leave" (setq members (map-delete members user-id))))) + ;; FIXME: Don't think we need this hook, the client can just process the event from timeline-new. + (run-hook-with-args 'matrix-event-m.room.member-hook room event))) + +(cl-defmethod matrix-event-m.room.name ((room matrix-room) event) + "Process m.room.name EVENT in ROOM." + (with-slots (name) room + (setq name (a-get* event 'content 'name)) + (run-hook-with-args 'matrix-room-metadata-hook room))) + +(defvar matrix-room-metadata-hook nil + "List of functions called when a room's metadata is updated. +Each function is called with one argument, the room object that +was updated.") + +(defvar matrix-room-update-hook nil + ;; FIXME: Rename to matrix-room-timeline-hook + "List of functions called when a room's timeline is updated. +Each function is called with one argument, the room object that +was updated.") + +(cl-defmethod matrix-clear-timeline ((room matrix-room)) + "Clear ROOM's `timeline-new' list." + (with-slots (timeline-new) room + (setq timeline-new nil))) + +(cl-defmethod matrix-clear-state ((room matrix-room)) + "Clear ROOM's `state-new' list." + (with-slots (state-new) room + (setq state-new nil))) + +(cl-defmethod matrix-messages ((room matrix-room) &key (direction "b") (limit 10)) "Request messages for ROOM-ID in SESSION. DIRECTION must be \"b\" (the default) or \"f\". LIMIT is the maximum number of events to return (default 10)." ;; TODO: As written, this may only work going backward. Needs testing. (with-slots (id session prev-batch last-full-sync) room - (matrix-get session (format "rooms/%s/messages" room-id) - (a-list 'from prev-batch - 'to last-full-sync - 'dir direction - 'limit limit) - (apply-partially #'matrix-messages-callback room)))) + (matrix-get session (format$ "rooms/$id/messages") + :data (a-list 'from prev-batch + 'to last-full-sync + 'dir direction + 'limit limit) + :success (apply-partially #'matrix-messages-callback room)))) (matrix-defcallback messages matrix-room "Callback for /rooms/{roomID}/messages." - :slots (id timeline prev-batch last-full-sync) - :body (pcase-let* (((map start end chunk) data)) + :slots (id timeline timeline-new timeline-event-ids prev-batch last-full-sync) + :body (pcase-let* (((map start end chunk) data) + ;; Disable notifications while loading old messages. + (matrix-client-ng-notifications nil) + (new-events-p)) + + (matrix-log (a-list 'type 'matrix-messages-callback + 'room-id id + 'data data + 'prev-batch prev-batch + 'last-full-sync last-full-sync)) ;; NOTE: API docs: ;; start: The token the pagination starts from. If dir=b ;; this will be the token supplied in from. @@ -505,24 +833,40 @@ maximum number of events to return (default 10)." ;; token should be used again to request even earlier ;; events. (seq-doseq (event chunk) - (push event timeline)) - - (if (equal end last-full-sync) - ;; Gap has been filled: clear the last-full-sync token (NOTE: Not sure if this is correct) - (progn - (matrix-log "MESSAGES CALLBACK for ROOM: %s: gap is filled: %s" id data) - (setq last-full-sync nil)) - ;; Gap not yet filled: continue filling - (matrix-log "MESSAGES CALLBACK for ROOM: %s: gap NOT filled: %s" id data) - (setq prev-batch end) - (matrix-messages room)))) - -(cl-defmethod matrix-sync-ephemeral ((room matrix-room) ephemeral) + (let ((id (a-get event 'event_id))) + (unless (ht-get timeline-event-ids id) + (setq new-events-p t) + (ht-set timeline-event-ids id t) + (push event timeline) + (push event timeline-new)))) + (setq timeline-new (nreverse timeline-new)) + (setq prev-batch end) + (setq last-full-sync nil) + (if new-events-p + (run-hook-with-args 'matrix-room-update-hook room :old-messages t) + (when (> (length chunk) 0) + ;; Only got events we already had: go back further + (matrix-messages room))) + + ;; NOTE: I don't think this code is necessary, but I'm temporarily leaving it for future reference. + ;; (if (equal end last-full-sync) + ;; ;; Gap has been filled: clear the last-full-sync token (NOTE: Not sure if this is correct) + ;; (progn + ;; (matrix-log "Gap is filled") + ;; ) + ;; ;; Gap not yet filled: continue filling + ;; (matrix-log "Gap not filled" id data) + ;; + ;; (matrix-messages room)) + )) + +(cl-defmethod matrix-sync-ephemeral ((room matrix-room) data) "Sync EPHEMERAL in ROOM." (with-slots (ephemeral) room - (pcase-let (((map events) ephemeral)) + (pcase-let (((map events) data)) (seq-doseq (event events) - (push event ephemeral))))) + (push event ephemeral) + (matrix-event room event))))) (cl-defmethod matrix-sync-account_data ((session matrix-session) data) "Sync ACCOUNT-DATA in SESSION." @@ -541,19 +885,23 @@ maximum number of events to return (default 10)." (cl-defmethod matrix-sync-to_device ((session matrix-session) data) "Sync to_device data in SESSION." ;; FIXME: Implement. - (matrix-log "Received to_device data: %s" data)) + ;; (matrix-log "Received to_device data: %s" data) + ) (cl-defmethod matrix-sync-device_lists ((session matrix-session) data) "Sync device_lists data in SESSION." ;; FIXME: Implement. - (matrix-log "Received device_lists data: %s" data)) + ;; (matrix-log "Received device_lists data: %s" data) + ) (cl-defmethod matrix-sync-unread_notifications ((room matrix-room) unread-notifications) "Sync UNREAD-NOTIFICATIONS in ROOM." - (pcase-let (((map highlight_count notification_count) unread-notifications)) - (matrix-log "Would process highlight_count in %s: " room highlight_count) - (matrix-log "Would process notification_count in %s: " room notification_count) - t)) + ;; (pcase-let (((eieio id) room) + ;; ((map highlight_count notification_count) unread-notifications)) + ;; (matrix-log "Would process highlight_count in %s: " id highlight_count) + ;; (matrix-log "Would process notification_count in %s: " id notification_count) + ;; t) + ) ;;;;; Rooms @@ -566,13 +914,14 @@ When IS-DIRECT is non-nil, set that flag on the new room." ;; MAYBE: Add other parameters: invite_3pid, creation_content, ;; initial_state. Not sure how useful these would be for us. - (matrix-post session 'createRoom (a-list 'visibility visibility - 'room_alias_name alias - 'name name - 'topic topic - 'preset preset - 'is-direct is-direct) - #'matrix-create-room-callback)) + (matrix-post session 'createRoom + :data (a-list 'visibility visibility + 'room_alias_name alias + 'name name + 'topic topic + 'preset preset + 'is-direct is-direct) + :success #'matrix-create-room-callback)) (matrix-defcallback create-room matrix-session "Callback for create-room. @@ -584,35 +933,91 @@ Add new room to SESSION." :id room_id))) (push room rooms))) -(cl-defmethod matrix-send-message ((room matrix-room) message) - "Send MESSAGE to ROOM." +(cl-defmethod matrix-join-room ((session matrix-session) room-id) + "Join ROOM-ID on SESSION. +If ROOM-ID does not have a server part, SESSION's server will be +added." + (let* ((room-id (if (not (s-match (rx (1+ (not space)) ":" (1+ (not space))) + room-id)) + ;; Add server + (concat room-id ":" (oref session server)) + ;; Already has server + room-id)) + (endpoint (concat "join/" (url-hexify-string room-id)))) + (matrix-post session endpoint + :success #'matrix-join-room-callback + :error #'matrix-join-room-error-callback))) + +(matrix-defcallback join-room matrix-session + "Callback for join-room." + ;; Just log it, because it will be handled on the next sync. + :body (matrix-log "JOINED ROOM: %s" (a-get data 'room_id))) + +(matrix-defcallback join-room-error matrix-session + "Error callback for join-room." + ;; Just log it, because it will be handled on the next sync. + :body (progn + (matrix-log (a-list 'event 'matrix-join-room-error-callback + 'data data + 'url url + 'status status)) + (let ((room-id (url-unhex-string (-last-item (s-split "/" url))))) + (pcase error + (`(error http 404) (matrix-error (format$ "Room not found: $room-id"))) + (_ (matrix-error (format$ "Error joining room $room-id: $error"))))))) + +(cl-defmethod matrix-send-message ((room matrix-room) message &key (msgtype "m.text") override-txn-id + extra-content success error) + "Send MESSAGE of MSGTYPE to ROOM. +SUCCESS should be a function which will be called when the server +acknowledges the message; if nil, `matrix-send-message-callback' +will be called. ERROR should be a function which will be called +if sending the message fails. If OVERRIDE-TXN-ID is non-nil, use +it as the transaction ID; otherwise, automatically increment and +use the session's. EXTRA-CONTENT is an alist to merge with the +standard event content object." ;; https://matrix.org/docs/spec/client_server/r0.3.0.html#id182 (with-slots* (((id session) room) ((txn-id) session)) ;; Use `with-slots*' instead of `pcase-let*' so we can `incf' the txn-id. (let* ((type "m.room.message") - (content (a-list 'msgtype "m.text" + (content (a-list 'msgtype msgtype 'body message)) - (txn-id (cl-incf txn-id)) - (endpoint (format "rooms/%s/send/%s/%s" - id type txn-id))) - (matrix-put session endpoint content - (apply-partially #'matrix-send-message-callback room))))) + (txn-id (or override-txn-id (cl-incf txn-id))) + (endpoint (format$ "rooms/$id/send/$type/$txn-id")) + (success (or success + (apply-partially #'matrix-send-message-callback room)))) + (when extra-content + (setq content (append content extra-content))) + ;; FIXME: I just received a send-message reply from the server, with the event_id, 16 + ;; (sixteen) minutes after the HTTP PUT request. I guess we need to set a timeout, now that + ;; we're implementing resend. + (matrix-put session endpoint + :data content + :success success + :error error + ;; Trying a 30 second timeout. However, given that 16-minute reply I experienced, who knows + ;; if this is a good idea. Theoretically, if we resend with the same transaction ID, the + ;; server won't duplicate the message... + :timeout 30) + ;; Return txn-id + txn-id))) (matrix-defcallback send-message matrix-room "Callback for send-message." ;; For now, just log it, because we'll get it back when we sync anyway. :slots (id) - :body (matrix-log "Message \"%s\" sent to room %s. Event ID: %s" - id message (a-get data 'event_id))) + :body (matrix-log (a-list 'event 'matrix-send-message-callback + 'room-id id + 'data data))) (cl-defmethod matrix-leave ((room matrix-room)) "Leave room." ;; https://matrix.org/docs/spec/client_server/r0.3.0.html#id203 (with-slots (id session) room - (let* ((endpoint (format "rooms/%s/leave" id))) - (matrix-post session endpoint nil - (apply-partially #'matrix-leave-callback room))))) + (let* ((endpoint (format$ "rooms/$id/leave"))) + (matrix-post session endpoint + :success (apply-partially #'matrix-leave-callback room))))) (matrix-defcallback leave matrix-room "Leave room callback." @@ -632,9 +1037,9 @@ Add new room to SESSION." ;; https://matrix.org/docs/spec/client_server/r0.3.0.html#id204 (with-slots (id session) room - (let* ((endpoint (format "rooms/%s/forget" id))) - (matrix-post session endpoint nil - (apply-partially #'matrix-forget-callback room))))) + (let* ((endpoint (format$ "rooms/$id/forget"))) + (matrix-post session endpoint + :success (apply-partially #'matrix-forget-callback room))))) (matrix-defcallback forget matrix-room "Forget room callback." @@ -646,10 +1051,56 @@ Add new room to SESSION." TYPING should be t or nil." (pcase-let* (((eieio id session) room) ((eieio user) session) - (endpoint (format "rooms/%s/typing/%s" id user)) + (endpoint (format$ "rooms/$id/typing/$user")) (data (a-list 'typing typing 'timeout 30000))) - (matrix-put session endpoint data #'ignore))) + (matrix-put session endpoint + :data data))) + +;;;;; Misc + +(cl-defmethod matrix-transform-mxc-uri ((session matrix-session) uri) + "Return HTTPS URL for MXI URI to be accessed through SESSION." + (pcase-let* (((eieio server) session) + (`(,protocol _ ,mxc-server ,file) (split-string uri "/"))) + (format$ "https://$server/_matrix/media/v1/download/$mxc-server/$file"))) + +(cl-defmethod matrix-upload ((room matrix-room) path) + "Upload file at PATH to SESSION's server." + (pcase-let* (((eieio session) room) + ((eieio server) session) + (filename (file-name-nondirectory path)) + (extension (file-name-extension filename)) + (mime-type (cond (extension (mailcap-extension-to-mime extension)) + (t (mailcap-extension-to-mime (symbol-name (or (image-type-from-file-header path) + (error "Can't determine image type'"))))))) + (file-contents (with-temp-buffer + (insert-file-contents path) + (buffer-string))) + (endpoint (url-encode-url (format$ "https://$server/_matrix/media/r0/upload?filename=$filename")))) + (matrix-request-request session endpoint + :method "POST" + :success (apply-partially #'matrix-upload-callback room + :cbargs (list :filename filename + :mime-type mime-type)) + :content-type mime-type + :raw-data file-contents))) + +(matrix-defcallback upload matrix-room + "Callback for `matrix-upload'. +Post the uploaded file to the room as an m.image or m.file +message." + :slots (id) + :body (-let* (((&plist :filename filename :mime-type mime-type) cbargs) + ((&alist 'content_uri url) data) + (msgtype (cond ((s-prefix? "image/" mime-type) "m.image") + (t "m.file")))) + (matrix-log (a-list 'fn 'matrix-upload-callback + 'room id + 'data data)) + (matrix-send-message room (concat "File: " filename) + :msgtype msgtype + :extra-content (a-list 'url url)))) ;;;; Footer diff --git a/matrix-api.el b/matrix-api.el deleted file mode 100644 index ee512c8..0000000 --- a/matrix-api.el +++ /dev/null @@ -1,243 +0,0 @@ -;;; matrix-api.el --- An ELisp client for the Matrix.org RPC - -;; Copyright (C) 2015 Ryan Rix -;; Author: Ryan Rix -;; Maintainer: Ryan Rix -;; Created: 21 June 2015 -;; Keywords: web -;; Homepage: http://doc.rix.si/matrix.html -;; Package-Version: 0.1.0 - -;; This file is not part of GNU Emacs. - -;; matrix-api.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. -;; -;; matrix.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 -;; this file. If not, see . - -;;; Commentary: - -;; This is a pure-elisp implementation of the Matrix.org RPC protocol -;; specification 0.1. It forms the basis of the included `matrix-client' Matrix chat -;; client, and can be used as a general RPC system using `matrix-send-event' and -;; `matrix-event-poll'. - -;;; Code: - -(require 'cl-lib) -(require 'json) -(require 'request) -(require 'matrix-helpers) -(require 'eieio) -(require 'map) - -(require 'a) - -(defvar matrix-error-hook nil - "This is a list of functions to pass Matrix errors to.") - -(defcustom matrix-homeserver-base-url "https://matrix.org" - "URI to your Matrix homeserver, defaults to the official homeserver." - :type 'string - :group 'matrix-client) - -(defcustom matrix-insecure-connection nil - "Whether to use insecure HTTPS connection when connecting to the homeserver." - :type 'boolean - :group 'matrix-client) - -(defclass matrix-connection () - ((base-url :initarg :base-url - :initform "https://matrix.org" - :type string - :documentation "URI to your Matrix homeserver, defaults to the official homeserver.") - (token :initarg :token - :initform nil - :documentation "Matrix access_token") - (txn-id :initarg :txn-id - :initform 1 - :type integer))) - -(cl-defmethod matrix-login ((con matrix-connection) login-type content) - "Log in to connection CON using LOGIN-TYPE and return the server response. -CONTENT is an alist of additional keys/values to add to the -submitted JSON. After logging in, the access token is set on -CON." - (when-let ((content (map-put content "type" login-type)) - (response (matrix-send con "POST" "/login" content))) - (oset con :token (map-elt response 'access_token)) - response)) - -(cl-defmethod matrix-login-with-password ((con matrix-connection) username password) - "Log in to connection CON with USERNAME and PASSWORD and save the access token." - (matrix-login con "m.login.password" (a-list 'user username 'password password))) - -(cl-defun matrix-request-error-handler - (con &rest args &key error-thrown symbol-status - &allow-other-keys) - ;; Call err handler functions - (dolist (handler matrix-error-hook) - (funcall handler con symbol-status error-thrown)) - ;; Message some warnings if we know what it is - (let ((exit-code (matrix-parse-curl-exit-code (cddr error-thrown)))) - (warn (pcase exit-code - ((or 51 60) "Error sending request to matrix homeserver, SSL certificate is invalid") - (`nil "Unknown error occurred sending request to matrix homeserver: %S") - (_ (format "Matrix request exited with exit code %d" exit-code)))))) - -(cl-defmethod matrix-send ((con matrix-connection) method path - &optional content query-params headers api-version) - "Send an event to the Matrix homeserver. - -METHOD is the HTTP method the given API endpoint PATH uses. -CONTENT is an optional `json-encode' compatible list which will -be used as the data in a POST or PUT request. QUERY-PARAMS is an -optional alist of URL parameters. HEADERS is optional HTTP -headers to add to the request. - -The return value is the `json-read' response from homeserver." - (let* ((token (oref con :token)) - (url-request-data (when content - (json-encode content))) - (endpoint (concat (matrix-homeserver-api-url api-version) path)) - (method (upcase method))) - (when token - (map-put query-params "access_token" token)) - (let ((request-curl-options request-curl-options)) - (when matrix-insecure-connection - (push "--insecure" request-curl-options)) - (request-response-data - (pcase method - ("GET" - (request endpoint - :type method - :params query-params - :sync t - :error (apply-partially #'matrix-request-error-handler con) - :parser 'json-read)) - ((or "POST" "PUT") - (request endpoint - :type method - :params query-params - :sync t - :error (apply-partially #'matrix-request-error-handler con) - :data (json-encode content) - :headers (map-put headers "Content-Type" "application/json") - :parser 'json-read))))))) - -(cl-defmethod matrix-send-async ((con matrix-connection) method path - &optional content query-params headers callback api-version) - "Perform an asynchronous Matrix API call. - -METHOD is the HTTP method the given API endpoint PATH uses. -CONTENT is an optional `json-encode' compatible list which will -be used as the data in a POST or PUT request. QUERY-PARAMS is an -optional alist of URL parameters. HEADERS is optional HTTP -headers to add to the request. CALLBACK is the callback which -will be called by `request' when the call completes" - (let* ((token (oref con token)) - (endpoint (concat (matrix-homeserver-api-url api-version) path)) - (request-curl-options request-curl-options)) - (when matrix-insecure-connection - (push "--insecure" request-curl-options)) - (when token - (map-put query-params "access_token" token)) - (request endpoint - :type (upcase method) - :params query-params - :parser 'json-read - :data (json-encode content) - :error (apply-partially #'matrix-request-error-handler con) - :headers (map-put headers "Content-Type" "application/json") - :complete (apply-partially #'matrix-async-cb-router callback con)))) - -(cl-defun matrix-async-cb-router (callback con &key data error-thrown symbol-status &allow-other-keys) - (if (or error-thrown - (eq symbol-status 'timeout)) - (dolist (handler matrix-error-hook) - (funcall handler con symbol-status error-thrown)) - (when callback - (funcall callback data)))) - -(cl-defmethod matrix-send-event ((con matrix-connection) room-id event-type content - &optional &key async) - "Send a raw event to the room ROOM-ID. -EVENT-TYPE is the matrix event type to send (see Matrix spec). -CONTENT is a `json-encode' compatible list to include in the -event. If ASYNC is non-nil, send the message asynchronously." - (let* ((txn-id (incf (oref con :txn-id))) - (path (format "/rooms/%s/send/%s/%s" - (url-encode-url room-id) - (url-encode-url event-type) - txn-id))) - (pcase async - (`nil (matrix-send con "PUT" path content)) - (`t (matrix-send-async con "PUT" path content))))) - -(cl-defmethod matrix-send-message ((con matrix-connection) room-id message) - "Send string MESSAGE to room ROOM-ID." - (matrix-send-event con room-id "m.room.message" - (a-list "msgtype" "m.text" - "body" message) - :async t)) - -(cl-defmethod matrix-sync ((con matrix-connection) since full-state timeout callback) - "Start an event poller starting from END-TOKEN. -It will wait at least TIMEOUT seconds before calling the -CALLBACK. After receiving any events it will call CALLBACK with -those events as its argument." - (let ((query-params (a-list "timeout" (int-to-string timeout) - "full_state" (if full-state "true" "false")))) - (when since - (map-put query-params "since" since)) - (matrix-send-async con "GET" "/sync" nil - query-params nil callback "r0"))) - -(cl-defmethod matrix-event-poll ((con matrix-connection) end-token timeout callback) - "Start an event poller starting from END-TOKEN. -It will wait at least TIMEOUT seconds before calling the -CALLBACK. After receiving any events it will call CALLBACK with -those events as its argument." - (matrix-send-async "GET" "/events" nil - (a-list "from" end-token - "timeout" (number-to-string timeout)) - nil callback)) - -(cl-defmethod matrix-mark-as-read ((con matrix-connection) room-id event-id) - "Mark as read EVENT-ID in ROOM-ID." - (let ((path (format "/rooms/%s/receipt/m.read/%s" room-id event-id))) - ;; TODO: Update API version. - (matrix-send-async con "POST" path nil nil nil (lambda (status)) "api/v2_alpha"))) - -(cl-defmethod matrix-join-room ((con matrix-connection) room-id) - "Join ROOM-ID." - (let* ((txn-id (incf (oref con :txn-id))) - ;; TODO: Standardize on `url-hexify-string' or `url-encode-url' - (path (format "/join/%s" (url-hexify-string room-id)))) - ;; MAYBE: error-handling needed here? - (matrix-send con "POST" path))) - -(cl-defmethod matrix-leave-room ((con matrix-connection) room-id) - "Leave ROOM-ID." - (let* ((txn-id (incf (oref con :txn-id))) - ;; TODO: Standardize on `url-hexify-string' or `url-encode-url' - (path (format "/rooms/%s/leave" (url-encode-url room-id)))) - (matrix-send con "POST" path))) - -(cl-defmethod matrix-sync-room ((con matrix-connection) room-id) - "Perform an /initialSync of a single room ROOM-ID." - (let* ((txn-id (incf (oref con :txn-id))) - (path (format "/rooms/%s/initialSync" (url-hexify-string room-id)))) - (matrix-send con "GET" path))) - -(provide 'matrix-api) - -;;; matrix-api.el ends here diff --git a/matrix-client-faces.el b/matrix-client-faces.el new file mode 100644 index 0000000..18bb769 --- /dev/null +++ b/matrix-client-faces.el @@ -0,0 +1,66 @@ +;;;;; Faces + +(defface matrix-client-metadata + '((((class color) (background light)) (:foreground "#000088" :weight bold)) + (((class color) (background dark)) (:foreground "#4444FF" :weight bold)) + (t (:weight bold))) + "Face for chat metadata properties." + :group 'matrix-client) + +(defface matrix-client-own-metadata + '((((class color) (background light)) (:foreground "#268bd2" :weight bold)) + (((class color) (background dark)) (:foreground "#268bd2" :weight bold)) + (t (:weight bold))) + "Face for user's own chat metadata properties." + :group 'matrix-client) + +(defface matrix-client-message-body + '((t (:inherit default))) + "Face for Matrix message bodies." + :group 'matrix-client) + +(defface matrix-client-own-message-body + '((t (:inherit matrix-client-message-body))) + "Face for user's own Matrix message bodies." + :group 'matrix-client) + +(defface matrix-client-quoted-message + '((t (:inherit matrix-client-message-body :slant italic))) + "Face for Matrix quoted messages." + :group 'matrix-client) + +(defface matrix-client-pending-messages + '((((class color) (background light)) (:foreground "#586e75" :weight bold :slant italic)) + (((class color) (background dark)) (:foreground "#586e75" :weight bold :slant italic)) + (t (:weight bold :slant italic))) + "Face for user's pending chat messages." + :group 'matrix-client) + +(defface matrix-client-failed-messages + '((((class color) (background light)) (:foreground "red" :weight bold :slant italic)) + (((class color) (background dark)) (:foreground "red" :weight bold :slant italic)) + (t (:weight bold :slant italic))) + "Face for user's failed chat messages." + :group 'matrix-client) + +(defface matrix-client-notice + '((t :inherit font-lock-comment-face)) + "Face for notices." + :group 'matrix-client) + +(defface matrix-client-notice-metadata + '((t :inherit font-lock-comment-face)) + "Face for notices." + :group 'matrix-client) + +(defface matrix-client-last-seen + '((t (:inherit 'highlight :height 0.1))) + "Face for last-seen overlay." + :group 'matrix-client) + +(defface matrix-client-date-header + '((t (:inherit highlight :weight bold))) + "Face for date headers." + :group 'matrix-client) + +(provide 'matrix-client-faces) diff --git a/matrix-client-handlers.el b/matrix-client-handlers.el index a095a20..498214e 100644 --- a/matrix-client-handlers.el +++ b/matrix-client-handlers.el @@ -36,38 +36,7 @@ (require 'matrix-client-images) (require 'matrix-notifications) -(cl-defmethod matrix-client-handlers-init ((con matrix-client-connection)) - "Set up all the matrix-client event type handlers. - -Each matrix-client-event-handler is an alist of matrix message type and -the function that handles them. Currently only a single handler -for each event is supported. The handler takes a single argument, -DATA, which is a `json-read' object from the Event stream. See -the Matrix spec for more information about its format." - ;; NOTE: Roughly corresponds with the Matrix Python SDK here: - ;; - ;; FIXME: `matrix-client-window-change-hook' should be renamed, and - ;; is currently unimplemented anyway. - (push 'matrix-client-window-change-hook window-configuration-change-hook) - (with-slots (event-handlers input-filters) con - (unless event-handlers - (setq event-handlers (a-list "m.room.message" 'matrix-client-handler-m.room.message - "m.lightrix.pattern" 'matrix-client-handler-m.lightrix.pattern - "m.room.topic" 'matrix-client-handler-m.room.topic - "m.room.name" 'matrix-client-handler-m.room.name - "m.room.member" 'matrix-client-handler-m.room.member - "m.room.aliases" 'matrix-client-handler-m.room.aliases - "m.room.avatar" 'matrix-client-handler-m.room.avatar - "m.presence" 'matrix-client-handler-m.presence - "m.typing" 'matrix-client-handler-m.typing))) - (unless input-filters - (setq input-filters '(matrix-client-input-filter-who - matrix-client-input-filter-emote - matrix-client-input-filter-join - matrix-client-input-filter-leave - matrix-client-send-to-current-room))))) - -(defun matrix-client-handler-m.room.avatar (con room data) +(cl-defmethod matrix-client-handler-m.room.avatar ((session matrix-session) room data) (when matrix-client-show-room-avatars (pcase-let* (((map sender content) data) ((map url) content) @@ -82,13 +51,15 @@ the Matrix spec for more information about its format." (if url ;; New avatar ;; TODO: Maybe display the new avatar in the chat list, like Riot. - (request (matrix-transform-mxc-uri url) - :parser (apply-partially #'matrix-client-parse-image room :max-width 32 :max-height 32) - :success (apply-partially #'matrix-client-room-avatar-callback - :room room - :message msg - :max-width 32 - :max-height 32)) + (matrix-url-with-retrieve-async (matrix-transform-mxc-uri session url) + :silent t + :inhibit-cookies t + :parser (apply-partially #'matrix-client-parse-image room :max-width 32 :max-height 32) + :success (apply-partially #'matrix-client-room-avatar-callback + :room room + :message msg + :max-width 32 + :max-height 32)) ;; Avatar removed (oset room avatar nil) ;; TODO: A function to automatically propertize a string with its related event data would be nice. @@ -212,7 +183,7 @@ like." (let (metadata-face message-face) (cond ((string= display-name own-display-name) (setq metadata-face 'matrix-client-own-metadata - message-face 'matrix-client-own-messages)) + message-face 'matrix-client-own-message-body)) ((string= msgtype "m.notice") (setq metadata-face 'matrix-client-notice-metadata message-face 'matrix-client-notice)) diff --git a/matrix-client-images.el b/matrix-client-images.el index d4d7be5..46531fb 100644 --- a/matrix-client-images.el +++ b/matrix-client-images.el @@ -10,7 +10,10 @@ (defcustom matrix-client-image-url-prefixes (list (rx bow "http" (optional "s") "://" - (or "i.imgur.com" "i.redd.it") + (or "i.imgur.com" + "i.redd.it" + "i.redditmedia.com" + ) "/")) "List of regexps matching parts of URLs to images that should be downloaded and displayed. Each regexp should match from the beginning of the URL, including @@ -25,16 +28,19 @@ to match until the next whitespace character." for regexp = (rx-to-string `(seq (regexp ,regexp) (1+ (not space)))) append (-map #'first (s-match-strings-all regexp text)))) -(cl-defmethod matrix-client-insert-image ((room matrix-client-room) message-id url) +(cl-defmethod matrix-client-insert-image ((room matrix-room) message-id url) "Download image from URL and insert it at message MESSAGE-ID in ROOM." - (request url - :parser (apply-partially #'matrix-client-parse-image room) - :success (apply-partially #'matrix-client-insert-image-callback - :room room - :message-id message-id - :url url))) + (matrix-url-with-retrieve-async url + :silent t + :inhibit-cookies t + :query-on-exit nil + :parser (apply-partially #'matrix-client-parse-image room) + :success (apply-partially #'matrix-client-insert-image-callback + :room room + :message-id message-id + :url url))) -(cl-defmethod matrix-client-parse-image ((room matrix-client-room) &rest rescale-args) +(cl-defmethod matrix-client-parse-image ((room matrix-room) &rest rescale-args) "Parse image from current HTTP response buffer and return image object. RESCALE-ARGS are passed to `matrix-client-rescale-image'." (pcase-let* ((data (progn @@ -43,7 +49,8 @@ RESCALE-ARGS are passed to `matrix-client-rescale-image'." (mm-disable-multibyte) ;; Point is where the body starts, after the headers (buffer-substring (point) (point-max)))) - ((eieio buffer) room)) + ((eieio extra) room) + ((eieio buffer) extra)) (with-current-buffer buffer ;; Rescale image in room buffer to get proper size (apply #'matrix-client-rescale-image data rescale-args)))) @@ -72,15 +79,15 @@ determined by the size of the buffer's window." :max-width max-width :max-height max-height))) -(cl-defmethod matrix-client-insert-image-callback (&key (room matrix-client-room) message-id url +(cl-defmethod matrix-client-insert-image-callback (&key (room matrix-room) message-id url data error-thrown symbol-status response &allow-other-keys) "Insert image into proper place at URL in message MESSAGE-ID in ROOM. Image is passed from parser as DATA, which should be an image object made with `create-image'. This function should be called as an async callback when the image is downloaded." - (with-slots (buffer) room - (with-current-buffer buffer + (with-current-buffer (oref* room extra buffer) + (save-excursion ;; Starting with last message, search backward to find message (cl-loop initially do (goto-char (point-max)) for event_id = (get-text-property (point) 'event_id) diff --git a/matrix-client-modes.el b/matrix-client-modes.el index 6a43f3a..9319445 100644 --- a/matrix-client-modes.el +++ b/matrix-client-modes.el @@ -33,13 +33,6 @@ (require 'simple) -(defvar matrix-client-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'matrix-client-send-active-line) - (define-key map (kbd "DEL") 'matrix-client-delete-backward-char) - map) - "Keymap for `matrix-client-mode'.") - (define-derived-mode matrix-client-mode fundamental-mode "Matrix Client" "Major mode for Matrix client buffers. @@ -59,7 +52,7 @@ "Face for user's own chat metadata properties." :group 'matrix-client) -(defface matrix-client-own-messages +(defface matrix-client-own-message-body '((((class color) (background light)) (:foreground "#586e75" :weight bold :slant italic)) (((class color) (background dark)) (:foreground "#586e75" :weight bold :slant italic)) (t (:weight bold :slant italic))) diff --git a/matrix-client-ng.el b/matrix-client-ng.el new file mode 100644 index 0000000..5350a1a --- /dev/null +++ b/matrix-client-ng.el @@ -0,0 +1,306 @@ +;;; matrix-client-ng.el --- summary --- -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Commentary. + +;;; Code: + +;; ARGH EMACS 26 WHY +(unless (fboundp 'if-let) + (defalias 'if-let 'if-let*) + (defalias 'when-let 'when-let*)) + +;;;; Requirements + +(require 'cl-lib) +(require 'calendar) + +(require 'f) +(require 'ov) +(require 'tracking) + +(require 'matrix-api-r0.3.0) +(require 'matrix-client-faces) +(require 'matrix-client-room) +(require 'matrix-notifications) +(require 'matrix-client-images) + +;;;; TEMP + +(cl-defun matrix-client-notify-m.room.message (event &key room &allow-other-keys) + "Show notification for m.room.message events. +EVENT should be the `event' variable from the +`defmatrix-client-handler'. ROOM should be the room object." + (pcase-let* (((map content sender event_id) event) + ((map body) content) + ((eieio extra) room) + ((eieio buffer) extra) + (display-name (matrix-user-displayname room sender)) + (id (notifications-notify :title (format$ "$display-name") + ;; Encode the message as ASCII because dbus-notify + ;; can't handle some Unicode chars. And + ;; `ignore-errors' doesn't work to ignore errors + ;; from it. Don't ask me why. + :body (encode-coding-string body 'us-ascii) + :category "im.received" + :timeout 5000 + :app-icon nil + :actions '("default" "Show") + :on-action #'matrix-client-notification-show))) + (map-put matrix-client-notifications id (a-list 'buffer buffer + 'event_id event_id)) + ;; Trim the list + (setq matrix-client-notifications (-take 20 matrix-client-notifications)))) + +;;;; Variables + +(defvar matrix-client-ng-sessions nil + "List of active sessions.") + +(defvar matrix-client-ng-mark-modified-rooms t) + +(defvar matrix-client-ng-input-prompt "â–¶ ") + +(defvar matrix-client-ng-midnight-timer nil + "Timer used to update date headers at midnight.") + +(defcustom matrix-client-ng-render-presence t + "Show presence changes in the main buffer windows." + :type 'boolean) + +(defcustom matrix-client-ng-render-membership t + "Show membership changes in the main buffer windows." + :type 'boolean) + +(defcustom matrix-client-ng-render-html (featurep 'shr) + "Render HTML messages in buffers. These are currently the +ad-hoc 'org.matrix.custom.html' messages that Vector emits." + :type 'boolean) + +(defcustom matrix-client-ng-save-token nil + "Save username and access token upon successful login." + :type 'boolean) + +(defcustom matrix-client-ng-save-token-file "~/.cache/matrix-client.el.token" + "Save username and access token to this file." + :type 'file) + +(defcustom matrix-client-use-tracking nil + "Enable tracking.el support in matrix-client." + :type 'boolean) + +(defcustom matrix-client-save-outgoing-messages t + "Save outgoing messages in kill ring before sending. +This way, in the event that a message gets lost in transit, the +user can recover it from the kill ring instead of retyping it." + :type 'boolean) + +;;;; Classes + +(matrix-defclass matrix-room-extra () + ((buffer :initarg :buffer)) + "Extra data stored in room objects.") + +;;;; Mode + +(define-derived-mode matrix-client-ng-mode fundamental-mode "Matrix" + "Mode for Matrix room buffers." + :group 'matrix-client-ng + ;; TODO: Add a new abbrev table that uses usernames, rooms, etc. + :keymap matrix-client-ng-mode-map) + +;;;; Connect / disconnect + +;;;###autoload +(defun matrix-client-ng-connect (&optional user password access-token server) + "Matrix Client NG" + (interactive) + (if matrix-client-ng-sessions + ;; TODO: Already have active session: display list of buffers + ;; FIXME: If login fails, it still shows as active. + (message "Already active") + ;; No existing session + (if-let ((enabled matrix-client-ng-save-token) + (saved (matrix-client-ng-load-token))) + ;; Use saved token + ;; FIXME: Change "username" to "user" when we no longer need compatibility with old code + (setq user (a-get saved 'username) + server (a-get saved 'server) + access-token (a-get saved 'token) + txn-id (a-get saved 'txn-id)) + ;; Not saved: prompt for username and password + (setq user (or user (read-string "User ID: ")) + password (or password (read-passwd "Password: ")) + server (or server + (--> (read-passwd "Server (leave blank to derive from user ID): ") + (if (string-empty-p it) + nil + it))))) + (if access-token + ;; Use saved token and call post-login hook + (matrix-client-ng-login-hook (matrix-session :user user + :server server + :access-token access-token + :txn-id txn-id + :initial-sync-p t)) + ;; Log in with username and password + (matrix-login (matrix-session :user user + :server server + :initial-sync-p t) + password)))) + +(cl-defmethod matrix-client-ng-login-hook ((session matrix-session)) + "Callback for successful login. +Add session to sessions list and run initial sync." + (push session matrix-client-ng-sessions) + (matrix-sync session) + (when matrix-client-ng-save-token + (matrix-client-ng-save-token session)) + ;; NOTE: What happens if the system is asleep at midnight? + (setq matrix-client-ng-midnight-timer (run-at-time "00:00" 86400 #'matrix-client-ng-update-all-date-headers)) + (message "Jacked in to %s. Syncing..." (oref session server))) + +(add-hook 'matrix-login-hook #'matrix-client-ng-login-hook) + +(cl-defmethod matrix-client-ng-save-token ((session matrix-session)) + "Save username and access token for session SESSION to file." + ;; FIXME: This does not work with multiple sessions. + ;; MAYBE: Could we use `savehist-additional-variables' instead of our own code for this? + ;; TODO: Check if file exists; if so, ensure it has a proper header so we know it's ours. + (with-temp-file matrix-client-ng-save-token-file + (with-slots (user server access-token txn-id) session + ;; FIXME: Change "username" to "user" when we no longer need compatibility with old code + ;; FIXME: Change token to access-token for clarity. + (prin1 (a-list 'username user + 'server server + 'token access-token + 'txn-id txn-id) + (current-buffer)))) + ;; Ensure permissions are safe + (chmod matrix-client-ng-save-token-file #o600)) + +(defun matrix-client-ng-load-token () + "Return saved username and access token from file." + (when (f-exists? matrix-client-ng-save-token-file) + (read (f-read matrix-client-ng-save-token-file)))) + +(defun matrix-client-ng-disconnect (&optional logout) + "Unplug from the Matrix. +If LOGOUT is non-nil, actually log out, canceling access +tokens (username and password will be required again)." + (interactive "P") + (cond (logout (seq-do #'matrix-logout matrix-client-ng-sessions) + ;; Remove saved token + (f-delete matrix-client-ng-save-token-file)) + ;; FIXME: This does not work for multiple sessions. + (t (matrix-client-ng-save-token (car matrix-client-ng-sessions)))) + (--each matrix-client-ng-sessions + ;; Kill pending sync response buffer processes + (with-slots (pending-syncs disconnect) it + (setq disconnect t) + (ignore-errors + ;; Ignore errors in case of "Attempt to get process for a dead buffer" + (seq-do #'delete-process pending-syncs))) + ;; Kill buffers + (with-slots (rooms) it + (--each rooms + (kill-buffer (oref* it extra buffer)))) + ;; Try to GC the session object. Hopefully no timers or processes or buffers still hold a ref... + (setf it nil)) + (cancel-timer matrix-client-ng-midnight-timer) + (setq matrix-client-ng-midnight-timer nil) + (setq matrix-client-ng-sessions nil)) + +;;;; Rooms + +(defun matrix-client-ng-update-all-date-headers () + "Update date headers in all rooms. +Intended to be called from a timer that runs at midnight." + (dolist (session matrix-client-ng-sessions) + (dolist (room (oref session rooms)) + (with-room-buffer room + (matrix-client--update-date-headers))))) + +;;;;; Timeline + +(cl-defmethod matrix-client-ng-timeline ((room matrix-room) event) + "Process EVENT in ROOM." + (pcase-let* (((map type) event)) + (apply-if-fn (concat "matrix-client-event-" type) + (list room event) + (matrix-unimplemented (format$ "Unimplemented client method: $fn-name"))))) + +;;;; Helper functions + +(defun matrix-client-ng-event-timestamp (data) + "Return timestamp of event DATA." + (let ((server-ts (float (a-get* data 'origin_server_ts))) + (event-age (float (or (a-get* data 'unsigned 'age) + 0)))) + ;; The timestamp and the age are in milliseconds. We need + ;; millisecond precision in case of two messages sent/received + ;; within one second, but we need to return seconds, not + ;; milliseconds. So we divide by 1000 to get the timestamp in + ;; seconds, but we keep millisecond resolution by using floats. + (/ (- server-ts event-age) 1000))) + +(defun matrix-client-ng-linkify-urls (text) + "Return TEXT with URLs in it made clickable." + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (cl-loop while (re-search-forward (rx bow "http" (optional "s") "://" (1+ (not space))) nil 'noerror) + do (make-text-button (match-beginning 0) (match-end 0) + 'mouse-face 'highlight + 'face 'link + 'help-echo (match-string 0) + 'action #'browse-url-at-mouse + 'follow-link t)) + (buffer-string))) + +(defun matrix-client-ng-buffer-visible-p (&optional buffer) + "Return non-nil if BUFFER is currently visible. +If BUFFER is nil, use the current buffer." + (let ((buffer (or buffer (current-buffer)))) + (or (eq buffer (window-buffer (selected-window))) + (get-buffer-window buffer)))) + +(defun matrix--calendar-absolute-to-timestamp (absolute) + "Convert ABSOLUTE day number to Unix timestamp. +Does not account for leap seconds. ABSOLUTE should be the number +of days since 0000-12-31, e.g. as returned by +`calendar-absolute-from-gregorian'." + ;; NOTE: This function should come with Emacs! + (let* ((gregorian (calendar-gregorian-from-absolute absolute)) + (days-between (1+ (days-between (format "%s-%02d-%02d 00:00" (cl-caddr gregorian) (car gregorian) (cadr gregorian)) + "1970-01-01 00:00"))) + (seconds-between (* 86400 days-between))) + (string-to-number (format-time-string "%s" seconds-between)))) + +(defun matrix-client--human-format-date (date) + "Return human-formatted DATE. +DATE should be either an integer timestamp, or a string in +\"YYYY-MM-DD HH:MM:SS\" format. The \"HH:MM:SS\" part is +optional." + ;; NOTE: This seems to be the only format that `days-between' (and `date-to-time') accept. This + ;; appears to be undocumented; it just says, "date-time strings" without specifying what KIND of + ;; date-time strings, leaving you to assume it pl. I only found this out by trial-and-error. + (setq date (cl-typecase date + (integer (format-time-string "%F" (seconds-to-time date))) + (float (format-time-string "%F" (seconds-to-time date))) + (list (format-time-string "%F" (seconds-to-time date))) + (string date))) + (unless (string-match (rx (= 2 digit) ":" (= 2 digit) eos) date) + (setq date (concat date " 00:00"))) + (let* ((difference (days-between (format-time-string "%F %T") date))) + (cond ((= 0 difference) "Today") + ((= 1 difference) "Yesterday") + ((< difference 7) (format-time-string "%A" (date-to-time date))) + (t (format-time-string "%A, %B %d, %Y" (date-to-time date)))))) + +;;;; Footer + +(provide 'matrix-client-ng) + +;;; matrix-client-ng.el ends here diff --git a/matrix-client-room.el b/matrix-client-room.el new file mode 100644 index 0000000..c464b0d --- /dev/null +++ b/matrix-client-room.el @@ -0,0 +1,1117 @@ +(require 'shr) + +(require 'ordered-buffer) + +(require 'esxml) + +;;;; Variables + +(defvar matrix-client-insert-prefix-fn nil + "When set, `matrix-client-ng-insert' will call this function before inserting. +Used to add a button for pending messages.") + +(defvar matrix-client-ng-mode-map + (let ((map (make-sparse-keymap)) + (mappings '( + "r" matrix-client-reply-or-insert + "R" (lambda () (interactive) (matrix-client-reply-or-insert t)) + "RET" matrix-client-ret + "DEL "matrix-client-delete-backward-char + "M-v" matrix-client-scroll-down + "C-k" matrix-client-kill-line-or-unsent-message + "TAB" matrix-client-tab + "" (lambda () + (interactive) + (matrix-client-tab :backward t)) + ))) + (cl-loop for (key fn) on mappings by #'cddr + do (define-key map (cl-typecase key + (string (kbd key)) + (otherwise key)) + fn)) + map) + "Keymap for `matrix-client-ng-mode'.") + +(defcustom matrix-client-show-room-avatars t + "Download and show room avatars." + :type 'boolean) + +(defcustom matrix-client-ng-timestamp-header-delta 300 + "Number of seconds between messages after which a timestamp header is shown." + :type 'integer) + +(defvar matrix-client-room-commands nil + "List of room commands, without leading slash. +Used for completion.") + +(defvar matrix-client-ng-shr-external-rendering-functions + (a-list 'mx-reply #'matrix-client-ng--shr-mx-reply) + "Functions used to render HTML in Matrix messages. See `shr-external-rendering-functions'.") + +;;;; Macros + +(cl-defmacro matrix-client-ng-defevent (type docstring &key object-slots event-keys content-keys let body) + "Define a method on `matrix-room' to handle Matrix events of TYPE. + +TYPE should be a symbol representing the event type, +e.g. `m.room.message'. + +DOCSTRING should be a docstring for the method. + +OBJECT-SLOTS should be a list of lists, each in the form (OBJECT +SLOT ...), which will be turned into a `with-slots*' form +surrounding the following `pcase-let*' and BODY. (This form +seems more natural than the (SLOTS OBJECT) form used by +`with-slots'.) + +The following are bound in order in `pcase-let*': + +EVENT-KEYS should be a list of symbols in the EVENT alist which +are bound with `pcase-let*' around the body. These keys are +automatically bound: `content', `event_id', `sender', +`origin_server_ts', `type', and `unsigned'. + +CONTENT-KEYS should be a list of symbols in the EVENTs `content' +key, which are bound in the `pcase-let*' around the body. + +LET should be a varlist which is bound in the `pcase-let*' around +the body. + +BODY will finally be evaluated in the context of these slots and +variables. + +It is hoped that using this macro is easier than defining a large +method without it." + ;; FIXME: It would probably be better to use the same form for OBJECT-SLOTS that is used by + ;; `pcase-let*', because having two different ways is too confusing. + (declare (indent defun) + (debug (&define symbolp stringp + &rest [&or [":body" def-form] [keywordp listp]]))) + (let ((method-name (intern (concat "matrix-client-event-" (symbol-name type)))) + (slots (cl-loop for (object . slots) in object-slots + collect (list slots object)))) + `(cl-defmethod ,method-name ((room matrix-room) event) + ,docstring + (declare (indent defun)) + (with-slots* ,slots + (pcase-let* (((map content event_id sender origin_server_ts type unsigned ,@event-keys) event) + ((map ,@content-keys) content) + ,@let) + ,body))))) + +(defmacro with-room-buffer (room &rest body) + (declare (debug (sexp body)) (indent defun)) + `(with-slots* (((extra id) room) + ((buffer) extra)) + (unless buffer + ;; Make buffer if necessary. This seems like the easiest way + ;; to guarantee that the room has a buffer, since it seems + ;; unclear what the first received event type for a joined room + ;; will be. + (setq buffer (get-buffer-create (matrix-client-ng-display-name room))) + (matrix-client-ng-setup-room-buffer room)) + (with-current-buffer buffer + ,@body))) + +;;;; Commands + +(defun matrix-client-scroll-down () + "Call `scroll-down-command'. If point is at the top of the buffer, load history." + (interactive) + (if (= (line-number-at-pos (point)) 1) + (matrix-client-ng-fetch-history matrix-client-ng-room) + (let ((scroll-error-top-bottom t)) + (scroll-down-command)))) + +(defun matrix-client-kill-line-or-unsent-message (&optional message) + "Kill current line; with prefix, kill everything after prompt." + (interactive "P") + (if message + (progn + (goto-char (matrix-client--prompt-position)) + (kill-region (point) (point-max))) + (call-interactively #'kill-visual-line))) + +(cl-defun matrix-client-tab (&key backward) + "If point is before prompt, move point to next event; otherwise call `indent-for-tab-command'." + (interactive) + (when-let ((pos (matrix-client--next-event-pos :backward backward))) + (goto-char pos))) + +(defun matrix-client-ret () + "If point is before prompt, move point to prompt; otherwise call `matrix-client-send-active-line'." + (interactive) + (let ((prompt (matrix-client--prompt-position))) + (if (< (point) prompt) + (goto-char prompt) + (call-interactively #'matrix-client-ng-send-input)))) + +(defun matrix-client-reply-or-insert (&optional quote-p) + "If point is on a previous message, begin a reply addressed to its sender. Otherwise, self-insert. +With prefix, quote message or selected region of message." + (interactive "P") + (if (get-text-property (point) 'sender) + ;; Start reply + (let* ((display-name (get-text-property (point) 'displayname)) + (sender (get-text-property (point) 'sender)) + (event-id (get-text-property (point) 'event_id)) + (quote (if quote-p + (--> (if (use-region-p) + (buffer-substring (region-beginning) (region-end)) + (matrix-client-ng--this-message)) + (s-trim it) + (prog1 it + (remove-text-properties 0 (length it) '(read-only t) it))) + ;; Not quoting + "")) + ;; Sort of hacky but it will do for now. + (string (propertize (concat display-name ": " (propertize (replace-regexp-in-string (rx bol) "> " quote) + 'quoted-body quote)) + 'event_id event-id + 'sender sender)) + (inhibit-read-only t)) + (goto-char (matrix-client--prompt-position)) + (insert string "\n\n")) + ;; Do self-insert + (call-interactively 'self-insert-command))) + +(defun matrix-client-ng-delete-backward-char (n &optional kill-flag) + "Delete backward unless the point is at the prompt or other read-only text." + (interactive "p\nP") + (unless (get-text-property (- (point) 2) 'read-only) + (call-interactively #'delete-backward-char n kill-flag))) + +(cl-defun matrix-client-ng-send-input (&key html) + "Send current input to current room. +If HTML is non-nil, treat input as HTML." + (interactive) + (goto-char (matrix-client--prompt-position)) + (pcase-let* ((room matrix-client-ng-room) + ((eieio session (id room-id)) room) + ((eieio user txn-id) session) + (input (let ((text (delete-and-extract-region (point) (point-max)))) + (remove-text-properties 0 (length text) '(read-only t) text) + text)) + (first-word (when (string-match (rx bos "/" (group (1+ (not space)))) input) + (match-string 1 input))) + (event-string (propertize input + 'sender user + 'timestamp (time-to-seconds))) + (matrix-client-insert-prefix-fn (lambda () + (insert-button "[pending] " + 'face 'matrix-client-pending-messages + 'action (lambda (&rest ignore) + (when (yes-or-no-p "Resend message?") + ;; FIXME: Include txn-id. FIXME: This will include + ;; the metadata, which we probably don't want to + ;; resend. + (matrix-send-message room string + :override-txn-id (1+ txn-id)))) + 'help-echo "Resend message" + 'transaction_id (1+ txn-id)))) + (format) (formatted-body) (extra-content)) + (when (get-text-property 0 'event_id input) + ;; Quoting + ;; FIXME: This is getting ugly. Needs refactoring. + (let* ((event-id (get-text-property 0 'event_id input)) + (sender (get-text-property 0 'sender input)) + (sender-displayname (matrix-user-displayname room sender)) + (quoted-body-start-pos (text-property-not-all 0 (length input) 'quoted-body nil input)) + (quoted-body (if quoted-body-start-pos + (get-text-property quoted-body-start-pos 'quoted-body input) + "")) + (input (let ((text (substring input (next-single-property-change 0 'event_id input)))) + ;; Not sure if removing read-only is necessary. + (remove-text-properties 0 (length text) '(read-only t) text) + text)) + (byline (if (string-empty-p quoted-body) + (format$ "$sender-displayname:") + (format$ "In reply to $sender-displayname
"))) + (html (if (string-empty-p quoted-body) + (concat byline input) + (concat "
" byline quoted-body "
" input)))) + (setq format "org.matrix.custom.html" + formatted-body html + input (concat "> <" sender "> " quoted-body "\n\n" input) + extra-content (a-list 'format format + 'formatted_body formatted-body + 'm.relates_to (a-list 'm.in_reply_to (a-list 'event_id event-id)))))) + (when html + (setq format "org.matrix.custom.html" + formatted-body input + input (matrix-client-ng--html-to-plain input) + extra-content (a-list 'format format + 'formatted_body formatted-body))) + (unless (s-blank-str? input) + (when matrix-client-save-outgoing-messages + (push input kill-ring)) + (apply-if-fn (concat "matrix-client-ng-room-command-" first-word) + ;; Special command: apply command argument (i.e. without "/command ") + (list room (s-chop-prefix (concat "/" first-word " ") input)) + (progn + ;; Normal message + (matrix-client-event-m.room.message + room (a-list 'origin_server_ts (* 1000 (string-to-number (format-time-string "%s"))) + 'sender user + 'unsigned (a-list 'transaction_id (1+ txn-id)) + 'content (a-list 'body input + 'msgtype "m.text" + 'format format + 'formatted_body formatted-body) + 'type "m.room.message")) + (matrix-send-message room input + :extra-content extra-content + :success (apply-partially #'matrix-client-send-message-callback room + ;; HACK: We have to get the txn-id + ;; ourselves here so we can apply it to the + ;; callback, before send-message returns + ;; the txn-id. + (1+ txn-id)) + :error (apply-partially #'matrix-client-send-message-error-callback room + (1+ txn-id))) + (matrix-client-ng-update-last-seen room)))))) + +(defun matrix-client-ng--event-body (id) + "Return event message body for ID." + ;; NOTE: Currently unused, but leaving in because it may be useful. + (save-excursion + ;; NOTE: `matrix--prev-property-change' is actually returning the point at which the property + ;; CEASES to have the value, rather than where the value begins. I don't like that, but + ;; changing that function would break a lot of other things, so I'm not going to do that now. + (when-let* ((metadata-start (matrix--prev-property-change (point-max) 'event_id id)) + (message-start (next-single-property-change metadata-start 'face)) + (message-end (next-single-property-change metadata-start 'event_id))) + (s-trim (buffer-substring message-start message-end))))) + +(defun matrix-client-ng--html-to-plain (html) + "Return plain-text rendering of HTML." + ;; `shr-insert-document' insists on wrapping lines, so we disable the function it uses. + (cl-letf (((symbol-function 'shr-fill-line) (lambda (&rest ignore) nil))) + (let* ((tree (with-temp-buffer + (insert html) + (libxml-parse-html-region (point-min) (point-max)))) + (plain-text (with-temp-buffer + (shr-insert-document tree) + (buffer-substring-no-properties (point-min) (point-max))))) + (s-trim plain-text)))) + +(cl-defmethod matrix-client-ng-upload ((room matrix-room) path) + "Upload file at PATH to ROOM. +PATH may be a local path, optionally prefixed with \"file://\", +or a remote HTTP(S) path, in which case the file will be +downloaded and then uploaded. Prompts for confirmation before +uploading. + +Interactively, completes local file path; with prefix, reads +path/URL without completion." + (interactive (list (if current-prefix-arg + (read-string "Path/URL: ") + (read-file-name "Upload file: " nil nil 'confirm)))) + (when (yes-or-no-p (format "Really upload %s? " path)) + (message "Uploading %s..." path) + (matrix-upload room (pcase path + ;; NOTE: `url-file-local-copy' is synchronous; might be nice to do this + ;; with a callback. + ((rx bos "http" (optional "s") "://") + (or (url-file-local-copy path) + (error "Download failed (%s)" path))) + ((rx bos "file://" (let local-path (1+ anything))) + local-path) + (_ path))))) + +;;;; Methods + +(cl-defmethod matrix-client-ng-fetch-history ((room matrix-room)) + "Load earlier messages for ROOM." + (matrix-client-ng-room-banner room "Loading history...") + (matrix-messages room )) + +(cl-defmethod matrix-client-ng-fetch-history-callback ((room matrix-room) &key data &allow-other-keys) + (pcase-let* (((map start end chunk) data) + (matrix-client-enable-notifications nil)) ; Silence notifications for old messages + ;; NOTE: We don't add the events to the timeline of the room object. + (seq-doseq (event chunk) + (matrix-event room event)) + ;; NOTE: When direction is "b", as it is when fetching earlier messages, the "end" token is the + ;; earliest chronologically, so it becomes the room's new "start" token. Not confusing at + ;; all... (maybe API 0.3.0 is better) + (matrix-client-ng-room-banner room nil))) + +(cl-defmethod matrix-client-ng-room-banner ((room matrix-room) message) + "Display MESSAGE in a banner overlay at top of ROOM's buffer. +If MESSAGE is nil, clear existing message." + (with-room-buffer room + (let ((ov (or (car (ov-in 'matrix-client-banner)) + (ov (point-min) (point-min) + 'matrix-client-banner t))) + (message (when message + (propertize message + 'face 'font-lock-comment-face)))) + (ov-set ov 'before-string message)))) + +(cl-defmethod matrix-client-ng--delete-event ((room matrix-room) plist) + "Delete event with text properties in PLIST from ROOM's buffer." + (with-room-buffer room + (-when-let* (((beg end) (matrix-client-ng--find-propertized-string plist)) + (inhibit-read-only t)) + (delete-region beg end)))) + +(cl-defmethod matrix-client-send-message-callback ((room matrix-room) txn-id &key data &allow-other-keys) + "Client callback for send-message. +Replacing pending button with normal message event." + ;; NOTE: ewoc.el might make this easier... + (matrix-log (a-list :event 'matrix-client-send-message-callback + :txn-id txn-id + :data data)) + (pcase-let* (((eieio session) room) + ((eieio user) session) + ((map event_id) data) + (inhibit-read-only t)) + (with-room-buffer room + (-when-let* (((beg end) (matrix-client-ng--find-propertized-string (list 'transaction_id txn-id)))) + (add-text-properties beg end (list 'event_id event_id)) + ;; Remove "pending" overlay + (--when-let (car (ov-in 'transaction_id txn-id)) + (delete-region (ov-beg it) (ov-end it)) + (delete-overlay it)))))) + +(cl-defmethod matrix-client-send-message-error-callback ((room matrix-room) txn-id &key data &allow-other-keys) + "Client error callback for send-message. +Update [pending] overlay." + ;; NOTE: ewoc.el might make this easier... + (matrix-log (a-list :event 'matrix-client-send-message-error-callback + :txn-id txn-id)) + (pcase-let* (((eieio session) room) + ((eieio user) session)) + (with-room-buffer room + ;; MAYBE: Should probably make a little library to insert and replace things in the buffer... + (if-let* ((inhibit-read-only t) + ;; MAYBE: Ensure that only one overlay is found. + (ov (car (ov-in 'transaction_id txn-id))) + (beg (ov-beg ov)) + (end (ov-end ov))) + (progn ;; Found message + (delete-region beg end) + (goto-char beg) + ;; This should insert into the overlay + (insert (propertize "[FAILED] " + 'face 'matrix-client-failed-messages))) + ;; Message not found + (matrix-error (a-list 'event 'matrix-client-send-message-callback + 'error "Can't find transaction" + :txn-id txn-id)))))) + +(defvar matrix-client-ordered-buffer-point-fn + (lambda (timestamp) + (funcall #'ordered-buffer-point-fn + :backward-from #'matrix-client--prompt-position + :property 'timestamp + :value timestamp + :comparator #'<=)) + "Used to override point function when fetching old messages.") + +(cl-defmethod matrix-client-ng-insert ((room matrix-room) string &key update) + "Insert STRING into ROOM's buffer. +STRING should have a `timestamp' text-property. + +UPDATE may be a plist, in which case the buffer will be searched +for an existing item having text properties matching the keys and +values in UPDATE; if found, it will be replaced with STRING, +otherwise a new item will be inserted. + +If `matrix-client-insert-prefix-fn' is non-nil, call that function with +point positioned before the inserted message." + (with-room-buffer room + (save-excursion + (let* ((inhibit-read-only t) ; MAYBE: use buffer-read-only mode instead + (timestamp (get-text-property 0 'timestamp string)) + (event-id (get-text-property 0 'event_id string)) + (non-face-properties (cl-loop for (key val) on (text-properties-at 0 string) by #'cddr + unless (eq key 'face) + append (list key val))) + (string (apply #'propertize (concat string "\n") 'read-only t non-face-properties))) + (unless (and update + ;; Inserting our own message, received back in /sync + (matrix-client-ng--replace-string update string)) + ;; Inserting someone else's message, or our own from earlier sessions + (let ((ordered-buffer-prefix-fn (apply-partially #'matrix-client-ng--ordered-buffer-prefix-fn timestamp)) + (ordered-buffer-point-fn (apply-partially matrix-client-ordered-buffer-point-fn timestamp))) + ;; MAYBE: Ensure event before point doesn't have the same ID. Removed this check when + ;; switched to ordered-buffer, not sure if necessary. + (ordered-buffer-insert string 'timestamp timestamp))) + ;; Update tracking + (unless (matrix-client-buffer-visible-p) + (set-buffer-modified-p t) + (when matrix-client-use-tracking + ;; TODO handle faces when receving highlights + (tracking-add-buffer (current-buffer)))))))) + +(defun matrix-client-ng--ordered-buffer-prefix-fn (timestamp) + "Insert headers at point if necessary, depending on TIMESTAMP." + ;; FIXME: When inserting from point-min, this should look at the next event, not the previous one. + ;; May want to use a defvar, maybe something like `ordered-buffer-insertion-direction'. + (let* ((ordered-buffer-header-face 'matrix-client-date-header) + (previous-timestamp (unless (bobp) + (get-text-property (1- (point)) 'timestamp))) + (day-number (time-to-days timestamp)) + (previous-day-number (when previous-timestamp + (time-to-days previous-timestamp)))) + (when (or (not previous-day-number) + (not (= previous-day-number day-number))) + (let ((ordered-buffer-header-face '(:inherit matrix-client-date-header :height 1.5)) + (ordered-buffer-header-suffix nil)) + (ordered-buffer-insert-header (matrix-client--human-format-date timestamp) + 'timestamp (->> timestamp + (format-time-string "%Y-%m-%d 00:00:00") + date-to-time + time-to-seconds) + 'matrix-client-day-header t))) + (when (or (not previous-timestamp) + (>= (abs (- timestamp previous-timestamp)) matrix-client-ng-timestamp-header-delta)) + ;; NOTE: When retrieving earlier messages, this inserts a new hour:minute header before every + ;; batch of messages. That's not consistent with `matrix-client-ng-timestamp-header-delta', + ;; but it does visually distinguish each batch of old messages, which is helpful, so I'm going + ;; to leave this behavior for now. If we decide it's not what we want, we could do something + ;; like check the next timestamp rather than the previous one, when inserting newer messages. + (ordered-buffer-insert-header (format-time-string "%H:%M" timestamp) + 'timestamp (->> timestamp + (format-time-string "%Y-%m-%d %H:%M:00") + date-to-time + time-to-seconds))))) + +(cl-defmethod matrix-client-ng-update-last-seen ((room matrix-room) &rest _) + "Move the last-seen overlay to after the last message in ROOM." + (with-room-buffer room + ;; FIXME: Does this need to be when-let? Shouldn't these always be found? + (when-let ((seen-ov (car (ov-in 'matrix-client-last-seen))) + (target-pos (1- (matrix-client--prompt-position)))) + (ov-move seen-ov target-pos target-pos)))) + +;;;;; Room metadata + +(cl-defmethod matrix-client-ng-rename-buffer ((room matrix-room)) + "Rename ROOM's buffer." + (with-room-buffer room + (rename-buffer (matrix-client-ng-display-name room)))) + +(cl-defmethod matrix-client-ng-display-name ((room matrix-room)) + "Return display name for ROOM. +If a buffer already exists with the name that would be returned, +a different name is returned." + ;; https://matrix.org/docs/spec/client_server/r0.3.0.html#id267 + + ;; FIXME: Make it easier to name the room separately from the room's buffer. e.g. I want the + ;; header line to have the official room name, but I want the buffer name in 1-on-1 chats to be + ;; the other person's name. + + (cl-macrolet ((displaynames-sorted-by-id (members) + `(--> ,members + (-sort (-on #'string< #'car) it) + (--map (matrix-user-displayname room (car it)) + it))) + (members-without-self () `(cl-remove self members :test #'string= :key #'car)) + (pick-name (&rest choices) + ;; This macro allows short-circuiting the choice forms, only evaluating them when needed. + `(or ,@(cl-loop for choice in choices + collect `(--when-let ,choice + ;; NOTE: We check to see if strings are empty, + ;; because apparently it can happen that an + ;; mxid is something like "@:hostname", with + ;; an empty displayname. Sigh. + (if (listp it) + (cl-loop for this-choice in (-non-nil (-flatten it)) + unless (or (string-empty-p this-choice) + (--when-let (get-buffer this-choice) + ;; Allow reusing current name of current buffer + (not (equal it (oref* room extra buffer))))) + return this-choice) + (unless (or (string-empty-p it) + (--when-let (get-buffer it) + ;; Allow reusing current name of current buffer + (not (equal it (oref* room extra buffer))))) + it))))))) + (pcase-let* (((eieio id name aliases members session) room) + ((eieio (user self)) session)) + (pcase (1- (length members)) + (1 (pick-name (matrix-user-displayname room (caar (members-without-self))) + name aliases id)) + (2 (pick-name name aliases + (s-join ", " (displaynames-sorted-by-id (members-without-self))) + id)) + ((or `nil (pred (< 0))) ;; More than 2 + (pick-name name + ;; FIXME: The API docs say to use the canonical_alias instead of aliases. + aliases + (format "%s and %s others" + (car (displaynames-sorted-by-id (members-without-self))) + (- (length members) 2)) + id)) + (_ (pick-name name aliases + ;; FIXME: The API says to use names of previous room + ;; members if nothing else works, but I don't feel like + ;; coding that right now, so we'll just use the room ID. + id)))))) + +(cl-defmethod matrix-client-ng-update-header ((room matrix-room)) + "Update the header line of the current buffer for ROOM. +Also update prompt with typers." + (unless (and (boundp 'tabbar-mode) tabbar-mode) + ;; Disable when tabbar mode is on. MAYBE: Remove this. + (with-room-buffer room + (pcase-let* (((eieio avatar typers name topic) room) + (name (when name + (propertize name 'face 'font-lock-keyword-face))) + (ov (car (ov-in 'matrix-client-prompt))) + (typers-string (s-join ", " (cl-loop for user across typers + collect (matrix-user-displayname room user)))) + (prompt (if (> (length typers) 0) + (concat (propertize (concat "Typing: " typers-string) + 'face 'font-lock-comment-face) + "\n" matrix-client-ng-input-prompt) + matrix-client-ng-input-prompt))) + (ov-set ov 'before-string prompt) + (setq header-line-format (concat avatar + ;; NOTE: Not sure if using `format' with an image-containing string works. + (format$ "$name: $topic"))))))) + +(add-hook 'matrix-room-metadata-hook #'matrix-client-ng-update-header) + +;;;;; Room buffer setup + +(cl-defmethod matrix-client-ng-setup-room-buffer ((room matrix-room)) + "Prepare and switch to buffer for ROOM-ID, and return room object." + (with-room-buffer room + (matrix-client-ng-mode) + (visual-line-mode 1) + (setq buffer-undo-list t) + ;; Unset buffer's modified status when it's selected + ;; FIXME: Reactivate this. + ;; (when matrix-client-ng-mark-modified-rooms + ;; (add-hook 'buffer-list-update-hook #'matrix-client-ng-buffer-list-update-hook 'append 'local)) + (erase-buffer) + (switch-to-buffer (current-buffer)) + ;; FIXME: Remove these or update them. + ;; (set (make-local-variable 'matrix-client-room-connection) con) + (setq-local matrix-client-ng-room room) + (when matrix-client-use-tracking + (tracking-mode 1))) + (matrix-client-ng-insert-prompt room) + (matrix-client-ng-insert-last-seen room)) + +(cl-defmethod matrix-client-ng-insert-last-seen ((room matrix-room)) + "Insert last-seen overlay into ROOM's buffer." + (with-room-buffer room + (when-let ((prompt-ov (car (ov-in 'matrix-client-prompt))) + (target-pos (1- (ov-beg prompt-ov)))) + (ov target-pos target-pos + 'before-string (concat "\n" (propertize "\n\n" 'face 'matrix-client-last-seen)) + 'matrix-client-last-seen t)))) + +(cl-defmethod matrix-client-ng-insert-prompt ((room matrix-room)) + "Insert prompt into ROOM's buffer." + (with-room-buffer room + (let ((inhibit-read-only t) + (ov-sticky-front t)) + (goto-char (point-max)) + (insert (propertize "\n" 'read-only t) + "\n") + (ov (point) (point) + 'before-string (concat (propertize "\n" + 'face '(:height 0.1)) + matrix-client-ng-input-prompt) + 'matrix-client-prompt t)))) + +;;;;; Room commands + +(cl-defmacro matrix-client-ng-def-room-command (name &key docstring message (msgtype "m.text") insert) + "Define a room command that sends the return value of FN as a message. + +In all expressions evaluated, the variable `room' is bound to the +room object, and `input' is bound to the command's +argument (i.e. everything after \"/command\"). + +MESSAGE may be a lisp expression, the value of which is sent to +the room as a message. + +MSGTYPE may be, e.g. \"m.text\" (the default), \"m.emote\", +etc (see API docs). + +INSERT may be a lisp expression which evaluates to a string, +which is inserted in the room buffer. This happens after MESSAGE +is sent, if any." + (declare (indent defun)) + (let* ((command (symbol-name name)) + (method-name (intern (concat "matrix-client-ng-room-command-" command)))) + `(progn + (cl-defmethod ,method-name ((room matrix-room) input) + ,docstring + (--when-let ,message + (matrix-send-message room it :msgtype ,msgtype)) + (--when-let ,insert + (let ((matrix-client-insert-prefix-fn nil)) + (matrix-client-ng-insert room (matrix-client-ng--notice-string it)))) + (matrix-client-ng-update-last-seen room)) + (add-to-list 'matrix-client-room-commands ,command)))) + +(matrix-client-ng-def-room-command me + :message input + :msgtype "m.emote" + :docstring "Send emote to room.") + +(matrix-client-ng-def-room-command who + :insert (with-slots (members) room + (concat "Room members: " + (--> members + (--map (a-get (cdr it) 'displayname) it) + (--sort (string-collate-lessp it other nil 'ignore-case) + it) + (s-join ", " it)))) + :docstring "Print list of room members.") + +(matrix-client-ng-def-room-command join + :insert (pcase-let* (((eieio session) room)) + ;; Only accept one room + (if (> (length (s-split (rx (1+ space)) input)) 1) + (user-error "Invalid /join command") + (matrix-join-room session input) + (concat "Joining room: " input))) + :docstring "Join room on session. +INPUT should be, e.g. \"#room:matrix.org\".") + +(cl-defmethod matrix-client-ng-room-command-html ((room matrix-room) input) + "Send HTML message to ROOM. +INPUT should be, e.g. \"/html ...\"." + ;; HACK: Reinsert HTML without "/html" and call send-input again + (insert input) + (matrix-client-ng-send-input :html t)) + +(matrix-client-ng-def-room-command upload + :insert (when (matrix-client-ng-upload room input) + (concat "Uploading: " input)) + :docstring "Upload file at local path or URL to ROOM.") + +;;;; Functions + +;;;;; Support + +(defun matrix-client-ng--notice-string (s) + "Return string S propertized for insertion with `matrix-client-ng-insert'. +Adds timestamp text-property at current time and sets notice face." + (propertize s + 'timestamp (time-to-seconds) + 'face 'matrix-client-notice)) + +(cl-defun matrix-client--next-event-pos (&key limit backward) + "Return position of next event in buffer. If BACKWARD is non-nil, look backward. +If LIMIT is non-nil, don't search past it; otherwise determine +limit automatically." + (let ((fn (cl-case backward + ('nil #'matrix--next-property-change) + (t #'matrix--prev-property-change)))) + (funcall fn (point) 'event_id nil limit))) + +(defun matrix-client-ng--this-message () + "Return message point is on." + (let* ((beg (previous-single-property-change (point) 'event_id)) + (end (next-single-property-change (point) 'event_id)) + ;; Skip past metadata + (message-beg (next-single-property-change beg 'face))) + (buffer-substring message-beg end))) + +(defun matrix-client-ng--replace-string (plist string) + "Replace text in buffer, which has text properties and values found in PLIST, with STRING. +If such text is not found, return nil." + (save-excursion + (goto-char (point-max)) + (-when-let* (((beg end) (matrix-client-ng--find-propertized-string plist))) + (goto-char beg) + (delete-region beg end) + (insert string) + t))) + +(defun matrix-client-ng--find-propertized-string (plist) + "Return list of beginning and ending positions in buffer that have text properties in PLIST." + (save-excursion + (goto-char (point-max)) + (-let* (((first-property first-value rest) (list (car plist) (cadr plist) (cddr plist)))) + (cl-loop for pos = (matrix--prev-property-change (point) first-property first-value) + ;; NOTE: We subtract 1 from pos because + ;; `previous-single-property-change' returns the position + ;; *after* the property is set, so checking that position will + ;; find no value, and then the loop will skip to where the + ;; property *starts*. + while pos + when (and pos + (cl-loop for (property value) on rest by #'cddr + always (equal (get-text-property pos property) value))) + ;; NOTE: We assume that when the first property changes again, + ;; we've found the beginning of the string. To be completely + ;; correct, we should check all of the properties and find the + ;; first place any of them change, but that probably isn't + ;; necessary, and it would be slower. + return (list (previous-single-property-change pos first-property) pos) + do (goto-char pos))))) + +(defun matrix-client--update-date-headers () + "Update date headers in current buffer." + (cl-flet ((next-header-pos () (matrix--next-property-change (point) 'matrix-client-day-header nil limit))) + (save-excursion + (goto-char (point-min)) + (cl-loop with inhibit-read-only = t + with limit = (matrix-client--prompt-position) + with pos = (if (get-text-property (point) 'matrix-client-day-header) + (point) + (next-header-pos)) + while pos + for timestamp = (get-text-property pos 'timestamp) + for new-date-string = (propertize (matrix-client--human-format-date timestamp) + 'timestamp timestamp + 'matrix-client-day-header t + ;; FIXME: Put the face in a variable. + 'face '(:inherit matrix-client-date-header :height 1.5)) + do (progn + (goto-char pos) + (setf (buffer-substring (+ 2 (point)) (1- (next-single-property-change (point) 'timestamp nil limit))) + new-date-string)) + do (setq pos (next-header-pos)))))) + +(defun matrix-client--prompt-position () + "Return position of prompt in current buffer." + (ov-beg (car (ov-in 'matrix-client-prompt)))) + +(defun matrix--prev-property-change (pos property &optional value limit) + "Return the previous position in buffer, starting from POS, where PROPERTY changes and is set. +If VALUE is non-nil, ensure PROPERTY has VALUE, compared with +`equal'. Positions where PROPERTY is not set are ignored. If +LIMIT is non-nil, don't search before that position. If property +doesn't change before POS, return nil." + (cl-loop do (setq pos (previous-single-property-change pos property nil limit)) + ;; NOTE: We have to test `limit' ourselves, because `previous-single-property-change' + ;; returns `limit' if nothing is found until it. + while (and pos + (or (not limit) + (> pos limit))) + for value-at-pos = (or (get-text-property pos property) + ;; HACK: We also check the value at the position before the change is detected, because + ;; `previous-single-property-change' returns the position after it changes, where it has + ;; no value. But we only do this when testing for a value. + (when value + (get-text-property (1- pos) property))) + when (and value-at-pos + (or (not value) + (equal value-at-pos value))) + return pos)) + +(defun matrix--next-property-change (pos property &optional value limit) + "Return the next position in buffer, starting from POS, where PROPERTY changes and is set. +If VALUE is non-nil, ensure PROPERTY has VALUE, compared with +`equal'. Positions where PROPERTY is not set are ignored. If +LIMIT is non-nil, don't search past that position. If property +doesn't change after POS, return nil." + (cl-loop do (setq pos (next-single-property-change pos property nil limit)) + ;; NOTE: We have to test `limit' ourselves, because `next-single-property-change' returns + ;; `limit' if nothing is found until it. + while (and pos + (or (not limit) + ;; Should this be <= ? + (< pos limit))) + for value-at-pos = (get-text-property pos property) + when (and value-at-pos + (or (not value) + (equal value-at-pos value))) + return pos)) + +(defun matrix-client-ng--propertize-buffer-string (find-plist set-plist) + "Find string in buffer having text properties in FIND-PLIST, then add the properties in SET-PLIST. +If string is not found or no properties change, return nil." + (-when-let* (((beg end) (matrix-client-ng--find-propertized-string find-plist)) + (inhibit-read-only t)) + (add-text-properties beg end set-plist))) + +;;;; Events + +(defun matrix-client-ng--shr-mx-reply (dom) + "Insert formatted text for DOM rooted at mx-reply tag. +The purpose of this function is to add the +`matrix-client-quoted-message' face to only the quoted message +body, rather than the entire contents of the mx-reply tag (which +includes the \"In reply to\" link to the quoted message ID)." + ;; TODO: Suggest that the Matrix server should send the quoted message as event metadata rather + ;; than pseudo-HTML. Then we wouldn't have to do this hacky parsing of the pseudo HTML. + (cl-labels ((newline-to-br (string) + ;; I couldn't find an existing function to split a string by a regexp + ;; AND replace the matches with other elements of a number equal to the + ;; length of each match, so I came up with this. + (cl-loop with length = (length string) + with positions = (append (s-matched-positions-all "\n+" string) + (list (cons length length))) + with from = 0 + for (match-start . match-end) in positions + collect (substring string from match-start) + append (-repeat (- match-end match-start) '(br nil)) + do (setq from match-end))) + (walk-dom (dom) + ;; Return DOM replacing newlines with `br' tag nodes to preserve newlines when the HTML is rendered. + (pcase dom + (`(,tag ,props . ,children) `((,tag ,props ,@(-flatten-n 1 (mapcar #'walk-dom children))))) + ((rx bos "\n" eos) '((br nil))) + ((pred stringp) (if (s-contains? "\n" dom) + (newline-to-br dom) + ;; Always return a list so we can flatten it. This is really messy. Ugh. + (list dom)))))) + (-let* ((((quoted-event-a &as _a ((_href . event-url)) . _) + (quoted-sender-a &as _a _attrs sender) . quoted-dom) + (esxml-query-all "blockquote a" dom)) + (quoted-dom (--> (esxml-query-all "blockquote *" dom) + ;; This query selects more than we want, including the parts we already + ;; selected in the previous query, so we use those queried elements to + ;; remove them from this query, leaving only the quoted message + ;; elements. + (--remove (or (equal it quoted-event-a) + (equal it quoted-sender-a) + (equal it "In reply to") + (equal it sender)) + it) + ;; Remove blank lines before quoted message + (cl-loop while (and (stringp it) + (s-blank-str? (car it))) + do (pop it) + finally return it) + (-map #'walk-dom it) + (-flatten-n 1 it))) + (dom `(html nil (body nil (blockquote nil ,@quoted-dom))))) + (shr-tag-a quoted-event-a) (insert " ") (shr-tag-a quoted-sender-a) (insert ":") + (let ((pos (point))) + ;; NOTE: It is crazy that I have to do this, but for some inexplicable reason, + ;; `shr-string-pixel-width' is returning 280 as the width of a single "-" character--except + ;; when I call this function manually, or when running in edebug: then it works fine. Oh, + ;; and in an earlier Emacs session, it also worked fine--it only started misbehaving this + ;; way after I restarted Emacs. WHO KNOWS WHY! + (cl-letf (((symbol-function 'shr-string-pixel-width) (lambda (string) + (if (not shr-use-fonts) + (length string) + (frame-char-width)))) + ((symbol-function 'shr-fill-line) (symbol-function 'matrix-client-ng--shr-fill-line))) + (shr-insert-document dom)) + (add-face-text-property pos (point) 'matrix-client-quoted-message) + ;; Insert extra newline after blockquote. (I think shr doesn't insert a blank line after + ;; the blockquote because it doesn't see anything after the blockquote.) + (insert "\n"))))) + +;; Copy the function's definition so we can use it later; an alias would not be correct. +(fset 'matrix-client-ng--shr-fill-line (symbol-function 'shr-fill-line)) + +(matrix-client-ng-defevent m.room.message + "Process m.room.message EVENT in ROOM." + :object-slots ((room session) + (session user initial-sync-p)) + :content-keys (body format formatted_body msgtype thumbnail_url url) + :let (;; We don't use `matrix-client-event-data-timestamp', because for + ;; room messages, the origin_server_ts is the actual message time. + (timestamp (/ origin_server_ts 1000)) + ;; FIXME: Not sure we need to call `seconds-to-time' here. + (timestamp-string (format-time-string "%T" (seconds-to-time timestamp))) + (displayname (matrix-user-displayname room sender)) + ((map transaction_id) unsigned) + (metadata) (msg) (matrix-image-url)) + :body (progn + (when content + ;; Redacted messages have no content, so we should do nothing for them. + (setq metadata (format$ "[$timestamp-string] $displayname> ")) + (setq message (string-trim + ;; Trim messages because HTML ones can have extra newlines + (pcase msgtype + ("m.emote" + (format$ "* $body")) + ((guard (and matrix-client-ng-render-html (string= "org.matrix.custom.html" format))) + (with-temp-buffer + ;; Because some unknown Matrix clients insert newlines between HTML + ;; tags, we must remove them to make the DOM easier to parse with + ;; `-let*' in `matrix-client-ng--shr-mx-reply'. This should be good + ;; enough. + (insert (replace-regexp-in-string (rx ">" (1+ "\n") "<") "><" formatted_body)) + (let* ((shr-external-rendering-functions matrix-client-ng-shr-external-rendering-functions) + (dom (libxml-parse-html-region (point-min) (point-max)))) + (erase-buffer) + (cl-letf (((symbol-function 'shr-fill-line) (lambda (&rest ignore) nil))) + (shr-insert-document dom))) + (buffer-string))) + ("m.image" + (setq matrix-image-url (matrix-transform-mxc-uri session (or url thumbnail_url))) + (concat body + ": " + (matrix-client-ng-linkify-urls matrix-image-url))) + (_ (matrix-client-ng-linkify-urls body))))) + ;; Apply face for own messages + (let (metadata-face message-face) + (cond ((equal sender user) + (setq metadata-face 'matrix-client-own-metadata + message-face 'matrix-client-own-message-body)) + ((string= msgtype "m.notice") + (setq metadata-face 'matrix-client-notice-metadata + message-face 'matrix-client-notice)) + (t + (setq metadata-face 'matrix-client-metadata + message-face 'matrix-client-message-body))) + ;; Use 'append so that link faces are not overridden. + (add-face-text-property 0 (length metadata) metadata-face 'append metadata) + (add-face-text-property 0 (length message) message-face 'append message)) + + ;; Delete existing event, and insert metadata with message and add text properties + (when event_id + (matrix-client-ng--delete-event room (list 'event_id event_id))) + (matrix-client-ng-insert room (propertize (concat metadata message) + 'timestamp timestamp + 'displayname displayname + 'sender sender + 'event_id event_id + 'transaction_id (cl-typecase transaction_id + (number transaction_id) + ;; The server treats txn-ids as strings. + (string (string-to-number transaction_id))))) + + ;; Start image insertion if necessary + (when matrix-client-show-images + (cl-loop for url in (-non-nil (append (matrix-client--image-urls message) + (list matrix-image-url))) + do (matrix-client-insert-image room event_id url))) + + ;; Move last-seen line if it's our own message + (when (equal sender user) + (matrix-client-ng-update-last-seen room)) + + ;; Notification + (unless (or initial-sync-p + (equal sender user)) + (matrix-client-notify "m.room.message" event :room room))))) + +(matrix-client-ng-defevent m.room.member + "Say that member in EVENT joined/left ROOM." + :object-slots ((room session) + (session initial-sync-p)) + :event-keys (state_key sender) + :content-keys (displayname membership) + :let ((displayname (or displayname sender)) + (timestamp (matrix-client-ng-event-timestamp event)) + (action (pcase membership + ("join" "joined") + ("leave" "left") + (_ membership))) + (msg (propertize (format$ "$displayname $action") + 'face 'matrix-client-notice + 'event_id event_id + 'sender sender + 'timestamp timestamp))) + ;; MAYBE: Get displayname from API room object's membership list. + :body (progn + (unless initial-sync-p + ;; FIXME: This does not seem to work; on initial connect, "user joined" messages still show up from when the user initially joined the room. + (matrix-client-ng-insert room msg) + (with-room-buffer room + (rename-buffer (matrix-client-ng-display-name room) 'unique))))) + +(matrix-client-ng-defevent m.typing + "Handle m.typing events." + :object-slots ((room typers)) + :content-keys (user_ids) + :body (progn + (setq typers user_ids) + (matrix-client-ng-update-header room))) + +(matrix-client-ng-defevent m.room.topic + "Handle m.room.topic events." + :object-slots ((room topic)) + :body (--when-let (a-get content 'topic) + ;; We can't use :content-keys to get the topic, because it shadows the room slot. + (setq topic it) + (matrix-client-ng-update-header room))) + +(matrix-client-ng-defevent m.room.avatar + "Handle room avatar events." + :object-slots ((room avatar session) + (session initial-sync-p user)) + :content-keys (sender url) + :let ((username (matrix-user-displayname room sender)) + (own-username (matrix-user-displayname room user)) + (timestamp (matrix-client-ng-event-timestamp event)) + (time-string (format-time-string "[%T]" (seconds-to-time timestamp))) + (action (if url "changed" "removed")) + (message (unless initial-sync-p + (propertize (format "%s %s %s the room avatar" time-string username action) + 'timestamp timestamp + 'face 'matrix-client-notice)))) + :body (when matrix-client-show-room-avatars + (if url + ;; New avatar + ;; TODO: Maybe display the new avatar in the chat list, like Riot. + (matrix-url-with-retrieve-async (matrix-transform-mxc-uri session url) + :parser (apply-partially #'matrix-client-parse-image room :max-width 32 :max-height 32) + :success (apply-partially #'matrix-client-room-avatar-callback + :room room + :message message + :max-width 32 + :max-height 32)) + ;; Avatar removed + (setq avatar nil) + ;; TODO: A function to automatically propertize a string with its related event data would be nice. + (when message + (matrix-client-ng-insert room message)) + (matrix-client-ng-update-header room)) + + ;; Move last-seen line if it's our own message + (when (equal own-username username) + (matrix-client-ng-update-last-seen room)))) + +(cl-defmethod matrix-client-room-avatar-callback (&key (room matrix-room) message data &allow-other-keys) + "Set avatar for ROOM. +Image is passed from parser as DATA, which should be an image +object made with `create-image'. This function should be called +as an async callback when the image is downloaded." + (with-slots (avatar) room + (when-let ((image-string (with-temp-buffer + (insert " ") + (insert-image data) + (insert " ") + (buffer-string)))) + (setq avatar image-string) + (matrix-client-ng-update-header room) + (when message + (matrix-client-ng-insert room message))))) + +;;;; Update-room-at-once approach + +(cl-defmethod matrix-client-ng-update ((room matrix-room) &key old-messages) + "Update ROOM." + (with-slots* (((extra state-new timeline-new ephemeral id) room)) + (let ((matrix-client-ordered-buffer-point-fn (if old-messages + (lambda (timestamp) + (funcall #'ordered-buffer-point-fn + :forward-from #'point-min + :property 'timestamp + :value timestamp + :comparator #'>)) + matrix-client-ordered-buffer-point-fn))) + ;; Process new timeline events + (dolist (event-list (list state-new timeline-new)) + (when old-messages + (setq event-list (nreverse event-list))) + (seq-doseq (event event-list) + (matrix-client-ng-timeline room event))) + ;; Clear new events + (matrix-clear-state room) + (matrix-clear-timeline room) + ;; Process new ephemeral events + (seq-doseq (event ephemeral) + (pcase-let* (((map type) event)) + (apply-if-fn (concat "matrix-client-event-" type) + (list room event) + (matrix-unimplemented (format$ "Unimplemented client method: $fn-name"))))) + (setq ephemeral nil) ; I think we can skip making a method for this. + ;; TODO: Update other room things: header, avatar, typers, topic, name, aliases, etc. + (matrix-client-ng-room-banner room nil)))) + +(add-hook 'matrix-room-update-hook #'matrix-client-ng-update) + +;;;; Footer + +(provide 'matrix-client-room) diff --git a/matrix-client.el b/matrix-client.el deleted file mode 100644 index ed80b69..0000000 --- a/matrix-client.el +++ /dev/null @@ -1,540 +0,0 @@ -;;; matrix-client.el --- A minimal chat client for the Matrix.org RPC - -;; Copyright (C) 2015 Ryan Rix -;; Author: Ryan Rix -;; Maintainer: Ryan Rix -;; Created: 21 June 2015 -;; Keywords: web -;; Homepage: http://doc.rix.si/matrix.html -;; Package-Version: 0.1.2 -;; Package-Requires: ((emacs "25.1") (dash "2.13.0") (json "1.4") (request "0.2.0") (a "0.1.0") (ov "1.0.6") (s "1.12.0")) - -;; This file is not part of GNU Emacs. - -;; matrix-client.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. -;; -;; matrix-client.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 -;; this file. If not, see . - -;;; Commentary: - -;; `matrix-client' is a chat client and API library for the Matrix.org decentralized RPC -;; system. `(package-install 'matrix-client)' and then either deploy your own homeserver or register -;; an account on the public homeserver https://matrix.org/beta/#/login . After you've done that, M-x -;; matrix-client will set you up with buffers corresponding to your Matrix rooms. You can join new -;; ones with /join, leave with /leave or /part, and hook in to the custom functions provided by -;; =matrix-client=. - -;; Implementation-wise `matrix-client' itself provides most of the core plumbing for -;; an interactive Matrix chat client. It uses the Matrix event stream framework -;; to dispatch a global event stream to individual rooms. There are a set of -;; 'event handlers' and 'input filters' in `matrix-client-handlers' which are used to -;; implement the render flow of the various event types and actions a user can -;; take. - -;;; Code: - -(require 'matrix-api) -(require 'cl-lib) -(require 'seq) - -(require 'dash) -(require 'ov) - -(defgroup matrix-client nil - "Settings for `matrix-client'." - :group 'communication - :link '(url-link "https://github.com/jgkamat/matrix-client-legacy-el")) - -(defcustom matrix-client-debug-events nil - "When non-nil, log raw events to *matrix-events* buffer." - :type 'boolean) - -(defcustom matrix-client-event-poll-timeout 30000 - "How long to wait, in milliseconds, for a Matrix event in the EventStream before timing out and trying again." - :type 'integer) - -(defcustom matrix-client-backfill-count 10 - "How many messages to backfill at a time when scrolling." - :type 'integer) - -(defcustom matrix-client-backfill-threshold 5 - "How close to the top of a buffer point needs to be before backfilling events." - :type 'integer) - -(defcustom matrix-client-render-presence t - "Show presence changes in the main buffer windows." - :type 'boolean) - -(defcustom matrix-client-render-membership t - "Show membership changes in the main buffer windows." - :type 'boolean) - -(defcustom matrix-client-render-html (featurep 'shr) - "Render HTML messages in buffers. These are currently the -ad-hoc 'org.matrix.custom.html' messages that Vector emits." - :type 'boolean) - -(defcustom matrix-client-enable-watchdog t - "If enabled, a timer will be run after twice the interval of -`matrix-client-event-poll-timeout'." - :type 'boolean) - -(defcustom matrix-client-show-room-avatars nil - "Download and show room avatars." - :type 'boolean) - -(defcustom matrix-client-mark-modified-rooms t - ;; This actually only controls whether a function is added to a hook - ;; in each room's buffer. - "Mark rooms with new messages as modified, and unmark them when their buffers are seen." - :type 'boolean) - -(defvar matrix-client-event-handlers '() - "An alist of (type . function) handler definitions for various matrix types. - -Each of these receives the raw event as a single DATA argument. -See `defmatrix-client-handler'. This value is used as the default -for every `matrix-client-connection' and can be overridden on a -connection basis.") - -;;;###autoload -(defclass matrix-client-connection (matrix-connection) - ((running :initarg :running - :initform nil - :documentation "BOOL specifiying if the event listener is currently running.") - (rooms :initarg :rooms - :initform nil - :documentation "List of matrix-room objects") - (end-token :initarg :end-token - :initform nil) - (event-handlers :initarg :event-handlers - :initform nil - :documentation "An alist of (type . function) handler definitions for various matrix types. - -Each of these receives the raw event as a single DATA argument. -See `defmatrix-client-handler'.") - (event-hook :initarg :event-hook - :initform nil - :documentation "A lists of functions that are evaluated when a new event comes in.") - (username :initarg :username - :initform nil - :documentation "Your Matrix username.") - (input-filters :initarg :input-filters - :initform nil - :documentation "List of functions to run input through. - -Each of these functions take a single argument, the TEXT the user -inputs. They can modify that text and return a new version of -it, or they can return nil to prevent further processing of it.") - (watchdog-timer :initarg :watchdog-timer - :initform nil) - (last-event-ts :initarg :last-event-ts - :initform 0)) - :documentation "This is the basic UI encapsulation of a Matrix connection. - -To build a UI on top of `matrix-api' start here, wire up -event-handlers and input-filters.") - -(defvar-local matrix-client-room-connection nil - "`matrix-client-connection' object for the current buffer") - -(defvar-local matrix-client-room-object nil - "`matrix-client-room' object for the current buffer") - -;; (defvar matrix-client-event-stream-end-token nil) - -(defclass matrix-client-room () - ((con :initarg :con - :initform nil) - (buffer :initarg :buffer - :initform nil - :documentation "The buffer that contains the room's chat session") - (name :initarg :room-name - :initform nil - :documentation "The name of the buffer's room.") - (aliases :initarg :aliases - :initform nil - :documentation "The aliases of the buffer's room.") - (topic :initarg :topic - :initform nil - :documentation "The topic of the buffer's room.") - (avatar :initarg :avatar - :initform nil - :documentation "The room avatar. This should be a string containing an image in its display properties.") - (id :initarg :id - :initform nil - :documentation "The Matrix ID of the buffer's room.") - (typers :initarg :typers - :initform nil) - (membership :initarg :membership - :initform nil - :documentation "The list of members of the buffer's room.") - (end-token :initarg :end-token - :initform nil - :documentation "The most recent event-id in a room, used to push read-receipts to the server."))) - -(cl-defmethod matrix-client-update-name ((room matrix-client-room)) - "Update ROOM's buffer's name. -If it only has two members, use the name of the other member. -Otherwise, use the room name or alias." - (with-slots (con membership name aliases id) room - (when-let ((username (oref con :username)) - ;; TODO: Make this a preference. Some users might want - ;; 1-1 chats always named after the other user, while - ;; others might want them named with the room name. - (buffer-name (cond ((> (length aliases) 0) - ;; First, if the room has a friendly alias (e.g. #room), use it. - (elt aliases 0)) ; The JSON list is converted to a vector. - ((when membership - (eq 2 (length membership))) - ;; Next, if the room is a 1-1 chat, use the other member's name. - (when-let ((username (cl-loop for member in membership - ;; Get non-self member - when (not (equal username (map-elt member 'displayname))) - return (or (map-elt member 'displayname) - (car member))))) - (if (eq (current-buffer) (get-buffer username)) - username - (generate-new-buffer-name username)))) - ;; Next, use the room's "name". - (name) - ;; Finally, use the plain room ID. - (id) - ;; If all else fails, use this string and give a warning. - (t (progn - (warn "Unknown room name for room: %s" room) - "[unknown]"))))) - (rename-buffer buffer-name)))) - -(defvar-local matrix-client-room-typers nil - "The list of members of the buffer's room who are currently typing.") - -(defvar matrix-client-connections '() - "Alist of (username . connection)") - -(defvar matrix-client-after-connect-hooks nil - "A list of functions to run when a new Matrix Client connection occurs.") - -(defvar matrix-client-initial-sync nil) - -(require 'matrix-client-handlers) -(require 'matrix-client-modes) - -;;;###autoload -(defun matrix-client (username) - "Connect to Matrix." - (interactive "i") - (let* ((base-url matrix-homeserver-base-url) - ;; Pass a username in to get an existing connection - (con (if username - (map-elt matrix-client-connections username) - (matrix-client-connection matrix-homeserver-base-url - :base-url matrix-homeserver-base-url)))) - (unless (oref con :token) - (matrix-client-login con username)) - (unless (oref con :running) - ;; Disable notifications for first sync - (setq matrix-client-initial-sync t) - (matrix-client-start-watchdog con nil 120) - (matrix-client-inject-event-listeners con) - (matrix-client-handlers-init con) - (matrix-sync con nil t matrix-client-event-poll-timeout - (apply-partially #'matrix-client-sync-handler con)) - (run-hook-with-args 'matrix-client-after-connect-hooks con)) - (map-put matrix-client-connections (oref con :username) con) - (oset con :running t) - (message "You're jacked in, welcome to Matrix. Your messages will arrive momentarily."))) - -(cl-defmethod matrix-client-login ((con matrix-client-connection) &optional username) - "Login to Matrix connection CON and get a token. -If [`matrix-client-use-auth-source'] is non-nil, attempt to log -in using data from auth-source. Otherwise, prompt for username -and password." - (let* ((auth-source-creation-prompts (a-list 'username "Matrix identity: " - 'secret "Matrix password for %u (homeserver: %h): ")) - (found (nth 0 (auth-source-search :max 1 - :host (oref con :base-url) - :user username - :require '(:user :secret) - :create t)))) - (when (and found - (matrix-login-with-password con (plist-get found :user) - (let ((secret (plist-get found :secret))) - (if (functionp secret) - (funcall secret) - secret)))) - (oset con :username (plist-get found :user)) - (when-let ((save-func (plist-get found :save-function))) - (funcall save-func))))) - -(defun matrix-client-disconnect (&optional connection) - "Disconnect from CONNECTION or all Matrix connections, killing room buffers." - (interactive) - (let ((connections (if connection - (list (cons nil connection)) - matrix-client-connections))) - (cl-loop for (_ . con) in connections - do (progn - ;; TODO: Improve the structure of these lists. It - ;; feels inconsistent and confusing. - (cl-loop for (_ . room) in (oref con :rooms) - do (kill-buffer (oref room :buffer))) - (oset con :running nil))) - (setq matrix-client-connections (seq-difference matrix-client-connections - connections - (-lambda ((_ . a-con) (_ . b-con)) - (equal (oref a-con :token) (oref b-con :token))))))) - -(cl-defmethod matrix-client-start-watchdog ((con matrix-client-connection) &optional force timer-secs) - (when (or force matrix-client-enable-watchdog) - (let ((last-ts (oref con :last-event-ts)) - (next (oref con :end-token)) - (timer (oref con :watchdog-timer))) - (if timer - (if (> (* 1000 (- (float-time) last-ts)) - matrix-client-event-poll-timeout) - (progn - ;; Timed out: resync - (cancel-timer timer) - ;; XXX Pull these fucking syncs out and bar them on (oref con :running) - (when (oref con :running) - (message "Reconnecting you to Matrix, one moment please...") - (cancel-timer timer) - (matrix-sync con next nil matrix-client-event-poll-timeout - (apply-partially #'matrix-client-sync-handler con)))) - ;; Not timed out: just cancel timer - (cancel-timer timer))) - (let ((timer-secs (or timer-secs (/ (* 2 matrix-client-event-poll-timeout) 1000)))) - (oset con :watchdog-timer (run-with-timer timer-secs timer-secs - (apply-partially #'matrix-client-start-watchdog con))))))) - -(cl-defmethod matrix-client-setup-room ((con matrix-client-connection) room-id) - "Prepare and switch to buffer for ROOM-ID, and return room object." - (when (get-buffer room-id) - (kill-buffer room-id)) - (let* ((room-buf (get-buffer-create room-id)) - (room-obj (matrix-client-room room-id :buffer room-buf :con con))) - (with-current-buffer room-buf - (matrix-client-mode) - (visual-line-mode 1) - (setq buffer-undo-list t) - ;; Unset buffer's modified status when it's selected - (when matrix-client-mark-modified-rooms - (add-hook 'buffer-list-update-hook #'matrix-client-buffer-list-update-hook 'append 'local)) - (erase-buffer) - (matrix-client-render-message-line room-obj) - (matrix-client-insert-last-seen-overlay)) - (switch-to-buffer room-buf) - (set (make-local-variable 'matrix-client-room-connection) con) - (set (make-local-variable 'matrix-client-room-object) room-obj) - (push (cons room-id room-obj) (oref con :rooms)) - (oset-multi room-obj - :id room-id - :buffer room-buf) - room-obj)) - -(cl-defmethod matrix-client-sync-handler ((con matrix-client-connection) data) - ;; NOTE: This function, in addition to `matrix-client-handlers-init', roughly corresponds with the Python SDK at - ;; . - (when (oref con :running) - - ;; Kill buffers for left rooms - (cl-loop for room in (a-get* data 'rooms 'leave) - do (let* ((room-id (symbol-name (car room))) - (room (matrix-client-room-for-id con room-id))) - (when (and room (oref room :buffer)) - (kill-buffer (oref room :buffer))))) - - ;; Join joined rooms - (cl-loop for room-data in (a-get* data 'rooms 'join) - do (let* ((room-id (symbol-name (car room-data))) - (room (or (a-get (oref con :rooms) room-id) - (matrix-client-setup-room con room-id))) - (room-events (cdr room-data))) - ;; For some reason, the events are in arrays instead of lists. - (cl-loop for event across (a-get* room-events 'ephemeral 'events) - ;; e.g. typing - do (matrix-client-room-event room event)) - (cl-loop for event across (a-get* room-events 'state 'events) - do (matrix-client-room-event room event)) - (cl-loop for event across (a-get* room-events 'timeline 'events) - do (matrix-client-room-event room event)))) - - ;; FIXME: `matrix-client-invite-room' is unimplemented. Looking - ;; at the API , - ;; I'm not sure this is even necessary. - ;; Process invitations - ;; (--each (a-get* data 'rooms 'invite) - ;; (matrix-client-invite-room con data)) - - ;; Process next batch - (let ((next (map-elt data 'next_batch))) - (oset-multi con - :end-token next - :last-event-ts (float-time)) - (matrix-client-start-watchdog con) - (matrix-sync con next nil matrix-client-event-poll-timeout - (apply-partially #'matrix-client-sync-handler con))) - (when matrix-client-initial-sync - (setq matrix-client-initial-sync nil)))) - -(cl-defmethod matrix-client-room-event ((room matrix-client-room) event) - "Handle state events from a sync." - (when-let ((con (oref room :con)) - (fns (oref con :event-hook))) - (--each fns - (funcall it con room event)))) - -(cl-defmethod matrix-client-render-event-to-room ((con matrix-client-connection) room item) - "Feed ITEM in to its proper `matrix-client-event-handlers' handler." - ;; NOTE: It's tempting to use `map-elt' here, but it uses `eql' to - ;; compare keys, and since the keys are strings, that doesn't work. - ;; MAYBE: Perhaps we should change the keys to symbols someday... - (when-let ((type (a-get item 'type)) - (handler (a-get (oref con :event-handlers) type))) - (funcall handler con room item))) - -(cl-defmethod matrix-client-insert ((room matrix-client-room) string) - "Insert STRING into ROOM's buffer. -STRING should have a `timestamp' text-property." - (let ((inhibit-read-only t) - (timestamp (get-text-property 0 'timestamp string))) - (with-current-buffer (oref room :buffer) - (cl-loop initially do (progn - (goto-char (ov-beg (car (ov-in 'matrix-client-prompt t)))) - (forward-line -1)) - for buffer-ts = (get-text-property (point) 'timestamp) - until (when buffer-ts - (< buffer-ts timestamp)) - while (when-let (pos (previous-single-property-change (point) 'timestamp)) - (goto-char pos)) - finally do (when-let (pos (next-single-property-change (point) 'timestamp)) - (goto-char pos))) - (insert "\n" - (propertize string 'read-only t)) - (unless (matrix-client-buffer-visible-p) - (set-buffer-modified-p t))))) - -(cl-defmethod matrix-client-inject-event-listeners ((con matrix-client-connection)) - "Inject the standard event listeners." - (unless (oref con :event-hook) - (oset con :event-hook '(matrix-client-debug-event-maybe - matrix-client-render-event-to-room)))) - -(cl-defmethod matrix-client-debug-event-maybe ((con matrix-client-connection) room data) - "Debug DATA to *matrix-events* if `matrix-client-debug-events' is non-nil." - (when matrix-client-debug-events - (with-current-buffer (get-buffer-create "*matrix-events*") - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (insert "\n" (prin1-to-string data)))))) - -(defun matrix-client-update-header-line (room) - "Update the header line of the current buffer for ROOM. -Also update prompt with typers." - ;; Disable when tabbar mode is on - (unless (and (boundp 'tabbar-mode) tabbar-mode) - (pcase-let* (((eieio avatar typers name topic buffer) room) - (name (when name - (propertize name 'face 'font-lock-keyword-face))) - (ov (car (ov-in 'matrix-client-prompt))) - (typers-string (s-join ", " (cl-loop for user across typers - collect (matrix-client-displayname-from-user-id room user)))) - (prompt (if (> (length typers) 0) - (concat (propertize (concat "Typing: " typers-string) - 'face 'font-lock-comment-face) - "\n" matrix-client-input-prompt) - matrix-client-input-prompt))) - (with-current-buffer buffer - (ov-set ov 'before-string prompt) - (setq header-line-format (concat avatar (format "%s: %s" name topic))))))) - -(defvar matrix-client-input-prompt "â–¶ ") - -(cl-defmethod matrix-client-render-message-line ((room matrix-client-room room)) - ;; FIXME: Why is there an extra "room" the arg list? EIEIO docs - ;; don't seem to mention this. - "Insert a message input at the end of the buffer." - (goto-char (point-max)) - (let ((inhibit-read-only t) - (ov-sticky-front t)) - (insert (propertize "\n" 'read-only t) - "\n") - (ov (point) (point) - 'before-string (concat (propertize "\n" 'face '(:height 0.1)) - matrix-client-input-prompt) - 'matrix-client-prompt t))) - -(defun matrix-client-send-active-line () - "Send the current message-line text after running it through input-filters." - (interactive) - (goto-char (point-max)) - - ;; TODO: Make the prompt character customizable, and probably use - ;; text-properties or an overlay to find it. - (goto-char (ov-end (car (ov-in 'matrix-client-prompt t)))) - - ;; MAYBE: Just delete the text and store it in a var instead of - ;; killing it to the kill-ring. On the one hand, it's a nice - ;; backup, but some users might prefer not to clutter the kill-ring - ;; with every message they send. - (kill-line) - (let* ((room matrix-client-room-object) - (con (oref room :con)) - (input-filters (oref con :input-filters))) - (cl-reduce 'matrix-client-run-through-input-filter - input-filters - :initial-value (pop kill-ring)) - (matrix-client-update-last-seen room))) - -(defun matrix-client-run-through-input-filter (text filter) - "Run each TEXT through a single FILTER. Used by `matrix-client-send-active-line'." - (when text - (funcall filter - (oref matrix-client-room-object :con) - text))) - -(defun matrix-client-send-to-current-room (con message) - "Send a string TEXT to the current buffer's room." - (let* (;; FIXME: Setting `room' here seems to be unnecessary, - ;; because the function is called in the context of `room'. - ;; Until adding this comment, the `let*' was `let', so `room' - ;; was coming from the surrounding context, not this. - (room matrix-client-room-object) - ;; FIXME: We shouldn't need to get `con' again here, because - ;; it's passed to the function. - (con (when room - (oref room :con))) - (room-id (when room - (oref room :id)))) - (matrix-send-message con room-id message))) - -(cl-defmethod matrix-client-update-last-seen ((room matrix-client-room) &rest _) - "Move the last-seen overlay to after the last message in ROOM." - (with-slots (buffer) room - (with-current-buffer buffer - (when-let ((prompt-ov (car (ov-in 'matrix-client-prompt))) - (seen-ov (car (ov-in 'matrix-client-last-seen))) - (target-pos (1- (ov-beg prompt-ov)))) - (ov-move seen-ov target-pos target-pos))))) - -(defun matrix-client-window-change-hook () - "Send a read receipt if necessary." - ;; FIXME: Unimplemented. - ;; (when (and matrix-client-room-id matrix-client-room-end-token) - ;; (message "%s as read from %s" matrix-client-room-end-token matrix-client-room-id) - ;; (matrix-mark-as-read matrix-client-room-id matrix-client-room-end-token)) - ) - -(provide 'matrix-client) - -;;; matrix-client.el ends here diff --git a/matrix-helpers.el b/matrix-helpers.el index f85f0f4..0d71030 100644 --- a/matrix-helpers.el +++ b/matrix-helpers.el @@ -65,6 +65,12 @@ PAIRS should be of the form (SLOT VALUE SLOT VALUE...)." ;;;; Functions +(defun matrix-pp-string (object) + "Return pretty-printed representation of OBJECT as string." + (with-temp-buffer + (pp object (current-buffer)) + (buffer-string))) + (defun matrix-client-buffer-list-update-hook () "Set buffer's modified status and move last-seen overlay when focused." ;; NOTE: Since this hook is added to the `buffer-list-update-hook', it @@ -122,18 +128,6 @@ If BUFFER is nil, use the current buffer." (let ((version (or version "api/v1"))) (format "%s/_matrix/client/%s" matrix-homeserver-base-url version))) -(defun matrix-get (key obj) - "Easy JSON accessor, get KEY's value from OBJ." - (cdr (assoc key obj))) - -(defun matrix-transform-mxc-uri (uri) - "Turn an MXC content URI in to an HTTP URL." - (let ((components (split-string uri "/"))) - (format "%s/_matrix/media/v1/download/%s/%s" - matrix-homeserver-base-url - (elt components 2) - (elt components 3)))) - (defun matrix-client-room-for-id (connection room-id) "Return room for ROOM-ID on CONNECTION." (a-get (oref connection :rooms) room-id)) @@ -157,5 +151,165 @@ If BUFFER is nil, use the current buffer." (t nil))) +(defun matrix--alist (&rest pairs) + "Return an alist of the key-value pairs in PAIRS whose value is non-nil. +PAIRS is a spliced plist." + ;; e.g. (matrix--alist "direction" "b" "limit" nil) => (("direction" . "b")) + (cl-loop for (key value) on pairs by #'cddr + when value + collect (cons key value))) + +(defun matrix--url-http-create-request (&optional ref-url) + "Create an HTTP request for `url-http-target-url', referred to by REF-URL. + +This is a copy of `url-http-create-request' from Emacs 26.1, +modified to allows binary uploads, which are prevented by the +\"fix\" for bug #23750 near the bottom of the function." + (let* ((extra-headers) + (request nil) + (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers))) + (using-proxy url-http-proxy) + (proxy-auth (if (or (cdr-safe (assoc "Proxy-Authorization" + url-http-extra-headers)) + (not using-proxy)) + nil + (let ((url-basic-auth-storage + 'url-http-proxy-basic-auth-storage)) + (url-get-authentication url-http-proxy nil 'any nil)))) + (real-fname (url-filename url-http-target-url)) + (host (url-http--encode-string (url-host url-http-target-url))) + (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers)) + nil + (url-get-authentication (or + (and (boundp 'proxy-info) + proxy-info) + url-http-target-url) nil 'any nil)))) + (if (equal "" real-fname) + (setq real-fname "/")) + (setq no-cache (and no-cache (string-match "no-cache" no-cache))) + (if auth + (setq auth (concat "Authorization: " auth "\r\n"))) + (if proxy-auth + (setq proxy-auth (concat "Proxy-Authorization: " proxy-auth "\r\n"))) + + ;; Protection against stupid values in the referrer + (if (and ref-url (stringp ref-url) (or (string= ref-url "file:nil") + (string= ref-url ""))) + (setq ref-url nil)) + + ;; We do not want to expose the referrer if the user is paranoid. + (if (or (memq url-privacy-level '(low high paranoid)) + (and (listp url-privacy-level) + (memq 'lastloc url-privacy-level))) + (setq ref-url nil)) + + ;; url-http-extra-headers contains an assoc-list of + ;; header/value pairs that we need to put into the request. + (setq extra-headers (mapconcat + (lambda (x) + (concat (car x) ": " (cdr x))) + url-http-extra-headers "\r\n")) + (if (not (equal extra-headers "")) + (setq extra-headers (concat extra-headers "\r\n"))) + + ;; This was done with a call to `format'. Concatenating parts has + ;; the advantage of keeping the parts of each header together and + ;; allows us to elide null lines directly, at the cost of making + ;; the layout less clear. + (setq request + (concat + ;; The request + (or url-http-method "GET") " " + (url-http--encode-string + (if using-proxy (url-recreate-url url-http-target-url) real-fname)) + " HTTP/" url-http-version "\r\n" + ;; Version of MIME we speak + "MIME-Version: 1.0\r\n" + ;; (maybe) Try to keep the connection open + "Connection: " (if (or using-proxy + (not url-http-attempt-keepalives)) + "close" "keep-alive") "\r\n" + ;; HTTP extensions we support + (if url-extensions-header + (format + "Extension: %s\r\n" url-extensions-header)) + ;; Who we want to talk to + (if (/= (url-port url-http-target-url) + (url-scheme-get-property + (url-type url-http-target-url) 'default-port)) + (format + "Host: %s:%d\r\n" (puny-encode-domain host) + (url-port url-http-target-url)) + (format "Host: %s\r\n" (puny-encode-domain host))) + ;; Who its from + (if url-personal-mail-address + (concat + "From: " url-personal-mail-address "\r\n")) + ;; Encodings we understand + (if (or url-mime-encoding-string + ;; MS-Windows loads zlib dynamically, so recheck + ;; in case they made it available since + ;; initialization in url-vars.el. + (and (eq 'system-type 'windows-nt) + (fboundp 'zlib-available-p) + (zlib-available-p) + (setq url-mime-encoding-string "gzip"))) + (concat + "Accept-encoding: " url-mime-encoding-string "\r\n")) + (if url-mime-charset-string + (concat + "Accept-charset: " + (url-http--encode-string url-mime-charset-string) + "\r\n")) + ;; Languages we understand + (if url-mime-language-string + (concat + "Accept-language: " url-mime-language-string "\r\n")) + ;; Types we understand + "Accept: " (or url-mime-accept-string "*/*") "\r\n" + ;; User agent + (url-http-user-agent-string) + ;; Proxy Authorization + proxy-auth + ;; Authorization + auth + ;; Cookies + (when (url-use-cookies url-http-target-url) + (url-http--encode-string + (url-cookie-generate-header-lines + host real-fname + (equal "https" (url-type url-http-target-url))))) + ;; If-modified-since + (if (and (not no-cache) + (member url-http-method '("GET" nil))) + (let ((tm (url-is-cached url-http-target-url))) + (if tm + (concat "If-modified-since: " + (url-get-normalized-date tm) "\r\n")))) + ;; Whence we came + (if ref-url (concat + "Referer: " ref-url "\r\n")) + extra-headers + ;; Length of data + (if url-http-data + (concat + "Content-length: " (number-to-string + (length url-http-data)) + "\r\n")) + ;; End request + "\r\n" + ;; Any data + url-http-data)) + ;; Bug#23750 + (unless (or + ;; Our local fix to the "fix" is to not do the string-bytes/length comparison when + ;; POSTing. + (equal url-http-method "POST") + (= (string-bytes request) + (length request))) + (error "Multibyte text in HTTP request: %s" request)) + (url-http-debug "Request is: \n%s" request) + request)) + (provide 'matrix-helpers) ;;; matrix-helpers.el ends here diff --git a/matrix-macros.el b/matrix-macros.el index 4e31e22..29ac49d 100644 --- a/matrix-macros.el +++ b/matrix-macros.el @@ -1,3 +1,164 @@ +;; -*- lexical-binding: t; -*- + + +(require 'subr-x) +(require 'url-http) + + +(defmacro format$ (string &rest objects) + "Interpolated `format'. +Any word in STRING beginning with \"$\" is replaced with the +contents of the variable named that word. OBJECTS are applied +in-order to %-sequences in STR. Words surrounded by \"${}\" may +contain %-sequences. + +For example: + + (format$ \"%s $name\" greeting) + +Is expanded to: + + (format \"%s %s\" greeting name) + +Variable names must contain only alphanumeric characters, -, or +_. Any other character will be considered not part of a variable +name, which allows placing such characters adjacent to variable +names. For example: + + (format$ \"[$date-time] %s $username>\" greeting) + +Is expanded to: + + (format \"[%s] %s %s>\" date-time greeting username) + +Including %-sequences, this: + + (format$ \"Amount: ${amount%.02f} $name %s\" date) + +Expands to: + + (format \"Amount: %.02f %s %s\" amount name date)" + (cl-macrolet ((concatf (place string) + `(setf ,place (concat ,place ,string))) + (peek (seq) + `(when (> (length ,seq) 1) + (seq-take ,seq 1)))) + (let* (current-var current-char current-% current-{ (new-str "") vars) + (while (setq current-char (when (not (string-empty-p string)) + (prog1 (seq-take string 1) + (setq string (seq-drop string 1))))) + (pcase current-char + ;; FIXME: Other whitespace chars. (Use pcase rx matcher in Emacs 26!) + (" " (progn + (or (pcase current-% + (`nil nil) + (_ (pcase current-{ + (`t (progn + ;; Space as part of %-sequence + (concatf current-% current-char))) + (_ (progn + ;; Space after %-sequence + (concatf new-str current-%)))))) + (pcase current-var + (`nil nil) + (_ (progn + ;; Space after var + (push (intern current-var) vars))))) + (unless current-{ + (concatf new-str current-char) + (setq current-var nil + current-% nil)))) + ("%" (pcase (peek string) + ("%" (progn + ;; %% + (concatf new-str "%%") + (seq-drop string 1))) + (" " (pcase current-{ + (`t (progn + ;; Part of %-sequence + (setq current-% current-char))) + (_ (progn + ;; % alone + (concatf new-str current-char))))) + (_ (progn + ;; New %-sequence + (setq current-% current-char) + (unless current-{ + (push (pop objects) vars)))))) + ("$" (pcase (peek string) + ("$" (progn + ;; "$$" + (concatf new-str "$$") + ;; FIXME: Using seq-drop here seems incorrect + (seq-drop string 1))) + (" " (progn + ;; Plain "$" + (concatf new-str "$"))) + (`nil (progn + ;; End of string + (concatf new-str "$"))) + ("{" (progn + ;; New variable with % control string + (setq current-var t + current-{ t) + (setq string (seq-drop string 1)))) + (_ (progn + ;; New var + (concatf new-str "%s") + (setq current-var t))))) + ((pred (string-match-p (rx (or alnum "-" "_" "." "+" "#")))) + ;; Character could be part of var name or %-sequence + (or (pcase current-% + (`nil nil) + (_ (progn + ;; Part of %-sequence + (concatf current-% current-char)))) + (pcase current-var + (`nil (progn + ;; Non-var character + (concatf new-str current-char))) + (`t (progn + ;; New var name + (setq current-var current-char))) + (_ (progn + ;; Partial var name + (concatf current-var current-char)))))) + ("}" (progn + (if (and current-var current-%) + (progn + ;; Closing ${} sequence + (push (intern current-var) vars) + (concatf new-str current-%) + (setq current-var nil + current-% nil + current-{ nil)) + ;; Plain } + (concatf new-str current-char)))) + (_ (progn + (if (or (pcase current-% + (`nil nil) + (_ (progn + ;; After %-sequence + t))) + (pcase current-var + (`nil nil) + (_ (progn + ;; After var + (push (intern current-var) vars))))) + (progn + (concatf new-str current-char) + (setq current-var nil + current-% nil)) + ;; Character not part of var name + (concatf new-str current-char)))))) + (cond (current-% + ;; String ended with %-sequence + (concatf new-str current-%)) + (current-var + ;; String ended with variable + (push (intern current-var) vars))) + `(format ,new-str ,@(nreverse vars))))) + (defmacro oref* (&rest slots) "Access SLOTS of nested EIEIO objects. The first of SLOTS should be an object, while the rest should be @@ -36,9 +197,193 @@ Is transformed to: \(with-slots (id session) room (with-slots (user) session user))" - (declare (indent defun)) + (declare (debug (listp body)) + (indent defun)) (cl-loop for (slots object) in (reverse slots-objects) do (setq body `((with-slots ,slots ,object ,@body))) finally return (car body))) +(defvar-local matrix-url-with-retrieve-async-timeout-timer nil + "When a response buffer has a timeout, this variable stores the + timer object so that it may be canceled if the request + completes successfully.") + +(cl-defun matrix-url-with-retrieve-async (url &key cbargs silent inhibit-cookies data + (method "GET") extra-headers query timeout success error + parser (query-on-exit t)) + "Retrieve URL asynchronously with `url-retrieve'. + +Arguments CBARGS, SILENT, and INHIBIT-COOKIES are passed to +`url-retrieve', which see. + +DATA is bound to `url-request-data', which see. + +METHOD may be a symbol or string, which is bound as a capitalized +string to `url-request-method', which see. + +EXTRA-HEADERS is an alist of header-value pairs, which is bound +to `url-request-extra-headers', which see. + +QUERY is an alist of key-value pairs which is appended to the URL +as the query. + +TIMEOUT may be a number of seconds, after which the error +callback will run if the request hasn't completed by then. + +SUCCESS may be a function symbol or a body form, which is called +with zero arguments upon successful completion of the request. +In the call to SUCCESS, these variables will be bound: + +`status': See `url-retrieve'. +`cbargs': See `url-retrieve'. +`headers': The HTTP response headers as a string. +`body': The HTTP response body as a string. + +ERROR may be a function symbol or a body form, which is called +with zero arguments if the request fails. In the error call, +these variables will be bound, in addition to the ones bound for +SUCCESS: + +`errors': The list of `url' error symbols for the most recent +error, e.g. `(error http 404)' for an HTTP 404 error. + +In the SUCCESS and ERROR calls, the current buffer is the +response buffer, and it is automatically killed when the call +completes. + +PARSE-BODY-FN may be a function which parses the body and returns +a value to bind `body' to. The point is positioned after the +headers, at the beginning of the body, before calling the +function. For example, `json-read' may be used to parse JSON +documents, after which the parsed JSON would be available in +SUCCESS and ERROR as `body'. Or, if the body is not needed, +`ignore' could be used to prevent the body from being parsed." + (declare (indent defun)) + (let* ((success-body-fn (cl-typecase success + (function success) + (otherwise (byte-compile + `(cl-function + (lambda (&key cbargs status headers data) + ,success)))))) + (error-body-fn (cl-typecase error + (function error) + (otherwise (byte-compile + `(cl-function + (lambda (&key cbargs status error headers data url) + ,error)))))) + (url-request-data (when data + (encode-coding-string data 'utf-8))) + (url-request-method (upcase (cl-typecase method + (symbol (symbol-name method)) + (string method)))) + ;; TODO: Note that extra-headers must be an alist, and both keys and values must be strings. + (url-request-extra-headers extra-headers) + ;; FIXME: Document how `url-http-attempt-keepalives' is set. + (url-http-attempt-keepalives (and (not timeout) + url-http-attempt-keepalives)) + (callback (lambda (status &optional cbargs) + (unwind-protect + ;; This is called by `url-http-activate-callback' with the response buffer + ;; as the current buffer. + + ;; Check for errors + (pcase status + ;; NOTE: This may need to be updated to correctly handle multiple errors + (`(:error . ,_) (funcall error-body-fn + :url url + :cbargs cbargs + :status status + :error (plist-get status :error))) + ((or 'nil + `(:peer (:certificate . ,_)) + `(:redirect . ,_)) + (if (not url-http-end-of-headers) + ;; HACK: It seems that the callback can be called with `nil' when + ;; the connection fails before getting any headers, like: + ;; url-http-end-of-document-sentinel(#> + ;; "connection broken by remote peer\n"), in which case + ;; `url-http-end-of-headers' is nil, so we need to call the error + ;; fn. Would like to structure this more cleanly. + (funcall error-body-fn + :url url + :cbargs cbargs + :status status + :error (plist-get status :error)) + (let ((headers (buffer-substring (point) url-http-end-of-headers)) + (data (if parser + (progn + (goto-char (1+ url-http-end-of-headers)) + (funcall parser)) + (buffer-substring (1+ url-http-end-of-headers) (point-max))))) + (funcall success-body-fn + :cbargs cbargs + :status status + :headers headers + :data data)))) + (_ (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))) + (when matrix-url-with-retrieve-async-timeout-timer + (cancel-timer matrix-url-with-retrieve-async-timeout-timer)) + (unless (kill-buffer (current-buffer)) + (warn "Unable to kill response buffer: %s" (current-buffer)))))) + url-obj query-string query-params response-buffer) + (when (or (memq 'http url-debug) + (eq url-debug t)) + (matrix-log (a-list 'type 'url-with-retrieve-async + 'method method + 'url url + 'query query + 'extra-headers extra-headers + 'data data + 'timeout timeout + 'parser parser + 'success success + 'error error))) + (when query + ;; Build and append query string to URL + (progn + ;; Transform alist to plain list for `url-build-query-string' + (setq query-params (cl-loop for (key . val) in query + when val + collect (list key val))) + (setq url-obj (url-generic-parse-url url)) + (setq query-string (url-build-query-string query-params)) + (setf (url-filename url-obj) (concat (url-filename url-obj) "?" query-string)) + (setq url (url-recreate-url url-obj)))) + (setq response-buffer (url-retrieve url callback cbargs silent inhibit-cookies)) + (when timeout + (with-current-buffer response-buffer + (setq-local matrix-url-with-retrieve-async-timeout-timer + (run-with-timer timeout nil + (lambda () + (when (and (buffer-live-p response-buffer) + (get-buffer-process response-buffer)) + (with-current-buffer response-buffer + ;; Since we are handling the timeout ourselves, when we kill the + ;; process, url.el considers it a "success", and therefore does not kill + ;; the buffer (it seems to only kill its own buffers when it detects a + ;; HTTP response error code, which we aren't getting). So we first add + ;; an errors list to the first element of the callback args (the + ;; `status' arg), then we delete the process, causing the process's + ;; sentinel to be called, which then calls the callback, which detects + ;; the error and calls the error-body-fn. + + ;; FIXME: Sometimes this seems to stop catching timeouts. + ;; When that happens, it seems that the response buffer + ;; process does not get deleted, as it remains listed in + ;; `list-processes'. Maybe the solution is to bind + ;; `url-http-attempt-keepalives' to nil when a timeout is + ;; set, because maybe that would prevent processes from + ;; being left around, which seems to contribute to the + ;; problem. + + ;; NOTE: This may be loosely relevant: + (setq url-callback-arguments (list (list :error 'timeout) url-callback-arguments)) + ;; Since `get-buffer-process' is a C function, we just call it again + ;; instead of storing the buffer process in a variable. + (delete-process (get-buffer-process response-buffer)) + (setq matrix-url-with-retrieve-async-timeout-timer nil)))))))) + (unless query-on-exit + (set-process-query-on-exit-flag (get-buffer-process response-buffer) nil)) + response-buffer)) + (provide 'matrix-macros) diff --git a/matrix-notifications.el b/matrix-notifications.el index f735235..a927794 100644 --- a/matrix-notifications.el +++ b/matrix-notifications.el @@ -25,6 +25,11 @@ ;;;; Variables +(defcustom matrix-client-ng-notifications t + "Enable notifications." + ;; This variable may be let-bound to nil to disable notifications, e.g. when loading old messages. + :type 'boolean) + (defvar matrix-client-notify-hook nil "List of functions called for events. Each is called with the event-type and the event data.") @@ -38,12 +43,14 @@ Automatically trimmed to last 20 notifications.") (defun matrix-client-notify (event-type data &rest rest) "Run notify hooks and built-in notificataion for an event of EVENT-TYPE with DATA. Optional REST of args are also applied to hooks and function." - (unless matrix-client-initial-sync - (run-hook-with-args 'matrix-client-notify-hook event-type data rest) - ;; Run built-in notification for this event type - (let ((fn (intern-soft (concat "matrix-client-notify-" event-type)))) - (when (functionp fn) - (apply #'funcall fn data rest))))) + ;; FIXME: Pass session so we can get its initial-sync-p + (when matrix-client-ng-notifications + (unless (oref (car matrix-client-ng-sessions) initial-sync-p) + (run-hook-with-args 'matrix-client-notify-hook event-type data rest) + ;; Run built-in notification for this event type + (let ((fn (intern-soft (concat "matrix-client-notify-" event-type)))) + (when (functionp fn) + (apply #'funcall fn data rest)))))) ;; MAYBE: Use a macro to define the handlers, because they have to ;; define their arg lists in a certain way, and the macro would take @@ -55,8 +62,8 @@ DATA should be the `data' variable from the `defmatrix-client-handler'. ROOM should be the room object." (pcase-let* (((map content sender event_id) event) ((map body) content) - (display-name (matrix-client-displayname-from-user-id room sender)) - (buffer (oref room :buffer)) + (display-name (matrix-user-displayname room sender)) + (buffer (oref* room extra buffer)) (id (notifications-notify :title (format "%s" display-name) ;; Encode the message as ASCII because dbus-notify ;; can't handle some Unicode chars. And diff --git a/notes.org b/notes.org new file mode 100644 index 0000000..6d17180 --- /dev/null +++ b/notes.org @@ -0,0 +1,128 @@ +* Tasks +** TODO format error + +#+BEGIN_QUOTE +Debugger entered--Lisp error: (error "Not enough arguments for format string") + format-message("Unknown error occurred sending request to matrix homeserver: %S") + apply(format-message "Unknown error occurred sending request to matrix homeserver: %S" nil) + warn("Unknown error occurred sending request to matrix homeserver: %S") + (let ((exit-code (matrix-parse-curl-exit-code (cdr error-thrown)))) (warn (cond ((memq exit-code (quote (60 51))) (let nil "Error sending request to matrix homeserver, SSL certificate is invalid")) ((null exit-code) (let nil "Unknown error occurred sending request to matrix homeserver: %S")) (t (let nil (format "Matrix request exited with exit code %d" exit-code)))))) + (progn (let ((--dolist-tail-- matrix-error-hook) handler) (while --dolist-tail-- (setq handler (car --dolist-tail--)) (funcall handler con symbol-status error-thrown) (setq --dolist-tail-- (cdr --dolist-tail--)))) (let ((exit-code (matrix-parse-curl-exit-code (cdr error-thrown)))) (warn (cond ((memq exit-code (quote (60 51))) (let nil "Error sending request to matrix homeserver, SSL certificate is invalid")) ((null exit-code) (let nil "Unknown error occurred sending request to matrix homeserver: %S")) (t (let nil (format "Matrix request exited with exit code %d" exit-code))))))) + (let* ((error-thrown (car (cdr (plist-member args (quote :error-thrown))))) (symbol-status (car (cdr (plist-member args (quote :symbol-status)))))) (progn (let ((--dolist-tail-- matrix-error-hook) handler) (while --dolist-tail-- (setq handler (car --dolist-tail--)) (funcall handler con symbol-status error-thrown) (setq --dolist-tail-- (cdr --dolist-tail--)))) (let ((exit-code (matrix-parse-curl-exit-code (cdr error-thrown)))) (warn (cond ((memq exit-code (quote ...)) (let nil "Error sending request to matrix homeserver, SSL certificate is invalid")) ((null exit-code) (let nil "Unknown error occurred sending request to matrix homeserver: %S")) (t (let nil (format "Matrix request exited with exit code %d" exit-code)))))))) + matrix-request-error-handler([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #0 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil (("@carmike:matrix.org" (avatar_url) (displayname . "Michael") (membership . "join")) ("@alphapapa:matrix.org" (avatar_url) (displayname . "alphapapa") (membership . "join"))) nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #0 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil (("@alphapapa:matrix.org" (avatar_url) (displayname . "alphapapa") (membership . "join")) ("@baneross:matrix.org" (avatar_url . "mxc://matrix.org/WWPKfhaIJxXLYXUqJtDmrsVm") (displayname . "Bane Ross") (membership . "join"))) nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog (#0) apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446] :data nil :symbol-status error :error-thrown (error http 502) :response [cl-struct-request-response 502 nil nil (error http 502) error "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" nil (:type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil ... nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil ... nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t ... "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" ... ... "alphapapa" ... [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil ... nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil ... nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response #0) # "HTTP/1.0 502 Bad Gateway\nCache-Control: no-cache\nConnection: close\nContent-Type: text/html\n" nil curl ("/tmp/emacs-request32113foL")]) + apply(matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #1 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil (("@carmike:matrix.org" (avatar_url) (displayname . "Michael") (membership . "join")) ("@alphapapa:matrix.org" (avatar_url) (displayname . "alphapapa") (membership . "join"))) nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #1 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil (("@alphapapa:matrix.org" (avatar_url) (displayname . "alphapapa") (membership . "join")) ("@baneross:matrix.org" (avatar_url . "mxc://matrix.org/WWPKfhaIJxXLYXUqJtDmrsVm") (displayname . "Bane Ross") (membership . "join"))) nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog (#1) apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446] :data nil :symbol-status error :error-thrown (error http 502) :response [cl-struct-request-response 502 nil nil (error http 502) error "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" nil (:type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ... apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response #1) # "HTTP/1.0 502 Bad Gateway\nCache-Control: no-cache\nConnection: close\nContent-Type: text/html\n" nil curl ("/tmp/emacs-request32113foL")])) + #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil (... ...) nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil (... ...) nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog (#3) apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"](:data nil :symbol-status error :error-thrown (error http 502) :response [cl-struct-request-response 502 nil nil (error http 502) error "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" nil (:type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil ... nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil ... nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t ... "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" ... ... "alphapapa" ... [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil ... nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil ... nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response #0) # "HTTP/1.0 502 Bad Gateway\nCache-Control: no-cache\nConnection: close\nContent-Type: text/html\n" nil curl ("/tmp/emacs-request32113foL")]) + apply(#[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil (... ...) nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil (... ...) nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog (#3) apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] (:data nil :symbol-status error :error-thrown (error http 502) :response [cl-struct-request-response 502 nil nil (error http 502) error "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" nil (:type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ... apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response #1) # "HTTP/1.0 502 Bad Gateway\nCache-Control: no-cache\nConnection: close\nContent-Type: text/html\n" nil curl ("/tmp/emacs-request32113foL")])) + apply(apply #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil (... ...) nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil (... ...) nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog (#3) apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] (:data nil :symbol-status error :error-thrown (error http 502) :response [cl-struct-request-response 502 nil nil (error http 502) error "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" nil (:type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ... apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response #1) # "HTTP/1.0 502 Bad Gateway\nCache-Control: no-cache\nConnection: close\nContent-Type: text/html\n" nil curl ("/tmp/emacs-request32113foL")])) + request--safe-apply(#[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil (... ...) nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil (... ...) nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog (#3) apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] (:data nil :symbol-status error :error-thrown (error http 502) :response [cl-struct-request-response 502 nil nil (error http 502) error "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" nil (:type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ... apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response #1) # "HTTP/1.0 502 Bad Gateway\nCache-Control: no-cache\nConnection: close\nContent-Type: text/html\n" nil curl ("/tmp/emacs-request32113foL")])) + request--callback(# :type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil (... ...) nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil (... ...) nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog (#3) apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (... ...) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (... ... ... ... ... ... ... ...) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil (... ...) nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #3 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil (... ...) nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog (#3) apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response [cl-struct-request-response 502 nil nil (error http 502) error "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" nil (:type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil ... nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil ... nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t ... "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" ... ... "alphapapa" ... [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil ... nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #5 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil ... nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response #0) # "HTTP/1.0 502 Bad Gateway\nCache-Control: no-cache\nConnection: close\nContent-Type: text/html\n" nil curl ("/tmp/emacs-request32113foL")]) + apply(request--callback # (:type "GET" :params (("access_token" . "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK") ("since" . "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436") ("timeout" . "30000") ("full_state" . "false")) :parser json-read :data "null" :error #[128 "\302\300\303\301\"\"\207" [matrix-request-error-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #4 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil ... nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #4 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil ... nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :headers (("Content-Type" . "application/json")) :complete #[128 "\302\300\303\301\"\"\207" [matrix-async-cb-router (#[128 "\302\300\303\301\"\"\207" [matrix-client-sync-handler ([eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t ... "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" ... ... "alphapapa" ... [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] [eieio-class-tag--matrix-client-connection "https://matrix.org" "MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK" 2 t (("!nnldzrRaEKzhEnLmjB:matrix.org" . [eieio-class-tag--matrix-client-room #4 # "The best chat room, ever." nil "Cars, computers, food." "!nnldzrRaEKzhEnLmjB:matrix.org" nil ... nil]) ("!MLtmepDRrBgyxCSiiq:matrix.org" . [eieio-class-tag--matrix-client-room #4 # "Muffins vs Cupcakes II: The Reckoning" nil "" "!MLtmepDRrBgyxCSiiq:matrix.org" nil ... nil])) "s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436" (("m.room.message" . matrix-client-handler-m\.room\.message) ("m.lightrix.pattern" . matrix-client-handler-m\.lightrix\.pattern) ("m.room.topic" . matrix-client-handler-m\.room\.topic) ("m.room.name" . matrix-client-handler-m\.room\.name) ("m.room.member" . matrix-client-handler-m\.room\.member) ("m.room.aliases" . matrix-client-handler-m\.room\.aliases) ("m.presence" . matrix-client-handler-m\.presence) ("m.typing" . matrix-client-handler-m\.typing)) (matrix-client-debug-event-maybe matrix-client-render-event-to-room) "alphapapa" (matrix-client-input-filter-emote matrix-client-input-filter-join matrix-client-input-filter-leave matrix-client-send-to-current-room) [nil 23049 27749 288169 60 #[128 "\302\300\303\301\"\"\207" [matrix-client-start-watchdog ... apply append] 6 "\n\n(fn &rest ARGS2)"] nil nil 350000] 1510566953.2881446]) apply append] 6 "\n\n(fn &rest ARGS2)"] :url "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" :response [cl-struct-request-response 502 nil nil (error http 502) error "https://matrix.org/_matrix/client/r0/sync?access_token=MDAxOGxvY2F0aW9uIG1hdHJpeC5vcmcKMDAxM2lkZW50aWZpZXIga2V5CjAwMTBjaWQgZ2VuID0gMQowMDI4Y2lkIHVzZXJfaWQgPSBAYWxwaGFwYXBhOm1hdHJpeC5vcmcKMDAxNmNpZCB0eXBlID0gYWNjZXNzCjAwMjFjaWQgbm9uY2UgPSBZWUhXYTdDU05WOjtjbFR-CjAwMmZzaWduYXR1cmUgztehcHdmTAfUnSocnyIZlgjaFHo5RyyCelYotyBHY-EK&since=s331858480_323898773_1164256_65303485_21467246_193158_2359311_2926812_436&timeout=30000&full_state=false" nil #0 # "HTTP/1.0 502 Bad Gateway\nCache-Control: no-cache\nConnection: close\nContent-Type: text/html\n" nil curl ("/tmp/emacs-request32113foL")])) + request--curl-callback(# "finished\n") + +#+END_QUOTE +** TODO Avatar change events are displayed as joins + +I wonder how Riot determines that it's a profile change event. e.g. + +#+BEGIN_EXAMPLE + ((timestamp . "2018-08-05 14:44:06") + ((event . matrix-sync-timeline) + (room-id . "!roomid:matrix.org") + (prev-batch . "s624701158_513867773_1093874_157527466_69933145_443272_9035199_7733013_17510") + (last-full-sync . "s624700933_513867590_1093793_157527355_69933114_443272_9035195_7733012_17510") + (data + (limited . :json-false) + (prev_batch . "s624701801_513868265_1094055_157527685_69933253_443272_9035215_7733024_17510") + (events . + [((origin_server_ts . 1533498245648) + (sender . "@userid:matrix.org") + (event_id . "$eventid:matrix.org") + (unsigned + (prev_content + (membership . "join") + (avatar_url . "mxc://matrix.org/oldurl") + (displayname . "Displayname")) + (prev_sender . "@userid:matrix.org") + (replaces_state . "$oldevent:matrix.org") + (age . 973)) + (state_key . "@userid:matrix.org") + (content + (membership . "join") + (avatar_url . "mxc://matrix.org/newurl") + (displayname . "Displayname")) + (membership . "join") + (type . "m.room.member"))])))) +#+END_EXAMPLE + +** TODO Error from broken image-loading connection +:PROPERTIES: +:ID: 18501c3b-76a2-4354-befa-d8ffd8340d1b +:END: + +[2018-07-15 Sun 15:11] + +#+BEGIN_EXAMPLE +Debugger entered--Lisp error: (error "Keyword argument :url not one of (:cbargs :status :error :headers :data)") + signal(error ("Keyword argument :url not one of (:cbargs :status :error :headers :data)")) + error("Keyword argument %s not one of (:cbargs :status :error :headers :data)" :url) + #f(compiled-function (&rest --cl-rest--) #)(:url "https://i.imgur.com/BsT9Yhn.jpg" :cbargs nil :status nil :error nil) + funcall(#f(compiled-function (&rest --cl-rest--) #) :url "https://i.imgur.com/BsT9Yhn.jpg" :cbargs nil :status nil :error nil) + (if (not url-http-end-of-headers) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error)) (let ((headers (buffer-substring (point) url-http-end-of-headers)) (data (if parser (progn (goto-char (1+ url-http-end-of-headers)) (funcall parser)) (buffer-substring (1+ url-http-end-of-headers) (point-max))))) (funcall success-body-fn :cbargs cbargs :status status :headers headers :data data))) + (closure ((cbargs) (status) (error-body-fn . #f(compiled-function (&rest --cl-rest--) #)) (success-body-fn . #f(compiled-function (&rest args2) #)) (query-on-exit) (parser . #f(compiled-function (&rest args2) #)) (error) (success . #f(compiled-function (&rest args2) #)) (timeout) (query) (extra-headers) (method . "GET") (data) (inhibit-cookies . t) (silent . t) (cbargs) (--cl-rest-- :silent t :inhibit-cookies t :query-on-exit nil :parser #f(compiled-function (&rest args2) #) :success #f(compiled-function (&rest args2) #)) (url . "https://i.imgur.com/BsT9Yhn.jpg") t) nil (if (not url-http-end-of-headers) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error)) (let ((headers (buffer-substring (point) url-http-end-of-headers)) (data (if parser (progn (goto-char (1+ url-http-end-of-headers)) (funcall parser)) (buffer-substring (1+ url-http-end-of-headers) (point-max))))) (funcall success-body-fn :cbargs cbargs :status status :headers headers :data data))))() + funcall((closure ((cbargs) (status) (error-body-fn . #f(compiled-function (&rest --cl-rest--) #)) (success-body-fn . #f(compiled-function (&rest args2) #)) (query-on-exit) (parser . #f(compiled-function (&rest args2) #)) (error) (success . #f(compiled-function (&rest args2) #)) (timeout) (query) (extra-headers) (method . "GET") (data) (inhibit-cookies . t) (silent . t) (cbargs) (--cl-rest-- :silent t :inhibit-cookies t :query-on-exit nil :parser #f(compiled-function (&rest args2) #) :success #f(compiled-function (&rest args2) #)) (url . "https://i.imgur.com/BsT9Yhn.jpg") t) nil (if (not url-http-end-of-headers) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error)) (let ((headers (buffer-substring (point) url-http-end-of-headers)) (data (if parser (progn (goto-char (1+ url-http-end-of-headers)) (funcall parser)) (buffer-substring (1+ url-http-end-of-headers) (point-max))))) (funcall success-body-fn :cbargs cbargs :status status :headers headers :data data))))) + (cond ((consp status) (let* ((x480 (car status))) (cond ((eq x480 :error) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error))) ((eq x480 :peer) (let* ((x482 (cdr status))) (if (consp x482) (let* ((x483 (car x482))) (if (consp x483) (let* ((x484 (car x483))) (if (eq x484 :certificate) (let* ((x486 (cdr x482))) (if (null x486) (funcall pcase-1) (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))) (funcall pcase-0))) (funcall pcase-0))) (funcall pcase-0)))) ((eq x480 :redirect) (funcall pcase-1)) (t (funcall pcase-0))))) ((null status) (funcall pcase-1)) (t (funcall pcase-0))) + (let* ((pcase-1 (function (lambda nil (if (not url-http-end-of-headers) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error)) (let ((headers (buffer-substring (point) url-http-end-of-headers)) (data (if parser (progn (goto-char (1+ url-http-end-of-headers)) (funcall parser)) (buffer-substring (1+ url-http-end-of-headers) (point-max))))) (funcall success-body-fn :cbargs cbargs :status status :headers headers :data data)))))) (pcase-0 (function (lambda nil (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))))) (cond ((consp status) (let* ((x480 (car status))) (cond ((eq x480 :error) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error))) ((eq x480 :peer) (let* ((x482 (cdr status))) (if (consp x482) (let* ((x483 (car x482))) (if (consp x483) (let* ((x484 (car x483))) (if (eq x484 :certificate) (let* ((x486 (cdr x482))) (if (null x486) (funcall pcase-1) (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))) (funcall pcase-0))) (funcall pcase-0))) (funcall pcase-0)))) ((eq x480 :redirect) (funcall pcase-1)) (t (funcall pcase-0))))) ((null status) (funcall pcase-1)) (t (funcall pcase-0)))) + (unwind-protect (let* ((pcase-1 (function (lambda nil (if (not url-http-end-of-headers) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error)) (let ((headers (buffer-substring (point) url-http-end-of-headers)) (data (if parser (progn (goto-char (1+ url-http-end-of-headers)) (funcall parser)) (buffer-substring (1+ url-http-end-of-headers) (point-max))))) (funcall success-body-fn :cbargs cbargs :status status :headers headers :data data)))))) (pcase-0 (function (lambda nil (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))))) (cond ((consp status) (let* ((x480 (car status))) (cond ((eq x480 :error) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error))) ((eq x480 :peer) (let* ((x482 (cdr status))) (if (consp x482) (let* ((x483 (car x482))) (if (consp x483) (let* ((x484 (car x483))) (if (eq x484 :certificate) (let* ((x486 (cdr x482))) (if (null x486) (funcall pcase-1) (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))) (funcall pcase-0))) (funcall pcase-0))) (funcall pcase-0)))) ((eq x480 :redirect) (funcall pcase-1)) (t (funcall pcase-0))))) ((null status) (funcall pcase-1)) (t (funcall pcase-0)))) (if matrix-url-with-retrieve-async-timeout-timer (progn (cancel-timer matrix-url-with-retrieve-async-timeout-timer))) (if (kill-buffer (current-buffer)) nil (warn "Unable to kill response buffer: %s" (current-buffer)))) + (closure ((error-body-fn . #f(compiled-function (&rest --cl-rest--) #)) (success-body-fn . #f(compiled-function (&rest args2) #)) (query-on-exit) (parser . #f(compiled-function (&rest args2) #)) (error) (success . #f(compiled-function (&rest args2) #)) (timeout) (query) (extra-headers) (method . "GET") (data) (inhibit-cookies . t) (silent . t) (cbargs) (--cl-rest-- :silent t :inhibit-cookies t :query-on-exit nil :parser #f(compiled-function (&rest args2) #) :success #f(compiled-function (&rest args2) #)) (url . "https://i.imgur.com/BsT9Yhn.jpg") t) (status &optional cbargs) (unwind-protect (let* ((pcase-1 (function (lambda nil (if (not url-http-end-of-headers) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error)) (let ((headers (buffer-substring (point) url-http-end-of-headers)) (data (if parser (progn (goto-char (1+ url-http-end-of-headers)) (funcall parser)) (buffer-substring (1+ url-http-end-of-headers) (point-max))))) (funcall success-body-fn :cbargs cbargs :status status :headers headers :data data)))))) (pcase-0 (function (lambda nil (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))))) (cond ((consp status) (let* ((x480 (car status))) (cond ((eq x480 :error) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error))) ((eq x480 :peer) (let* ((x482 (cdr status))) (if (consp x482) (let* ((x483 (car x482))) (if (consp x483) (let* ((x484 (car x483))) (if (eq x484 :certificate) (let* ((x486 (cdr x482))) (if (null x486) (funcall pcase-1) (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))) (funcall pcase-0))) (funcall pcase-0))) (funcall pcase-0)))) ((eq x480 :redirect) (funcall pcase-1)) (t (funcall pcase-0))))) ((null status) (funcall pcase-1)) (t (funcall pcase-0)))) (if matrix-url-with-retrieve-async-timeout-timer (progn (cancel-timer matrix-url-with-retrieve-async-timeout-timer))) (if (kill-buffer (current-buffer)) nil (warn "Unable to kill response buffer: %s" (current-buffer)))))(nil) + apply((closure ((error-body-fn . #f(compiled-function (&rest --cl-rest--) #)) (success-body-fn . #f(compiled-function (&rest args2) #)) (query-on-exit) (parser . #f(compiled-function (&rest args2) #)) (error) (success . #f(compiled-function (&rest args2) #)) (timeout) (query) (extra-headers) (method . "GET") (data) (inhibit-cookies . t) (silent . t) (cbargs) (--cl-rest-- :silent t :inhibit-cookies t :query-on-exit nil :parser #f(compiled-function (&rest args2) #) :success #f(compiled-function (&rest args2) #)) (url . "https://i.imgur.com/BsT9Yhn.jpg") t) (status &optional cbargs) (unwind-protect (let* ((pcase-1 (function (lambda nil (if (not url-http-end-of-headers) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error)) (let ((headers (buffer-substring (point) url-http-end-of-headers)) (data (if parser (progn (goto-char (1+ url-http-end-of-headers)) (funcall parser)) (buffer-substring (1+ url-http-end-of-headers) (point-max))))) (funcall success-body-fn :cbargs cbargs :status status :headers headers :data data)))))) (pcase-0 (function (lambda nil (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))))) (cond ((consp status) (let* ((x480 (car status))) (cond ((eq x480 :error) (funcall error-body-fn :url url :cbargs cbargs :status status :error (plist-get status :error))) ((eq x480 :peer) (let* ((x482 (cdr status))) (if (consp x482) (let* ((x483 (car x482))) (if (consp x483) (let* ((x484 (car x483))) (if (eq x484 :certificate) (let* ((x486 (cdr x482))) (if (null x486) (funcall pcase-1) (error "Response status unrecognized; please report this error: %s" (pp-to-string status)))) (funcall pcase-0))) (funcall pcase-0))) (funcall pcase-0)))) ((eq x480 :redirect) (funcall pcase-1)) (t (funcall pcase-0))))) ((null status) (funcall pcase-1)) (t (funcall pcase-0)))) (if matrix-url-with-retrieve-async-timeout-timer (progn (cancel-timer matrix-url-with-retrieve-async-timeout-timer))) (if (kill-buffer (current-buffer)) nil (warn "Unable to kill response buffer: %s" (current-buffer))))) nil) + url-http-activate-callback() + url-http-end-of-document-sentinel(# "connection broken by remote peer\n") + url-http-async-sentinel(# "connection broken by remote peer\n") +#+END_EXAMPLE +** TODO Make /sync update existing events + +The cleanest way to do "pending/sending" messages would be to make fake room message events and give them to the standard handler. The problem is that some fields, like =origin_server_ts=, can only come from the server (we could fake that field, but then it wouldn't be accurate). + +So what we need is to update existing events in the message buffer. (Or try using =ewoc=, but that would be a major rewrite of a lot of things, so maybe later...) + +* Plans + +** client-ng + +*** UNDERWAY Storing and processing new timeline events +:LOGBOOK: +- State "UNDERWAY" from [2017-11-23 Thu 22:19] +:END: + +There are several approaches, and I'm not sure which is best. + +**** Run client function for batch of updates + +I'm not sure there would be any advantage to this approach unless we were to write a function to rewrite a buffer from a timeline. But if we were to do that, we could easily do that by re-running the per-event function for each event. + +The advantage would be that the API could call a single client function with the room object, and the client could then do whatever updating it wanted. This avoids duplicating some of the API structure in the client, and seems like a better separation of concerns. + +***** Store separate lists of new and old events in API + +One of the easiest ways might be to store new events to two lists, old and new, and let the client clear the list of new events when it's processed them. + +I think this is what I will try first. It's almost like keeping an index in a db on a column, and it should be simple for clients. + +***** Calculate offset into event list + +Store the number of events processed, then when processing new events, calculate an offset into the list, and start processing new events from there. + +This is fairly simple and quick, and since events are pushed to the timeline list by order-received, not by origin timestamp, it would work. But if we ever moved to an ordered list of events, inserting them by timestamp, this would break. + +***** Store a read/processed flag/status for each event + +This would be very simple, but, obviously, as the list of events grows, it becomes slower to process. + +**** Run client function for each event + +This is maybe the simplest, and the most similar to the existing code. However, it means that the client has to duplicate some of the structure of the API code, because the client has to handle each event differently as well. Whereas, if we let the API handle events and let the client handle presenting the stored state, it seems like a better separation of concerns. + +*** TODO Add more event handlers + +It's at the stage now where more event handlers need to be added to fill out functionality. I should probably do some refactoring and rethinking before this. Might need to write a macro for client handlers. + diff --git a/ordered-buffer.el b/ordered-buffer.el new file mode 100644 index 0000000..11d6597 --- /dev/null +++ b/ordered-buffer.el @@ -0,0 +1,123 @@ +;;; ordered-buffer.el --- Insert strings into buffers in flexibly defined order -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Adam Porter + +;; Author: Adam Porter +;; Keywords: buffers + +;; 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: + +;; The result of factoring out some of the buffer-insertion code in matrix-client-room.el. Could be +;; useful in other projects. The basic idea is to insert strings into a buffer, ordered by a text +;; property (like an integer timestamp). The strings may "arrive" in any order, but they will +;; always be inserted at the correct, ordered position. + +;;; Code: + +(require 'cl-lib) + +(defface ordered-buffer-header + '((t (:inherit highlight :weight bold))) + "Face for headers." + :group 'ordered-buffer) + +(defvar ordered-buffer-header-face 'ordered-buffer-header + "Face applied to headers.") +(defvar ordered-buffer-point-fn #'point-max + "Function called by `ordered-buffer-insert' which returns the position at which to insert a new string.") +(defvar ordered-buffer-prefix-fn nil + "An optional function which is called by `ordered-buffer-insert' before inserting its string. +Called with point at the insertion position. May be used to +insert headers, etc.") +(defvar ordered-buffer-header-suffix "\n" + "String inserted after headers. May be nil.") + +(defun ordered-buffer-insert (string &rest properties) + "Insert STRING into current buffer at appropriate position. +The `ordered-buffer-point-fn' function returns the position. If +`ordered-buffer-prefix-fn' is non-nil, it is called with point at +the position before inserting STRING. PROPERTIES are applied to +STRING." + (save-excursion + (goto-char (funcall ordered-buffer-point-fn)) + (when ordered-buffer-prefix-fn + (funcall ordered-buffer-prefix-fn)) + (insert (apply #'propertize string properties)))) + +(defun ordered-buffer-insert-header (string &rest properties) + "Insert header containing STRING at point. +PROPERTIES are applied to STRING, and the face in +`ordered-buffer-header-face' is applied to it. The string +`ordered-buffer-header-suffix' is appended to the header. The +header has the text-property `ordered-buffer-header' set." + (let* ((visible-header (propertize (concat " " string "\n") + 'face ordered-buffer-header-face)) + (whole-header (apply #'propertize (concat "\n" visible-header ordered-buffer-header-suffix) + 'ordered-buffer-header t + 'read-only t + properties))) + (insert whole-header))) + +(cl-defun ordered-buffer-point-fn (&key backward-from forward-from property comparator value) + "Return position at which a new string should be inserted, depending on criteria. + +One of BACKWARD-FROM or FORWARD-FROM may be set and should be an +integer position in the buffer or a function which returns a +position, from which the search starts. + +PROPERTY should be a symbol of the text property (which should +not be a keyword symbol) which is compared with VALUE using +COMPARATOR. + +When the comparison is non-nil, the point at that position is +returned. If the search reaches a point after which PROPERTY +does not change again in the buffer, the point returned depends +on the search direction: if BACKWARD-FROM, `point-min'; if +FORWARD-FROM, `point-max'." + (declare (indent defun)) + (when (and backward-from forward-from) + (user-error "Only one of `:backward-from' or `:forward-from' may be set")) + (let* ((get-property-fn (cond (backward-from `(lambda () + (get-text-property (if (> (point) 1) + (1- (point)) + (point)) + ',property))) + (forward-from `(lambda () + (get-text-property (point) ',property))))) + (property-change-fn (cond (backward-from #'previous-single-property-change) + (forward-from #'next-single-property-change))) + (from (or backward-from forward-from))) + (goto-char (cl-etypecase from + (function (funcall from)) + (integer from))) + (cl-loop for this-value = (funcall get-property-fn) + until (when this-value + (funcall comparator this-value value)) + for next-pos = (funcall property-change-fn (point) property) + if next-pos + do (goto-char next-pos) + else + return (if backward-from + (point-min) + (point-max)) + finally return (point)))) + + +;;;; Footer + +(provide 'ordered-buffer) + +;;; ordered-buffer.el ends here diff --git a/scratch.el b/scratch.el index 2fcc2ae..21f33ad 100644 --- a/scratch.el +++ b/scratch.el @@ -1,54 +1,114 @@ -(defun matrix-client-reconnect (arg) - "Reconnect to Matrix. - -Without a `prefix-arg' ARG it will simply restart the -matrix-client-stream poller, but with a prefix it will disconnect and -connect, clearing all room data." - (interactive "P") - (if (or arg (not matrix-client-event-stream-end-token)) - (progn - (matrix-client-disconnect) - (matrix-client)) - (matrix-client-stream-from-end-token))) - -(defun matrix-client-event-listener-callback (data) - "The callback which `matrix-event-poll' pushes its data in to. - -This calls each function in matrix-client-new-event-hook with the data -object with a single argument, DATA." - (setq matrix-client-watchdog-last-message-ts - (time-to-seconds)) - (unless (eq (car data) 'error) - (dolist (hook matrix-client-new-event-hook) - (funcall hook data))) - (matrix-client-start-event-listener (matrix-get 'end data))) - -(defun matrix-client-render-events-to-room (data) - "Given a chunk of data from an /initialSyc, render each element from DATA in to its room." - (let ((chunk (matrix-get 'chunk data))) - (mapc 'matrix-client-render-event-to-room chunk))) - -(defun matrix-client-restart-listener-maybe (sym error-thrown) - "The error handler for matrix-client's event-poll. - -SYM and ERROR-THROWN come from Request and are used to decide whether to connect." - (cond ((or (string-match "code 6" (cdr error-thrown)) - (eq sym 'parse-error) - (eq sym 'timeout) - (string-match "interrupt" (cdr error-thrown)) - (string-match "code 7" (cdr error-thrown))) - (message "Lost connection with matrix, will re-attempt in %s ms" - (/ matrix-client-event-poll-timeout 2)) - (matrix-client-restart-later)) - ((string-match "code 60" (cdr error-thrown)) - (message "curl couldn't validate CA, not advising --insecure? File bug pls.")))) - -(defun matrix-client-stream-from-end-token () - "Restart the matrix-client stream from the saved end-token." - (matrix-client-start-event-listener matrix-client-event-stream-end-token)) - -(defun matrix-client-restart-later () - "Try to restart the Matrix poller later, maybe." - (run-with-timer (/ matrix-client-event-poll-timeout 1000) nil - 'matrix-client-stream-from-end-token)) +(matrix-defclass argh-test nil + ((extra :initarg :extra))) +;;;; Works + +(let ((room (argh-test))) + ;; WORKS + (with-slots* (((extra) room)) + (let* ((buffer (a-get extra 'buffer))) + (unless buffer + (map-put extra 'buffer "BUFFER NAME")))) + (oref room extra)) + +(let ((room (argh-test))) + ;; WORKS + (with-slots* (((extra) room)) + (pcase-let* (((map buffer) extra)) + (unless buffer + (map-put extra 'buffer "BUFFER NAME")))) + (oref room extra)) + +;;;; Doesn't work + +(let ((room (argh-test))) + ;; DOES NOT WORK + (pcase-let* (((eieio extra) room) + ((map buffer) extra)) + (unless buffer + (map-put extra 'buffer "BUFFER NAME"))) + (oref room extra)) + +(let ((room (argh-test))) + ;; DOES NOT WORK + (pcase-let* (((eieio extra) room) + ((map buffer) extra)) + (unless buffer + (setf buffer "BUFFER NAME"))) + (oref room extra)) + +;;; derp + +(cl-defmethod matrix-client-ng-room-command-cowsay ((room matrix-room) input) + "Cowsay!" + (let* ((s (replace-regexp-in-string (rx bos "/" (1+ (not space)) (1+ space)) "" input)) + (cow-type (seq-random-elt '("-b" "-d" "-g" "-p" "-s" "-t" "-w" "-y"))) + (cowsaid (shell-command-to-string (format "cowsay %s %s" cow-type (shell-quote-argument s)))) + (html (concat "
\n"
+                       "" (htmlize-escape-or-link cowsaid) ""
+                       "
"))) + (matrix-send-message room (concat "Cow: \"" s "\"") + :extra-content (a-list 'formatted_body html + 'format "org.matrix.custom.html")))) + +;; (defun cowsay (s) +;; (shell-command-to-string (format "cowsay %s" (shell-quote-argument s)))) + +;;; Replay room + +(cl-defmethod matrix-client-ng-replay ((room matrix-room)) + "Erase and replay events into ROOM's buffer." + (with-room-buffer room + (let ((inhibit-read-only t) + (matrix-client-ng-notifications nil)) + (ov-clear) + (erase-buffer) + (matrix-client-ng-insert-prompt room) + (matrix-client-ng-insert-last-seen room) + (cl-loop for event in (reverse (oref room timeline)) + do (matrix-client-ng-timeline room event))))) + +;;; ordered-buffer + +(defun ordered-buffer-test (&optional timestamp) + (interactive (list (cond (current-prefix-arg (- (string-to-number (format-time-string "%s")) + (read-number "Seconds before now: "))) + (t (string-to-number (format-time-string "%s")))))) + (with-current-buffer (get-buffer-create "*ordered-buffer-test*") + (let* ((string (concat (format-time-string "%H:%M:%S" timestamp) + " " + (s-trim (shell-command-to-string "cat /usr/share/dict/words | shuf -n1")) + "\n")) + (inhibit-read-only t) + (ordered-buffer-prefix-fn (apply-partially #'matrix-client-ng--ordered-buffer-prefix-fn timestamp)) + (ordered-buffer-point-fn (apply-partially #'ordered-buffer-point-fn + :backward-from #'point-max + :property 'timestamp + :value timestamp + :comparator #'<=))) + (ordered-buffer-insert string 'timestamp timestamp) + (pop-to-buffer (current-buffer))))) + +(defun timestamp-overlays () + "Display overlays in margin in current buffer indicating `timestamp' text-property on each line. +For debugging." + (interactive) + (setq left-margin-width 40) + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (ov-clear :timestamp-overlay) + (cl-loop for ts = (get-text-property (point) 'timestamp) + when ts + do (ov (point) (or (next-single-property-change (point) 'timestamp) + (point-max)) + 'before-string (propertize "o" + 'display (list '(margin left-margin) + (concat (number-to-string ts) + " " + (format-time-string "%Y-%m-%d %H:%M:%S" ts)))) + :timestamp-overlay t) + for next = (next-single-property-change (point) 'timestamp) + if next + do (goto-char next) + else return nil))))