System GUI taskbar and progress reporter hooks (bug#79859)

Implement system GUI taskbar/dock/launcher icon badge, icon
progress indicator, icon attention alert features for D-Bus
platforms (tested on KDE and GNOME), NS (macOS/GNUstep),
MS-Windows.

Add 'progress-reporter-update-functions' abnormal hook to facilitate
taskbar progress display, and other custom progress reporters.
The default function list is 'progress-reporter-echo-area' which
is backward compatible.

* lisp/subr.el (progress-reporter-update-functions):
New defvar.
(progress-reporter-echo-area): New defun.
(progress-reporter-do-update): Run
progress-reporter-update-functions for both numerical and
pulsing reporters.
(progress-reporter-done): Run progress-reporter-done-functions.
* lisp/system-taskbar.el: New file.
* src/nsfns.m (Fns_badge, Fns_progress_indicator)
(Fns_request_user_attention): New function.
(syms_of_nsfns): Add defsubr Sns_badge,
Sns_request_user_attention, Sns_progress_indicator. Add DEFSYM
Qinformational, Qcritical.
* src/w32fns.c (rgb_list_to_colorref, Fw32_badge)
(Fw32_request_user_attention, Fw32_progress_indicator): New
function.
(syms_of_w32fns): Add defsubr Sw32_badge,
Sw32_progress_indicator, Sw32_request_user_attention. Add DEFSYM
Qinformational, Qcritical.
* doc/emacs/frames.texi: User documentation.
* doc/lispref/os.texi: Programmer documentation.
* etc/NEWS: Announce system-taskbar-mode.  Announce progress
reporter callback enhancements.

2 files changed, 455 insertions, 0 deletions

diff --git a/src/nsfns.m b/src/nsfns.m
index 3528c4acd50..2b94b32e59c 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -3674,6 +3674,129 @@ DEFUN ("ns-show-character-palette",
   return Qnil;
 }
 
+DEFUN ("ns-badge", Fns_badge, Sns_badge, 1, 1, 0,
+       doc: /* Set the app icon badge to BADGE.
+BADGE should be a string short enough to display nicely in the short
+space intended for badges.
+If BADGE is nil, clear the app badge.  */)
+  (Lisp_Object badge)
+{
+  block_input ();
+  if (NILP (badge))
+    [[NSApp dockTile] setBadgeLabel: nil];
+  else
+    {
+      CHECK_STRING (badge);
+      [[NSApp dockTile] setBadgeLabel:
+                          [NSString stringWithUTF8String: SSDATA (badge)]];
+    }
+  unblock_input ();
+  return Qnil;
+}
+
+/* Use -1 to indicate no active request.  */
+static NSInteger ns_request_user_attention_id = -1;
+
+DEFUN ("ns-request-user-attention",
+       Fns_request_user_attention,
+       Sns_request_user_attention,
+       1, 1, 0,
+       doc: /* Bounce the app dock icon to request user attention.
+If URGENCY nil, cancel the outstanding request, if any.
+If URGENCY is the symbol `informational', bouncing lasts a few seconds.
+If URGENCY is the symbol `critical', bouncing lasts until Emacs is
+focused.  */)
+  (Lisp_Object urgency)
+{
+  block_input ();
+  if (ns_request_user_attention_id != -1)
+    {
+      [NSApp cancelUserAttentionRequest: ns_request_user_attention_id];
+      ns_request_user_attention_id = -1;
+    }
+  if (!NILP (urgency) && SYMBOLP (urgency))
+    {
+      if (EQ (urgency, Qinformational))
+        ns_request_user_attention_id = [NSApp requestUserAttention:
+                                                NSInformationalRequest];
+      else if (EQ (urgency, Qcritical))
+        ns_request_user_attention_id = [NSApp requestUserAttention:
+                                                NSCriticalRequest];
+    }
+  unblock_input ();
+  return Qnil;
+}
+
+DEFUN ("ns-progress-indicator",
+       Fns_progress_indicator,
+       Sns_progress_indicator,
+       1, 1, 0,
+       doc: /* Bounce the app dock icon to request user attention.
+PROGRESS is a float between 0.0 and 1.0.
+If PROGRESS is nil, remove the progress indicator.  */)
+  (Lisp_Object progress)
+{
+  block_input ();
+  NSDockTile *dock_tile = [NSApp dockTile];
+  /* Use NSLevelIndicator with reliable redraws, not NSProgressIndicator.  */
+  NSLevelIndicator *level_indicator;
+  /* Reuse the indicator subview or create one. */
+  if (dock_tile.contentView
+      && [[dock_tile.contentView subviews] count] > 0
+      && [[[dock_tile.contentView subviews] lastObject]
+                        isKindOfClass:[NSLevelIndicator class]])
+    level_indicator =
+      (NSLevelIndicator *)[[[dock_tile contentView] subviews] lastObject];
+    else
+      {
+        if (!dock_tile.contentView)
+          {
+            NSImageView* image_view = [[NSImageView alloc] init];
+            [image_view setImage: [NSApp applicationIconImage]];
+            [dock_tile setContentView: image_view];
+          }
+        /* Set width to the width of the application icon, and height to
+           % of the icon height to respect scaled icons.  */
+        float width = [[NSApp applicationIconImage] size].width;
+        float height = 0.10 * [[NSApp applicationIconImage] size].height;
+        level_indicator =
+          [[NSLevelIndicator alloc] initWithFrame:
+                                      NSMakeRect (0.0, 0.0,
+                                                  width, height)];
+        [level_indicator setWantsLayer: YES]; /* Performance.  */
+        [level_indicator setEnabled: NO]; /* Ignore mouse input.  */
+        [level_indicator setLevelIndicatorStyle:
+                           NSLevelIndicatorStyleContinuousCapacity];
+        /* Match NSProgressIndicator color.  */
+        [level_indicator setFillColor: [NSColor controlAccentColor]];
+        [level_indicator setMinValue: 0.0];
+        [level_indicator setMaxValue: 1.0];
+        /* The contentView takes ownership.  */
+        [dock_tile.contentView addSubview: level_indicator];
+      }
+  double progress_value;
+  BOOL hide = (NILP (progress)
+               || (!NILP (progress) && !(FLOATP (progress))));
+  if (!hide)
+    {
+      progress_value = XFLOAT_DATA (progress);
+      hide = (progress_value < 0.0 || progress_value > 1.0);
+    }
+  if (hide)
+    {
+      [level_indicator setDoubleValue: 0.0];
+      [level_indicator setHidden: YES];
+    }
+  else
+    {
+      [level_indicator setDoubleValue: progress_value];
+      [level_indicator setHidden: NO];
+    }
+  [dock_tile display];
+  unblock_input ();
+  return Qnil;
+}
+
 #ifdef NS_IMPL_COCOA
 
 DEFUN ("ns-send-items",
@@ -3957,6 +4080,9 @@ The default value is t.  */);
   defsubr (&Sns_set_mouse_absolute_pixel_position);
   defsubr (&Sns_mouse_absolute_pixel_position);
   defsubr (&Sns_show_character_palette);
+  defsubr (&Sns_badge);
+  defsubr (&Sns_request_user_attention);
+  defsubr (&Sns_progress_indicator);
 #ifdef NS_IMPL_COCOA
   defsubr (&Sns_send_items);
 #endif
@@ -4023,4 +4149,6 @@ The default value is t.  */);
   DEFSYM (Qassq_delete_all, "assq-delete-all");
   DEFSYM (Qrun_at_time, "run-at-time");
   DEFSYM (Qx_hide_tip, "x-hide-tip");
