From: Po Lu Date: Wed, 14 Sep 2022 06:24:49 +0000 (+0000) Subject: Implement wallpaper.el support for Haiku X-Git-Tag: emacs-29.0.90~1856^2~534 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b9ca1a8e4fbd3f8ef0d384d402ec5721ddcad28c;p=emacs.git Implement wallpaper.el support for Haiku * lisp/image/wallpaper.el (haiku-set-wallpaper, wallpaper-set): Use `haiku-set-wallpaper' on Haiku. * lisp/term/haiku-win.el (haiku-write-node-attribute) (haiku-send-message, haiku-set-wallpaper): New function. * src/haiku_support.cc (be_write_node_message, be_send_message): New functions. * src/haiku_support.h: Update prototypes. * src/haikuselect.c (haiku_message_to_lisp) (haiku_lisp_to_message): Fix CSTR type handling to include NULL byte. (haiku_report_system_error, Fhaiku_write_node_attribute) (Fhaiku_send_message): New functions. (syms_of_haikuselect): Add defsubrs. --- diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index ca2b36db2e3..19741a20f15 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -105,6 +105,8 @@ You can also use \\[report-emacs-bug]." (executable-find (car cmd))) (throw 'found cmd))))) +(declare-function haiku-set-wallpaper "term/haiku-win.el") + (defun wallpaper-set (file) "Set the desktop background to FILE in a graphical environment." (interactive (list (and @@ -121,32 +123,34 @@ You can also use \\[report-emacs-bug]." (unless (file-readable-p file) (error "File is not readable: %s" file)) (when (display-graphic-p) - (let* ((command (wallpaper--find-command)) - (fmt-spec `((?f . ,(expand-file-name file)) - (?h . ,(display-pixel-height)) - (?w . ,(display-pixel-width)))) - (bufname (format " *wallpaper-%s*" (random))) - (process - (and command - (apply #'start-process "set-wallpaper" bufname - (car command) - (mapcar (lambda (arg) (format-spec arg fmt-spec)) - (cdr command)))))) - (unless command - (error "Can't find a suitable command for setting the wallpaper")) - (wallpaper-debug "Using command %s" (car command)) - (setf (process-sentinel process) - (lambda (process status) - (unwind-protect - (unless (and (eq (process-status process) 'exit) - (zerop (process-exit-status process))) - (message "command %S %s: %S" (string-join (process-command process) " ") - (string-replace "\n" "" status) - (with-current-buffer (process-buffer process) - (string-clean-whitespace (buffer-string))))) - (ignore-errors - (kill-buffer (process-buffer process)))))) - process))) + (if (featurep 'haiku) + (haiku-set-wallpaper file) + (let* ((command (wallpaper--find-command)) + (fmt-spec `((?f . ,(expand-file-name file)) + (?h . ,(display-pixel-height)) + (?w . ,(display-pixel-width)))) + (bufname (format " *wallpaper-%s*" (random))) + (process + (and command + (apply #'start-process "set-wallpaper" bufname + (car command) + (mapcar (lambda (arg) (format-spec arg fmt-spec)) + (cdr command)))))) + (unless command + (error "Can't find a suitable command for setting the wallpaper")) + (wallpaper-debug "Using command %s" (car command)) + (setf (process-sentinel process) + (lambda (process status) + (unwind-protect + (unless (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (message "command %S %s: %S" (string-join (process-command process) " ") + (string-replace "\n" "" status) + (with-current-buffer (process-buffer process) + (string-clean-whitespace (buffer-string))))) + (ignore-errors + (kill-buffer (process-buffer process)))))) + process)))) (provide 'wallpaper) diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index a16169d477f..24942d96c18 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -598,6 +598,45 @@ MODIFIERS is the internal modifier mask of the wheel movement." ;; the Deskbar will not, so kill ourself here. (unless cancel-shutdown (kill-emacs)))) +;;;; Wallpaper support. + + +(declare-function haiku-write-node-attribute "haikuselect.c") +(declare-function haiku-send-message "haikuselect.c") + +(defun haiku-set-wallpaper (file) + "Make FILE the wallpaper. +Set the desktop background to the image FILE, on all workspaces, +with an offset of 0, 0." + (let ((encoded-file (encode-coding-string + (expand-file-name file) + (or file-name-coding-system + default-file-name-coding-system)))) + ;; Write the necessary information to the desktop directory. + (haiku-write-node-attribute "/boot/home/Desktop" + "be:bgndimginfo" + (list '(type . 0) + '("be:bgndimginfoerasetext" bool t) + (list "be:bgndimginfopath" 'string + encoded-file) + '("be:bgndimginfoworkspaces" long + ;; This is a mask of all the + ;; workspaces the background + ;; image will be applied to. It + ;; is treated as an unsigned + ;; value by the Tracker, despite + ;; the type being signed. + -1) + ;; Don't apply an offset + '("be:bgndimginfooffset" point (0 . 0)) + ;; Don't stretch or crop or anything + '("be:bgndimginfomode" long 0) + ;; Don't apply a set + '("be:bgndimginfoset" long 0))) + ;; Tell the tracker to redisplay the wallpaper. + (haiku-send-message "application/x-vnd.Be-TRAK" + (list (cons 'type (haiku-numeric-enum Tbgr)))))) + ;;;; Cursors. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 983928442a1..0f8e26d0db4 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -54,12 +54,14 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #include #include #include #include #include +#include #include #include @@ -5501,3 +5503,54 @@ be_set_use_frame_synchronization (void *view, bool sync) vw = (EmacsView *) view; vw->SetFrameSynchronization (sync); } + +status_t +be_write_node_message (const char *path, const char *name, void *message) +{ + BNode node (path); + status_t rc; + ssize_t flat, result; + char *buffer; + BMessage *msg; + + rc = node.InitCheck (); + msg = (BMessage *) message; + + if (rc < B_OK) + return rc; + + flat = msg->FlattenedSize (); + if (flat < B_OK) + return flat; + + buffer = new (std::nothrow) char[flat]; + if (!buffer) + return B_NO_MEMORY; + + rc = msg->Flatten (buffer, flat); + if (rc < B_OK) + { + delete[] buffer; + return rc; + } + + result = node.WriteAttr (name, B_MIME_TYPE, 0, + buffer, flat); + delete[] buffer; + + if (result < B_OK) + return result; + + if (result != flat) + return B_ERROR; + + return B_OK; +} + +void +be_send_message (const char *app_id, void *message) +{ + BMessenger messenger (app_id); + + messenger.SendMessage ((BMessage *) message); +} diff --git a/src/haiku_support.h b/src/haiku_support.h index ca1808556a4..d66dbc5fa60 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -724,6 +724,9 @@ extern void be_get_window_decorator_frame (void *, int *, int *, int *, int *); extern void be_send_move_frame_event (void *); extern void be_set_window_fullscreen_mode (void *, enum haiku_fullscreen_mode); +extern status_t be_write_node_message (const char *, const char *, void *); +extern void be_send_message (const char *, void *); + extern void be_lock_window (void *); extern void be_unlock_window (void *); extern bool be_get_explicit_workarea (int *, int *, int *, int *); diff --git a/src/haikuselect.c b/src/haikuselect.c index 7eb93a2754d..bd004f4900a 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -325,6 +325,15 @@ haiku_message_to_lisp (void *message) t1 = make_float (*(float *) buf); break; + case 'CSTR': + /* Is this even possible? */ + if (!buf_size) + buf_size = 1; + + t1 = make_uninit_string (buf_size - 1); + memcpy (SDATA (t1), buf, buf_size - 1); + break; + default: t1 = make_uninit_string (buf_size); memcpy (SDATA (t1), buf, buf_size); @@ -747,6 +756,21 @@ haiku_lisp_to_message (Lisp_Object obj, void *message) signal_error ("Failed to add bool", data); break; + case 'CSTR': + /* C strings must be handled specially, since they + include a trailing NULL byte. */ + CHECK_STRING (data); + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, SDATA (data), + SBYTES (data) + 1); + unblock_input (); + + if (rc) + signal_error ("Failed to add", data); + break; + default: decode_normally: CHECK_STRING (data); @@ -779,6 +803,49 @@ haiku_unwind_drag_message (void *message) BMessage_delete (message); } +static void +haiku_report_system_error (status_t code, const char *format) +{ + switch (code) + { + case B_BAD_VALUE: + error (format, "Bad value"); + break; + + case B_ENTRY_NOT_FOUND: + error (format, "File not found"); + break; + + case B_PERMISSION_DENIED: + error (format, "Permission denied"); + break; + + case B_LINK_LIMIT: + error (format, "Link limit reached"); + break; + + case B_BUSY: + error (format, "Device busy"); + break; + + case B_NO_MORE_FDS: + error (format, "No more file descriptors"); + break; + + case B_FILE_ERROR: + error (format, "File error"); + break; + + case B_NO_MEMORY: + memory_full (SIZE_MAX); + break; + + default: + error (format, "Unknown error"); + break; + } +} + DEFUN ("haiku-drag-message", Fhaiku_drag_message, Shaiku_drag_message, 2, 4, 0, doc: /* Begin dragging MESSAGE from FRAME. @@ -958,6 +1025,66 @@ after it starts. */) return SAFE_FREE_UNBIND_TO (depth, Qnil); } +DEFUN ("haiku-write-node-attribute", Fhaiku_write_node_attribute, + Shaiku_write_node_attribute, 3, 3, 0, + doc: /* Write a message as a file-system attribute of NODE. +FILE should be a file name of a file on a Be File System volume, NAME +should be a string describing the name of the attribute that will be +written, and MESSAGE will be the attribute written to FILE, as a +system message in the format accepted by `haiku-drag-message', which +see. */) + (Lisp_Object file, Lisp_Object name, Lisp_Object message) +{ + void *be_message; + status_t rc; + specpdl_ref count; + + CHECK_STRING (file); + CHECK_STRING (name); + + file = ENCODE_FILE (file); + name = ENCODE_SYSTEM (name); + + be_message = be_create_simple_message (); + count = SPECPDL_INDEX (); + + record_unwind_protect_ptr (BMessage_delete, be_message); + haiku_lisp_to_message (message, be_message); + rc = be_write_node_message (SSDATA (file), SSDATA (name), + be_message); + + if (rc < B_OK) + haiku_report_system_error (rc, "Failed to set attribute: %s"); + + return unbind_to (count, Qnil); +} + +DEFUN ("haiku-send-message", Fhaiku_send_message, Shaiku_send_message, + 2, 2, 0, + doc: /* Send a system message to PROGRAM. +PROGRAM must be the name of the application to which the message will +be sent. MESSAGE is the system message, serialized in the format +accepted by `haiku-drag-message', that will be sent to the application +specified by PROGRAM. There is no guarantee that the message will +arrive after this function is called. */) + (Lisp_Object program, Lisp_Object message) +{ + specpdl_ref count; + void *be_message; + + CHECK_STRING (program); + program = ENCODE_SYSTEM (program); + + be_message = be_create_simple_message (); + count = SPECPDL_INDEX (); + + record_unwind_protect_ptr (BMessage_delete, be_message); + haiku_lisp_to_message (message, be_message); + be_send_message (SSDATA (program), be_message); + + return unbind_to (count, Qnil); +} + static void haiku_dnd_compute_tip_xy (int *root_x, int *root_y) { @@ -1191,6 +1318,8 @@ keyboard modifiers currently held down. */); defsubr (&Shaiku_selection_owner_p); defsubr (&Shaiku_drag_message); defsubr (&Shaiku_roster_launch); + defsubr (&Shaiku_write_node_attribute); + defsubr (&Shaiku_send_message); haiku_dnd_frame = NULL; }