[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master b9ca1a8e4f: Implement wallpaper.el support for Haiku
From: |
Po Lu |
Subject: |
master b9ca1a8e4f: Implement wallpaper.el support for Haiku |
Date: |
Wed, 14 Sep 2022 02:25:52 -0400 (EDT) |
branch: master
commit b9ca1a8e4fbd3f8ef0d384d402ec5721ddcad28c
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
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.
---
lisp/image/wallpaper.el | 56 +++++++++++----------
lisp/term/haiku-win.el | 39 +++++++++++++++
src/haiku_support.cc | 53 ++++++++++++++++++++
src/haiku_support.h | 3 ++
src/haikuselect.c | 129 ++++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 254 insertions(+), 26 deletions(-)
diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el
index ca2b36db2e..19741a20f1 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 a16169d477..24942d96c1 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 983928442a..0f8e26d0db 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -54,12 +54,14 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <game/WindowScreen.h>
#include <game/DirectWindow.h>
+#include <storage/FindDirectory.h>
#include <storage/Entry.h>
#include <storage/Path.h>
#include <storage/FilePanel.h>
#include <storage/AppFileInfo.h>
#include <storage/Path.h>
#include <storage/PathFinder.h>
+#include <storage/Node.h>
#include <support/Beep.h>
#include <support/DataIO.h>
@@ -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 ca1808556a..d66dbc5fa6 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 7eb93a2754..bd004f4900 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;
}
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master b9ca1a8e4f: Implement wallpaper.el support for Haiku,
Po Lu <=