add alert-toast to org profile

This commit is contained in:
KemoNine 2023-02-25 09:09:47 -05:00
parent e3d0589559
commit 356980b7ce
3 changed files with 347 additions and 0 deletions

View File

@ -0,0 +1,29 @@
;;; alert-toast-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "alert-toast" "alert-toast.el" (0 0 0 0))
;;; Generated autoloads from alert-toast.el
(autoload 'alert-toast-notify "alert-toast" "\
Send INFO using Windows 10 toast notification.
Handles :ICON, :SEVERITY, :PERSISTENT, :NEVER-PERSIST, :TITLE and
:MESSAGE keywords from INFO plist.
\(fn INFO)" nil nil)
(register-definition-prefixes "alert-toast" '("alert-toast-"))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; alert-toast-autoloads.el ends here

View File

@ -0,0 +1,2 @@
;;; Generated package description from alert-toast.el -*- no-byte-compile: t -*-
(define-package "alert-toast" "20220312.229" "Windows 10 toast notifications" '((emacs "25.1") (alert "1.2") (f "0.20.0") (s "1.12.0")) :commit "96c88c93c1084de681700f655223142ee0eb944a" :authors '(("Grzegorz Kowzan" . "grzegorz@kowzan.eu")) :maintainer '("Grzegorz Kowzan" . "grzegorz@kowzan.eu") :url "https://github.com/gkowzan/alert-toast")

View File

@ -0,0 +1,316 @@
;;; alert-toast.el --- Windows 10 toast notifications -*- lexical-binding: t; -*-
;; Copyright 2020, 2022 Grzegorz Kowzan
;; Author: Grzegorz Kowzan <grzegorz@kowzan.eu>
;; Created: 25 Oct 2020
;; Updated: 25 Mar 2022
;; Version: 1.0.0
;; Package-Version: 20220312.229
;; Package-Commit: 96c88c93c1084de681700f655223142ee0eb944a
;; Package-Requires: ((emacs "25.1") (alert "1.2") (f "0.20.0") (s "1.12.0"))
;; Url: https://github.com/gkowzan/alert-toast
;; This program 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 2, or (at
;; your option) any later version.
;; This program 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package defines a new alert style (`toast') for alert.el using Windows
;; 10 toast notifications. It works with native Windows 10 Emacs versions and
;; with Emacs run under Windows Subsystem for Linux (WSL) or under Cygwin. These
;; notifications are limited to a single-line title and four lines of text.
;; Longer text can be passed but it will be truncated by Windows 10.
;;
;; * Icons
;; Icons located on network shares are not supported. This includes icons on the
;; WSL virtual drive, therefore for Emacs running under WSL the default Emacs
;; icon is copied to C:\Users\<user>\AppData\Local\Emacs-Toast\Emacs.png. PNG
;; version is used because toast notifications render SVG graphics as tiny and
;; put them in top left corner of the notification.
;; Under WSL or Cygwin, a path to a custom icon should be given as a WSL/Cygwin
;; path (/mnt/c/... or /cygdrive/c/...) instead of a Windows path (C:\\...).
;;
;; * Priorities
;; Looking at Windows.UI.Notifications API, toast notifications seem to support
;; 2 priority levels: High and Default. Mapping between alert.el priorities and
;; these levels is defined by `alert-toast-priorities'.
;;
;; * Bugs
;; There is an issue in WSL where wslhost.exe dies for no discernible reason,
;; which prevents accessing Windows partitions and executables
;; (https://github.com/microsoft/WSL/issues/6161). If this happens then you
;; should see powershell.exe process failing to start. This will obviously
;; prevent this package from working. The only known workaround is to call `wsl
;; --shutdown' and start WSL again.
;;; Code:
(require 'f)
(require 's)
(require 'alert)
(require 'dom)
(require 'shr)
;; WSL-related functions and constants
;; In the words of WSL developers, there is no official way of testing for WSL
;; but they said at the same time that either "wsl" or "microsoft" should always
;; be present in the kernel release string.
(defun alert-toast--check-wsl ()
"Check if running under Windows Subsystem for Linux."
(and (eq system-type 'gnu/linux)
(let ((kernel-release (shell-command-to-string "uname --kernel-release")))
(or (s-contains? "wsl" kernel-release t)
(s-contains? "microsoft" kernel-release t)))))
(defconst alert-toast--wsl (alert-toast--check-wsl))
(defconst alert-toast--appdir-text "[System.Environment]::GetFolderPath([System.Environment+SpecialFolder]::LocalApplicationData) | Join-Path -ChildPath Emacs-Toast\\Emacs.png")
(defun alert-toast--appdir ()
"Path to Windows user's data directory."
(with-temp-buffer
(let ((coding-system-for-read 'utf-8-dos))
(call-process-region alert-toast--appdir-text nil "powershell.exe" nil t nil "-noprofile" "-NonInteractive" "-WindowStyle" "Hidden" "-Command" "-"))
(s-chomp (buffer-string))))
(defun alert-toast--default-wsl-icon-path ()
"Path to Emacs icon in Windows user's data directory."
(with-temp-buffer
(call-process "wslpath" nil t nil (alert-toast--appdir))
(s-chomp (buffer-string))))
(defun alert-toast--init-wsl-icon ()
"Copy Emacs icon to a Windows-side directory."
(let ((icon-path (alert-toast--default-wsl-icon-path)))
(unless (f-exists? icon-path)
(make-directory (f-parent icon-path) t)
(f-copy (concat data-directory "images/icons/hicolor/128x128/apps/emacs.png")
icon-path))))
(defun alert-toast--icon-path (path)
"Convert icon PATH from WSL/Cygwin to Windows path if needed."
(cond
(alert-toast--wsl
(with-temp-buffer
(call-process "wslpath" nil t nil "-m" path)
(s-chomp (buffer-string))))
((eq system-type 'cygwin)
(with-temp-buffer
(call-process "cygpath.exe" nil t nil "-w" path)
(s-chomp (buffer-string))))
(t path)))
;; Default icon
(defvar alert-toast-default-icon
(if alert-toast--wsl
(alert-toast--default-wsl-icon-path)
(concat data-directory "images/icons/hicolor/128x128/apps/emacs.png"))
"Path to default icon for toast notifications.")
;; Common part -- script body, powershell quoting, priorities and main function
(defconst alert-toast--psquote-replacements
'(("'" . "''")))
(defcustom alert-toast-priorities
'((urgent . "[Windows.UI.Notifications.ToastNotificationPriority]::High")
(high . "[Windows.UI.Notifications.ToastNotificationPriority]::High")
(moderate . "[Windows.UI.Notifications.ToastNotificationPriority]::Default")
(normal . "[Windows.UI.Notifications.ToastNotificationPriority]::Default")
(low . "[Windows.UI.Notifications.ToastNotificationPriority]::Default")
(trivial . "[Windows.UI.Notifications.ToastNotificationPriority]::Default"))
"A mapping of alert severities onto Windows 10 toast priority values."
:type '(alist :key-type symbol :value-type string)
:group 'alert)
(defconst alert-toast--sounds
'((default . "ms-winsoundevent:Notification.Default")
(im . "ms-winsoundevent:Notification.IM")
(mail . "ms-winsoundevent:Notification.Mail")
(reminder . "ms-winsoundevent:Notification.Reminder")
(sms . "ms-winsoundevent:Notification.SMS"))
"Alist of available sounds.")
(defconst alert-toast--looping-sounds
(let ((looping-sounds '((call . "ms-winsoundevent:Notification.Looping.Call")
(alarm . "ms-winsoundevent:Notification.Looping.Alarm"))))
(dolist (i '(2 3 4 5 6 7 8 9 10) looping-sounds)
(setq looping-sounds
(cons `(,(intern (format "call%d" i)) . ,(format "ms-winsoundevent:Notification.Looping.Call%d" i))
looping-sounds))
(setq looping-sounds
(cons `(,(intern (format "alarm%d" i)) . ,(format "ms-winsoundevent:Notification.Looping.Alarm%d" i))
looping-sounds))))
"Alist of available looping sounds.")
(defvar alert-toast--psprocess nil
"Persistent powershell process emitting toast notifications.")
(defun alert-toast--coding-page ()
"Get powershell encoding."
(with-temp-buffer
(let ((coding-system-for-read 'utf-8-dos))
(call-process-region "[console]::InputEncoding.BodyName" nil "powershell.exe" nil t nil "-noprofile" "-NonInteractive" "-WindowStyle" "Hidden" "-Command" "-"))
(intern-soft (s-chomp (buffer-string)))))
(defun alert-toast--psprocess-init ()
"Initialize powershell process."
(setq alert-toast--psprocess
(make-process :name "powershell-toast"
:buffer "*powershell-toast*"
:command '("powershell.exe" "-noprofile" "-NoExit" "-NonInteractive" "-WindowStyle" "Hidden"
"-Command" "-")
:coding (if alert-toast--wsl 'utf-8 (alert-toast--coding-page))
:noquery t
:connection-type 'pipe))
(process-send-string alert-toast--psprocess "[Windows.UI.Notifications.ToastNotificationManager, Windows.UI.Notifications, ContentType = WindowsRuntime] > $null
[Windows.Data.Xml.Dom.XmlDocument, Windows.Data.Xml, ContentType=WindowsRuntime] > $null\n"))
(defun alert-toast--psprocess-kill ()
"Kill powershell process (for debugging)."
(delete-process alert-toast--psprocess)
(setq alert-toast--psprocess nil))
(defun alert-toast--fill-template (title message icon-path &optional audio silent long loop)
"Create alert toast XML document.
Set title to TITLE, message body to MESSAGE and icon to the image at ICON-PATH.
ICON-PATH has to be a native Windows path, use `alert-toast--icon-path' for
Cygwin->native and WSL->native conversion.
AUDIO can be one of symbols defined in `alert-toast--sounds' or
`alert-toast--looping-sounds'. If SILENT is non-nil, the notification is muted.
If LONG is non-nil or one of the sounds in `alert-toast--looping-sounds' was
provided as AUDIO, then the notification will last for ~20 s; otherwise it lasts
for several seconds. Non-nil LOOP will loop the sound."
(let ((looping-sound (alist-get audio alert-toast--looping-sounds))
(dom
(dom-node
'toast nil
(dom-node
'visual nil
(dom-node
'binding
'((template . "ToastImageAndText02"))
(dom-node 'text '((id . "1")) title)
(dom-node 'text '((id . "2")) message)
(dom-node 'image `((id . "1")
(src . ,icon-path)
(placement . "appLogoOverride"))))))))
(when (or audio silent loop)
(dom-append-child
dom (dom-node 'audio `((src . ,(or looping-sound
(alist-get audio alert-toast--sounds)
(alist-get 'default alert-toast--sounds)))
(silent . ,(if silent "true" "false"))
(loop . ,(if (or loop looping-sound) "true" "false"))))))
(when (or long looping-sound)
(dom-set-attribute dom 'duration "long"))
(shr-dom-to-xml dom)))
(defun alert-toast--fill-shoulder (title message icon-path person payload)
"Create shoulder tap XML document.
PERSON is an email address given as 'mailto:login@domain.com' of a contact
previously added to My People. PAYLOAD is either remote http or local path to a
GIF or PNG image. Under WSL and Cygwin, local paths need to be converted to
native Windows paths with `alert-toast--icon-path'.
As a fallback, set title to TITLE, message body to MESSAGE and icon to the image
at ICON-PATH. ICON-PATH has to be a native Windows path, use
`alert-toast--icon-path' for Cygwin->native and WSL->native conversion."
(let ((dom
(dom-node 'toast
`((hint-people . ,person))
(dom-node 'visual nil
(dom-node 'binding '((template . "ToastGeneric"))
(dom-node 'text nil title)
(dom-node 'text nil message)
(dom-node 'image `((src . ,icon-path)
(placement . "appLogoOverride")
(hint-crop . "circle"))))
(dom-node 'binding '((template . "ToastGeneric")
(experienceType . "shoulderTap"))
(dom-node 'image `((src . ,payload))))))))
(shr-dom-to-xml dom)))
(defconst alert-toast--psscript-text "$Xml = New-Object Windows.Data.Xml.Dom.XmlDocument
$Xml.LoadXml('%s')
$Toast = [Windows.UI.Notifications.ToastNotification]::new($Xml)
$Toast.Tag = \"Emacs\"
$Toast.Group = \"Emacs\"
$Toast.Priority = %s
$Toast.ExpirationTime = [DateTimeOffset]::Now.AddSeconds(%f)
$Notifier = [Windows.UI.Notifications.ToastNotificationManager]::CreateToastNotifier(\"Emacs\")
$Notifier.Show($Toast);\n"
"Template of Powershell script emitting regular toast notification.")
(defconst alert-toast--psscript-shoulder "$Xml = New-Object Windows.Data.Xml.Dom.XmlDocument
$Xml.LoadXml('%s')
$Toast = [Windows.UI.Notifications.ToastNotification]::new($Xml)
$Notifier = [Windows.UI.Notifications.ToastNotificationManager]::CreateToastNotifier('Microsoft.People_8wekyb3d8bbwe!x4c7a3b7dy2188y46d4ya362y19ac5a5805e5x')
$Notifier.Show($Toast);\n"
"Template of Powershell script emitting shoulder tap.")
;;;###autoload
(defun alert-toast-notify (info)
"Send INFO using Windows 10 toast notification.
Handles :ICON, :SEVERITY, :PERSISTENT, :NEVER-PERSIST, :TITLE and
:MESSAGE keywords from INFO plist."
(let ((data-plist (plist-get info :data))
psscript)
(if (and (plist-get data-plist :shoulder-person) (plist-get data-plist :shoulder-payload))
(setq psscript (format alert-toast--psscript-shoulder
(s-replace-all alert-toast--psquote-replacements
(alert-toast--fill-shoulder
(plist-get info :title)
(plist-get info :message)
(alert-toast--icon-path
(or (plist-get info :icon)
alert-toast-default-icon))
(plist-get data-plist :shoulder-person)
(plist-get data-plist :shoulder-payload)))))
(setq psscript
(format alert-toast--psscript-text
(s-replace-all alert-toast--psquote-replacements
(alert-toast--fill-template
(plist-get info :title)
(plist-get info :message)
(alert-toast--icon-path (or (plist-get info :icon) alert-toast-default-icon))
(plist-get data-plist :audio)
(plist-get data-plist :silent)
(plist-get data-plist :long)
(plist-get data-plist :loop)))
(or (cdr (assq (plist-get info :severity) alert-toast-priorities))
(cdr (assq 'normal alert-toast-priorities)))
(if (and (plist-get info :persistent)
(not (plist-get info :never-persist)))
(* 60 60 24 7) ; a week
alert-fade-time))))
(unless alert-toast--psprocess
(alert-toast--psprocess-init))
(process-send-string alert-toast--psprocess psscript)))
(alert-define-style 'toast :title "Windows 10 toast notification"
:notifier #'alert-toast-notify)
(when alert-toast--wsl
(alert-toast--init-wsl-icon))
(provide 'alert-toast)
;;; alert-toast.el ends here