+  DEFSYM (Qinformational, "informational");
+  DEFSYM (Qcritical, "critical");
 }
diff --git a/src/w32fns.c b/src/w32fns.c
index f7bf6110991..b1f5799d1c5 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -35,7 +35,12 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <c-ctype.h>
 
 #define COBJMACROS /* Ask for C definitions for COM.  */
+#if !defined MINGW_W64 && !defined CYGWIN
+# define INITGUID
+#endif
+#include <initguid.h>
 #include <shlobj.h>
+#include <shobjidl.h>
 #include <oleidl.h>
 #include <objidl.h>
 #include <ole2.h>
@@ -232,6 +237,8 @@ typedef struct Emacs_GESTURECONFIG
 typedef BOOL (WINAPI * SetGestureConfig_proc) (HWND, DWORD, UINT,
                                                Emacs_PGESTURECONFIG, UINT);
 
+typedef BOOL (WINAPI * FlashWindowEx_Proc) (PFLASHWINFO pfwi);
+
 static TrackMouseEvent_Proc track_mouse_event_fn = NULL;
 static ImmGetCompositionString_Proc get_composition_string_fn = NULL;
 static ImmGetContext_Proc get_ime_context_fn = NULL;
@@ -254,6 +261,7 @@ static WTSUnRegisterSessionNotification_Proc WTSUnRegisterSessionNotification_fn
 static WTSRegisterSessionNotification_Proc WTSRegisterSessionNotification_fn = NULL;
 static RegisterTouchWindow_proc RegisterTouchWindow_fn = NULL;
 static SetGestureConfig_proc SetGestureConfig_fn = NULL;
