hiro/ement.el
1
0
Fork 0
mirror of https://github.com/vale981/ement.el synced 2025-03-05 09:21:37 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Change: (ement-room-send-reaction) Take key as argument

Browse source
This commit is contained in:
Adam Porter 2021-08-10 03:17:30 -05:00
parent 3a615a6182
commit 11a73eb60d
1 changed files with 48 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

91
ement-room.el
View file

@ -952,55 +952,60 @@ The message must be one sent by the local user."
(ement-room-read-string prompt nil nil nil 'inherit-input-method)))) (ement-room-read-string prompt nil nil nil 'inherit-input-method))))
(ement-room-send-message room session :body body :replying-to-event event)))) (ement-room-send-message room session :body body :replying-to-event event))))
(defun ement-room-send-reaction (position) (defun ement-room-send-reaction (key position)
"Send reaction to event at POSITION. "Send reaction of KEY to event at POSITION.
Interactively, send reaction to event at point." Interactively, send reaction to event at point. KEY should be a
reaction string, e.g. \"👍\"."
;; SPEC: MSC2677 <https://github.com/matrix-org/matrix-doc/pull/2677> ;; SPEC: MSC2677 <https://github.com/matrix-org/matrix-doc/pull/2677>
(interactive (list (point))) (interactive
(cl-labels
((face-at-point-p
(face) (let ((face-at-point (get-text-property (point) 'face)))
(or (eq face face-at-point)
(and (listp face-at-point)
(member face face-at-point)))))
(buffer-substring-while
(beg pred &key (forward-fn #'forward-char))
"Return substring of current buffer from BEG while PRED is true."
(save-excursion
(goto-char beg)
(cl-loop while (funcall pred)
do (funcall forward-fn)
finally return (buffer-substring-no-properties beg (point)))))
(key-at
(pos) (cond ((face-at-point-p 'ement-room-reactions-key)
(buffer-substring-while pos (apply-partially #'face-at-point-p 'ement-room-reactions-key)))
((face-at-point-p 'ement-room-reactions)
;; Point is in a reaction button but after the key.
(buffer-substring-while (button-start (button-at pos))
(apply-partially #'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): ")))
(point))))
;; HACK: We could simplify this by storing the key in a text property... ;; HACK: We could simplify this by storing the key in a text property...
(cl-labels ((face-at-point-p (ement-room-with-highlighted-event-at position
(face) (let ((face-at-point (get-text-property (point) 'face))) (pcase-let* ((event (or (ewoc-data (ewoc-locate ement-ewoc position))
(or (eq face face-at-point) (user-error "No event at point")))
(and (listp face-at-point) ;; NOTE: Sadly, `face-at-point' doesn't work here because, e.g. if
(member face face-at-point))))) ;; hl-line-mode is enabled, it only returns the hl-line face.
(buffer-substring-while ((cl-struct ement-event (id event-id)) event)
(beg pred &key (forward-fn #'forward-char)) ((cl-struct ement-room (id room-id)) ement-room)
"Return substring of current buffer from BEG while PRED is true." (endpoint (format "rooms/%s/send/%s/%s" (url-hexify-string room-id)
(save-excursion "m.reaction" (cl-incf (ement-session-transaction-id ement-session))))
(goto-char beg) (content (ement-alist "m.relates_to"
(cl-loop while (funcall pred) (ement-alist "rel_type" "m.annotation"
do (funcall forward-fn) "event_id" event-id
finally return (buffer-substring-no-properties beg (point))))) "key" key))))
(key-at (ement-api ement-session endpoint :method 'put :data (json-encode content)
(pos) (cond ((face-at-point-p 'ement-room-reactions-key) :then (apply-partially #'ement-room-send-event-callback :room ement-room :session ement-session
(buffer-substring-while pos (apply-partially #'face-at-point-p 'ement-room-reactions-key))) :content content :data)))))
((face-at-point-p 'ement-room-reactions)
;; Point is in a reaction button but after the key.
(buffer-substring-while (button-start (button-at pos))
(apply-partially #'face-at-point-p 'ement-room-reactions-key))))))
(ement-room-with-highlighted-event-at (point)
(pcase-let* ((event (or (ewoc-data (ewoc-locate ement-ewoc position))
(user-error "No event at point")))
;; NOTE: Sadly, `face-at-point' doesn't work here because, e.g. if
;; hl-line-mode is enabled, it only returns the hl-line face.
(key (or (key-at position)
(char-to-string (read-char-by-name "Reaction (prepend \"*\" for substring search): "))))
((cl-struct ement-event (id event-id)) event)
((cl-struct ement-room (id room-id)) ement-room)
(endpoint (format "rooms/%s/send/%s/%s" (url-hexify-string room-id)
"m.reaction" (cl-incf (ement-session-transaction-id ement-session))))
(content (ement-alist "m.relates_to"
(ement-alist "rel_type" "m.annotation"
"event_id" event-id
"key" key))))
(ement-api ement-session endpoint :method 'put :data (json-encode content)
:then (apply-partially #'ement-room-send-event-callback :room ement-room :session ement-session
:content content :data))))))
(defun ement-room-reaction-button-action (button) (defun ement-room-reaction-button-action (button)
"Push reaction BUTTON at point." "Push reaction BUTTON at point."
;; TODO: Toggle reactions off with redactions (not in spec yet, but Element does it). ;; TODO: Toggle reactions off with redactions (not in spec yet, but Element does it).
(ement-room-send-reaction (button-start button))) (save-excursion
(goto-char (button-start button))
(call-interactively #'ement-room-send-reaction)))
;;;; Functions ;;;; Functions