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. * 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 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. * 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 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 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 + and +. + * 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 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." ;; 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. 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 @@ +;;; 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 . + +;;; 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 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 @@ 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"); } 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 . */ #include #define COBJMACROS /* Ask for C definitions for COM. */ +#if !defined MINGW_W64 && !defined CYGWIN +# define INITGUID +#endif +#include #include +#include #include #include #include @@ -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");