+static FlashWindowEx_Proc flash_window_ex_fn = NULL;
 
 extern AppendMenuW_Proc unicode_append_menu;
 
@@ -11008,6 +11016,313 @@ Return -1 if the required system API is not available or fails.  */)
 
 #endif
 
+
+#ifdef WINDOWSNT
+
+/***********************************************************************
+                     Taskbar Indicators
+ ***********************************************************************/
+
+#ifndef MINGW_W64
+  /* mingw.org's MinGW doesn't have this stuff.  */
+  DEFINE_GUID(CLSID_TaskbarList, 0x56fdf344, 0xfd6d, 0x11d0, 0x95,0x8a, 0x00,0x60,0x97,0xc9,0xa0,0x90);
+  DEFINE_GUID(IID_ITaskbarList3, 0xea1afb91, 0x9e28, 0x4b86, 0x90,0xe9, 0x9e,0x9f,0x8a,0x5e,0xef,0xaf);
+#endif
+
+DEFUN ("w32-badge",
+       Fw32_badge,
+       Sw32_badge,
+       3, 3, 0,
+       doc: /* Display a taskbar icon overlay image on the selected frame.
+BADGE is a string.  If BADGE is nil, remove the overlay.  Do nothing if
+Windows does not support the ITaskbarList3 interface and return nil,
+otherwise return t.  Do nothing if the selected frame is not (yet)
+associated with a window handle.  BACKGROUND and FOREGROUND are RGB
+triplet strings of the form \"#RRGGBB\".  */)
+  (Lisp_Object badge, Lisp_Object background, Lisp_Object foreground)
+{
+  struct frame *sf = SELECTED_FRAME ();
+  HWND hwnd = NULL;
+
+  if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
+    hwnd = FRAME_W32_WINDOW (sf);
+
+  if (hwnd == NULL)
+    return Qnil;
+
+  CoInitialize (NULL);
+  ITaskbarList3 *task_bar_list = NULL;
+  HRESULT r = CoCreateInstance(&CLSID_TaskbarList,
+                               NULL,
+                               CLSCTX_INPROC_SERVER,
+                               &IID_ITaskbarList3,
+                               (void **)&task_bar_list);
+  if (r != S_OK)
+    return Qnil;
+
+  if (!NILP (badge) && STRINGP (badge)
+      && STRINGP (background) && STRINGP (foreground))
+    {
+      COLORREF bg_rgb;
+      COLORREF fg_rgb;
+      unsigned short r, g, b;
+      if (parse_color_spec (SSDATA (background), &r, &g, &b))
+        bg_rgb = RGB (r, b, b);
+      else
+        return Qnil;
+      if (parse_color_spec (SSDATA (foreground), &r, &g, &b))
+        fg_rgb = RGB (r, b, b);
+      else
+        return Qnil;
+
+      /* Prepare a string for drawing and as alt-text.  */
+      Lisp_Object badge_utf8 = ENCODE_UTF_8 (badge);
+      int wide_len = pMultiByteToWideChar (CP_UTF8, 0,
+                                           SSDATA (badge_utf8),
+                                           -1, NULL, 0);
+      wchar_t *badge_w = alloca ((wide_len + 1) * sizeof (wchar_t));
+      pMultiByteToWideChar (CP_UTF8, 0, SSDATA (badge_utf8), -1,
+                            (LPWSTR) badge_w,
+                            wide_len);
+
+      /* Use the small icon size Windows suggests to not hard code 16x16.  */
+      int icon_width = GetSystemMetrics (SM_CXSMICON);
+      int icon_height = GetSystemMetrics (SM_CXSMICON);
+
+      HDC hwnd_dc = GetDC (hwnd);
+      HDC dc = CreateCompatibleDC (hwnd_dc);
+
+      BITMAPV5HEADER bi;
+      memset (&bi, 0, sizeof (bi));
+      bi.bV5Size = sizeof (bi);
+      bi.bV5Width = icon_width;
+      bi.bV5Height = -icon_height; /* Negative for a top-down DIB.  */
+      bi.bV5Planes = 1;
+      bi.bV5BitCount = 32;
+      bi.bV5Compression = BI_BITFIELDS;  /* Enable the masks below.  */
+      bi.bV5RedMask   =  0x00FF0000;
+      bi.bV5GreenMask =  0x0000FF00;
+      bi.bV5BlueMask  =  0x000000FF;
+      bi.bV5AlphaMask =  0xFF000000;
+
+      DWORD *bitmap_pixels;
+      HBITMAP bitmap = CreateDIBSection (dc, (BITMAPINFO *) &bi,
+                                         DIB_RGB_COLORS,
+                                         (void **) &bitmap_pixels,
+                                         NULL, 0);
+      HGDIOBJ old_bitmap = SelectObject(dc, bitmap);
+
+      /* Draw a circle filled with bg.  */
+      HBRUSH bg_brush = CreateSolidBrush (bg_rgb);
+      HGDIOBJ old_brush = SelectObject (dc, bg_brush);
+      Ellipse (dc, 0, 0, icon_width, icon_height);
+      SelectObject (dc, old_brush);
+      DeleteObject (bg_brush);
+
+      /* Derive a font scaled to fit the icon.  First find the system's
+         base font.  Then scale it to fit icon_height.  */
+      HFONT base_font;
+      BOOL clean_up_base_font = FALSE;
+      if (system_parameters_info_w_fn)
+        {
+          NONCLIENTMETRICS ncm;
+          memset (&ncm, 0, sizeof (ncm));
+          ncm.cbSize = sizeof (ncm);
+          SystemParametersInfo (SPI_GETNONCLIENTMETRICS, sizeof (ncm), &ncm, 0);
+          base_font = CreateFontIndirect (&ncm.lfSmCaptionFont);
+          clean_up_base_font = TRUE;
+        }
+      else
+        base_font = (HFONT) GetStockObject (DEFAULT_GUI_FONT);
+      if (clean_up_base_font)
+        DeleteObject (base_font);
+
+      LOGFONT lf;
+      GetObject (base_font, sizeof (lf), &lf);
+      lf.lfWeight = FW_BOLD;
+      lf.lfOutPrecision = OUT_OUTLINE_PRECIS;
+      /* ClearType quality needs opqaue, but we draw transparent.  */
+      lf.lfQuality = ANTIALIASED_QUALITY;
+      /* Negative lfHeight indicates pixel units vs. positive in points.
+         Use the LOGPIXELSY px/in of the primary monitor.  */
+      lf.lfHeight = -MulDiv(icon_height / 2, /* Fit ~3 chars.  */
+                            72,
+                            GetDeviceCaps (GetDC (NULL), LOGPIXELSY));
+      /* Ensure lfHeight pixel interpretation.  */
+      int old_map_mode = SetMapMode (dc, MM_TEXT);
+      HFONT scaled_font = CreateFontIndirect (&lf);
+      HGDIOBJ old_font = SelectObject (dc, scaled_font);
+      SetMapMode (dc, old_map_mode);
+
+      /* Draw badge text.  */
+      SetBkMode (dc, TRANSPARENT);
+      SetTextColor (dc, fg_rgb);
+      RECT rect;
+      rect.left = rect.top = 0;
+      rect.right = icon_width;
+      rect.bottom = icon_height;
+      DrawText (dc, SSDATA (badge_utf8),
+                -1, /* Indicate null-terminated string.  */
+                &rect,
+                DT_CENTER | DT_VCENTER | DT_SINGLELINE | DT_NOCLIP);
+      SelectObject (dc, old_font);
+      DeleteObject (scaled_font);
+
+      /* Make the circle and its text opaque by setting the alpha
+         channel on each pixel falling within the circle.  */
+      int circle_center_x = icon_width / 2;
+      int circle_center_y = icon_height / 2;
+      int circle_radius = (icon_width < icon_height
+                           ? icon_width
+                           : icon_height) / 2 - 2;
+      int circle_radius_sq = circle_radius * circle_radius;
+      DWORD *pixel;
+      for (int y = 0; y < icon_height; ++y)
+        for (int x = 0; x < icon_width; ++x)
+          {
+            int dx = x - circle_center_x;
+            int dy = y - circle_center_y;
+            if (dx * dx + dy * dy <= circle_radius_sq)
+              {
+                  pixel = bitmap_pixels + (y * icon_width + x);
+                  *pixel |= 0xff000000; /* Flip the 0xAARRGGBB alpha channel.  */
+              }
+          }
+
+      /* Dummy monochrome bitmap mask, ignored when the color bitmap has
+         an alpha channel, but needed to satisfy CreateIconIndirect.  */
+      HBITMAP mask_bitmap = CreateBitmap (icon_width, icon_height, 1, 1, NULL);
+
+      /* https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-createiconindirect
+         hbmMask and hbmColor members of the ICONINFO structure should
+         not already be selected into a device context.  */
+      SelectObject (dc, old_bitmap);
+
+      ICONINFO icon_info;
+      memset (&icon_info, 0, sizeof (icon_info));
+      icon_info.fIcon = TRUE;
+      icon_info.hbmMask = mask_bitmap;
+      icon_info.hbmColor = bitmap;
+
+      HICON icon = CreateIconIndirect (&icon_info);
+      task_bar_list->lpVtbl->SetOverlayIcon (task_bar_list, hwnd, icon, badge_w);
+
+      DestroyIcon (icon);
+      DeleteObject (mask_bitmap);
+      DeleteObject (bitmap);
+      DeleteDC (dc);
+      ReleaseDC (hwnd, hwnd_dc);
+    }
+  else
+    task_bar_list->lpVtbl->SetOverlayIcon (task_bar_list, hwnd, NULL, NULL);
+
+  task_bar_list->lpVtbl->Release(task_bar_list);
+  return Qt;
+}
+
+DEFUN ("w32-request-user-attention",
+       Fw32_request_user_attention,
+       Sw32_request_user_attention,
+       1, 1, 0,
+       doc: /* Flash the selected frame's taskbar icon and/or its window.
+If URGENCY is nil, cancel the request, if any.  If URGENCY is the symbol
+`informational', flash the taskbar icon.  If URGENCY is the symbol
+`critical', flash the taskbar icon and the frame.  Windows stops
+flashing if the user focuses the frame.  Do nothing if Windows does not
+support FlashWindowEx and return nil, otherwise return t.  Do nothing if
+the frame is not (yet) associated with a window handle.  */)
+  (Lisp_Object urgency)
+{
+  if (flash_window_ex_fn == NULL)
+    return Qnil;
+
+  struct frame *sf = SELECTED_FRAME ();
+  HWND hwnd = NULL;
+
+  if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
+    hwnd = FRAME_W32_WINDOW (sf);
+
+  if (hwnd == NULL)
+    return Qnil;
+
+  FLASHWINFO flash_info;
+  flash_info.cbSize = sizeof(flash_info);
+  flash_info.uCount = 0;
+  flash_info.dwTimeout = 0;
+  flash_info.hwnd = hwnd;
+  if (!NILP (urgency) && SYMBOLP (urgency))
+    {
+      /* The intended caller, 'system-taskbar-attention', has an
+         optional timer to clear the attention indicator so this will
+         flash until cleared via the timer, or the window comes to the
+         foreground.  For informational attention, flash the tray icon.
+         For critical attention, flash the tray icon and the window.  */
+      if (EQ (urgency, Qinformational))
+        flash_info.dwFlags = FLASHW_TRAY | FLASHW_TIMERNOFG;
+      else if (EQ (urgency, Qcritical))
+        flash_info.dwFlags = FLASHW_ALL | FLASHW_TIMERNOFG;
+    }
+  else
+    flash_info.dwFlags = FLASHW_STOP;
+
+  flash_window_ex_fn (&flash_info);
+  return Qt;
+}
+
+DEFUN ("w32-progress-indicator",
+       Fw32_progress_indicator,
+       Sw32_progress_indicator,
+       1, 1, 0,
+       doc: /* Show a progress bar on the selected frame's taskbar icon.
+PROGRESS is a float in the range 0.0 to 1.0.  If PROGRESS is nil, remove
+the progress indicator.  Do nothing if Windows does not support the
+ITaskbarList3 interface and return nil, otherwise return t.  Do nothing
+if the selected frame is not (yet) associated with a window handle  */)
+  (Lisp_Object progress)
+{
+  struct frame *sf = SELECTED_FRAME ();
+  HWND hwnd = NULL;
+
+  if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
+    hwnd = FRAME_W32_WINDOW (sf);
+
+  if (hwnd == NULL)
+    return Qnil;
+
+  CoInitialize (NULL);
+  ITaskbarList3 *task_bar_list = NULL;
+  HRESULT r = CoCreateInstance(&CLSID_TaskbarList,
+                               NULL,
+                               CLSCTX_INPROC_SERVER,
+                               &IID_ITaskbarList3,
+                               (void **)&task_bar_list);
+  if (r != S_OK)
+    return Qnil;
+
+  /* Scale task bar progress from 0.0-1.0 to 0-100.  */
+  ULONGLONG adj_progress = 0;
+  if (!NILP (progress) && FLOATP (progress))
+      adj_progress = (ULONGLONG) (100.0 *
+                                  XFLOAT_DATA (progress));
+  if (adj_progress > 0)
+    {
+      task_bar_list->lpVtbl->SetProgressState (task_bar_list,
+                                               hwnd, TBPF_NORMAL);
+      task_bar_list->lpVtbl->SetProgressValue (task_bar_list,
+                                               hwnd, adj_progress, 100);
+    }
+  else
+    {
+      task_bar_list->lpVtbl->SetProgressState (task_bar_list,
+                                               hwnd, TBPF_NOPROGRESS);
+    }
+
+  task_bar_list->lpVtbl->Release(task_bar_list);
+  return Qt;
+}
+
+#endif /* WINDOWSNT */
+
 /***********************************************************************
                             Initialization
  ***********************************************************************/
@@ -11509,6 +11824,15 @@ keys when IME input is received.  */);
   DEFSYM (Qcapslock, "capslock");
   DEFSYM (Qkp_numlock, "kp-numlock");
   DEFSYM (Qscroll, "scroll");
+
+  #ifdef WINDOWSNT
+  /* Taskbar indicators support.  */
+  defsubr (&Sw32_badge);
+  defsubr (&Sw32_progress_indicator);
+  defsubr (&Sw32_request_user_attention);
+  DEFSYM (Qinformational, "informational");
+  DEFSYM (Qcritical, "critical");
+  #endif
 }
 
 
@@ -11797,6 +12121,9 @@ globals_of_w32fns (void)
   SetGestureConfig_fn
     = (SetGestureConfig_proc) get_proc_addr (user32_lib,
                                              "SetGestureConfig");
+  flash_window_ex_fn
+    = (FlashWindowEx_Proc) get_proc_addr (user32_lib,
+                                          "FlashWindowEx");
 
   {
     HMODULE imm32_lib = GetModuleHandle ("imm32.dll");