Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-17 18:37:33 +00:00
Code Issues Projects Releases Packages Wiki Activity

Handle be:actions field in Haiku DND messages

Browse source 
* lisp/term/haiku-win.el (haiku-get-numeric-enum): New function.
(haiku-numeric-enum): New macro.
(haiku-select-encode-xstring, haiku-select-encode-utf-8-string):
Replace hard-coded numeric enumerators.
(haiku-parse-drag-actions): New function.
(haiku-drag-and-drop): Use action returned by that function.
(x-begin-drag): Replace hard-coded enumerator.
This commit is contained in:
Po Lu 2022-06-29 06:05:25 +00:00
parent 9c2b1d37e7
commit 7fa37d7a14
1 changed files with 71 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

102
lisp/term/haiku-win.el
View file

@ -174,6 +174,30 @@ VALUE as a unibyte string, or nil if VALUE was not a string."
(insert "\n")))
(buffer-string))))))
(defun haiku-get-numeric-enum (name)
"Return the numeric value of the system enumerator NAME."
(or (get name 'haiku-numeric-enum)
(let ((value 0)
(offset 0)
(string (symbol-name name)))
(cl-loop for octet across string
do (progn
(when (or (< octet 0)
(> octet 255))
(error "Out of range octet: %d" octet))
(setq value
(logior value
(lsh octet
(- (* (1- (length string)) 8)
offset))))
(setq offset (+ offset 8))))
(prog1 value
(put name 'haiku-enumerator-id value)))))
(defmacro haiku-numeric-enum (name)
"Expand to the numeric value NAME as a system identifier."
(haiku-get-numeric-enum name))
(declare-function x-open-connection "haikufns.c")
(declare-function x-handle-args "common-win")
(declare-function haiku-selection-data "haikuselect.c")
@ -237,7 +261,7 @@ under the type `text/plain;charset=iso-8859-1'."
(buffer-substring (nth 0 bounds)
(nth 1 bounds)))))))
(when (and (stringp value) (not (string-empty-p value)))
(list "text/plain;charset=iso-8859-1" 1296649541
(list "text/plain;charset=iso-8859-1" (haiku-numeric-enum MIME)
(encode-coding-string value 'iso-latin-1))))
(defun haiku-select-encode-utf-8-string (_selection value)
@ -251,7 +275,7 @@ VALUE will be encoded as UTF-8 and stored under the type
(buffer-substring (nth 0 bounds)
(nth 1 bounds)))))))
(when (and (stringp value) (not (string-empty-p value)))
(list "text/plain" 1296649541
(list "text/plain" (haiku-numeric-enum MIME)
(encode-coding-string value 'utf-8-unix))))
(defun haiku-select-encode-file-name (_selection value)
@ -304,6 +328,21 @@ or a pair of markers) and turns it into a file system reference."
(file-name-nondirectory default-filename)))
(error "x-file-dialog on a tty frame")))
(defun haiku-parse-drag-actions (message)
"Given the drag-and-drop message MESSAGE, retrieve the desired action."
(let ((actions (cddr (assoc "be:actions" message)))
(sorted nil))
(dolist (action (list (haiku-numeric-enum DDCP)
(haiku-numeric-enum DDMV)
(haiku-numeric-enum DDLN)))
(when (member action actions)
(push sorted action)))
(cond
((eql (car sorted) (haiku-numeric-enum DDCP)) 'copy)
((eql (car sorted) (haiku-numeric-enum DDMV)) 'move)
((eql (car sorted) (haiku-numeric-enum DDLN)) 'link)
(t 'private))))
(defun haiku-drag-and-drop (event)
"Handle specified drag-n-drop EVENT."
(interactive "e")
@ -311,34 +350,35 @@ or a pair of markers) and turns it into a file system reference."
(window (posn-window (event-start event))))
(if (eq string 'lambda) ; This means the mouse moved.
(dnd-handle-movement (event-start event))
(cond
;; Don't allow dropping on something other than the text area.
;; It does nothing and doesn't work with text anyway.
((posn-area (event-start event)))
((assoc "refs" string)
(with-selected-window window
(dolist (filename (cddr (assoc "refs" string)))
(dnd-handle-one-url window 'private
(concat "file:" filename)))))
((assoc "text/uri-list" string)
(dolist (text (cddr (assoc "text/uri-list" string)))
(let ((uri-list (split-string text "[\0\r\n]" t)))
(dolist (bf uri-list)
(dnd-handle-one-url window 'private bf)))))
((assoc "text/plain" string)
(with-selected-window window
(dolist (text (cddr (assoc "text/plain" string)))
(unless mouse-yank-at-point
(goto-char (posn-point (event-start event))))
(dnd-insert-text window 'private
(if (multibyte-string-p text)
text
(decode-coding-string text 'undecided))))))
((not (eq (cdr (assq 'type string))
3003)) ; Type of the placeholder message Emacs uses
; to cancel a drop on C-g.
(message "Don't know how to drop any of: %s"
(mapcar #'car string)))))))
(let ((action (haiku-parse-drag-actions string)))
(cond
;; Don't allow dropping on something other than the text area.
;; It does nothing and doesn't work with text anyway.
((posn-area (event-start event)))
((assoc "refs" string)
(with-selected-window window
(dolist (filename (cddr (assoc "refs" string)))
(dnd-handle-one-url window action
(concat "file:" filename)))))
((assoc "text/uri-list" string)
(dolist (text (cddr (assoc "text/uri-list" string)))
(let ((uri-list (split-string text "[\0\r\n]" t)))
(dolist (bf uri-list)
(dnd-handle-one-url window action bf)))))
((assoc "text/plain" string)
(with-selected-window window
(dolist (text (cddr (assoc "text/plain" string)))
(unless mouse-yank-at-point
(goto-char (posn-point (event-start event))))
(dnd-insert-text window action
(if (multibyte-string-p text)
text
(decode-coding-string text 'undecided))))))
((not (eq (cdr (assq 'type string))
3003)) ; Type of the placeholder message Emacs uses
; to cancel a drop on C-g.
(message "Don't know how to drop any of: %s"
(mapcar #'car string))))))))
(define-key special-event-map [drag-n-drop] 'haiku-drag-and-drop)
@ -393,7 +433,7 @@ take effect on menu items until the menu bar is updated again."
;; Add B_MIME_TYPE to the message if the type was not
;; previously specified, or the type if it was.
(push (or (get-text-property 0 'type maybe-string)
1296649541)
(haiku-numeric-enum MIME))
(alist-get (car selection-result) message
nil nil #'equal))))
(if (not (consp (cadr selection-result)))