Skip to content

Commit

Permalink
Change: Allow user to customise reaction function
Browse files Browse the repository at this point in the history
  • Loading branch information
@9viz
9viz authored and Visuwesh committed Apr 22, 2022
1 parent e54ad99 commit 579b817
Show file tree
Hide file tree
Showing 2 changed files with 41 additions and 31 deletions.
2 changes: 1 addition & 1 deletion ement-room.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1402,7 +1402,7 @@ reaction string, e.g. \"👍\"."
(lambda () (face-at-point-p 'ement-room-reactions-key)))))))
(list
(or (key-at (point))
(char-to-string (read-char-by-name "Reaction (prepend \"*\" for substring search): ")))
(funcall ement-read-reaction)
(point))))
;; HACK: We could simplify this by storing the key in a text property...
(ement-room-with-highlighted-event-at position
Expand Down
70 changes: 40 additions & 30 deletions ement.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -151,6 +151,12 @@ Alist mapping user IDs to a list of room aliases/IDs to open buffers for."
:type '(alist :key-type (string :tag "Local user ID")
:value-type (repeat (string :tag "Room alias/ID"))))

(defcustom ement-read-reaction #'ement-read-reaction
"Function that prompts the user for reaction string.
The function is called with no arguments and should return a
string to be used as the reaction."
:type 'function)

;;;; Commands

;;;###autoload
Expand Down Expand Up @@ -187,38 +193,38 @@ the port, e.g.
(1 (list :session (cdar ement-sessions)))
(otherwise (list :session (ement-complete-session))))))
(cl-labels ((new-session
() (unless (string-match (rx bos "@" (group (1+ (not (any ":")))) ; Username
":" (group (optional (1+ (not (any blank)))))) ; Server name
user-id)
(user-error "Invalid user ID format: use @USERNAME:SERVER"))
(let* ((username (match-string 1 user-id))
(server-name (match-string 2 user-id))
(uri-prefix (or uri-prefix (ement--hostname-uri server-name)))
(user (make-ement-user :id user-id :username username :room-display-names (make-hash-table)))
(server (make-ement-server :name server-name :uri-prefix uri-prefix))
(transaction-id (ement--initial-transaction-id)))
(make-ement-session :user user :server server :transaction-id transaction-id
:events (make-hash-table :test #'equal))))
() (unless (string-match (rx bos "@" (group (1+ (not (any ":")))) ; Username
":" (group (optional (1+ (not (any blank)))))) ; Server name
user-id)
(user-error "Invalid user ID format: use @USERNAME:SERVER"))
(let* ((username (match-string 1 user-id))
(server-name (match-string 2 user-id))
(uri-prefix (or uri-prefix (ement--hostname-uri server-name)))
(user (make-ement-user :id user-id :username username :room-display-names (make-hash-table)))
(server (make-ement-server :name server-name :uri-prefix uri-prefix))
(transaction-id (ement--initial-transaction-id)))
(make-ement-session :user user :server server :transaction-id transaction-id
:events (make-hash-table :test #'equal))))
(password-login
() (pcase-let* (((cl-struct ement-session user device-id initial-device-display-name) session)
((cl-struct ement-user id) user)
(data (ement-alist "type" "m.login.password"
"user" id
"password" password
"device_id" device-id
"initial_device_display_name" initial-device-display-name)))
;; TODO: Clear password in callback (if we decide to hold on to it for retrying login timeouts).
(ement-api session "login" :method 'post :data (json-encode data)
:then (apply-partially #'ement--login-callback session))))
() (pcase-let* (((cl-struct ement-session user device-id initial-device-display-name) session)
((cl-struct ement-user id) user)
(data (ement-alist "type" "m.login.password"
"user" id
"password" password
"device_id" device-id
"initial_device_display_name" initial-device-display-name)))
;; TODO: Clear password in callback (if we decide to hold on to it for retrying login timeouts).
(ement-api session "login" :method 'post :data (json-encode data)
:then (apply-partially #'ement--login-callback session))))
(flows-callback
(data) (if (cl-loop for flow across (map-elt data 'flows)
thereis (equal (map-elt flow 'type) "m.login.password"))
(progn
(message "Ement: Logging in with password...")
(password-login))
(error "Matrix server doesn't support m.login.password login flow. Supported flows: %s"
(cl-loop for flow in (map-elt data 'flows)
collect (map-elt flow 'type))))))
(data) (if (cl-loop for flow across (map-elt data 'flows)
thereis (equal (map-elt flow 'type) "m.login.password"))
(progn
(message "Ement: Logging in with password...")
(password-login))
(error "Matrix server doesn't support m.login.password login flow. Supported flows: %s"
(cl-loop for flow in (map-elt data 'flows)
collect (map-elt flow 'type))))))
(if session
;; Start syncing given session.
(let ((user-id (ement-user-id (ement-session-user session))))
Expand Down Expand Up @@ -1384,6 +1390,10 @@ To be called after initial sync."
(when-let ((child-room (cl-find child-id rooms :key #'ement-room-id :test #'equal)))
(cl-pushnew parent-id (alist-get 'parents (ement-room-local child-room)) :test #'equal))))))))

(defun ement-read-reaction ()
"Prompt user for reaction and return it."
(char-to-string (read-char-by-name "Reaction (prepend \"*\" for substring search): ")))

;;;; Footer

(provide 'ement)
Expand Down

0 comments on commit 579b817

Please sign in to comment.