aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStéphane Marks2025-11-20 12:54:40 -0500
committerMichael Albinus2025-12-21 12:55:10 +0100
commitf5f2306fc1d4370730fdcdd91c8acdf0d7930487 (patch)
tree01f1ed23cf987c424dc3eb54948a19deef7ee81b
parent28a2a7d811a9d99de7103a3be4e1dd3e3a59c813 (diff)
downloademacs-f5f2306fc1d4370730fdcdd91c8acdf0d7930487.tar.gz
emacs-f5f2306fc1d4370730fdcdd91c8acdf0d7930487.zip
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.
-rw-r--r--doc/emacs/frames.texi70
-rw-r--r--doc/lispref/os.texi122
-rw-r--r--etc/NEWS22
-rw-r--r--lisp/subr.el83
-rw-r--r--lisp/system-taskbar.el534
-rw-r--r--src/nsfns.m128
-rw-r--r--src/w32fns.c327
7 files changed, 1263 insertions, 23 deletions
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 5b11af2b17f..1b1f0ca8db2 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -58,6 +58,7 @@ for doing so on MS-DOS). Menus are supported on all text terminals.
58* Menu Bars:: Enabling and disabling the menu bar. 58* Menu Bars:: Enabling and disabling the menu bar.
59* Tool Bars:: Enabling and disabling the tool bar. 59* Tool Bars:: Enabling and disabling the tool bar.
60* Tab Bars:: Enabling and disabling the tab bar. 60* Tab Bars:: Enabling and disabling the tab bar.
61* System Taskbar:: Using system GUI taskbar features.
61* Dialog Boxes:: Controlling use of dialog boxes. 62* Dialog Boxes:: Controlling use of dialog boxes.
62* Tooltips:: Displaying information at the current mouse position. 63* Tooltips:: Displaying information at the current mouse position.
63* Mouse Avoidance:: Preventing the mouse pointer from obscuring text. 64* Mouse Avoidance:: Preventing the mouse pointer from obscuring text.
@@ -1631,6 +1632,75 @@ This moves forward in the history of window configurations.
1631 It's possible to customize the items displayed on the tab bar 1632 It's possible to customize the items displayed on the tab bar
1632by the user option @code{tab-bar-format}. 1633by the user option @code{tab-bar-format}.
1633 1634
1635@node System Taskbar
1636@section Using System GUI Taskbar Features
1637@cindex system taskbar
1638@cindex mode, system taskbar
1639
1640 Emacs can use your GUI system taskbar to display a badge overlay on
1641the Emacs taskbar icon, a progress bar report, and alert the user that
1642an Emacs session needs attention. Note: The system taskbar might be
1643called the dock, the launcher, or something similar.
1644
1645@cindex system taskbar, GNU/Linux
1646On GNU/Linux eligible GUI desktops, system taskbar effects will appear
1647on the desktop destinations determined by your shell extension, most
1648often the application launcher or dock panel, or the top panel. Effects
1649are global for an Emacs instance.
1650
1651Note: The GNU/Linux implementation sends system taskbar messages to the
1652GUI using D-Bus. You may need to install or configure shell extensions
1653such as @url{https://extensions.gnome.org/extension/307/dash-to-dock/}
1654that implement Ubuntu's Unity D-Bus launcher spec which you can read
1655more about here @url{https://wiki.ubuntu.com/Unity/LauncherAPI}.
1656@xref{Top,,, dbus, The D-Bus Manual}.
1657
1658@cindex system taskbar, macOS/GNUstep
1659@cindex system taskbar, NS
1660On macOS/GNUstep 10.5+, system taskbar effects appear on the Dock and in
1661the App Switcher. Effects are global for an Emacs instance.
1662macOS/GNUstep need no special configuration.
1663
1664@cindex system taskbar, MS-Windows
1665On MS-Windows 7+, taskbar effects appear on the Windows system taskbar.
1666Effects are associated with the frame from which they are initiated.
1667MS-Windows needs no special configuration.
1668
1669@findex system-taskbar-mode
1670 You must initialize system-taskbar before using it. To do that, type
1671@kbd{M-x system-taskbar-mode}.
1672
1673@vindex system-taskbar-use-progress-reporter
1674 The user option @code{system-taskbar-use-progress-reporter} integrates
1675@code{system-taskbar-mode} with Emacs progress report functions, which
1676many longer-running functions use to indicate the progress of their
1677work. Progress reports will appear in the echo area and on the system
1678taskbar Emacs icon. This variable defaults to @code{t}. Customize this
1679variable before enabling @code{system-taskbar-mode}. @xref{Progress,,,
1680elisp}
1681
1682@vindex system-taskbar-clear-attention-on-frame-focus
1683 The user option @code{system-taskbar-clear-attention-on-frame-focus}
1684turns on a helper useful on GNU/Linux D-Bus platforms which
1685automatically clears the system taskbar attention indicator when any
1686Emacs frame is focused. This has no effect on macOS/GNUstep or
1687MS-Windows. It defaults to @code{t}. Customize this variable before
1688enabling @code{system-taskbar-mode}.
1689
1690@vindex system-taskbar-dbus-desktop-file-name
1691 The user option @code{system-taskbar-dbus-desktop-file-name} helps
1692D-Bus on GNU/Linux identify launched instance of Emacs. It defaults to
1693@samp{emacsclient} and may need to be changed to @samp{emacs} depending
1694on your GNU/Linux configuration.
1695
1696@vindex system-taskbar-dbus-timeout
1697 The user option @code{system-taskbar-dbus-timeout} is a
1698troubleshooting tool and it likely does not need to be customized. It
1699defaults to @code{nil} which uses the D-Bus default timeout which is
170025,000ms or 25s.
1701
1702@xref{System Taskbar,,, elisp, The Emacs Lisp Reference Manual}
1703
1634@node Dialog Boxes 1704@node Dialog Boxes
1635@section Using Dialog Boxes 1705@section Using Dialog Boxes
1636@cindex dialog boxes 1706@cindex dialog boxes
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 44dd3bbb63c..02fefea35ab 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -34,6 +34,7 @@ terminal and the screen.
34* Batch Mode:: Running Emacs without terminal interaction. 34* Batch Mode:: Running Emacs without terminal interaction.
35* Session Management:: Saving and restoring state with X Session Management. 35* Session Management:: Saving and restoring state with X Session Management.
36* Desktop Notifications:: Desktop notifications. 36* Desktop Notifications:: Desktop notifications.
37* System Taskbar:: Controlling system GUI taskbar features.
37* File Notifications:: File notifications. 38* File Notifications:: File notifications.
38* Dynamic Libraries:: On-demand loading of support libraries. 39* Dynamic Libraries:: On-demand loading of support libraries.
39* Security Considerations:: Running Emacs in an unfriendly environment. 40* Security Considerations:: Running Emacs in an unfriendly environment.
@@ -3371,6 +3372,127 @@ Android 13 and later, any notifications sent will be silently
3371disregarded. 3372disregarded.
3372@end defun 3373@end defun
3373 3374
3375@node System Taskbar
3376@section Controlling System GUI Taskbar Features
3377@cindex system taskbar
3378@cindex mode, system taskbar
3379
3380 @xref{System Taskbar,,, emacs, The GNU Emacs Manual}, for an overview
3381and configuration.
3382
3383@defun system-taskbar-badge &optional count
3384This function displays @var{count} as an overlay on the system taskbar
3385Emacs icon.
3386
3387If @var{count} is an integer, display that.
3388
3389If @var{count} is a string on back ends that support strings, display
3390that. The string should be short.
3391
3392On back ends which do not support strings, convert @var{count} to an
3393integer, or @code{nil} if that fails.
3394
3395If @var{count} is @code{nil} or an empty string, remove the counter or
3396short string.
3397
3398Display the system taskbar icon badge set to @var{count}. If
3399@var{count} is @code{nil}, clear the badge. @var{count} is typically an
3400integer.
3401
3402If @var{count} is a string, it is converted to an integer on systems
3403that do not support string badges, such as GNU/Linux D-Bus, and the
3404badge will be cleared if the string is an invalid integer
3405representation. On systems that support strings, such as macOS/GNUstep
3406and MS-Windows, the badge is set to the string and displayed, and may be
3407truncated to fit the visual space allocated by the system. In any case,
3408if the string is empty, clear the badge.
3409@end defun
3410
3411@defun system-taskbar-attention &optional urgency timeout
3412This function flashes or bounces system taskbar Emacs icon and/or its
3413frame to alert the user.
3414
3415@var{urgency} can be one of the symbols @code{informational}, or
3416@code{critical}.
3417
3418If @var{urgency} is @code{nil}, clear the attention indicator.
3419
3420The attention indicator is cleared by the earliest of bringing the Emacs
3421GUI into focus, or after @var{timeout} seconds. If @var{timeout} is
3422@code{nil}, the system GUI behavior has priority.
3423
3424On some back ends, @code{critical} has the same effect as
3425@code{informational}.
3426
3427On some back ends, attention will be displayed
3428only if Emacs is not the currently focused application.
3429@end defun
3430
3431@defun system-taskbar-progress &optional progress
3432 This function displays a progress indicator overlay on the system
3433taskbar Emacs icon.
3434
3435@var{progress} is a float in the range 0.0 to 1.0. If @var{progress} is
3436@code{nil}, remove the progress indicator.
3437
3438It is convenient to use the built-in progress reporter functions which,
3439when @code{system-taskbar-mode} is enabled, integrate with
3440@code{system-taskbar-progress} by default. @xref{Progress}
3441@end defun
3442
3443@noindent
3444Examples of system-taskbar functions:
3445
3446@lisp
3447@group
3448;; Enable and initialize system-taskbar-mode before calling its
3449;; package functions.
3450(system-taskbar-mode)
3451
3452;; Display a badge integer on the taskbar icon.
3453(system-taskbar-badge emacs-major-version)
3454
3455;; A string representation of an integer is converted to an
3456;; integer on GNU/Linux.
3457(system-taskbar-badge "31")
3458
3459;; Short strings are displayed on macOS/GNUstep and MS-Windows.
3460(system-taskbar-badge "Test")
3461
3462;; Clear the badge.
3463(system-taskbar-badge)
3464@end group
3465
3466@group
3467;; Get the user's attention and clear the request after 3 seconds.
3468(system-taskbar-attention 'informational 3)
3469
3470;; Get the user's attention and clear when Emacs is focused.
3471(system-taskbar-attention 'critical)
3472
3473;; Clear the attention request.
3474(system-taskbar-attention)
3475@end group
3476
3477@group
3478;; Make sure system-taskbar is integrated with progress-reporter.
3479(setopt system-taskbar-use-progress-reporter t) ; t is the default
3480(system-taskbar-mode)
3481
3482;; Report `dotimes` progress on the taskbar icon.
3483(dotimes-with-progress-reporter
3484 (i 10)
3485 "Counting from 1 to 10..."
3486 (sleep-for 1))
3487
3488;; Report `dolist` progress on the taskbar icon.
3489(dolist-with-progress-reporter
3490 (i (make-list 10 t))
3491 "Progress from 1 to 10 elements..."
3492 (sleep-for 1))
3493@end group
3494@end lisp
3495
3374@node File Notifications 3496@node File Notifications
3375@section Notifications on File Changes 3497@section Notifications on File Changes
3376@cindex file notifications 3498@cindex file notifications
diff --git a/etc/NEWS b/etc/NEWS
index 122760b7a85..a60cb383dbd 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3284,6 +3284,21 @@ This library provides functions to throttle or debounce Emacs Lisp
3284functions. This is useful for corralling overeager code that is slow 3284functions. This is useful for corralling overeager code that is slow
3285and blocks Emacs, or does not provide ways to limit how often it runs. 3285and blocks Emacs, or does not provide ways to limit how often it runs.
3286 3286
3287+++
3288** New mode 'system-taskbar-mode'.
3289This is a global minor mode and companion functions that integrate Emacs
3290with system GUI taskbars (also called docks or launchers or something
3291similar) to display a taskbar icon "badge" overlay, a progress bar
3292report overlay, alert the user that an Emacs session needs attention,
3293often by flashing or bouncing the Emacs application icon. Supported
3294capable systems are GNU/Linux via D-Bus, macOS/GNUstep 10.5+, MS-Windows
32957+.
3296
3297On GNU/Linux systems, shell extensions or similar helpers such as
3298"dash-to-dock" may be required. See
3299<https://extensions.gnome.org/extension/307/dash-to-dock/> and
3300<https://wiki.ubuntu.com/Unity/LauncherAPI>.
3301
3287 3302
3288* Incompatible Lisp Changes in Emacs 31.1 3303* Incompatible Lisp Changes in Emacs 31.1
3289 3304
@@ -3748,6 +3763,13 @@ When the theme is set on PGTK, Android, or MS-Windows systems,
3748variable 'toolkit-theme' as either symbol 'dark' or 'light', but may be 3763variable 'toolkit-theme' as either symbol 'dark' or 'light', but may be
3749extended to encompass other toolkit-specific symbols in the future. 3764extended to encompass other toolkit-specific symbols in the future.
3750 3765
3766+++
3767** Progress reporter callbacks.
3768'make-progress-reporter' now accepts optional arguments UPDATE-CALLBACK,
3769called on progress steps, and DONE-CALLBACK, called when the progress
3770reporter is done. See the 'make-progress-reporter' docstring for a full
3771specification of these new optional arguments.
3772
3751 3773
3752* Changes in Emacs 31.1 on Non-Free Operating Systems 3774* Changes in Emacs 31.1 on Non-Free Operating Systems
3753 3775
diff --git a/lisp/subr.el b/lisp/subr.el
index fcf931b64e9..37200f0c961 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6974,19 +6974,33 @@ to deactivate this transient map, regardless of KEEP-PRED."
6974;; digits of precision, it doesn't really matter here. On the other 6974;; digits of precision, it doesn't really matter here. On the other
6975;; hand, it greatly simplifies the code. 6975;; hand, it greatly simplifies the code.
6976 6976
6977(defvar progress-reporter-update-functions (list #'progress-reporter-echo-area)
6978 "Special hook run on progress-reporter updates.
6979Each function is called with two arguments:
6980REPORTER is the result of a call to `make-progress-reporter'.
6981STATE can be one of:
6982- A float representing the percentage complete in the range 0.0-1.0
6983for a numeric reporter.
6984- An integer representing the index which cycles through the range 0-3
6985for a pulsing reporter.
6986- The symbol `done' to indicate that the progress reporter is complete.")
6987
6977(defsubst progress-reporter-update (reporter &optional value suffix) 6988(defsubst progress-reporter-update (reporter &optional value suffix)
6978 "Report progress of an operation in the echo area. 6989 "Report progress of an operation, by default, in the echo area.
6979REPORTER should be the result of a call to `make-progress-reporter'. 6990REPORTER should be the result of a call to `make-progress-reporter'.
6980 6991
6981If REPORTER is a numerical progress reporter---i.e. if it was 6992If REPORTER is a numerical progress reporter---i.e. if it was
6982 made using non-nil MIN-VALUE and MAX-VALUE arguments to 6993made using non-nil MIN-VALUE and MAX-VALUE arguments to
6983 `make-progress-reporter'---then VALUE should be a number between 6994`make-progress-reporter'---then VALUE should be a number between
6984 MIN-VALUE and MAX-VALUE. 6995MIN-VALUE and MAX-VALUE.
6996
6997Optional argument SUFFIX is a string to be displayed after REPORTER's
6998main message and progress text. If REPORTER is a non-numerical
6999reporter, then VALUE should be nil, or a string to use instead of
7000SUFFIX. SUFFIX is considered obsolete and may be removed in the future.
6985 7001
6986Optional argument SUFFIX is a string to be displayed after 7002See `progress-reporter-update-functions' for the list of functions
6987REPORTER's main message and progress text. If REPORTER is a 7003called on each update.
6988non-numerical reporter, then VALUE should be nil, or a string to
6989use instead of SUFFIX.
6990 7004
6991This function is relatively inexpensive. If the change since 7005This function is relatively inexpensive. If the change since
6992last update is too small or insufficient time has passed, it does 7006last update is too small or insufficient time has passed, it does
@@ -7045,6 +7059,10 @@ effectively rounded up."
7045 7059
7046(defalias 'progress-reporter-make #'make-progress-reporter) 7060(defalias 'progress-reporter-make #'make-progress-reporter)
7047 7061
7062(defun progress-reporter-text (reporter)
7063 "Return REPORTER's text."
7064 (aref (cdr reporter) 3))
7065
7048(defun progress-reporter-force-update (reporter &optional value new-message suffix) 7066(defun progress-reporter-force-update (reporter &optional value new-message suffix)
7049 "Report progress of an operation in the echo area unconditionally. 7067 "Report progress of an operation in the echo area unconditionally.
7050 7068
@@ -7060,12 +7078,29 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
7060(defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"] 7078(defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
7061 "Characters to use for pulsing progress reporters.") 7079 "Characters to use for pulsing progress reporters.")
7062 7080
7081(defun progress-reporter-echo-area (reporter state)
7082 "Progress reporter echo area update function.
7083REPORTER and STATE are the same as in
7084`progress-reporter-update-functions'."
7085 (let ((text (progress-reporter-text reporter)))
7086 (pcase state
7087 ((pred floatp)
7088 (if (plusp state)
7089 (message "%s%d%%" text (* state 100.0))
7090 (message "%s" text)))
7091 ((pred integerp)
7092 (let ((message-log-max nil)
7093 (pulse-char (aref progress-reporter--pulse-characters
7094 state)))
7095 (message "%s %s" text pulse-char)))
7096 ('done
7097 (message "%sdone" text)))))
7098
7063(defun progress-reporter-do-update (reporter value &optional suffix) 7099(defun progress-reporter-do-update (reporter value &optional suffix)
7064 (let* ((parameters (cdr reporter)) 7100 (let* ((parameters (cdr reporter))
7065 (update-time (aref parameters 0)) 7101 (update-time (aref parameters 0))
7066 (min-value (aref parameters 1)) 7102 (min-value (aref parameters 1))
7067 (max-value (aref parameters 2)) 7103 (max-value (aref parameters 2))
7068 (text (aref parameters 3))
7069 (enough-time-passed 7104 (enough-time-passed
7070 ;; See if enough time has passed since the last update. 7105 ;; See if enough time has passed since the last update.
7071 (or (not update-time) 7106 (or (not update-time)
@@ -7098,9 +7133,9 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
7098 (if suffix 7133 (if suffix
7099 (aset parameters 6 suffix) 7134 (aset parameters 6 suffix)
7100 (setq suffix (or (aref parameters 6) ""))) 7135 (setq suffix (or (aref parameters 6) "")))
7101 (if (plusp percentage) 7136 (run-hook-with-args 'progress-reporter-update-functions
7102 (message "%s%d%% %s" text percentage suffix) 7137 reporter
7103 (message "%s %s" text suffix))))) 7138 (/ percentage 100.0)))))
7104 ;; Pulsing indicator 7139 ;; Pulsing indicator
7105 (enough-time-passed 7140 (enough-time-passed
7106 (when (and value (not suffix)) 7141 (when (and value (not suffix))
@@ -7108,16 +7143,18 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
7108 (if suffix 7143 (if suffix
7109 (aset parameters 6 suffix) 7144 (aset parameters 6 suffix)
7110 (setq suffix (or (aref parameters 6) ""))) 7145 (setq suffix (or (aref parameters 6) "")))
7111 (let* ((index (mod (1+ (car reporter)) 4)) 7146 (let ((index (mod (1+ (car reporter)) 4)))
7112 (message-log-max nil)
7113 (pulse-char (aref progress-reporter--pulse-characters
7114 index)))
7115 (setcar reporter index) 7147 (setcar reporter index)
7116 (message "%s %s %s" text pulse-char suffix)))))) 7148 (run-hook-with-args 'progress-reporter-update-functions
7149 reporter
7150 index))))))
7117 7151
7118(defun progress-reporter-done (reporter) 7152(defun progress-reporter-done (reporter)
7119 "Print reporter's message followed by word \"done\" in echo area." 7153 "Print reporter's message followed by word \"done\" in echo area.
7120 (message "%sdone" (aref (cdr reporter) 3))) 7154Call the functions on `progress-reporter-update-functions`."
7155 (run-hook-with-args 'progress-reporter-update-functions
7156 reporter
7157 'done))
7121 7158
7122(defmacro dotimes-with-progress-reporter (spec reporter-or-message &rest body) 7159(defmacro dotimes-with-progress-reporter (spec reporter-or-message &rest body)
7123 "Loop a certain number of times and report progress in the echo area. 7160 "Loop a certain number of times and report progress in the echo area.
diff --git a/lisp/system-taskbar.el b/lisp/system-taskbar.el
new file mode 100644
index 00000000000..7872d527549
--- /dev/null
+++ b/lisp/system-taskbar.el
@@ -0,0 +1,534 @@
1;;; system-taskbar.el --- System GUI taskbar/dock/launcher status display -*- lexical-binding: t -*-
2
3;; Copyright (C) 2025 Free Software Foundation, Inc.
4
5;; Author: Stephane Marks
6;; Maintainer: emacs-devel@gnu.org
7;; Keywords: convenience
8;; Package-Requires: ((emacs "31.1"))
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Use this package to display a taskbar icon "badge" overlay, a
28;; progress bar report overlay, or alert the user that an Emacs session
29;; needs attention, often by flashing or bouncing the Emacs application
30;; icon.
31;;
32;; Note: The term taskbar is inclusive of dock or launcher or some other
33;; terminology as may be used for your system.
34;;
35;; On GNU/Linux, the visible effects will appear on the destinations
36;; determined by your shell extension, most often the application
37;; launcher or dock panel, or the top panel. Effects are global for an
38;; Emacs instance.
39;;
40;; On macOS/GNUstep, the effects will appear on the Dock and in the App
41;; Switcher. Effects are global for an Emacs instance.
42;;
43;; On MS-Windows, the effects appear on the taskbar. Effects are
44;; associated with the frame from which they are initiated.
45
46;;; Usage:
47
48;; The global minor mode `system-taskbar-mode' initializes the GUI
49;; platform back-end and must be enabled before using the functions
50;; below.
51;;
52;; `system-taskbar-badge' overlays a count, which is an integer, on the
53;; Emacs taskbar icon. You can use this, for example, to indicate the
54;; number of unread email messages. On GNU/Linux, the count must be an
55;; integer or nil. On macOS/GNUstep, the count may be an integer or a
56;; string, which the operating system will abbreviate if too long. On
57;; MS-Windows, the taskbar badge will be abbreviated to three
58;; characters; if the count is an integer outside the range -99 to 99,
59;; it is shown as "-99" or "99+", if count is a string longer than 3
60;; characters it is truncated.
61;;
62;; `system-taskbar-attention' flashes or bounces the Emacs taskbar icon
63;; to indicate that your Emacs session wants attention. Its behaviors
64;; are back-end specific.
65;;
66;; `system-taskbar-progress' overlays a graphical progress bar on the
67;; Emacs taskbar icon to illustrate progress of a potentially
68;; long-running operation.
69;;
70;; When `system-taskbar-mode' is enabled, Emacs progress reporters will
71;; be enhanced to display taskbar GUI progress bars. Customize
72;; `system-taskbar-use-progress-reporter' if you want to disable this
73;; before enabling system-taskbar-mode.
74;;
75;; On GNU/Linux systems, taskbar effects will appear on the GUI
76;; window-system destinations determined by your shell extension, most
77;; often the application launcher or dock panel, or the top panel.
78;; Taskbar effects are global for an Emacs instance. The GNU/Linux
79;; implementation sends taskbar messages to the system GUI using D-Bus.
80;; You may need to install or configure shell extensions such as
81;; https://extensions.gnome.org/extension/307/dash-to-dock/ that
82;; implement Ubuntu's Unity D-Bus launcher spec which you can read more
83;; about here https://wiki.ubuntu.com/Unity/LauncherAPI.
84;;
85;; Your Linux Emacs instance should be launched via an appropriate shell
86;; "desktop" file such as those distributed with Emacs; e.g.,
87;; "etc/emacsclient.desktop" as documented here
88;; https://specifications.freedesktop.org/desktop-entry/latest/ and
89;; which your GUI system should implement.
90;;
91;; On macOS/GNUstep 10.5+, taskbar effects appear on the Dock and in the
92;; App Switcher. Effects are global for an Emacs instance.
93;; macOS/GNUstep is implemented via its native API and needs no special
94;; configuration.
95;;
96;; On MS-Windows 7+, taskbar effects appear on the Windows taskbar.
97;; Effects are associated with the frame from which they are initiated.
98;; MS-Windows is implemented via its native API and needs no special
99;; configuration.
100;;
101;; To add support for additional systems, provide a back end that
102;; implements the cl-generic functions below.
103
104;;; Code:
105
106(require 'dbus)
107
108(defgroup system-taskbar nil
109 "System GUI taskbar icon badge, progress report, alerting."
110 :group 'convenience
111 :version "31.1")
112
113(defcustom system-taskbar-use-progress-reporter t
114 "Supplement progress-reporters with GUI taskbar icon progress bars.
115Set this before enabling `system-taskbar-mode'."
116 :type 'boolean
117 :version "31.1")
118
119(defcustom system-taskbar-clear-attention-on-frame-focus t
120 "Clear the icon attention indicator when any GUI frame is focused.
121Back ends that automatically clear the attention indicator, such as
122macOS/GNUstep and MS-Windows, ignore this option."
123 :type 'boolean
124 :version "31.1")
125
126(defcustom system-taskbar-dbus-desktop-file-name "emacsclient"
127 "D-Bus desktop file base name for the system taskbar destination.
128This should be the base name of the desktop file used to launch an Emacs
129instance. For example, if your launcher desktop file is called
130\"emacs.desktop\", this option should be \"emacs\"."
131 :type 'string
132 :version "31.1")
133
134(defcustom system-taskbar-dbus-timeout nil
135 "Number of milliseconds to wait for D-Bus responses.
136If nil, use the D-Bus default timeout which is 25,000 (i.e., 25s).
137
138If your D-Bus desktop extension needs extra time to respond, in which
139case `system-taskbar-mode' might not initialize or related functions
140might not take visible effect, bind this to a value higher than 25,000
141to find what works for your system."
142 :type '(choice (const :tag "Default" nil) natnum)
143 :version "31.1")
144
145(defun system-taskbar-progress-reporter-install ()
146 "Install system-taskbar progress reporter."
147 (add-hook 'progress-reporter-update-functions
148 #'system-taskbar--progress-reporter-update))
149
150(defun system-taskbar-progress-reporter-remove ()
151 "Remove system-taskbar progress reporter."
152 (remove-hook 'progress-reporter-update-functions
153 #'system-taskbar--progress-reporter-update))
154
155(defvar system-taskbar--back-end nil
156 "Generic taskbar method system dispatcher.")
157
158;;;###autoload
159(define-minor-mode system-taskbar-mode
160 "System GUI taskbar icon badge, progress report, alerting."
161 :global t
162 (when noninteractive
163 (warn "Batch mode does not support `system-taskbar'"))
164 (cond (system-taskbar-mode
165 (if (system-taskbar--set-back-end)
166 (system-taskbar--enable)
167 (warn "System does not support `system-taskbar'"))
168 (when system-taskbar-use-progress-reporter
169 (system-taskbar-progress-reporter-install)))
170 (t
171 (system-taskbar-progress-reporter-remove)
172 (when system-taskbar--back-end
173 (system-taskbar--badge nil)
174 (system-taskbar--attention nil)
175 (system-taskbar--progress nil)
176 (system-taskbar--disable)
177 (setq system-taskbar--back-end nil)))))
178
179(defun system-taskbar-badge (&optional count)
180 "Display COUNT as an overlay on the system taskbar Emacs icon.
181If COUNT is an integer, display that.
182If COUNT is a string on back ends that support strings, display that.
183The string should be short.
184On back ends which do not support strings, convert COUNT to an integer
185using `string-to-number' and testing `integerp', or nil if that fails.
186If COUNT is nil or an empty string, remove the counter."
187 (when system-taskbar-mode
188 (system-taskbar--badge count)))
189
190(defun system-taskbar-attention (&optional urgency timeout)
191 "Flash the system taskbar icon and/or frame to alert the user.
192URGENCY can be one of the symbols `informational', or `critical'.
193If URGENCY is nil, clear the attention indicator.
194
195The attention indicator is cleared by the earliest of bringing the Emacs
196GUI into focus, or after TIMEOUT seconds. If TIMEOUT is nil, the system
197GUI behavior has priority.
198
199On some back ends, `critical' has the same effect as `informational'."
200 (when system-taskbar-mode
201 (system-taskbar--attention urgency timeout)))
202
203(defun system-taskbar-progress (&optional progress)
204 "Display a progress indicator overlay on the system taskbar icon.
205PROGRESS is a float in the range 0.0 to 1.0.
206If PROGRESS is nil, remove the progress indicator."
207 (when system-taskbar-mode
208 (system-taskbar--progress progress)))
209
210
211;; Internal implementation.
212
213(defvar w32-initialized)
214
215(defun system-taskbar--set-back-end ()
216 "Determine taskbar host system type."
217 ;; Order matters to accommodate the cases where an NS or MS-Windows
218 ;; build have the dbus feature.
219 (setq system-taskbar--back-end
220 (cond ((boundp 'ns-version-string) 'ns)
221 (w32-initialized 'w32)
222 ((and (featurep 'dbusbind)
223 (member "org.freedesktop.login1"
224 (dbus-list-activatable-names :system)))
225 'dbus)
226 (t nil))))
227
228(cl-defgeneric system-taskbar--enable ()
229 "Enable the system-taskbar back end.")
230
231(cl-defgeneric system-taskbar--disable ()
232 "Disable the system-taskbar back end.")
233
234(cl-defgeneric system-taskbar--badge (&optional count)
235 "Display COUNT as an overlay on the system taskbar Emacs icon.
236If COUNT is an integer, display that.
237If COUNT is a string on back ends that support strings, display that.
238The string should be short.
239On back ends which do not support strings, convert COUNT to an integer
240using `string-to-number' and testing `integerp', or nil if that fails.
241If COUNT is nil or an empty string, remove the counter.")
242
243(cl-defgeneric system-taskbar--attention (&optional urgency timeout)
244 "Flash the system taskbar icon and/or frame to alert the user.
245URGENCY can be one of the symbols `informational', or `critical'.
246If URGENCY is nil, clear the attention indicator.
247
248The attention indicator is cleared by the earliest of bringing the Emacs
249GUI into focus, or after TIMEOUT seconds. If TIMEOUT is nil, the system
250GUI behavior has priority.
251
252On some back ends, `critical' has the same effect as `informational'.
253
254On some back ends, attention will be displayed only if Emacs is not the
255currently focused application.")
256
257(cl-defgeneric system-taskbar--progress (&optional progress)
258 "Display a progress indicator overlay on the system taskbar icon.
259PROGRESS is a float in the range 0.0 to 1.0.
260If PROGRESS is nil, remove the progress indicator.")
261
262(defun system-taskbar--validate-progress (progress)
263 "Return PROGRESS as a float in the range 0.0 to 1.0, or nil."
264 (when (natnump progress)
265 (setq progress (float progress)))
266 (when (and progress (>= progress 0.0) (<= progress 1.0))
267 progress))
268
269
270;; `progress-reporter' support.
271
272(defun system-taskbar--progress-reporter-update (_reporter state)
273 "Progress reporter system-taskbar update function.
274REPORTER and STATE are the same as in
275`progress-reporter-update-functions'."
276 (when system-taskbar-mode
277 (pcase state
278 ((pred floatp)
279 (system-taskbar--progress state))
280 ((pred integerp)
281 (system-taskbar--progress (/ (1+ state) 4.0)))
282 ('done
283 (system-taskbar--progress nil)))))
284
285
286;; D-Bus support.
287
288(defconst system-taskbar--dbus-service "com.canonical.Unity")
289(defconst system-taskbar--dbus-interface "com.canonical.Unity.LauncherEntry")
290
291(defvar system-taskbar--dbus-attention nil
292 "Non-nil when attention is requested.")
293
294(defun system-taskbar--dbus-send-signal (message)
295 "Send MESSAGE to the D-Bus system taskbar service."
296 (let ((app-uri
297 (format "application://%s.desktop"
298 system-taskbar-dbus-desktop-file-name)))
299 (dbus-send-signal
300 :session
301 system-taskbar--dbus-service
302 "/"
303 system-taskbar--dbus-interface
304 "Update"
305 app-uri
306 message)))
307
308(defun system-taskbar--dbus-clear-attention-on-frame-focus ()
309 "Clear an active D-Bus attention request if any frame is focused."
310 (when (and system-taskbar--dbus-attention
311 (catch :clear
312 (dolist (frame (frame-list))
313 (when (eq (frame-focus-state frame) t)
314 (throw :clear t)))))
315 (system-taskbar-attention nil)))
316
317(defun system-taskbar-dbus-ping-service ()
318 "Return non-nil if `system-taskbar--dbus-service' responds.
319Return nil if no response within `system-taskbar-dbus-timeout'."
320 (dbus-ping
321 :session
322 system-taskbar--dbus-service
323 system-taskbar-dbus-timeout))
324
325(cl-defmethod system-taskbar--enable (&context
326 (system-taskbar--back-end (eql 'dbus)))
327 (unless (system-taskbar-dbus-ping-service)
328 (error "D-Bus service `%s' unavailable" system-taskbar--dbus-service))
329 (when system-taskbar-clear-attention-on-frame-focus
330 (add-function :after after-focus-change-function
331 #'system-taskbar--dbus-clear-attention-on-frame-focus)))
332
333(cl-defmethod system-taskbar--disable (&context
334 (system-taskbar--back-end (eql 'dbus)))
335 (remove-function after-focus-change-function
336 #'system-taskbar--dbus-clear-attention-on-frame-focus))
337
338(cl-defmethod system-taskbar--badge (&context
339 (system-taskbar--back-end (eql 'dbus))
340 &optional count)
341 "Display COUNT as an overlay on the system taskbar Emacs icon.
342If COUNT is an integer, display that. If COUNT is a string, convert it
343to an integer, or nil if that fails. If COUNT is any other type, use
344nil. If COUNT is nil or an empty string, remove the badge.
345Note: The Unity D-Bus protocol supports only integer badges."
346 (cond ((stringp count)
347 (if (string-empty-p count)
348 (setq count nil)
349 (let ((count-1 (string-to-number count)))
350 (setq count (if (integerp count-1) count-1 nil)))))
351 ((not (integerp count))
352 (setq count nil)))
353 (system-taskbar--dbus-send-signal
354 `((:dict-entry "count-visible"
355 (:variant :boolean ,(not (null count))))
356 (:dict-entry "count"
357 (:variant :uint32 ,(if (null count) 0
358 count))))))
359
360(cl-defmethod system-taskbar--attention (&context
361 (system-taskbar--back-end (eql 'dbus))
362 &optional urgency timeout)
363 "Request URGENCY user attention on the system taskbar Emacs icon.
364The request will time out within the TIMEOUT seconds interval.
365The Unity D-Bus protocol does not support differentiated urgencies."
366 (setq system-taskbar--dbus-attention urgency)
367 (system-taskbar--dbus-send-signal
368 `((:dict-entry "urgent"
369 (:variant :boolean ,(not (null urgency))))))
370 (when (and urgency timeout)
371 (run-with-timer
372 timeout
373 nil
374 #'system-taskbar-attention nil)))
375
376(cl-defmethod system-taskbar--progress (&context
377 (system-taskbar--back-end (eql 'dbus))
378 &optional progress)
379 "Display a progress bar overlay on the system taskbar icon.
380PROGRESS is a float in the range 0.0 to 1.0.
381If PROGRESS is nil, remove the progress bar."
382 (setq progress (system-taskbar--validate-progress progress))
383 (system-taskbar--dbus-send-signal
384 `((:dict-entry "progress-visible"
385 (:variant :boolean ,(not (null progress))))
386 (:dict-entry "progress"
387 (:variant :double ,(if (null progress) 0 progress))))))
388
389
390;; macOS/GNUstep NS support.
391
392(declare-function ns-badge "nsfns.m")
393(declare-function ns-request-user-attention "nsfns.m")
394(declare-function ns-progress-indicator "nsfns.m")
395
396(cl-defmethod system-taskbar--enable (&context
397 (system-taskbar--back-end (eql 'ns)))
398 (ignore))
399
400(cl-defmethod system-taskbar--disable (&context
401 (system-taskbar--back-end (eql 'ns)))
402 (ignore))
403
404(cl-defmethod system-taskbar--badge (&context
405 (system-taskbar--back-end (eql 'ns))
406 &optional count)
407 "Display COUNT as an overlay on the Dock badge.
408If COUNT is an integer or a non-empty string, display that. If COUNT is
409nil or an empty string, clear the badge overlay.
410Note: NS will abbreviate long strings to fit the badge's allocated
411space."
412 (cond ((stringp count)
413 (when (string-empty-p count)
414 (setq count nil)))
415 ((integerp count)
416 (setq count (number-to-string count)))
417 (t (setq count nil)))
418 (ns-badge count))
419
420(cl-defmethod system-taskbar--attention (&context
421 (system-taskbar--back-end (eql 'ns))
422 &optional urgency timeout)
423 "Request URGENCY user attention on the Dock.
424The attention indicator will be cleared after TIMEOUT seconds."
425 (ns-request-user-attention urgency)
426 (when (and urgency timeout)
427 (run-with-timer
428 timeout
429 nil
430 #'system-taskbar-attention nil)))
431
432(cl-defmethod system-taskbar--progress (&context
433 (system-taskbar--back-end (eql 'ns))
434 &optional progress)
435 "Display a progress bar overlay on the Dock and App Switcher.
436PROGRESS is a float in the range 0.0 to 1.0.
437If PROGRESS is nil, remove the progress bar."
438 (ns-progress-indicator (system-taskbar--validate-progress progress)))
439
440
441;; MS-Windows support.
442
443(declare-function w32-badge "w32fns.c")
444(declare-function w32-request-user-attention "w32fns.c")
445(declare-function w32-progress-indicator "w32fns.c")
446
447(defvar system-taskbar-w32-badge-background "#e75857" ; redish
448 "w32 badge background RGB triple string.")
449
450(defvar system-taskbar-w32-badge-foreground "#ffffff" ; white
451 "w32 badge foreground RGB triple string.")
452
453(defun system-taskbar--w32-clear-frame-indicators (frame)
454 ;; NOTE: Update the below if adding new w32 system-taskbar functions.
455 (with-selected-frame frame
456 (system-taskbar-badge nil)
457 (system-taskbar-attention nil)
458 (system-taskbar-progress nil)))
459
460(cl-defmethod system-taskbar--enable (&context
461 (system-taskbar--back-end (eql 'w32)))
462 ;; Clear system-taskbar indicators for a frame when it is deleted.
463 (add-hook 'delete-frame-functions
464 #'system-taskbar--w32-clear-frame-indicators))
465
466(cl-defmethod system-taskbar--disable (&context
467 (system-taskbar--back-end (eql 'w32)))
468 (remove-hook 'delete-frame-functions
469 #'system-taskbar--w32-clear-frame-indicators))
470
471(cl-defmethod system-taskbar--badge (&context
472 (system-taskbar--back-end (eql 'w32))
473 &optional count)
474 "Display a COUNT overlay on the system taskbar icon.
475The taskbar icon target is associated with the selected frame.
476
477If COUNT is an integer or a non-empty string, display that. If COUNT is
478nil or an empty string, clear the badge.
479
480Due to MS-Windows icon overlay size limitations, if COUNT is an integer
481and is outside the range -99 to 99, display \"-99\" and \"99+\",
482respectively, if COUNT is a string longer than 2 characters truncate it
483using `truncate-string-to-width'.
484
485Consult `system-taskbar-w32-badge-background' and
486`system-taskbar-w32-badge-foreground' for the background and foreground
487colors for the painted overlay."
488 (cond ((stringp count)
489 (if (string-empty-p count)
490 (setq count nil)
491 (when (length> count 2)
492 (setq count (truncate-string-to-width count 3 0 nil t)))))
493 ((integerp count)
494 (if (and (> count -100)
495 (< count 100))
496 (setq count (number-to-string count))
497 (if (< count 0)
498 (setq count "-99")
499 (setq count "99+"))))
500 (t (setq count nil)))
501 (w32-badge count
502 system-taskbar-w32-badge-background
503 system-taskbar-w32-badge-foreground))
504
505(cl-defmethod system-taskbar--attention (&context
506 (system-taskbar--back-end (eql 'w32))
507 &optional urgency timeout)
508 "Request URGENCY user attention on the system taskbar icon.
509Indicate the icon associated with the selected frame.
510If URGENCY is the symbol `informational', flash the taskbar icon.
511If URGENCY is the symbol `critical', flash the taskbar icon and the
512MS-Windows window frame.
513Clear attention indicator after TIMEOUT seconds. If TIMEOUT is nil,
514default to MS-Windows default behavior."
515 (w32-request-user-attention urgency)
516 (when (and urgency timeout)
517 (run-with-timer
518 timeout
519 nil
520 #'system-taskbar-attention nil)))
521
522(cl-defmethod system-taskbar--progress (&context
523 (system-taskbar--back-end (eql 'w32))
524 &optional progress)
525 "Display a progress bar on the system taskbar icon.
526PROGRESS is a float in the range 0.0 to 1.0.
527If PROGRESS is nil, remove the progress bar."
528 (w32-progress-indicator (system-taskbar--validate-progress progress)))
529
530
531
532(provide 'system-taskbar)
533
534;;; system-taskbar.el ends here
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",
3674 return Qnil; 3674 return Qnil;
3675} 3675}
3676 3676
3677DEFUN ("ns-badge", Fns_badge, Sns_badge, 1, 1, 0,
3678 doc: /* Set the app icon badge to BADGE.
3679BADGE should be a string short enough to display nicely in the short
3680space intended for badges.
3681If BADGE is nil, clear the app badge. */)
3682 (Lisp_Object badge)
3683{
3684 block_input ();
3685 if (NILP (badge))
3686 [[NSApp dockTile] setBadgeLabel: nil];
3687 else
3688 {
3689 CHECK_STRING (badge);
3690 [[NSApp dockTile] setBadgeLabel:
3691 [NSString stringWithUTF8String: SSDATA (badge)]];
3692 }
3693 unblock_input ();
3694 return Qnil;
3695}
3696
3697/* Use -1 to indicate no active request. */
3698static NSInteger ns_request_user_attention_id = -1;
3699
3700DEFUN ("ns-request-user-attention",
3701 Fns_request_user_attention,
3702 Sns_request_user_attention,
3703 1, 1, 0,
3704 doc: /* Bounce the app dock icon to request user attention.
3705If URGENCY nil, cancel the outstanding request, if any.
3706If URGENCY is the symbol `informational', bouncing lasts a few seconds.
3707If URGENCY is the symbol `critical', bouncing lasts until Emacs is
3708focused. */)
3709 (Lisp_Object urgency)
3710{
3711 block_input ();
3712 if (ns_request_user_attention_id != -1)
3713 {
3714 [NSApp cancelUserAttentionRequest: ns_request_user_attention_id];
3715 ns_request_user_attention_id = -1;
3716 }
3717 if (!NILP (urgency) && SYMBOLP (urgency))
3718 {
3719 if (EQ (urgency, Qinformational))
3720 ns_request_user_attention_id = [NSApp requestUserAttention:
3721 NSInformationalRequest];
3722 else if (EQ (urgency, Qcritical))
3723 ns_request_user_attention_id = [NSApp requestUserAttention:
3724 NSCriticalRequest];
3725 }
3726 unblock_input ();
3727 return Qnil;
3728}
3729
3730DEFUN ("ns-progress-indicator",
3731 Fns_progress_indicator,
3732 Sns_progress_indicator,
3733 1, 1, 0,
3734 doc: /* Bounce the app dock icon to request user attention.
3735PROGRESS is a float between 0.0 and 1.0.
3736If PROGRESS is nil, remove the progress indicator. */)
3737 (Lisp_Object progress)
3738{
3739 block_input ();
3740 NSDockTile *dock_tile = [NSApp dockTile];
3741 /* Use NSLevelIndicator with reliable redraws, not NSProgressIndicator. */
3742 NSLevelIndicator *level_indicator;
3743 /* Reuse the indicator subview or create one. */
3744 if (dock_tile.contentView
3745 && [[dock_tile.contentView subviews] count] > 0
3746 && [[[dock_tile.contentView subviews] lastObject]
3747 isKindOfClass:[NSLevelIndicator class]])
3748 level_indicator =
3749 (NSLevelIndicator *)[[[dock_tile contentView] subviews] lastObject];
3750 else
3751 {
3752 if (!dock_tile.contentView)
3753 {
3754 NSImageView* image_view = [[NSImageView alloc] init];
3755 [image_view setImage: [NSApp applicationIconImage]];
3756 [dock_tile setContentView: image_view];
3757 }
3758 /* Set width to the width of the application icon, and height to
3759 % of the icon height to respect scaled icons. */
3760 float width = [[NSApp applicationIconImage] size].width;
3761 float height = 0.10 * [[NSApp applicationIconImage] size].height;
3762 level_indicator =
3763 [[NSLevelIndicator alloc] initWithFrame:
3764 NSMakeRect (0.0, 0.0,
3765 width, height)];
3766 [level_indicator setWantsLayer: YES]; /* Performance. */
3767 [level_indicator setEnabled: NO]; /* Ignore mouse input. */
3768 [level_indicator setLevelIndicatorStyle:
3769 NSLevelIndicatorStyleContinuousCapacity];
3770 /* Match NSProgressIndicator color. */
3771 [level_indicator setFillColor: [NSColor controlAccentColor]];
3772 [level_indicator setMinValue: 0.0];
3773 [level_indicator setMaxValue: 1.0];
3774 /* The contentView takes ownership. */
3775 [dock_tile.contentView addSubview: level_indicator];
3776 }
3777 double progress_value;
3778 BOOL hide = (NILP (progress)
3779 || (!NILP (progress) && !(FLOATP (progress))));
3780 if (!hide)
3781 {
3782 progress_value = XFLOAT_DATA (progress);
3783 hide = (progress_value < 0.0 || progress_value > 1.0);
3784 }
3785 if (hide)
3786 {
3787 [level_indicator setDoubleValue: 0.0];
3788 [level_indicator setHidden: YES];
3789 }
3790 else
3791 {
3792 [level_indicator setDoubleValue: progress_value];
3793 [level_indicator setHidden: NO];
3794 }
3795 [dock_tile display];
3796 unblock_input ();
3797 return Qnil;
3798}
3799
3677#ifdef NS_IMPL_COCOA 3800#ifdef NS_IMPL_COCOA
3678 3801
3679DEFUN ("ns-send-items", 3802DEFUN ("ns-send-items",
@@ -3957,6 +4080,9 @@ The default value is t. */);
3957 defsubr (&Sns_set_mouse_absolute_pixel_position); 4080 defsubr (&Sns_set_mouse_absolute_pixel_position);
3958 defsubr (&Sns_mouse_absolute_pixel_position); 4081 defsubr (&Sns_mouse_absolute_pixel_position);
3959 defsubr (&Sns_show_character_palette); 4082 defsubr (&Sns_show_character_palette);
4083 defsubr (&Sns_badge);
4084 defsubr (&Sns_request_user_attention);
4085 defsubr (&Sns_progress_indicator);
3960#ifdef NS_IMPL_COCOA 4086#ifdef NS_IMPL_COCOA
3961 defsubr (&Sns_send_items); 4087 defsubr (&Sns_send_items);
3962#endif 4088#endif
@@ -4023,4 +4149,6 @@ The default value is t. */);
4023 DEFSYM (Qassq_delete_all, "assq-delete-all"); 4149 DEFSYM (Qassq_delete_all, "assq-delete-all");
4024 DEFSYM (Qrun_at_time, "run-at-time"); 4150 DEFSYM (Qrun_at_time, "run-at-time");
4025 DEFSYM (Qx_hide_tip, "x-hide-tip"); 4151 DEFSYM (Qx_hide_tip, "x-hide-tip");
4152 DEFSYM (Qinformational, "informational");
4153 DEFSYM (Qcritical, "critical");
4026} 4154}
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/>. */
35#include <c-ctype.h> 35#include <c-ctype.h>
36 36
37#define COBJMACROS /* Ask for C definitions for COM. */ 37#define COBJMACROS /* Ask for C definitions for COM. */
38#if !defined MINGW_W64 && !defined CYGWIN
39# define INITGUID
40#endif
41#include <initguid.h>
38#include <shlobj.h> 42#include <shlobj.h>
43#include <shobjidl.h>
39#include <oleidl.h> 44#include <oleidl.h>
40#include <objidl.h> 45#include <objidl.h>
41#include <ole2.h> 46#include <ole2.h>
@@ -232,6 +237,8 @@ typedef struct Emacs_GESTURECONFIG
232typedef BOOL (WINAPI * SetGestureConfig_proc) (HWND, DWORD, UINT, 237typedef BOOL (WINAPI * SetGestureConfig_proc) (HWND, DWORD, UINT,
233 Emacs_PGESTURECONFIG, UINT); 238 Emacs_PGESTURECONFIG, UINT);
234 239
240typedef BOOL (WINAPI * FlashWindowEx_Proc) (PFLASHWINFO pfwi);
241
235static TrackMouseEvent_Proc track_mouse_event_fn = NULL; 242static TrackMouseEvent_Proc track_mouse_event_fn = NULL;
236static ImmGetCompositionString_Proc get_composition_string_fn = NULL; 243static ImmGetCompositionString_Proc get_composition_string_fn = NULL;
237static ImmGetContext_Proc get_ime_context_fn = NULL; 244static ImmGetContext_Proc get_ime_context_fn = NULL;
@@ -254,6 +261,7 @@ static WTSUnRegisterSessionNotification_Proc WTSUnRegisterSessionNotification_fn
254static WTSRegisterSessionNotification_Proc WTSRegisterSessionNotification_fn = NULL; 261static WTSRegisterSessionNotification_Proc WTSRegisterSessionNotification_fn = NULL;
255static RegisterTouchWindow_proc RegisterTouchWindow_fn = NULL; 262static RegisterTouchWindow_proc RegisterTouchWindow_fn = NULL;
256static SetGestureConfig_proc SetGestureConfig_fn = NULL; 263static SetGestureConfig_proc SetGestureConfig_fn = NULL;
264static FlashWindowEx_Proc flash_window_ex_fn = NULL;
257 265
258extern AppendMenuW_Proc unicode_append_menu; 266extern AppendMenuW_Proc unicode_append_menu;
259 267
@@ -11008,6 +11016,313 @@ Return -1 if the required system API is not available or fails. */)
11008 11016
11009#endif 11017#endif
11010 11018
11019
11020#ifdef WINDOWSNT
11021
11022/***********************************************************************
11023 Taskbar Indicators
11024 ***********************************************************************/
11025
11026#ifndef MINGW_W64
11027 /* mingw.org's MinGW doesn't have this stuff. */
11028 DEFINE_GUID(CLSID_TaskbarList, 0x56fdf344, 0xfd6d, 0x11d0, 0x95,0x8a, 0x00,0x60,0x97,0xc9,0xa0,0x90);
11029 DEFINE_GUID(IID_ITaskbarList3, 0xea1afb91, 0x9e28, 0x4b86, 0x90,0xe9, 0x9e,0x9f,0x8a,0x5e,0xef,0xaf);
11030#endif
11031
11032DEFUN ("w32-badge",
11033 Fw32_badge,
11034 Sw32_badge,
11035 3, 3, 0,
11036 doc: /* Display a taskbar icon overlay image on the selected frame.
11037BADGE is a string. If BADGE is nil, remove the overlay. Do nothing if
11038Windows does not support the ITaskbarList3 interface and return nil,
11039otherwise return t. Do nothing if the selected frame is not (yet)
11040associated with a window handle. BACKGROUND and FOREGROUND are RGB
11041triplet strings of the form \"#RRGGBB\". */)
11042 (Lisp_Object badge, Lisp_Object background, Lisp_Object foreground)
11043{
11044 struct frame *sf = SELECTED_FRAME ();
11045 HWND hwnd = NULL;
11046
11047 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
11048 hwnd = FRAME_W32_WINDOW (sf);
11049
11050 if (hwnd == NULL)
11051 return Qnil;
11052
11053 CoInitialize (NULL);
11054 ITaskbarList3 *task_bar_list = NULL;
11055 HRESULT r = CoCreateInstance(&CLSID_TaskbarList,
11056 NULL,
11057 CLSCTX_INPROC_SERVER,
11058 &IID_ITaskbarList3,
11059 (void **)&task_bar_list);
11060 if (r != S_OK)
11061 return Qnil;
11062
11063 if (!NILP (badge) && STRINGP (badge)
11064 && STRINGP (background) && STRINGP (foreground))
11065 {
11066 COLORREF bg_rgb;
11067 COLORREF fg_rgb;
11068 unsigned short r, g, b;
11069 if (parse_color_spec (SSDATA (background), &r, &g, &b))
11070 bg_rgb = RGB (r, b, b);
11071 else
11072 return Qnil;
11073 if (parse_color_spec (SSDATA (foreground), &r, &g, &b))
11074 fg_rgb = RGB (r, b, b);
11075 else
11076 return Qnil;
11077
11078 /* Prepare a string for drawing and as alt-text. */
11079 Lisp_Object badge_utf8 = ENCODE_UTF_8 (badge);
11080 int wide_len = pMultiByteToWideChar (CP_UTF8, 0,
11081 SSDATA (badge_utf8),
11082 -1, NULL, 0);
11083 wchar_t *badge_w = alloca ((wide_len + 1) * sizeof (wchar_t));
11084 pMultiByteToWideChar (CP_UTF8, 0, SSDATA (badge_utf8), -1,
11085 (LPWSTR) badge_w,
11086 wide_len);
11087
11088 /* Use the small icon size Windows suggests to not hard code 16x16. */
11089 int icon_width = GetSystemMetrics (SM_CXSMICON);
11090 int icon_height = GetSystemMetrics (SM_CXSMICON);
11091
11092 HDC hwnd_dc = GetDC (hwnd);
11093 HDC dc = CreateCompatibleDC (hwnd_dc);
11094
11095 BITMAPV5HEADER bi;
11096 memset (&bi, 0, sizeof (bi));
11097 bi.bV5Size = sizeof (bi);
11098 bi.bV5Width = icon_width;
11099 bi.bV5Height = -icon_height; /* Negative for a top-down DIB. */
11100 bi.bV5Planes = 1;
11101 bi.bV5BitCount = 32;
11102 bi.bV5Compression = BI_BITFIELDS; /* Enable the masks below. */
11103 bi.bV5RedMask = 0x00FF0000;
11104 bi.bV5GreenMask = 0x0000FF00;
11105 bi.bV5BlueMask = 0x000000FF;
11106 bi.bV5AlphaMask = 0xFF000000;
11107
11108 DWORD *bitmap_pixels;
11109 HBITMAP bitmap = CreateDIBSection (dc, (BITMAPINFO *) &bi,
11110 DIB_RGB_COLORS,
11111 (void **) &bitmap_pixels,
11112 NULL, 0);
11113 HGDIOBJ old_bitmap = SelectObject(dc, bitmap);
11114
11115 /* Draw a circle filled with bg. */
11116 HBRUSH bg_brush = CreateSolidBrush (bg_rgb);
11117 HGDIOBJ old_brush = SelectObject (dc, bg_brush);
11118 Ellipse (dc, 0, 0, icon_width, icon_height);
11119 SelectObject (dc, old_brush);
11120 DeleteObject (bg_brush);
11121
11122 /* Derive a font scaled to fit the icon. First find the system's
11123 base font. Then scale it to fit icon_height. */
11124 HFONT base_font;
11125 BOOL clean_up_base_font = FALSE;
11126 if (system_parameters_info_w_fn)
11127 {
11128 NONCLIENTMETRICS ncm;
11129 memset (&ncm, 0, sizeof (ncm));
11130 ncm.cbSize = sizeof (ncm);
11131 SystemParametersInfo (SPI_GETNONCLIENTMETRICS, sizeof (ncm), &ncm, 0);
11132 base_font = CreateFontIndirect (&ncm.lfSmCaptionFont);
11133 clean_up_base_font = TRUE;
11134 }
11135 else
11136 base_font = (HFONT) GetStockObject (DEFAULT_GUI_FONT);
11137 if (clean_up_base_font)
11138 DeleteObject (base_font);
11139
11140 LOGFONT lf;
11141 GetObject (base_font, sizeof (lf), &lf);
11142 lf.lfWeight = FW_BOLD;
11143 lf.lfOutPrecision = OUT_OUTLINE_PRECIS;
11144 /* ClearType quality needs opqaue, but we draw transparent. */
11145 lf.lfQuality = ANTIALIASED_QUALITY;
11146 /* Negative lfHeight indicates pixel units vs. positive in points.
11147 Use the LOGPIXELSY px/in of the primary monitor. */
11148 lf.lfHeight = -MulDiv(icon_height / 2, /* Fit ~3 chars. */
11149 72,
11150 GetDeviceCaps (GetDC (NULL), LOGPIXELSY));
11151 /* Ensure lfHeight pixel interpretation. */
11152 int old_map_mode = SetMapMode (dc, MM_TEXT);
11153 HFONT scaled_font = CreateFontIndirect (&lf);
11154 HGDIOBJ old_font = SelectObject (dc, scaled_font);
11155 SetMapMode (dc, old_map_mode);
11156
11157 /* Draw badge text. */
11158 SetBkMode (dc, TRANSPARENT);
11159 SetTextColor (dc, fg_rgb);
11160 RECT rect;
11161 rect.left = rect.top = 0;
11162 rect.right = icon_width;
11163 rect.bottom = icon_height;
11164 DrawText (dc, SSDATA (badge_utf8),
11165 -1, /* Indicate null-terminated string. */
11166 &rect,
11167 DT_CENTER | DT_VCENTER | DT_SINGLELINE | DT_NOCLIP);
11168 SelectObject (dc, old_font);
11169 DeleteObject (scaled_font);
11170
11171 /* Make the circle and its text opaque by setting the alpha
11172 channel on each pixel falling within the circle. */
11173 int circle_center_x = icon_width / 2;
11174 int circle_center_y = icon_height / 2;
11175 int circle_radius = (icon_width < icon_height
11176 ? icon_width
11177 : icon_height) / 2 - 2;
11178 int circle_radius_sq = circle_radius * circle_radius;
11179 DWORD *pixel;
11180 for (int y = 0; y < icon_height; ++y)
11181 for (int x = 0; x < icon_width; ++x)
11182 {
11183 int dx = x - circle_center_x;
11184 int dy = y - circle_center_y;
11185 if (dx * dx + dy * dy <= circle_radius_sq)
11186 {
11187 pixel = bitmap_pixels + (y * icon_width + x);
11188 *pixel |= 0xff000000; /* Flip the 0xAARRGGBB alpha channel. */
11189 }
11190 }
11191
11192 /* Dummy monochrome bitmap mask, ignored when the color bitmap has
11193 an alpha channel, but needed to satisfy CreateIconIndirect. */
11194 HBITMAP mask_bitmap = CreateBitmap (icon_width, icon_height, 1, 1, NULL);
11195
11196 /* https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-createiconindirect
11197 hbmMask and hbmColor members of the ICONINFO structure should
11198 not already be selected into a device context. */
11199 SelectObject (dc, old_bitmap);
11200
11201 ICONINFO icon_info;
11202 memset (&icon_info, 0, sizeof (icon_info));
11203 icon_info.fIcon = TRUE;
11204 icon_info.hbmMask = mask_bitmap;
11205 icon_info.hbmColor = bitmap;
11206
11207 HICON icon = CreateIconIndirect (&icon_info);
11208 task_bar_list->lpVtbl->SetOverlayIcon (task_bar_list, hwnd, icon, badge_w);
11209
11210 DestroyIcon (icon);
11211 DeleteObject (mask_bitmap);
11212 DeleteObject (bitmap);
11213 DeleteDC (dc);
11214 ReleaseDC (hwnd, hwnd_dc);
11215 }
11216 else
11217 task_bar_list->lpVtbl->SetOverlayIcon (task_bar_list, hwnd, NULL, NULL);
11218
11219 task_bar_list->lpVtbl->Release(task_bar_list);
11220 return Qt;
11221}
11222
11223DEFUN ("w32-request-user-attention",
11224 Fw32_request_user_attention,
11225 Sw32_request_user_attention,
11226 1, 1, 0,
11227 doc: /* Flash the selected frame's taskbar icon and/or its window.
11228If URGENCY is nil, cancel the request, if any. If URGENCY is the symbol
11229`informational', flash the taskbar icon. If URGENCY is the symbol
11230`critical', flash the taskbar icon and the frame. Windows stops
11231flashing if the user focuses the frame. Do nothing if Windows does not
11232support FlashWindowEx and return nil, otherwise return t. Do nothing if
11233the frame is not (yet) associated with a window handle. */)
11234 (Lisp_Object urgency)
11235{
11236 if (flash_window_ex_fn == NULL)
11237 return Qnil;
11238
11239 struct frame *sf = SELECTED_FRAME ();
11240 HWND hwnd = NULL;
11241
11242 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
11243 hwnd = FRAME_W32_WINDOW (sf);
11244
11245 if (hwnd == NULL)
11246 return Qnil;
11247
11248 FLASHWINFO flash_info;
11249 flash_info.cbSize = sizeof(flash_info);
11250 flash_info.uCount = 0;
11251 flash_info.dwTimeout = 0;
11252 flash_info.hwnd = hwnd;
11253 if (!NILP (urgency) && SYMBOLP (urgency))
11254 {
11255 /* The intended caller, 'system-taskbar-attention', has an
11256 optional timer to clear the attention indicator so this will
11257 flash until cleared via the timer, or the window comes to the
11258 foreground. For informational attention, flash the tray icon.
11259 For critical attention, flash the tray icon and the window. */
11260 if (EQ (urgency, Qinformational))
11261 flash_info.dwFlags = FLASHW_TRAY | FLASHW_TIMERNOFG;
11262 else if (EQ (urgency, Qcritical))
11263 flash_info.dwFlags = FLASHW_ALL | FLASHW_TIMERNOFG;
11264 }
11265 else
11266 flash_info.dwFlags = FLASHW_STOP;
11267
11268 flash_window_ex_fn (&flash_info);
11269 return Qt;
11270}
11271
11272DEFUN ("w32-progress-indicator",
11273 Fw32_progress_indicator,
11274 Sw32_progress_indicator,
11275 1, 1, 0,
11276 doc: /* Show a progress bar on the selected frame's taskbar icon.
11277PROGRESS is a float in the range 0.0 to 1.0. If PROGRESS is nil, remove
11278the progress indicator. Do nothing if Windows does not support the
11279ITaskbarList3 interface and return nil, otherwise return t. Do nothing
11280if the selected frame is not (yet) associated with a window handle */)
11281 (Lisp_Object progress)
11282{
11283 struct frame *sf = SELECTED_FRAME ();
11284 HWND hwnd = NULL;
11285
11286 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
11287 hwnd = FRAME_W32_WINDOW (sf);
11288
11289 if (hwnd == NULL)
11290 return Qnil;
11291
11292 CoInitialize (NULL);
11293 ITaskbarList3 *task_bar_list = NULL;
11294 HRESULT r = CoCreateInstance(&CLSID_TaskbarList,
11295 NULL,
11296 CLSCTX_INPROC_SERVER,
11297 &IID_ITaskbarList3,
11298 (void **)&task_bar_list);
11299 if (r != S_OK)
11300 return Qnil;
11301
11302 /* Scale task bar progress from 0.0-1.0 to 0-100. */
11303 ULONGLONG adj_progress = 0;
11304 if (!NILP (progress) && FLOATP (progress))
11305 adj_progress = (ULONGLONG) (100.0 *
11306 XFLOAT_DATA (progress));
11307 if (adj_progress > 0)
11308 {
11309 task_bar_list->lpVtbl->SetProgressState (task_bar_list,
11310 hwnd, TBPF_NORMAL);
11311 task_bar_list->lpVtbl->SetProgressValue (task_bar_list,
11312 hwnd, adj_progress, 100);
11313 }
11314 else
11315 {
11316 task_bar_list->lpVtbl->SetProgressState (task_bar_list,
11317 hwnd, TBPF_NOPROGRESS);
11318 }
11319
11320 task_bar_list->lpVtbl->Release(task_bar_list);
11321 return Qt;
11322}
11323
11324#endif /* WINDOWSNT */
11325
11011/*********************************************************************** 11326/***********************************************************************
11012 Initialization 11327 Initialization
11013 ***********************************************************************/ 11328 ***********************************************************************/
@@ -11509,6 +11824,15 @@ keys when IME input is received. */);
11509 DEFSYM (Qcapslock, "capslock"); 11824 DEFSYM (Qcapslock, "capslock");
11510 DEFSYM (Qkp_numlock, "kp-numlock"); 11825 DEFSYM (Qkp_numlock, "kp-numlock");
11511 DEFSYM (Qscroll, "scroll"); 11826 DEFSYM (Qscroll, "scroll");
11827
11828 #ifdef WINDOWSNT
11829 /* Taskbar indicators support. */
11830 defsubr (&Sw32_badge);
11831 defsubr (&Sw32_progress_indicator);
11832 defsubr (&Sw32_request_user_attention);
11833 DEFSYM (Qinformational, "informational");
11834 DEFSYM (Qcritical, "critical");
11835 #endif
11512} 11836}
11513 11837
11514 11838
@@ -11797,6 +12121,9 @@ globals_of_w32fns (void)
11797 SetGestureConfig_fn 12121 SetGestureConfig_fn
11798 = (SetGestureConfig_proc) get_proc_addr (user32_lib, 12122 = (SetGestureConfig_proc) get_proc_addr (user32_lib,
11799 "SetGestureConfig"); 12123 "SetGestureConfig");
12124 flash_window_ex_fn
12125 = (FlashWindowEx_Proc) get_proc_addr (user32_lib,
12126 "FlashWindowEx");
11800 12127
11801 { 12128 {
11802 HMODULE imm32_lib = GetModuleHandle ("imm32.dll"); 12129 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");