]> git.eshelyaron.com Git - emacs.git/commitdiff
Implement wallpaper.el support for Haiku
authorPo Lu <luangruo@yahoo.com>
Wed, 14 Sep 2022 06:24:49 +0000 (06:24 +0000)
committerPo Lu <luangruo@yahoo.com>
Wed, 14 Sep 2022 06:25:11 +0000 (06:25 +0000)
* 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
lisp/term/haiku-win.el
src/haiku_support.cc
src/haiku_support.h
src/haikuselect.c

index ca2b36db2e35092137aa3594e5ec7dc27bd5c202..19741a20f156cbc0ec3917f735f1f624b7b80c93 100644 (file)
@@ -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)
 
index a16169d477f6ff8dee8a0176acac0a7d73528fd5..24942d96c1869aaee38605a5b5c6c2c5df1ff62e 100644 (file)
@@ -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.
+\f
+
+(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))))))
+
 \f
 ;;;; Cursors.
 
index 983928442a136af89c285f32763099d2810dbdd9..0f8e26d0db485b72fcf7993e82dd144821039da4 100644 (file)
@@ -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);
+}
index ca1808556a4abc2c3c94d4404e4e0dc4f0edded0..d66dbc5fa606812e485d37ec27b1986572d2c223 100644 (file)
@@ -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 *);
index 7eb93a2754d36d02a681ad9eae0a02ee0a39736d..bd004f4900ab9d0bc21e33de5414564d3d10fa9b 100644 (file)
@@ -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;
 }