From 941b19b2b3f8aff586b57e804718a74bacd55cee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Tue, 7 May 2024 12:53:25 +0200 Subject: [PATCH 1/2] Stop using deprecated [GdkPixbuf.from_xpm_data] This function can fail at runtime with certain versions of gdk-pixbuf. Replace it with an XPM parsing function created specifically for the icon data in the Pixmaps module. --- src/pixmaps.ml | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/uigtk3.ml | 2 +- 2 files changed, 58 insertions(+), 1 deletion(-) diff --git a/src/pixmaps.ml b/src/pixmaps.ml index 1eeb21351..7ea04f977 100644 --- a/src/pixmaps.ml +++ b/src/pixmaps.ml @@ -252,6 +252,63 @@ let copyBAblack_asym = [| |] +(***********************************************************************) +(* XPM parse function *) +(***********************************************************************) + +(* This function is not for universal XPM parsing. It is intended only + for parsing the icon definitions above in this file. + Do not use [GdkPixbuf.from_xpm_data] as it has been removed from + upstream gdk-pixbuf. *) +let to_pixbuf dat = + let colormap = Array.make 256 [| 0; 0; 0; 0 |] in + let getColor ch = colormap.(Char.code ch) in + let setColor ch col = + colormap.(Char.code ch) <- + [| (col asr 16) land 0xff; + (col asr 8) land 0xff; + (col asr 0) land 0xff; + 0xff |] + in + + (* width height num_colors chars_per_pixel *) + let parseValues w h nc chp = + (* Very basic sanity checks *) + if w < 1 || w > 128 || h < 1 || h > 128 || nc < 1 || nc > 256 || chp <> 1 then + invalid_arg "XPM: Unsupported header values"; + w, h, nc + in + let width, height, colors = Scanf.sscanf dat.(0) " %u %u %u %u" parseValues in + + let parseColor ch t s = + if t <> 'c' then invalid_arg "XPM: Unsupported color type"; + if s <> "None" then begin + if s = "" || s.[0] <> '#' then invalid_arg "XPM: Unsupported color code"; + Scanf.sscanf s "#%x" (setColor ch) + end + in + for i = 1 to colors do + Scanf.sscanf dat.(i) "%c %c %s" parseColor + done; + + let p = GdkPixbuf.create ~width ~height ~has_alpha:true () in + let pixels = GdkPixbuf.get_pixels p in + let setPixel pos v = + let pos = pos * 4 in + Gpointer.set_byte pixels ~pos:(pos + 0) v.(0); + Gpointer.set_byte pixels ~pos:(pos + 1) v.(1); + Gpointer.set_byte pixels ~pos:(pos + 2) v.(2); + Gpointer.set_byte pixels ~pos:(pos + 3) v.(3) + in + let pxlStart = colors + 1 in + for i = 0 to height - 1 do + for j = 0 to width - 1 do + setPixel (i * width + j) (getColor dat.(pxlStart + i).[j]) + done + done; + p + + (***********************************************************************) (* Unison icon *) (***********************************************************************) diff --git a/src/uigtk3.ml b/src/uigtk3.ml index 352f5d290..f9e3f7d23 100644 --- a/src/uigtk3.ml +++ b/src/uigtk3.ml @@ -3293,7 +3293,7 @@ let createToplevelWindow () = let blackPixel = "000000" in *) let buildPixmap p = - GdkPixbuf.from_xpm_data p in + Pixmaps.to_pixbuf p in let buildPixmaps f c1 = (buildPixmap (f c1), buildPixmap (f lightbluePixel)) in From 6eddded5096157b5bcfb9d6a209ecfd321c0b27c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Tue, 7 May 2024 13:18:47 +0200 Subject: [PATCH 2/2] Fix dune build of the GTK GUI --- src/dune | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/dune b/src/dune index c784f1092..06d60786f 100644 --- a/src/dune +++ b/src/dune @@ -1,7 +1,7 @@ (library (name unison_lib) (wrapped false) - (modules :standard \ linktext linkgtk3 uigtk3 uimacbridge test) + (modules :standard \ linktext linkgtk3 uigtk3 pixmaps uimacbridge test) (modules_without_implementation ui) (flags :standard -w -3-6-9-10-26-27-32-34-35-38-39-50-52 @@ -27,5 +27,5 @@ (public_name unison-gui) (package unison-gui) ; Dummy: we don't use packages (flags :standard -w -3-6-9-27-32-52) - (modules linkgtk3 uigtk3) + (modules linkgtk3 uigtk3 pixmaps) (libraries threads unison_lib lablgtk3))