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