Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

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

Browse source 
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.
This commit is contained in:
Stéphane Marks 2025-11-20 12:54:40 -05:00 committed by Michael Albinus
parent 28a2a7d811
commit f5f2306fc1
7 changed files with 1263 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
doc/emacs/frames.texi
View file

@ -58,6 +58,7 @@ for doing so on MS-DOS). Menus are supported on all text terminals.
* Menu Bars:: Enabling and disabling the menu bar.
* Tool Bars:: Enabling and disabling the tool bar.
* Tab Bars:: Enabling and disabling the tab bar.
* System Taskbar:: Using system GUI taskbar features.
* Dialog Boxes:: Controlling use of dialog boxes.
* Tooltips:: Displaying information at the current mouse position.
* Mouse Avoidance:: Preventing the mouse pointer from obscuring text.
@ -1631,6 +1632,75 @@ This moves forward in the history of window configurations.
It's possible to customize the items displayed on the tab bar
by the user option @code{tab-bar-format}.
@node System Taskbar
@section Using System GUI Taskbar Features
@cindex system taskbar
@cindex mode, system taskbar
Emacs can use your GUI system taskbar to display a badge overlay on
the Emacs taskbar icon, a progress bar report, and alert the user that
an Emacs session needs attention. Note: The system taskbar might be
called the dock, the launcher, or something similar.
@cindex system taskbar, GNU/Linux
On GNU/Linux eligible GUI desktops, system taskbar effects will appear
on the desktop destinations determined by your shell extension, most
often the application launcher or dock panel, or the top panel. Effects
are global for an Emacs instance.
Note: The GNU/Linux implementation sends system taskbar messages to the
GUI using D-Bus. You may need to install or configure shell extensions
such as @url{https://extensions.gnome.org/extension/307/dash-to-dock/}
that implement Ubuntu's Unity D-Bus launcher spec which you can read
more about here @url{https://wiki.ubuntu.com/Unity/LauncherAPI}.
@xref{Top,,, dbus, The D-Bus Manual}.
@cindex system taskbar, macOS/GNUstep
@cindex system taskbar, NS
On macOS/GNUstep 10.5+, system taskbar effects appear on the Dock and in
the App Switcher. Effects are global for an Emacs instance.
macOS/GNUstep need no special configuration.
@cindex system taskbar, MS-Windows
On MS-Windows 7+, taskbar effects appear on the Windows system taskbar.
Effects are associated with the frame from which they are initiated.
MS-Windows needs no special configuration.
@findex system-taskbar-mode
You must initialize system-taskbar before using it. To do that, type
@kbd{M-x system-taskbar-mode}.
@vindex system-taskbar-use-progress-reporter
The user option @code{system-taskbar-use-progress-reporter} integrates
@code{system-taskbar-mode} with Emacs progress report functions, which
many longer-running functions use to indicate the progress of their
work. Progress reports will appear in the echo area and on the system
taskbar Emacs icon. This variable defaults to @code{t}. Customize this
variable before enabling @code{system-taskbar-mode}. @xref{Progress,,,
elisp}
@vindex system-taskbar-clear-attention-on-frame-focus
The user option @code{system-taskbar-clear-attention-on-frame-focus}
turns on a helper useful on GNU/Linux D-Bus platforms which
automatically clears the system taskbar attention indicator when any
Emacs frame is focused. This has no effect on macOS/GNUstep or
MS-Windows. It defaults to @code{t}. Customize this variable before
enabling @code{system-taskbar-mode}.
@vindex system-taskbar-dbus-desktop-file-name
The user option @code{system-taskbar-dbus-desktop-file-name} helps
D-Bus on GNU/Linux identify launched instance of Emacs. It defaults to
@samp{emacsclient} and may need to be changed to @samp{emacs} depending
on your GNU/Linux configuration.
@vindex system-taskbar-dbus-timeout
The user option @code{system-taskbar-dbus-timeout} is a
troubleshooting tool and it likely does not need to be customized. It
defaults to @code{nil} which uses the D-Bus default timeout which is
25,000ms or 25s.
@xref{System Taskbar,,, elisp, The Emacs Lisp Reference Manual}
@node Dialog Boxes
@section Using Dialog Boxes
@cindex dialog boxes

122
doc/lispref/os.texi
View file

@ -34,6 +34,7 @@ terminal and the screen.
* Batch Mode:: Running Emacs without terminal interaction.
* Session Management:: Saving and restoring state with X Session Management.
* Desktop Notifications:: Desktop notifications.
* System Taskbar:: Controlling system GUI taskbar features.
* File Notifications:: File notifications.
* Dynamic Libraries:: On-demand loading of support libraries.
* Security Considerations:: Running Emacs in an unfriendly environment.
@ -3371,6 +3372,127 @@ Android 13 and later, any notifications sent will be silently
disregarded.
@end defun
@node System Taskbar
@section Controlling System GUI Taskbar Features
@cindex system taskbar
@cindex mode, system taskbar
@xref{System Taskbar,,, emacs, The GNU Emacs Manual}, for an overview
and configuration.
@defun system-taskbar-badge &optional count
This function displays @var{count} as an overlay on the system taskbar
Emacs icon.
If @var{count} is an integer, display that.
If @var{count} is a string on back ends that support strings, display
that. The string should be short.
On back ends which do not support strings, convert @var{count} to an
integer, or @code{nil} if that fails.
If @var{count} is @code{nil} or an empty string, remove the counter or
short string.
Display the system taskbar icon badge set to @var{count}. If
@var{count} is @code{nil}, clear the badge. @var{count} is typically an
integer.
If @var{count} is a string, it is converted to an integer on systems
that do not support string badges, such as GNU/Linux D-Bus, and the
badge will be cleared if the string is an invalid integer
representation. On systems that support strings, such as macOS/GNUstep
and MS-Windows, the badge is set to the string and displayed, and may be
truncated to fit the visual space allocated by the system. In any case,
if the string is empty, clear the badge.
@end defun
@defun system-taskbar-attention &optional urgency timeout
This function flashes or bounces system taskbar Emacs icon and/or its
frame to alert the user.
@var{urgency} can be one of the symbols @code{informational}, or
@code{critical}.
If @var{urgency} is @code{nil}, clear the attention indicator.
The attention indicator is cleared by the earliest of bringing the Emacs
GUI into focus, or after @var{timeout} seconds. If @var{timeout} is
@code{nil}, the system GUI behavior has priority.
On some back ends, @code{critical} has the same effect as
@code{informational}.
On some back ends, attention will be displayed
only if Emacs is not the currently focused application.
@end defun
@defun system-taskbar-progress &optional progress
This function displays a progress indicator overlay on the system
taskbar Emacs icon.
@var{progress} is a float in the range 0.0 to 1.0. If @var{progress} is
@code{nil}, remove the progress indicator.
It is convenient to use the built-in progress reporter functions which,
when @code{system-taskbar-mode} is enabled, integrate with
@code{system-taskbar-progress} by default. @xref{Progress}
@end defun
@noindent
Examples of system-taskbar functions:
@lisp
@group
;; Enable and initialize system-taskbar-mode before calling its
;; package functions.
(system-taskbar-mode)
;; Display a badge integer on the taskbar icon.
(system-taskbar-badge emacs-major-version)
;; A string representation of an integer is converted to an
;; integer on GNU/Linux.
(system-taskbar-badge "31")
;; Short strings are displayed on macOS/GNUstep and MS-Windows.
(system-taskbar-badge "Test")
;; Clear the badge.
(system-taskbar-badge)
@end group
@group
;; Get the user's attention and clear the request after 3 seconds.
(system-taskbar-attention 'informational 3)
;; Get the user's attention and clear when Emacs is focused.
(system-taskbar-attention 'critical)
;; Clear the attention request.
(system-taskbar-attention)
@end group
@group
;; Make sure system-taskbar is integrated with progress-reporter.
(setopt system-taskbar-use-progress-reporter t) ; t is the default
(system-taskbar-mode)
;; Report `dotimes` progress on the taskbar icon.
(dotimes-with-progress-reporter
(i 10)
"Counting from 1 to 10..."
(sleep-for 1))
;; Report `dolist` progress on the taskbar icon.
(dolist-with-progress-reporter
(i (make-list 10 t))
"Progress from 1 to 10 elements..."
(sleep-for 1))
@end group
@end lisp
@node File Notifications
@section Notifications on File Changes
@cindex file notifications

22
etc/NEWS
View file

@ -3284,6 +3284,21 @@ This library provides functions to throttle or debounce Emacs Lisp
functions. This is useful for corralling overeager code that is slow
and blocks Emacs, or does not provide ways to limit how often it runs.
+++
** New mode 'system-taskbar-mode'.
This is a global minor mode and companion functions that integrate Emacs
with system GUI taskbars (also called docks or launchers or something
similar) to display a taskbar icon "badge" overlay, a progress bar
report overlay, alert the user that an Emacs session needs attention,
often by flashing or bouncing the Emacs application icon. Supported
capable systems are GNU/Linux via D-Bus, macOS/GNUstep 10.5+, MS-Windows
7+.
On GNU/Linux systems, shell extensions or similar helpers such as
"dash-to-dock" may be required. See
<https://extensions.gnome.org/extension/307/dash-to-dock/> and
<https://wiki.ubuntu.com/Unity/LauncherAPI>.
* Incompatible Lisp Changes in Emacs 31.1
@ -3748,6 +3763,13 @@ When the theme is set on PGTK, Android, or MS-Windows systems,
variable 'toolkit-theme' as either symbol 'dark' or 'light', but may be
extended to encompass other toolkit-specific symbols in the future.
+++
** Progress reporter callbacks.
'make-progress-reporter' now accepts optional arguments UPDATE-CALLBACK,
called on progress steps, and DONE-CALLBACK, called when the progress
reporter is done. See the 'make-progress-reporter' docstring for a full
specification of these new optional arguments.
* Changes in Emacs 31.1 on Non-Free Operating Systems

83
lisp/subr.el
View file

@ -6974,19 +6974,33 @@ to deactivate this transient map, regardless of KEEP-PRED."
;; digits of precision, it doesn't really matter here. On the other
;; hand, it greatly simplifies the code.
(defvar progress-reporter-update-functions (list #'progress-reporter-echo-area)
"Special hook run on progress-reporter updates.
Each function is called with two arguments:
REPORTER is the result of a call to `make-progress-reporter'.
STATE can be one of:
- A float representing the percentage complete in the range 0.0-1.0
for a numeric reporter.
- An integer representing the index which cycles through the range 0-3
for a pulsing reporter.
- The symbol `done' to indicate that the progress reporter is complete.")
(defsubst progress-reporter-update (reporter &optional value suffix)
"Report progress of an operation in the echo area.
"Report progress of an operation, by default, in the echo area.
REPORTER should be the result of a call to `make-progress-reporter'.
If REPORTER is a numerical progress reporter---i.e. if it was
made using non-nil MIN-VALUE and MAX-VALUE arguments to
`make-progress-reporter'---then VALUE should be a number between
MIN-VALUE and MAX-VALUE.
made using non-nil MIN-VALUE and MAX-VALUE arguments to
`make-progress-reporter'---then VALUE should be a number between
MIN-VALUE and MAX-VALUE.
Optional argument SUFFIX is a string to be displayed after
REPORTER's main message and progress text. If REPORTER is a
non-numerical reporter, then VALUE should be nil, or a string to
use instead of SUFFIX.
Optional argument SUFFIX is a string to be displayed after REPORTER's
main message and progress text. If REPORTER is a non-numerical
reporter, then VALUE should be nil, or a string to use instead of
SUFFIX. SUFFIX is considered obsolete and may be removed in the future.
See `progress-reporter-update-functions' for the list of functions
called on each update.
This function is relatively inexpensive. If the change since
last update is too small or insufficient time has passed, it does
@ -7045,6 +7059,10 @@ effectively rounded up."
(defalias 'progress-reporter-make #'make-progress-reporter)
(defun progress-reporter-text (reporter)
"Return REPORTER's text."
(aref (cdr reporter) 3))
(defun progress-reporter-force-update (reporter &optional value new-message suffix)
"Report progress of an operation in the echo area unconditionally.
@ -7060,12 +7078,29 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
(defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
"Characters to use for pulsing progress reporters.")
(defun progress-reporter-echo-area (reporter state)
"Progress reporter echo area update function.
REPORTER and STATE are the same as in
`progress-reporter-update-functions'."
(let ((text (progress-reporter-text reporter)))
(pcase state
((pred floatp)
(if (plusp state)
(message "%s%d%%" text (* state 100.0))
(message "%s" text)))
((pred integerp)
(let ((message-log-max nil)
(pulse-char (aref progress-reporter--pulse-characters
state)))
(message "%s %s" text pulse-char)))
('done
(message "%sdone" text)))))
(defun progress-reporter-do-update (reporter value &optional suffix)
(let* ((parameters (cdr reporter))
(update-time (aref parameters 0))
(min-value (aref parameters 1))
(max-value (aref parameters 2))
(text (aref parameters 3))
(let* ((parameters (cdr reporter))
(update-time (aref parameters 0))
(min-value (aref parameters 1))
(max-value (aref parameters 2))
(enough-time-passed
;; See if enough time has passed since the last update.
(or (not update-time)
@ -7098,9 +7133,9 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
(if suffix
(aset parameters 6 suffix)
(setq suffix (or (aref parameters 6) "")))
(if (plusp percentage)
(message "%s%d%% %s" text percentage suffix)
(message "%s %s" text suffix)))))
(run-hook-with-args 'progress-reporter-update-functions
reporter
(/ percentage 100.0)))))
;; Pulsing indicator
(enough-time-passed
(when (and value (not suffix))
@ -7108,16 +7143,18 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
(if suffix
(aset parameters 6 suffix)
(setq suffix (or (aref parameters 6) "")))
(let* ((index (mod (1+ (car reporter)) 4))
(message-log-max nil)
(pulse-char (aref progress-reporter--pulse-characters
index)))
(let ((index (mod (1+ (car reporter)) 4)))
(setcar reporter index)
(message "%s %s %s" text pulse-char suffix))))))
(run-hook-with-args 'progress-reporter-update-functions
reporter
index))))))
(defun progress-reporter-done (reporter)
"Print reporter's message followed by word \"done\" in echo area."
(message "%sdone" (aref (cdr reporter) 3)))
"Print reporter's message followed by word \"done\" in echo area.
Call the functions on `progress-reporter-update-functions`."
(run-hook-with-args 'progress-reporter-update-functions
reporter
'done))
(defmacro dotimes-with-progress-reporter (spec reporter-or-message &rest body)
"Loop a certain number of times and report progress in the echo area.

534
lisp/system-taskbar.el Normal file
View file

@ -0,0 +1,534 @@
;;; system-taskbar.el --- System GUI taskbar/dock/launcher status display -*- lexical-binding: t -*-
;; Copyright (C) 2025 Free Software Foundation, Inc.
;; Author: Stephane Marks
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; Package-Requires: ((emacs "31.1"))
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Use this package to display a taskbar icon "badge" overlay, a
;; progress bar report overlay, or alert the user that an Emacs session
;; needs attention, often by flashing or bouncing the Emacs application
;; icon.
;;
;; Note: The term taskbar is inclusive of dock or launcher or some other
;; terminology as may be used for your system.
;;
;; On GNU/Linux, the visible effects will appear on the destinations
;; determined by your shell extension, most often the application
;; launcher or dock panel, or the top panel. Effects are global for an
;; Emacs instance.
;;
;; On macOS/GNUstep, the effects will appear on the Dock and in the App
;; Switcher. Effects are global for an Emacs instance.
;;
;; On MS-Windows, the effects appear on the taskbar. Effects are
;; associated with the frame from which they are initiated.
;;; Usage:
;; The global minor mode `system-taskbar-mode' initializes the GUI
;; platform back-end and must be enabled before using the functions
;; below.
;;
;; `system-taskbar-badge' overlays a count, which is an integer, on the
;; Emacs taskbar icon. You can use this, for example, to indicate the
;; number of unread email messages. On GNU/Linux, the count must be an
;; integer or nil. On macOS/GNUstep, the count may be an integer or a
;; string, which the operating system will abbreviate if too long. On
;; MS-Windows, the taskbar badge will be abbreviated to three
;; characters; if the count is an integer outside the range -99 to 99,
;; it is shown as "-99" or "99+", if count is a string longer than 3
;; characters it is truncated.
;;
;; `system-taskbar-attention' flashes or bounces the Emacs taskbar icon
;; to indicate that your Emacs session wants attention. Its behaviors
;; are back-end specific.
;;
;; `system-taskbar-progress' overlays a graphical progress bar on the
;; Emacs taskbar icon to illustrate progress of a potentially
;; long-running operation.
;;
;; When `system-taskbar-mode' is enabled, Emacs progress reporters will
;; be enhanced to display taskbar GUI progress bars. Customize
;; `system-taskbar-use-progress-reporter' if you want to disable this
;; before enabling system-taskbar-mode.
;;
;; On GNU/Linux systems, taskbar effects will appear on the GUI
;; window-system destinations determined by your shell extension, most
;; often the application launcher or dock panel, or the top panel.
;; Taskbar effects are global for an Emacs instance. The GNU/Linux
;; implementation sends taskbar messages to the system GUI using D-Bus.
;; You may need to install or configure shell extensions such as
;; https://extensions.gnome.org/extension/307/dash-to-dock/ that
;; implement Ubuntu's Unity D-Bus launcher spec which you can read more
;; about here https://wiki.ubuntu.com/Unity/LauncherAPI.
;;
;; Your Linux Emacs instance should be launched via an appropriate shell
;; "desktop" file such as those distributed with Emacs; e.g.,
;; "etc/emacsclient.desktop" as documented here
;; https://specifications.freedesktop.org/desktop-entry/latest/ and
;; which your GUI system should implement.
;;
;; On macOS/GNUstep 10.5+, taskbar effects appear on the Dock and in the
;; App Switcher. Effects are global for an Emacs instance.
;; macOS/GNUstep is implemented via its native API and needs no special
;; configuration.
;;
;; On MS-Windows 7+, taskbar effects appear on the Windows taskbar.
;; Effects are associated with the frame from which they are initiated.
;; MS-Windows is implemented via its native API and needs no special
;; configuration.
;;
;; To add support for additional systems, provide a back end that
;; implements the cl-generic functions below.
;;; Code:
(require 'dbus)
(defgroup system-taskbar nil
"System GUI taskbar icon badge, progress report, alerting."
:group 'convenience
:version "31.1")
(defcustom system-taskbar-use-progress-reporter t
"Supplement progress-reporters with GUI taskbar icon progress bars.
Set this before enabling `system-taskbar-mode'."
:type 'boolean
:version "31.1")
(defcustom system-taskbar-clear-attention-on-frame-focus t
"Clear the icon attention indicator when any GUI frame is focused.
Back ends that automatically clear the attention indicator, such as
macOS/GNUstep and MS-Windows, ignore this option."
:type 'boolean
:version "31.1")
(defcustom system-taskbar-dbus-desktop-file-name "emacsclient"
"D-Bus desktop file base name for the system taskbar destination.
This should be the base name of the desktop file used to launch an Emacs
instance. For example, if your launcher desktop file is called
\"emacs.desktop\", this option should be \"emacs\"."
:type 'string
:version "31.1")
(defcustom system-taskbar-dbus-timeout nil
"Number of milliseconds to wait for D-Bus responses.
If nil, use the D-Bus default timeout which is 25,000 (i.e., 25s).
If your D-Bus desktop extension needs extra time to respond, in which
case `system-taskbar-mode' might not initialize or related functions
might not take visible effect, bind this to a value higher than 25,000
to find what works for your system."
:type '(choice (const :tag "Default" nil) natnum)
:version "31.1")
(defun system-taskbar-progress-reporter-install ()
"Install system-taskbar progress reporter."
(add-hook 'progress-reporter-update-functions
#'system-taskbar--progress-reporter-update))
(defun system-taskbar-progress-reporter-remove ()
"Remove system-taskbar progress reporter."
(remove-hook 'progress-reporter-update-functions
#'system-taskbar--progress-reporter-update))
(defvar system-taskbar--back-end nil
"Generic taskbar method system dispatcher.")
;;;###autoload
(define-minor-mode system-taskbar-mode
"System GUI taskbar icon badge, progress report, alerting."
:global t
(when noninteractive
(warn "Batch mode does not support `system-taskbar'"))
(cond (system-taskbar-mode
(if (system-taskbar--set-back-end)
(system-taskbar--enable)
(warn "System does not support `system-taskbar'"))
(when system-taskbar-use-progress-reporter
(system-taskbar-progress-reporter-install)))
(t
(system-taskbar-progress-reporter-remove)
(when system-taskbar--back-end
(system-taskbar--badge nil)
(system-taskbar--attention nil)
(system-taskbar--progress nil)
(system-taskbar--disable)
(setq system-taskbar--back-end nil)))))
(defun system-taskbar-badge (&optional count)
"Display COUNT as an overlay on the system taskbar Emacs icon.
If COUNT is an integer, display that.
If COUNT is a string on back ends that support strings, display that.
The string should be short.
On back ends which do not support strings, convert COUNT to an integer
using `string-to-number' and testing `integerp', or nil if that fails.
If COUNT is nil or an empty string, remove the counter."
(when system-taskbar-mode
(system-taskbar--badge count)))
(defun system-taskbar-attention (&optional urgency timeout)
"Flash the system taskbar icon and/or frame to alert the user.
URGENCY can be one of the symbols `informational', or `critical'.
If URGENCY is nil, clear the attention indicator.
The attention indicator is cleared by the earliest of bringing the Emacs
GUI into focus, or after TIMEOUT seconds. If TIMEOUT is nil, the system
GUI behavior has priority.
On some back ends, `critical' has the same effect as `informational'."
(when system-taskbar-mode
(system-taskbar--attention urgency timeout)))
(defun system-taskbar-progress (&optional progress)
"Display a progress indicator overlay on the system taskbar icon.
PROGRESS is a float in the range 0.0 to 1.0.
If PROGRESS is nil, remove the progress indicator."
(when system-taskbar-mode
(system-taskbar--progress progress)))
;; Internal implementation.
(defvar w32-initialized)
(defun system-taskbar--set-back-end ()
"Determine taskbar host system type."
;; Order matters to accommodate the cases where an NS or MS-Windows
;; build have the dbus feature.
(setq system-taskbar--back-end
(cond ((boundp 'ns-version-string) 'ns)
(w32-initialized 'w32)
((and (featurep 'dbusbind)
(member "org.freedesktop.login1"
(dbus-list-activatable-names :system)))
'dbus)
(t nil))))
(cl-defgeneric system-taskbar--enable ()
"Enable the system-taskbar back end.")
(cl-defgeneric system-taskbar--disable ()
"Disable the system-taskbar back end.")
(cl-defgeneric system-taskbar--badge (&optional count)
"Display COUNT as an overlay on the system taskbar Emacs icon.
If COUNT is an integer, display that.
If COUNT is a string on back ends that support strings, display that.
The string should be short.
On back ends which do not support strings, convert COUNT to an integer
using `string-to-number' and testing `integerp', or nil if that fails.
If COUNT is nil or an empty string, remove the counter.")
(cl-defgeneric system-taskbar--attention (&optional urgency timeout)
"Flash the system taskbar icon and/or frame to alert the user.
URGENCY can be one of the symbols `informational', or `critical'.
If URGENCY is nil, clear the attention indicator.
The attention indicator is cleared by the earliest of bringing the Emacs
GUI into focus, or after TIMEOUT seconds. If TIMEOUT is nil, the system
GUI behavior has priority.
On some back ends, `critical' has the same effect as `informational'.
On some back ends, attention will be displayed only if Emacs is not the
currently focused application.")
(cl-defgeneric system-taskbar--progress (&optional progress)
"Display a progress indicator overlay on the system taskbar icon.
PROGRESS is a float in the range 0.0 to 1.0.
If PROGRESS is nil, remove the progress indicator.")
(defun system-taskbar--validate-progress (progress)
"Return PROGRESS as a float in the range 0.0 to 1.0, or nil."
(when (natnump progress)
(setq progress (float progress)))
(when (and progress (>= progress 0.0) (<= progress 1.0))
progress))
;; `progress-reporter' support.
(defun system-taskbar--progress-reporter-update (_reporter state)
"Progress reporter system-taskbar update function.
REPORTER and STATE are the same as in
`progress-reporter-update-functions'."
(when system-taskbar-mode
(pcase state
((pred floatp)
(system-taskbar--progress state))
((pred integerp)
(system-taskbar--progress (/ (1+ state) 4.0)))
('done
(system-taskbar--progress nil)))))
;; D-Bus support.
(defconst system-taskbar--dbus-service "com.canonical.Unity")
(defconst system-taskbar--dbus-interface "com.canonical.Unity.LauncherEntry")
(defvar system-taskbar--dbus-attention nil
"Non-nil when attention is requested.")
(defun system-taskbar--dbus-send-signal (message)
"Send MESSAGE to the D-Bus system taskbar service."
(let ((app-uri
(format "application://%s.desktop"
system-taskbar-dbus-desktop-file-name)))
(dbus-send-signal
:session
system-taskbar--dbus-service
"/"
system-taskbar--dbus-interface
"Update"
app-uri
message)))
(defun system-taskbar--dbus-clear-attention-on-frame-focus ()
"Clear an active D-Bus attention request if any frame is focused."
(when (and system-taskbar--dbus-attention
(catch :clear
(dolist (frame (frame-list))
(when (eq (frame-focus-state frame) t)
(throw :clear t)))))
(system-taskbar-attention nil)))
(defun system-taskbar-dbus-ping-service ()
"Return non-nil if `system-taskbar--dbus-service' responds.
Return nil if no response within `system-taskbar-dbus-timeout'."
(dbus-ping
:session
system-taskbar--dbus-service
system-taskbar-dbus-timeout))
(cl-defmethod system-taskbar--enable (&context
(system-taskbar--back-end (eql 'dbus)))
(unless (system-taskbar-dbus-ping-service)
(error "D-Bus service `%s' unavailable" system-taskbar--dbus-service))
(when system-taskbar-clear-attention-on-frame-focus
(add-function :after after-focus-change-function
#'system-taskbar--dbus-clear-attention-on-frame-focus)))
(cl-defmethod system-taskbar--disable (&context
(system-taskbar--back-end (eql 'dbus)))
(remove-function after-focus-change-function
#'system-taskbar--dbus-clear-attention-on-frame-focus))
(cl-defmethod system-taskbar--badge (&context
(system-taskbar--back-end (eql 'dbus))
&optional count)
"Display COUNT as an overlay on the system taskbar Emacs icon.
If COUNT is an integer, display that. If COUNT is a string, convert it
to an integer, or nil if that fails. If COUNT is any other type, use
nil. If COUNT is nil or an empty string, remove the badge.
Note: The Unity D-Bus protocol supports only integer badges."
(cond ((stringp count)
(if (string-empty-p count)
(setq count nil)
(let ((count-1 (string-to-number count)))
(setq count (if (integerp count-1) count-1 nil)))))
((not (integerp count))
(setq count nil)))
(system-taskbar--dbus-send-signal
`((:dict-entry "count-visible"
(:variant :boolean ,(not (null count))))
(:dict-entry "count"
(:variant :uint32 ,(if (null count) 0
count))))))
(cl-defmethod system-taskbar--attention (&context
(system-taskbar--back-end (eql 'dbus))
&optional urgency timeout)
"Request URGENCY user attention on the system taskbar Emacs icon.
The request will time out within the TIMEOUT seconds interval.
The Unity D-Bus protocol does not support differentiated urgencies."
(setq system-taskbar--dbus-attention urgency)
(system-taskbar--dbus-send-signal
`((:dict-entry "urgent"
(:variant :boolean ,(not (null urgency))))))
(when (and urgency timeout)
(run-with-timer
timeout
nil
#'system-taskbar-attention nil)))
(cl-defmethod system-taskbar--progress (&context
(system-taskbar--back-end (eql 'dbus))
&optional progress)
"Display a progress bar overlay on the system taskbar icon.
PROGRESS is a float in the range 0.0 to 1.0.
If PROGRESS is nil, remove the progress bar."
(setq progress (system-taskbar--validate-progress progress))
(system-taskbar--dbus-send-signal
`((:dict-entry "progress-visible"
(:variant :boolean ,(not (null progress))))
(:dict-entry "progress"
(:variant :double ,(if (null progress) 0 progress))))))
;; macOS/GNUstep NS support.
(declare-function ns-badge "nsfns.m")
(declare-function ns-request-user-attention "nsfns.m")
(declare-function ns-progress-indicator "nsfns.m")
(cl-defmethod system-taskbar--enable (&context
(system-taskbar--back-end (eql 'ns)))
(ignore))
(cl-defmethod system-taskbar--disable (&context
(system-taskbar--back-end (eql 'ns)))
(ignore))
(cl-defmethod system-taskbar--badge (&context
(system-taskbar--back-end (eql 'ns))
&optional count)
"Display COUNT as an overlay on the Dock badge.
If COUNT is an integer or a non-empty string, display that. If COUNT is
nil or an empty string, clear the badge overlay.
Note: NS will abbreviate long strings to fit the badge's allocated
space."
(cond ((stringp count)
(when (string-empty-p count)
(setq count nil)))
((integerp count)
(setq count (number-to-string count)))
(t (setq count nil)))
(ns-badge count))
(cl-defmethod system-taskbar--attention (&context
(system-taskbar--back-end (eql 'ns))
&optional urgency timeout)
"Request URGENCY user attention on the Dock.
The attention indicator will be cleared after TIMEOUT seconds."
(ns-request-user-attention urgency)
(when (and urgency timeout)
(run-with-timer
timeout
nil
#'system-taskbar-attention nil)))
(cl-defmethod system-taskbar--progress (&context
(system-taskbar--back-end (eql 'ns))
&optional progress)
"Display a progress bar overlay on the Dock and App Switcher.
PROGRESS is a float in the range 0.0 to 1.0.
If PROGRESS is nil, remove the progress bar."
(ns-progress-indicator (system-taskbar--validate-progress progress)))
;; MS-Windows support.
(declare-function w32-badge "w32fns.c")
(declare-function w32-request-user-attention "w32fns.c")
(declare-function w32-progress-indicator "w32fns.c")
(defvar system-taskbar-w32-badge-background "#e75857" ; redish
"w32 badge background RGB triple string.")
(defvar system-taskbar-w32-badge-foreground "#ffffff" ; white
"w32 badge foreground RGB triple string.")
(defun system-taskbar--w32-clear-frame-indicators (frame)
;; NOTE: Update the below if adding new w32 system-taskbar functions.
(with-selected-frame frame
(system-taskbar-badge nil)
(system-taskbar-attention nil)
(system-taskbar-progress nil)))
(cl-defmethod system-taskbar--enable (&context
(system-taskbar--back-end (eql 'w32)))
;; Clear system-taskbar indicators for a frame when it is deleted.
(add-hook 'delete-frame-functions
#'system-taskbar--w32-clear-frame-indicators))
(cl-defmethod system-taskbar--disable (&context
(system-taskbar--back-end (eql 'w32)))
(remove-hook 'delete-frame-functions
#'system-taskbar--w32-clear-frame-indicators))
(cl-defmethod system-taskbar--badge (&context
(system-taskbar--back-end (eql 'w32))
&optional count)
"Display a COUNT overlay on the system taskbar icon.
The taskbar icon target is associated with the selected frame.
If COUNT is an integer or a non-empty string, display that. If COUNT is
nil or an empty string, clear the badge.
Due to MS-Windows icon overlay size limitations, if COUNT is an integer
and is outside the range -99 to 99, display \"-99\" and \"99+\",
respectively, if COUNT is a string longer than 2 characters truncate it
using `truncate-string-to-width'.
Consult `system-taskbar-w32-badge-background' and
`system-taskbar-w32-badge-foreground' for the background and foreground
colors for the painted overlay."
(cond ((stringp count)
(if (string-empty-p count)
(setq count nil)
(when (length> count 2)
(setq count (truncate-string-to-width count 3 0 nil t)))))
((integerp count)
(if (and (> count -100)
(< count 100))
(setq count (number-to-string count))
(if (< count 0)
(setq count "-99")
(setq count "99+"))))
(t (setq count nil)))
(w32-badge count
system-taskbar-w32-badge-background
system-taskbar-w32-badge-foreground))
(cl-defmethod system-taskbar--attention (&context
(system-taskbar--back-end (eql 'w32))
&optional urgency timeout)
"Request URGENCY user attention on the system taskbar icon.
Indicate the icon associated with the selected frame.
If URGENCY is the symbol `informational', flash the taskbar icon.
If URGENCY is the symbol `critical', flash the taskbar icon and the
MS-Windows window frame.
Clear attention indicator after TIMEOUT seconds. If TIMEOUT is nil,
default to MS-Windows default behavior."
(w32-request-user-attention urgency)
(when (and urgency timeout)
(run-with-timer
timeout
nil
#'system-taskbar-attention nil)))
(cl-defmethod system-taskbar--progress (&context
(system-taskbar--back-end (eql 'w32))
&optional progress)
"Display a progress bar on the system taskbar icon.
PROGRESS is a float in the range 0.0 to 1.0.
If PROGRESS is nil, remove the progress bar."
(w32-progress-indicator (system-taskbar--validate-progress progress)))
(provide 'system-taskbar)
;;; system-taskbar.el ends here

128
src/nsfns.m
View file

@ -3674,6 +3674,129 @@ The position is returned as a cons cell (X . Y) of the
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 @@ - (Lisp_Object)lispString
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 @@ - (Lisp_Object)lispString
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");
}

327
src/w32fns.c
View file

@ -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");