diff --git a/ement-api.el b/ement-api.el index f609028..7130fc3 100644 --- a/ement-api.el +++ b/ement-api.el @@ -24,6 +24,12 @@ ;;; Code: +;;;; Debugging + +(eval-and-compile + (setq-local warning-minimum-log-level nil) + (setq-local warning-minimum-log-level :debug)) + ;;;; Requirements (require 'json) @@ -45,17 +51,24 @@ ;;;; Functions -(cl-defun ement-api (hostname port token transaction-id endpoint data then - &key timeout raw-data +(cl-defun ement-api (hostname port token _transaction-id endpoint _data then + &key _timeout _raw-data (content-type "application/json") (else #'ement-api-error) (method 'get)) + ;; FIXME: Use transaction-id or add it in calling functions. + ;; FIXME: Use timeout. (declare (indent defun)) (pcase-let* ((path (concat "/_matrix/client/r0/" endpoint)) (url (url-recreate-url (url-parse-make-urlobj "https" nil nil hostname port path nil nil t))) (headers (ement-alist "Content-Type" content-type "Authorization" (concat "Bearer " token)))) - (debug-warn (current-time) session method endpoint data then timeout url) - (debug-warn (list 'plz-get url :headers headers :as #'json-read :then then :else else)))) + (debug-warn (current-time) method url headers then) + (pcase method + ('get (plz-get url :headers headers :as #'json-read :then then :else else))))) + +(defun ement-api-error (&rest args) + (debug-warn args) + (error "ement-api-error: %S" args)) ;;;; Footer diff --git a/ement-macros.el b/ement-macros.el index 488f06a..cdf47bc 100644 --- a/ement-macros.el +++ b/ement-macros.el @@ -26,12 +26,70 @@ ;;;; Requirements +(require 'map) + +;;;; Debugging + +(eval-and-compile + (setq-local warning-minimum-log-level nil) + (setq-local warning-minimum-log-level :debug)) + +(cl-defmacro debug-warn (&rest args) + "Display a debug warning showing the runtime value of ARGS. +The warning automatically includes the name of the containing +function, and it is only displayed if `warning-minimum-log-level' +is `:debug' at expansion time (otherwise the macro expands to nil +and is eliminated by the byte-compiler). When debugging, the +form also returns nil so, e.g. it may be used in a conditional in +place of nil. + +Each of ARGS may be a string, which is displayed as-is, or a +symbol, the value of which is displayed prefixed by its name, or +a Lisp form, which is displayed prefixed by its first symbol. + +Before the actual ARGS arguments, you can write keyword +arguments, i.e. alternating keywords and values. The following +keywords are supported: + + :buffer BUFFER Name of buffer to pass to `display-warning'. + :level LEVEL Level passed to `display-warning', which see. + Default is :debug." + (pcase-let* ((fn-name (with-current-buffer + (or byte-compile-current-buffer (current-buffer)) + ;; This is a hack, but a nifty one. + (save-excursion + (beginning-of-defun) + (cl-second (read (current-buffer)))))) + (plist-args (cl-loop while (keywordp (car args)) + collect (pop args) + collect (pop args))) + ((map (:buffer buffer) (:level level)) plist-args) + (level (or level :debug)) + (string (cl-loop for arg in args + concat (pcase arg + ((pred stringp) "%S ") + ((pred symbolp) + (concat (upcase (symbol-name arg)) ":%S ")) + ((pred listp) + (concat "(" (upcase (symbol-name (car arg))) + (pcase (length arg) + (1 ")") + (_ "...)")) + ":%S ")))))) + (when (eq :debug warning-minimum-log-level) + `(progn + (display-warning ',fn-name (format ,string ,@args) ,level ,buffer) + nil)))) + ;;;; Macros (defmacro ement-alist (&rest pairs) + "Expand to an alist of the keys and values in PAIRS." `(list ,@(cl-loop for (key value) on pairs by #'cddr collect `(cons ,key ,value)))) + + ;;;; Variables diff --git a/ement.el b/ement.el index 82f2377..42f6532 100644 --- a/ement.el +++ b/ement.el @@ -25,6 +25,12 @@ ;;; Code: +;;;; Debugging + +(eval-and-compile + (setq-local warning-minimum-log-level nil) + (setq-local warning-minimum-log-level :debug)) + ;;;; Requirements ;; Built in. @@ -36,69 +42,16 @@ (require 'ement-api) (require 'ement-macros) -;;;; Debugging - -(eval-and-compile - (setq-local warning-minimum-log-level nil) - (setq-local warning-minimum-log-level :debug)) - -(cl-defmacro debug-warn (&rest args) - "Display a debug warning showing the runtime value of ARGS. -The warning automatically includes the name of the containing -function, and it is only displayed if `warning-minimum-log-level' -is `:debug' at expansion time (otherwise the macro expands to nil -and is eliminated by the byte-compiler). When debugging, the -form also returns nil so, e.g. it may be used in a conditional in -place of nil. - -Each of ARGS may be a string, which is displayed as-is, or a -symbol, the value of which is displayed prefixed by its name, or -a Lisp form, which is displayed prefixed by its first symbol. - -Before the actual ARGS arguments, you can write keyword -arguments, i.e. alternating keywords and values. The following -keywords are supported: - - :buffer BUFFER Name of buffer to pass to `display-warning'. - :level LEVEL Level passed to `display-warning', which see. - Default is :debug." - (pcase-let* ((fn-name (with-current-buffer - (or byte-compile-current-buffer (current-buffer)) - ;; This is a hack, but a nifty one. - (save-excursion - (beginning-of-defun) - (cl-second (read (current-buffer)))))) - (plist-args (cl-loop while (keywordp (car args)) - collect (pop args) - collect (pop args))) - ((map (:buffer buffer) (:level level)) plist-args) - (level (or level :debug)) - (string (cl-loop for arg in args - concat (pcase arg - ((pred stringp) "%S ") - ((pred symbolp) - (concat (upcase (symbol-name arg)) ":%S ")) - ((pred listp) - (concat "(" (upcase (symbol-name (car arg))) - (pcase (length arg) - (1 ")") - (_ "...)")) - ":%S ")))))) - (when (eq :debug warning-minimum-log-level) - `(progn - (display-warning ',fn-name (format ,string ,@args) ,level ,buffer) - nil)))) - ;;;; Structs (cl-defstruct ement-user - id displayname) + id displayname account-data) (cl-defstruct ement-server hostname port) (cl-defstruct ement-session - user server token transaction-id rooms) + user server token transaction-id rooms next-batch) ;;;; Variables @@ -115,46 +68,50 @@ keywords are supported: "Save username and access token upon successful login." :type 'boolean) -(defcustom ement-save-token-file "~/.cache/matrix-client.el.token" +(defcustom ement-save-session-file "~/.cache/matrix-client.el.token" ;; FIXME: Uses matrix-client.el token. "Save username and access token to this file." :type 'file) ;;;; Commands -(defun ement-connect (user-id _password hostname token) +(defun ement-connect (user-id _password hostname token &optional transaction-id) ;; FIXME: Use password if given. "Connect to Matrix and sync once." - (interactive (list (read-string "User ID: " (or (when (car ement-sessions) - (ement-session-user (car ement-sessions))) - "")) - (read-passwd "Password: ") - (read-string "Hostname (default: from user ID): ") - (ement--load-token))) + (interactive (pcase-let* (((map username server token ('txn-id transaction-id)) + (ement--load-session))) + (list username nil server token transaction-id)) + ;; (list (read-string "User ID: " (or (when (car ement-sessions) + ;; (ement-session-user (car ement-sessions))) + ;; "")) + ;; (read-passwd "Password: ") + ;; (read-string "Hostname (default: from user ID): ") + ;; (alist-get 'token (ement--load-session))) + ) ;; FIXME: Overwrites any current session. (pcase-let* ((hostname (if (not (string-empty-p hostname)) hostname - (or (awhen (string-match (rx ":" (group (1+ anything))) user-id) - (match-string 1 user-id)) - "matrix.org"))) + (if (string-match (rx ":" (group (1+ anything))) user-id) + (match-string 1 user-id) + "matrix.org"))) ;; FIXME: Lookup hostname from user ID with DNS. ;; FIXME: Dynamic port. (server (make-ement-server :hostname hostname :port 443)) (user (make-ement-user :id user-id)) - (transaction-id (random 100000)) + (transaction-id (or transaction-id (random 100000))) (session (make-ement-session :user user :server server :token token :transaction-id transaction-id))) (setf ement-sessions (list session))) (debug-warn (car ement-sessions)) (ement--sync (car ement-sessions))) -(defun ement-view-room (room) - "Switch to a buffer for ROOM." - (interactive (list (ement-complete-room (car ement-sessions))))) +;; (defun ement-view-room (room) +;; "Switch to a buffer for ROOM." +;; (interactive (list (ement-complete-room (car ement-sessions))))) ;;;; Functions -(defun ement-complete-room (session) - "Return a room selected from SESSION with completion.") +;; (defun ement-complete-room (session) +;; "Return a room selected from SESSION with completion.") (cl-defun ement--sync (session &key since) ;; SPEC: . @@ -170,13 +127,33 @@ keywords are supported: (defun ement--sync-callback (session data) "SESSION. DATA should be the parsed JSON response." - (debug-warn session data)) + (pcase-let* (((map rooms) data) + ((map ('join joined-rooms)) rooms)) + (mapc (apply-partially #'ement--push-joined-room-events session) joined-rooms) + (message "Sync done"))) -(defun ement--load-token () - "Return saved username and access token from file." - (when (file-exists-p ement-save-token-file) +(cl-defstruct ement-room + id summary state timeline timeline* ephemeral account-data unread-notifications) + +(defun ement--push-joined-room-events (session joined-room) + (pcase-let* ((`(,id . ,event-types) joined-room) + (room (or (cl-find-if (lambda (room) + (equal id (ement-room-id room))) + (ement-session-rooms session)) + (car (push (make-ement-room :id id) (ement-session-rooms session))))) + ((map summary state ephemeral timeline + ('account_data account-data) + ('unread_notifications unread-notifications)) + event-types)) + (ignore account-data unread-notifications summary state ephemeral) + (cl-loop for event across (alist-get 'events timeline) + do (push event (ement-room-timeline* room))))) + +(defun ement--load-session () + "Return saved session from file." + (when (file-exists-p ement-save-session-file) (read (with-temp-buffer - (insert-file-contents ement-save-token-file) + (insert-file-contents ement-save-session-file) (buffer-substring-no-properties (point-min) (point-max)))))) ;;;; Footer