@@ -1263,10 +1263,12 @@ otherwise use current room."
12631263 :then (lambda (_data )
12641264 (message " Topic set (%s ): %s " display-name topic)))))
12651265
1266- (cl-defun ement-room-send-file (file body room session &key (msgtype " m.file" ))
1266+ (cl-defun ement-room-send-file (file body room session &key (msgtype " m.file" ) (then # 'ignore ) )
12671267 " Send FILE to ROOM on SESSION, using message BODY and MSGTYPE.
12681268Interactively, with prefix, prompt for room and session,
1269- otherwise use current room."
1269+ otherwise use current room.
1270+ When THEN is non-nil, it should be a function of no arguments and
1271+ will be called once the image is uploaded."
12701272 ; ; TODO: Support URLs to remote files.
12711273 (interactive
12721274 (ement-with-room-and-session
@@ -1279,7 +1281,7 @@ otherwise use current room."
12791281 (list file body ement-room ement-session)))))
12801282 ; ; NOTE: The typing notification won't be quite right, because it'll be canceled while waiting
12811283 ; ; for the file to upload. It would be awkward to handle that, so this will do for now.
1282- (when (yes-or-no-p (format " Upload file %S to room %S ? "
1284+ (when (yes-or-no-p (format " Upload file %s to room %s ? "
12831285 file (ement-room-display-name room)))
12841286 (pcase-let* ((filename (file-name-nondirectory file))
12851287 (extension (or (file-name-extension file) " " ))
@@ -1289,6 +1291,8 @@ otherwise use current room."
12891291 (ement-upload session :data data :filename filename :content-type mime-type
12901292 :then (lambda (data )
12911293 (message " Uploaded file %S . Sending message... " file)
1294+ (when then
1295+ (funcall then))
12921296 (pcase-let* (((map ('content_uri content-uri)) data)
12931297 ((cl-struct ement-room (id room-id)) room)
12941298 (endpoint (format " rooms/%s /send/%s /%s " (url-hexify-string room-id)
@@ -1328,6 +1332,50 @@ otherwise use current room."
13281332 " m.image"
13291333 " m.file" ))))
13301334
1335+ (defun ement-room-dnd-xds-upload-file (need-name filename )
1336+ " Upload the file dropped via XDS protocol.
1337+ When NEED-NAME is t, FILENAME is the base name of the file to be
1338+ saved by the source of the file being droped.
1339+ When NEED-NAME is nil, the drop is complete."
1340+ (if need-name
1341+ (expand-file-name filename temporary-file-directory)
1342+ (ement-room-send-file filename (file-name-nondirectory filename)
1343+ ement-room ement-session
1344+ :msgtype (if (string-prefix-p " image/" (mailcap-file-name-to-mime-type filename))
1345+ " m.image"
1346+ " m.file" )
1347+ :then (lambda () (delete-file filename)))))
1348+
1349+ (defun ement-room-send-image-in-clipboard (mimetype data )
1350+ " Upload image file in clipboard whose contents is DATA.
1351+ The mimetype of the image is given by MIMETYPE."
1352+ (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype)))
1353+ (coding-system-for-write 'no-conversion )
1354+ (filename (make-temp-file " emacs" nil (concat " ." ext) data)))
1355+ (ement-room-send-file filename
1356+ (concat " clipboard." ext)
1357+ ement-room ement-session
1358+ :msgtype " m.image"
1359+ :then (lambda () (delete-file filename)))))
1360+
1361+ (defun ement-room-send-copied-files (_mimetype data )
1362+ " Upload files in clipboard to the current room.
1363+ DATA follows the following format:
1364+
1365+ cut OR copy
1366+ file://...
1367+ ..."
1368+ (let* ((files (cdr (split-string data " [\0\n\r ]" t " ^file://" ))))
1369+ (dolist (f files )
1370+ ; ; NOTE: We are assuming the filename is always UTF-8!
1371+ (setq f (decode-coding-string (url-unhex-string f) 'utf-8 ))
1372+ (when (file-readable-p f)
1373+ (ement-room-send-file f (file-name-nondirectory f) ement-room ement-session
1374+ :msgtype
1375+ (if (string-prefix-p " image/" (mailcap-file-name-to-mime-type f))
1376+ " m.image"
1377+ " m.file" ))))))
1378+
13311379(cl-defun ement-room-join (id-or-alias session &key then )
13321380 " Join room by ID-OR-ALIAS on SESSION.
13331381THEN may be a function to call after joining the room (and when
@@ -2093,7 +2141,12 @@ and erases the buffer."
20932141 '(ement-room--complete-members-at-point ement-room--complete-rooms-at-point))
20942142 (setq-local dnd-protocol-alist (append '((" ^file:///" . ement-room-dnd-upload-file)
20952143 (" ^file:" . ement-room-dnd-upload-file))
2096- dnd-protocol-alist)))
2144+ dnd-protocol-alist))
2145+ (when (boundp 'x-dnd-direct-save-function )
2146+ (setq-local x-dnd-direct-save-function #'ement-room-dnd-xds-upload-file ))
2147+ (when (fboundp 'yank-media-handler )
2148+ (yank-media-handler " image/.*" #'ement-room-send-image-in-clipboard )
2149+ (yank-media-handler " x/special-\\ (?:gnome\\ |KDE\\ |mate\\ )-files" #'ement-room-send-copied-files )))
20972150(add-hook 'ement-room-mode-hook 'visual-line-mode )
20982151
20992152(defun ement-room-read-string (prompt &optional initial-input history default-value inherit-input-method )
0 commit comments