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.
This commit is contained in:
Po Lu
parent
f0798ac13d
commit
b9ca1a8e4f
5 changed files with 254 additions and 26 deletions
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 *);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue