Compare commits
No commits in common. "e5952e241f20ac05e352f809c61d4a73749b6b7d" and "2d28bdf85e5205a2db0b55ac6e9346a1085998f2" have entirely different histories.
e5952e241f
...
2d28bdf85e
|
|
@ -1,102 +0,0 @@
|
|||
;;; alert-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" "alert.el" (0 0 0 0))
|
||||
;;; Generated autoloads from alert.el
|
||||
|
||||
(autoload 'alert-add-rule "alert" "\
|
||||
Programmatically add an alert configuration rule.
|
||||
|
||||
Normally, users should custoimze `alert-user-configuration'.
|
||||
This facility is for module writers and users that need to do
|
||||
things the Lisp way.
|
||||
|
||||
Here is a rule the author currently uses with ERC, so that the
|
||||
fringe gets colored whenever people chat on BitlBee:
|
||||
|
||||
\(alert-add-rule :status \\='(buried visible idle)
|
||||
:severity \\='(moderate high urgent)
|
||||
:mode \\='erc-mode
|
||||
:predicate
|
||||
#\\='(lambda (info)
|
||||
(string-match (concat \"\\\\`[^&].*@BitlBee\\\\\\='\")
|
||||
(erc-format-target-and/or-network)))
|
||||
:persistent
|
||||
#\\='(lambda (info)
|
||||
;; If the buffer is buried, or the user has been
|
||||
;; idle for `alert-reveal-idle-time' seconds,
|
||||
;; make this alert persistent. Normally, alerts
|
||||
;; become persistent after
|
||||
;; `alert-persist-idle-time' seconds.
|
||||
(memq (plist-get info :status) \\='(buried idle)))
|
||||
:style \\='fringe
|
||||
:continue t)
|
||||
|
||||
\(fn &key SEVERITY STATUS MODE CATEGORY TITLE MESSAGE PREDICATE ICON (STYLE alert-default-style) PERSISTENT CONTINUE NEVER-PERSIST APPEND)" nil nil)
|
||||
|
||||
(autoload 'alert "alert" "\
|
||||
Alert the user that something has happened.
|
||||
MESSAGE is what the user will see. You may also use keyword
|
||||
arguments to specify additional details. Here is a full example:
|
||||
|
||||
\(alert \"This is a message\"
|
||||
:severity \\='high ;; The default severity is `normal'
|
||||
:title \"Title\" ;; An optional title
|
||||
:category \\='example ;; A symbol to identify the message
|
||||
:mode \\='text-mode ;; Normally determined automatically
|
||||
:buffer (current-buffer) ;; This is the default
|
||||
:data nil ;; Unused by alert.el itself
|
||||
:persistent nil ;; Force the alert to be persistent;
|
||||
;; it is best not to use this
|
||||
:never-persist nil ;; Force this alert to never persist
|
||||
:id \\='my-id) ;; Used to replace previous message of
|
||||
;; the same id in styles that support it
|
||||
:style \\='fringe) ;; Force a given style to be used;
|
||||
;; this is only for debugging!
|
||||
:icon \\=\"mail-message-new\" ;; if style supports icon then add icon
|
||||
;; name or path here
|
||||
|
||||
If no :title is given, the buffer-name of :buffer is used. If
|
||||
:buffer is nil, it is the current buffer at the point of call.
|
||||
|
||||
:data is an opaque value which modules can pass through to their
|
||||
own styles if they wish.
|
||||
|
||||
Here are some more typical examples of usage:
|
||||
|
||||
;; This is the most basic form usage
|
||||
(alert \"This is an alert\")
|
||||
|
||||
;; You can adjust the severity for more important messages
|
||||
(alert \"This is an alert\" :severity \\='high)
|
||||
|
||||
;; Or decrease it for purely informative ones
|
||||
(alert \"This is an alert\" :severity \\='trivial)
|
||||
|
||||
;; Alerts can have optional titles. Otherwise, the title is the
|
||||
;; buffer-name of the (current-buffer) where the alert originated.
|
||||
(alert \"This is an alert\" :title \"My Alert\")
|
||||
|
||||
;; Further, alerts can have categories. This allows users to
|
||||
;; selectively filter on them.
|
||||
(alert \"This is an alert\" :title \"My Alert\"
|
||||
:category \\='some-category-or-other)
|
||||
|
||||
\(fn MESSAGE &key (SEVERITY \\='normal) TITLE ICON CATEGORY BUFFER MODE DATA STYLE PERSISTENT NEVER-PERSIST ID)" nil nil)
|
||||
|
||||
(register-definition-prefixes "alert" '("alert-" "x-urgen"))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; alert-autoloads.el ends here
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;;; Generated package description from alert.el -*- no-byte-compile: t -*-
|
||||
(define-package "alert" "20221213.1619" "Growl-style notification system for Emacs" '((gntp "0.1") (log4e "0.3.0") (cl-lib "0.5")) :commit "c762380ff71c429faf47552a83605b2578656380" :authors '(("John Wiegley" . "jwiegley@gmail.com")) :maintainer '("John Wiegley" . "jwiegley@gmail.com") :keywords '("notification" "emacs" "message") :url "https://github.com/jwiegley/alert")
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,29 +0,0 @@
|
|||
;;; 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
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;;; 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")
|
||||
|
|
@ -1,316 +0,0 @@
|
|||
;;; 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
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
;;; gntp-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 "gntp" "gntp.el" (0 0 0 0))
|
||||
;;; Generated autoloads from gntp.el
|
||||
|
||||
(autoload 'gntp-notify "gntp" "\
|
||||
Send notification NAME with TITLE, TEXT, PRIORITY and ICON to SERVER:PORT.
|
||||
PORT defaults to `gntp-server-port'
|
||||
|
||||
\(fn NAME TITLE TEXT SERVER &optional PORT PRIORITY ICON)" nil nil)
|
||||
|
||||
(register-definition-prefixes "gntp" '("gntp-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; gntp-autoloads.el ends here
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;;; Generated package description from gntp.el -*- no-byte-compile: t -*-
|
||||
(define-package "gntp" "20141025.250" "Growl Notification Protocol for Emacs" 'nil :commit "767571135e2c0985944017dc59b0be79af222ef5" :authors '(("Engelke Eschner" . "tekai@gmx.li")) :maintainer '("Engelke Eschner" . "tekai@gmx.li"))
|
||||
|
|
@ -1,244 +0,0 @@
|
|||
;;; gntp.el --- Growl Notification Protocol for Emacs -*- lexical-binding: t -*-
|
||||
|
||||
;; Author: Engelke Eschner <tekai@gmx.li>
|
||||
;; Version: 0.1
|
||||
;; Package-Version: 20141025.250
|
||||
;; Package-Commit: 767571135e2c0985944017dc59b0be79af222ef5
|
||||
;; Created: 2013-03-21
|
||||
|
||||
;; LICENSE
|
||||
;; Copyright (c) 2013 Engelke Eschner
|
||||
;; All rights reserved.
|
||||
|
||||
;; Redistribution and use in source and binary forms, with or without
|
||||
;; modification, are permitted provided that the following conditions
|
||||
;; are met:
|
||||
;; * Redistributions of source code must retain the above copyright
|
||||
;; notice, this list of conditions and the following disclaimer.
|
||||
;; * Redistributions in binary form must reproduce the above
|
||||
;; copyright notice, this list of conditions and the following
|
||||
;; disclaimer in the documentation and/or other materials provided
|
||||
;; with the distribution.
|
||||
;; * Neither the name of the gntp.el nor the names of its
|
||||
;; contributors may be used to endorse or promote products derived
|
||||
;; from this software without specific prior written permission.
|
||||
|
||||
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT
|
||||
;; HOLDER> BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
|
||||
;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
|
||||
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
|
||||
;; OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
|
||||
;;; Commentary:
|
||||
;; This package implements the Growl Notification Protocol GNTP
|
||||
;; described at http://www.growlforwindows.com/gfw/help/gntp.aspx
|
||||
;; It is incomplete as it only lets you send but not receive
|
||||
;; notifications.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup gntp nil
|
||||
"GNTP, send/register growl notifications via GNTP from within emacs."
|
||||
:group 'external)
|
||||
|
||||
(defcustom gntp-application-name "Emacs/gntp.el"
|
||||
"Name of the application gntp registers itself."
|
||||
:type '(string))
|
||||
|
||||
(defcustom gntp-application-icon nil
|
||||
"Icon to display as the application icon.
|
||||
Either a URL or a path to a file."
|
||||
:type '(string))
|
||||
|
||||
(defcustom gntp-server "localhost"
|
||||
"Default port of the server.
|
||||
Standard says can't be changed, but port-forwarding etc."
|
||||
:type '(string))
|
||||
|
||||
(defcustom gntp-server-port 23053
|
||||
"Default port of the server.
|
||||
Standard says can't be changed, but port-forwarding etc."
|
||||
:type '(integer))
|
||||
|
||||
(defcustom gntp-register-alist nil
|
||||
"Registration item list."
|
||||
:type '(choice string (const nil)))
|
||||
|
||||
(defun gntp-register (&optional notifications server port)
|
||||
(interactive)
|
||||
"Register NOTIFICATIONS at SERVER:PORT.
|
||||
PORT defaults to `gntp-server-port'."
|
||||
(let ((message (gntp-build-message-register (if notifications notifications gntp-register-alist))))
|
||||
(gntp-send message (if server server gntp-server) port)))
|
||||
|
||||
;;;###autoload
|
||||
(defun gntp-notify (name title text server &optional port priority icon)
|
||||
"Send notification NAME with TITLE, TEXT, PRIORITY and ICON to SERVER:PORT.
|
||||
PORT defaults to `gntp-server-port'"
|
||||
(let ((message (gntp-build-message-notify name title text priority icon)))
|
||||
(gntp-send message server port)))
|
||||
|
||||
(defun gntp-build-message-register (notifications)
|
||||
"Build the message to register NOTIFICATIONS types."
|
||||
(let ((lines (list "GNTP/1.0 REGISTER NONE"
|
||||
(format "Application-Name: %s"
|
||||
gntp-application-name)
|
||||
(format "Notifications-Count: %d"
|
||||
(length notifications))))
|
||||
(icon-uri (gntp-app-icon-uri))
|
||||
(icon-data (gntp-app-icon-data))
|
||||
(icons (list)))
|
||||
|
||||
;; append icon uri
|
||||
(when icon-uri
|
||||
(nconc lines (list (format "Application-Icon: %s" icon-uri)))
|
||||
;; and data when it exists
|
||||
(when icon-data
|
||||
(setq icons (cons icon-data icons))))
|
||||
|
||||
(dolist (notice notifications)
|
||||
;; "For each notification being registered:
|
||||
;; Each notification being registered should be seperated by a
|
||||
;; blank line, including the first notification
|
||||
(nconc lines (cons "" (gntp-notification-lines notice)))
|
||||
;; c
|
||||
(let ((icon (gntp-notice-icon-data notice)))
|
||||
(when icon
|
||||
(nconc icons (list "" icon)))))
|
||||
|
||||
;; icon data must come last
|
||||
(when icons
|
||||
(nconc lines (cons "" icons)))
|
||||
|
||||
(mapconcat 'identity (remove nil lines) "\r\n")))
|
||||
|
||||
(defun gntp-notification-lines (notice)
|
||||
"Transform NOTICE into a list of strings."
|
||||
(let ((display-name (gntp-notice-get notice :display))
|
||||
(enabled (gntp-notice-get notice :enabled))
|
||||
(icon-uri (gntp-notice-icon-uri notice)))
|
||||
(list
|
||||
;; Required - The name (type) of the notification being registered
|
||||
(concat "Notification-Name: " (gntp-notice-name notice))
|
||||
;; Optional - The name of the notification that is displayed to
|
||||
;; the user (defaults to the same value as Notification-Name)
|
||||
(when display-name
|
||||
(concat "Notification-Display-Name: " display-name))
|
||||
;; Optional - Indicates if the notification should be enabled by
|
||||
;; default (defaults to False)
|
||||
(when enabled
|
||||
"Notification-Enabled: True")
|
||||
;; Optional - The default icon to use for notifications of this type
|
||||
(when icon-uri
|
||||
(concat "Notification-Icon: " icon-uri)))))
|
||||
|
||||
(defun gntp-build-message-notify (name title text &optional priority icon)
|
||||
"Build a message of type NAME with TITLE and TEXT."
|
||||
|
||||
(format
|
||||
"GNTP/1.0 NOTIFY NONE\r\n\
|
||||
Application-Name: %s\r\n\
|
||||
Notification-Name: %s\r\n\
|
||||
Notification-Title: %s\r\n\
|
||||
Notification-Text: %s\r\n\
|
||||
Notification-Priority: %s\r\n\
|
||||
Notification-Icon: %s\r\n\
|
||||
\r\n"
|
||||
gntp-application-name
|
||||
(if (symbolp name) (symbol-name name) name)
|
||||
title
|
||||
;; no CRLF in the text to avoid accidentel msg end
|
||||
(replace-regexp-in-string "\r\n" "\n" text)
|
||||
(if priority priority "0")
|
||||
(if icon (gntp-icon-uri icon) "")))
|
||||
|
||||
;; notice
|
||||
;;(list name ; everthing else is optional
|
||||
;; :display "name to display"
|
||||
;; :enabled nil
|
||||
;; :icon "url or file")
|
||||
|
||||
|
||||
(defun gntp-notice-icon-uri (notice)
|
||||
"Get the icon URI from NOTICE."
|
||||
(gntp-icon-uri (gntp-notice-get notice :icon)))
|
||||
|
||||
(defun gntp-notice-icon-data (notice)
|
||||
"Get icon data from NOTICE."
|
||||
(gntp-icon-data (gntp-notice-get notice :icon)))
|
||||
|
||||
(defun gntp-app-icon-uri ()
|
||||
"Return the value to be used in the Application-Icon header."
|
||||
(gntp-icon-uri gntp-application-icon))
|
||||
|
||||
(defun gntp-app-icon-data ()
|
||||
"Return the value to be used in the Application-Icon header."
|
||||
(gntp-icon-data gntp-application-icon))
|
||||
|
||||
(defun gntp-icon-uri (icon)
|
||||
"Get the URI of ICON."
|
||||
(when icon
|
||||
(cond ((string-equal (substring icon 0 7) "http://") icon)
|
||||
((and (file-exists-p icon) (file-readable-p icon))
|
||||
(concat "x-growl-resource://" (md5 icon))))))
|
||||
|
||||
(defun gntp-icon-data (icon)
|
||||
"Get the URI of ICON."
|
||||
(when (and icon (not (string-equal (substring icon 0 7) "http://"))
|
||||
(file-exists-p icon) (file-readable-p icon))
|
||||
(let ((id (md5 icon))
|
||||
(data (gntp-file-string icon)))
|
||||
(format "Identifier: %s\r\nLength: %d\r\n\r\n%s"
|
||||
id (length data) data))))
|
||||
|
||||
(defun gntp-notice-name (notice)
|
||||
"Get the name of NOTICE. The name must be either a symbol or string."
|
||||
(let ((name (car notice)))
|
||||
(if (symbolp name)
|
||||
(symbol-name name)
|
||||
name)))
|
||||
|
||||
(defun gntp-notice-get (notice property)
|
||||
"Get PROPERTY from NOTICE."
|
||||
(plist-get (cdr notice) property))
|
||||
|
||||
(defun gntp-send (message server &optional port)
|
||||
"Send MESSAGE to SERVER:PORT. PORT defaults to `gntp-server-port'."
|
||||
(let ((proc (make-network-process
|
||||
:name "gntp"
|
||||
:host server
|
||||
:server nil
|
||||
:service (if port port gntp-server-port)
|
||||
;;:sentinel 'gntp-sentinel
|
||||
:filter 'gntp-filter)))
|
||||
;; hmm one CRLF too much?
|
||||
(process-send-string proc (concat message "\r\n\r\n\r\n"))))
|
||||
|
||||
(defun gntp-filter (proc string)
|
||||
"Filter for PROC started by `gntp-send'.
|
||||
Argument STRING reply from the server."
|
||||
(when (string-equal "GNTP/1.0 -ERROR" (substring string 0 15))
|
||||
(error "GNTP: Something went wrong take a look at the reply:\n %s"
|
||||
string)))
|
||||
|
||||
;; (defun gntp-sentinel (proc msg)
|
||||
;; (when (string= msg "connection broken by remote peer\n")
|
||||
;; (message (format "client %s has quit" proc))))
|
||||
|
||||
|
||||
(defun gntp-file-string (file)
|
||||
"Read the contents of a FILE and return as a string."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents-literally file)
|
||||
(buffer-string)))
|
||||
|
||||
(provide 'gntp)
|
||||
|
||||
;;; gntp.el ends here
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
;;; log4e-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 "log4e" "log4e.el" (0 0 0 0))
|
||||
;;; Generated autoloads from log4e.el
|
||||
|
||||
(autoload 'log4e-mode "log4e" "\
|
||||
Major mode for browsing a buffer made by log4e.
|
||||
|
||||
\\<log4e-mode-map>
|
||||
\\{log4e-mode-map}
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'log4e:insert-start-log-quickly "log4e" "\
|
||||
Insert logging statment for trace level log at start of current function/macro." t nil)
|
||||
|
||||
(register-definition-prefixes "log4e" '("log4e"))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; log4e-autoloads.el ends here
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;;; Generated package description from log4e.el -*- no-byte-compile: t -*-
|
||||
(define-package "log4e" "20211019.948" "provide logging framework for elisp" 'nil :commit "737d275eac28dbdfb0b26d28e99da148bfce9d16" :authors '(("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) :maintainer '("Hiroaki Otsu" . "ootsuhiroaki@gmail.com") :keywords '("log") :url "https://github.com/aki2o/log4e")
|
||||
|
|
@ -1,592 +0,0 @@
|
|||
;;; log4e.el --- provide logging framework for elisp
|
||||
|
||||
;; Copyright (C) 2013 Hiroaki Otsu
|
||||
|
||||
;; Author: Hiroaki Otsu <ootsuhiroaki@gmail.com>
|
||||
;; Keywords: log
|
||||
;; Package-Version: 20211019.948
|
||||
;; Package-Commit: 737d275eac28dbdfb0b26d28e99da148bfce9d16
|
||||
;; URL: https://github.com/aki2o/log4e
|
||||
;; Version: 0.3.3
|
||||
|
||||
;; 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This file 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This extension provides logging framework for elisp.
|
||||
|
||||
;;; Dependency:
|
||||
;;
|
||||
;; Nothing.
|
||||
|
||||
;;; Installation:
|
||||
;;
|
||||
;; Put this to your load-path.
|
||||
;; And put the following lines in your elisp file.
|
||||
;;
|
||||
;; (require 'log4e)
|
||||
|
||||
;;; Configuration:
|
||||
;;
|
||||
;; See <https://github.com/aki2o/log4e/blob/master/README.md>
|
||||
;; Otherwise, eval following sexp.
|
||||
;; (describe-function 'log4e:deflogger)
|
||||
|
||||
;;; API:
|
||||
;;
|
||||
;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "log4e:" :docstring t)
|
||||
;; `log4e:next-log'
|
||||
;; Move to start of next log on log4e-mode.
|
||||
;; `log4e:previous-log'
|
||||
;; Move to start of previous log on log4e-mode.
|
||||
;; `log4e:insert-start-log-quickly'
|
||||
;; Insert logging statment for trace level log at start of current function/macro.
|
||||
;;
|
||||
;; *** END auto-documentation
|
||||
;;
|
||||
;; For detail, see <https://github.com/aki2o/log4e/blob/master/README.md>
|
||||
;;
|
||||
;; [Note] Other than listed above, Those specifications may be changed without notice.
|
||||
|
||||
;;; Tested On:
|
||||
;;
|
||||
;; - Emacs ... GNU Emacs 23.3.1 (i386-mingw-nt5.1.2600) of 2011-08-15 on GNUPACK
|
||||
|
||||
|
||||
;; Enjoy!!!
|
||||
|
||||
|
||||
;;; Code:
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(require 'rx)
|
||||
|
||||
|
||||
(defconst log4e-log-level-alist '((fatal . 6)
|
||||
(error . 5)
|
||||
(warn . 4)
|
||||
(info . 3)
|
||||
(debug . 2)
|
||||
(trace . 1))
|
||||
"Alist of log level value.")
|
||||
|
||||
(defconst log4e-default-logging-function-name-alist '((fatal . "log-fatal")
|
||||
(error . "log-error")
|
||||
(warn . "log-warn")
|
||||
(info . "log-info")
|
||||
(debug . "log-debug")
|
||||
(trace . "log-trace"))
|
||||
"Alist of logging function name at default.")
|
||||
|
||||
|
||||
(defmacro log4e--def-symmaker (symnm)
|
||||
`(progn
|
||||
(defsubst ,(intern (concat "log4e--make-symbol-" symnm)) (prefix)
|
||||
(intern (concat ,(format "log4e--%s-" symnm) prefix)))))
|
||||
|
||||
(log4e--def-symmaker "log-buffer")
|
||||
(log4e--def-symmaker "msg-buffer")
|
||||
(log4e--def-symmaker "log-template")
|
||||
(log4e--def-symmaker "time-template")
|
||||
(log4e--def-symmaker "min-level")
|
||||
(log4e--def-symmaker "max-level")
|
||||
(log4e--def-symmaker "toggle-logging")
|
||||
(log4e--def-symmaker "toggle-debugging")
|
||||
(log4e--def-symmaker "buffer-coding-system")
|
||||
(log4e--def-symmaker "author-mail-address")
|
||||
|
||||
(defmacro log4e--def-level-logger (prefix suffix level)
|
||||
(let ((argform (if suffix
|
||||
'(msg &rest msgargs)
|
||||
'(level msg &rest msgargs)))
|
||||
(buff (log4e--make-symbol-log-buffer prefix))
|
||||
(msgbuff (log4e--make-symbol-msg-buffer prefix))
|
||||
(codsys (log4e--make-symbol-buffer-coding-system prefix))
|
||||
(logtmpl (log4e--make-symbol-log-template prefix))
|
||||
(timetmpl (log4e--make-symbol-time-template prefix))
|
||||
(minlvl (log4e--make-symbol-min-level prefix))
|
||||
(maxlvl (log4e--make-symbol-max-level prefix))
|
||||
(logging-p (log4e--make-symbol-toggle-logging prefix)))
|
||||
`(progn
|
||||
|
||||
;; Define logging function
|
||||
(defun ,(intern (concat prefix "--" (or suffix "log"))) ,argform
|
||||
,(format "Do logging for %s level log.
|
||||
%sMSG/MSGARGS are passed to `format'."
|
||||
(if suffix level "any")
|
||||
(if suffix "" "LEVEL is symbol as a log level in '(trace debug info warn error fatal).\n"))
|
||||
(let ((log4e--current-msg-buffer ,msgbuff))
|
||||
(apply 'log4e--logging ,buff ,codsys ,logtmpl ,timetmpl ,minlvl ,maxlvl ,logging-p ,(if suffix level 'level) msg msgargs)))
|
||||
|
||||
;; Define logging macro
|
||||
(defmacro ,(intern (concat prefix "--" (or suffix "log") "*")) ,argform
|
||||
,(format "Do logging for %s level log.
|
||||
%sMSG/MSGARGS are passed to `format'.
|
||||
Evaluation of MSGARGS is invoked only if %s level log should be printed."
|
||||
(if suffix level "any")
|
||||
(if suffix "" "LEVEL is symbol as a log level in '(trace debug info warn error fatal).\n")
|
||||
(if suffix level "the"))
|
||||
(let (,@(if suffix (list `(level ',level)) '())
|
||||
(buff (log4e--make-symbol-log-buffer ,prefix))
|
||||
(msgbuff (log4e--make-symbol-msg-buffer ,prefix))
|
||||
(codsys (log4e--make-symbol-buffer-coding-system ,prefix))
|
||||
(logtmpl (log4e--make-symbol-log-template ,prefix))
|
||||
(timetmpl (log4e--make-symbol-time-template ,prefix))
|
||||
(minlvl (log4e--make-symbol-min-level ,prefix))
|
||||
(maxlvl (log4e--make-symbol-max-level ,prefix))
|
||||
(logging-p (log4e--make-symbol-toggle-logging ,prefix)))
|
||||
`(let ((log4e--current-msg-buffer ,msgbuff))
|
||||
(when (and ,logging-p
|
||||
(log4e--logging-level-p ,minlvl ,maxlvl ,level))
|
||||
(log4e--logging ,buff ,codsys ,logtmpl ,timetmpl ,minlvl ,maxlvl ,logging-p ,level ,msg ,@msgargs)))))
|
||||
|
||||
)))
|
||||
|
||||
(defsubst log4e--logging-level-p (minlevel maxlevel currlevel)
|
||||
(let ((minlvlvalue (or (assoc-default minlevel log4e-log-level-alist)
|
||||
1))
|
||||
(maxlvlvalue (or (assoc-default maxlevel log4e-log-level-alist)
|
||||
6))
|
||||
(currlvlvalue (or (assoc-default currlevel log4e-log-level-alist)
|
||||
0)))
|
||||
(and (>= currlvlvalue minlvlvalue)
|
||||
(<= currlvlvalue maxlvlvalue))))
|
||||
|
||||
(defsubst log4e--get-or-create-log-buffer (buffnm &optional codesys)
|
||||
(or (get-buffer buffnm)
|
||||
(let ((buff (get-buffer-create buffnm)))
|
||||
(with-current-buffer buff
|
||||
(log4e-mode)
|
||||
(when codesys
|
||||
(setq buffer-file-coding-system codesys)))
|
||||
buff)))
|
||||
|
||||
(defvar log4e--regexp-msg-format
|
||||
(rx-to-string `(and "%"
|
||||
(* (any "+#-0")) ; flags
|
||||
(* (any "0-9")) ; width
|
||||
(? "." (+ (any "0-9"))) ; precision
|
||||
(any "a-zA-Z"))))
|
||||
|
||||
(defsubst log4e--insert-log (logtmpl timetmpl level msg msgargs propertize-p)
|
||||
(let ((timetext (format-time-string timetmpl))
|
||||
(lvltext (format "%-05s" (upcase (symbol-name level))))
|
||||
(buffer-read-only nil))
|
||||
(when propertize-p
|
||||
(put-text-property 0 (length timetext) 'face 'font-lock-doc-face timetext)
|
||||
(put-text-property 0 (length lvltext) 'face 'font-lock-keyword-face lvltext))
|
||||
(let* ((logtext logtmpl)
|
||||
(logtext (replace-regexp-in-string "%t" timetext logtext))
|
||||
(logtext (replace-regexp-in-string "%l" lvltext logtext))
|
||||
(logtext (replace-regexp-in-string "%m" msg logtext))
|
||||
(begin (point)))
|
||||
(insert logtext "\n")
|
||||
(when propertize-p
|
||||
(put-text-property begin (+ begin 1) 'log4e--level level))
|
||||
(cl-loop initially (goto-char begin)
|
||||
while (and msgargs
|
||||
(re-search-forward log4e--regexp-msg-format nil t))
|
||||
do (let* ((currtype (match-string-no-properties 0))
|
||||
(currarg (pop msgargs))
|
||||
(failfmt nil)
|
||||
(currtext (condition-case e
|
||||
(format currtype currarg)
|
||||
(error (setq failfmt t)
|
||||
(format "=%s=" (error-message-string e))))))
|
||||
(save-match-data
|
||||
(when propertize-p
|
||||
(ignore-errors
|
||||
(cond (failfmt (put-text-property 0 (length currtext) 'face 'font-lock-warning-face currtext))
|
||||
(t (put-text-property 0 (length currtext) 'face 'font-lock-string-face currtext))))))
|
||||
(replace-match currtext t t)))
|
||||
(goto-char begin))))
|
||||
|
||||
(defvar log4e--current-msg-buffer nil)
|
||||
|
||||
;; We needs this signature be stay for other compiled plugins using old version
|
||||
(defun log4e--logging (buffnm codsys logtmpl timetmpl minlevel maxlevel logging-p level msg &rest msgargs)
|
||||
(when (and logging-p
|
||||
(log4e--logging-level-p minlevel maxlevel level))
|
||||
(save-match-data
|
||||
(with-current-buffer (log4e--get-or-create-log-buffer buffnm codsys)
|
||||
(goto-char (point-max))
|
||||
(let* ((buffer-read-only nil)
|
||||
(begin (point))
|
||||
(currlog (progn
|
||||
(log4e--insert-log logtmpl timetmpl level msg msgargs t)
|
||||
(goto-char (point-max))
|
||||
(buffer-substring-no-properties begin (point))))
|
||||
(msgbuf (or (when (and log4e--current-msg-buffer
|
||||
(not (eq log4e--current-msg-buffer t)))
|
||||
(ignore-errors (get-buffer log4e--current-msg-buffer)))
|
||||
log4e--current-msg-buffer)))
|
||||
(when msgbuf
|
||||
(let ((standard-output (if (buffer-live-p msgbuf)
|
||||
msgbuf
|
||||
standard-output)))
|
||||
(princ currlog))))
|
||||
nil))))
|
||||
|
||||
(defun log4e--get-current-log-line-level ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(get-text-property (point) 'log4e--level)))
|
||||
|
||||
;; We needs this signature be stay for other plugins compiled with this old version
|
||||
(defun log4e--clear-log (buffnm)
|
||||
(with-current-buffer (log4e--get-or-create-log-buffer buffnm)
|
||||
(setq buffer-read-only nil)
|
||||
(erase-buffer)))
|
||||
|
||||
;; We needs this signature be stay for other plugins compiled with this old version
|
||||
(defun log4e--open-log (buffnm)
|
||||
(let* ((buff (get-buffer buffnm)))
|
||||
(if (not (buffer-live-p buff))
|
||||
(message "[Log4E] Not exist log buffer.")
|
||||
(with-current-buffer buff
|
||||
(setq buffer-read-only t))
|
||||
(pop-to-buffer buff))))
|
||||
|
||||
;; We needs this signature be stay for other plugins compiled with this old version
|
||||
(defun log4e--open-log-if-debug (buffnm dbg)
|
||||
(when dbg
|
||||
(log4e--open-log buffnm)))
|
||||
|
||||
;; (defun log4e--send-report-if-not-debug (buffnm dbg addr prefix)
|
||||
;; (let* ((buff (get-buffer buffnm)))
|
||||
;; (when (and (not dbg)
|
||||
;; (stringp addr)
|
||||
;; (buffer-live-p buff))
|
||||
;; (reporter-submit-bug-report addr prefix nil nil nil nil))))
|
||||
|
||||
|
||||
(defmacro log4e:deflogger (prefix msgtmpl timetmpl &optional log-function-name-custom-alist)
|
||||
"Define the functions of logging for your elisp.
|
||||
|
||||
Specification:
|
||||
After eval this, you can use the functions for supporting about logging. They are the following ...
|
||||
- do logging for each log level. Log level are trace, debug, info, warn, error and fatal.
|
||||
- set max and min log level.
|
||||
- switch logging.
|
||||
- switch debugging.
|
||||
- open and clear log buffer.
|
||||
- send bug report for you.
|
||||
For details, see Functions section.
|
||||
|
||||
Argument:
|
||||
- PREFIX is string as your elisp prefix.
|
||||
- MSGTMPL is string as format of log. The following words has a special meaning.
|
||||
- %t ... Replaced with time string. About it, see TIMETMPL argument.
|
||||
- %l ... Replaced with log level. They are 'TRACE', 'DEBUG', 'INFO', 'WARN', 'ERROR', 'FATAL'.
|
||||
- %m ... Replaced with log message that passed by you.
|
||||
- TIMETMPL is string as format of time. This value is passed to `format-time-string'.
|
||||
- LOG-FUNCTION-NAME-CUSTOM-ALIST is alist as the function name of logging.
|
||||
- If this value is nil, define the following functions.
|
||||
yourprefix--log-trace
|
||||
yourprefix--log-debug
|
||||
...
|
||||
yourprefix--log-fatal
|
||||
- If you want to custom the name of them, give like the following value.
|
||||
'((fatal . \"fatal\")
|
||||
(error . \"error\")
|
||||
(warn . \"warn\")
|
||||
(info . \"info\")
|
||||
(debug . \"debug\")
|
||||
(trace . \"trace\"))
|
||||
Then, define the following functions.
|
||||
yourprefix--trace
|
||||
yourprefix--debug
|
||||
...
|
||||
yourprefix--fatal
|
||||
|
||||
Functions:
|
||||
List all functions defined below. PREFIX is your prefix.
|
||||
- PREFIX--log-fatal ... #1
|
||||
- PREFIX--log-error ... #1
|
||||
- PREFIX--log-warn ... #1
|
||||
- PREFIX--log-info ... #1
|
||||
- PREFIX--log-debug ... #1
|
||||
- PREFIX--log-trace ... #1
|
||||
- PREFIX--log-fatal* ... #2
|
||||
- PREFIX--log-error* ... #2
|
||||
- PREFIX--log-warn* ... #2
|
||||
- PREFIX--log-info* ... #2
|
||||
- PREFIX--log-debug* ... #2
|
||||
- PREFIX--log-trace* ... #2
|
||||
- PREFIX--log
|
||||
- PREFIX--log-set-level
|
||||
- PREFIX--log-enable-logging ... #3
|
||||
- PREFIX--log-disable-logging ... #3
|
||||
- PREFIX--log-enable-messaging ... #3
|
||||
- PREFIX--log-disable-messaging ... #3
|
||||
- PREFIX--log-enable-debugging ... #3
|
||||
- PREFIX--log-disable-debugging ... #3
|
||||
- PREFIX--log-debugging-p
|
||||
- PREFIX--log-set-coding-system
|
||||
- PREFIX--log-set-author-mail-address
|
||||
- PREFIX--log-clear-log ... #3
|
||||
- PREFIX--log-open-log ... #3
|
||||
- PREFIX--log-open-log-if-debug
|
||||
|
||||
#1 : You can customize this name
|
||||
#2 : Name is a #1 name + \"*\"
|
||||
#3 : This is command
|
||||
|
||||
Example:
|
||||
;; If you develop elisp that has prefix \"hoge\", write and eval the following sexp in your elisp file.
|
||||
|
||||
(require 'log4e)
|
||||
(log4e:deflogger \"hoge\" \"%t [%l] %m\" \"%H:%M:%S\")
|
||||
|
||||
;; Eval the following
|
||||
(hoge--log-enable-logging)
|
||||
|
||||
;; Then, write the following
|
||||
|
||||
(defun hoge-do-hoge (hoge)
|
||||
(if (not (stringp hoge))
|
||||
(hoge--log-fatal \"failed do hoge : hoge is '%s'\" hoge)
|
||||
(hoge--log-debug \"start do hoge about '%s'\" hoge)
|
||||
(message \"hoge!\")
|
||||
(hoge--log-info \"done hoge about '%s'\" hoge)))
|
||||
|
||||
;; Eval the following
|
||||
(hoge-do-hoge \"HOGEGE\")
|
||||
|
||||
;; Do M-x hoge--log-open-log
|
||||
;; Open the buffer which name is \" *log4e-hoge*\". The buffer string is below
|
||||
12:34:56 [INFO ] done hoge about 'HOGEGE'
|
||||
|
||||
;; Eval the following
|
||||
(hoge--log-set-level 'trace)
|
||||
(hoge-do-hoge \"FUGAGA\")
|
||||
|
||||
;; Do M-x hoge--log-open-log
|
||||
;; Open the buffer. its string is below
|
||||
12:34:56 [INFO ] done hoge about 'HOGEGE'
|
||||
12:35:43 [DEBUG] start do hoge about 'FUGAGA'
|
||||
12:35:43 [INFO ] done hoge about 'FUGAGA'
|
||||
|
||||
"
|
||||
(declare (indent 0))
|
||||
(if (or (not (stringp prefix)) (string= prefix "")
|
||||
(not (stringp msgtmpl)) (string= msgtmpl "")
|
||||
(not (stringp timetmpl)) (string= timetmpl ""))
|
||||
(message "[LOG4E] invalid argument of deflogger")
|
||||
(let* ((bufsym (log4e--make-symbol-log-buffer prefix))
|
||||
(msgbufsym (log4e--make-symbol-msg-buffer prefix))
|
||||
(logtmplsym (log4e--make-symbol-log-template prefix))
|
||||
(timetmplsym (log4e--make-symbol-time-template prefix))
|
||||
(minlvlsym (log4e--make-symbol-min-level prefix))
|
||||
(maxlvlsym (log4e--make-symbol-max-level prefix))
|
||||
(tglsym (log4e--make-symbol-toggle-logging prefix))
|
||||
(dbgsym (log4e--make-symbol-toggle-debugging prefix))
|
||||
(codsyssym (log4e--make-symbol-buffer-coding-system prefix))
|
||||
(addrsym (log4e--make-symbol-author-mail-address prefix))
|
||||
(funcnm-alist (cl-loop with custom-alist = (car (cdr log-function-name-custom-alist))
|
||||
for lvl in '(fatal error warn info debug trace)
|
||||
for lvlpair = (assq lvl custom-alist)
|
||||
for fname = (or (cdr-safe lvlpair) "")
|
||||
collect (or (if (string-match "\*" fname)
|
||||
(progn
|
||||
(message "[LOG4E] ignore %s level name in log-function-name-custom-alist. can't use '*' for the name." lvl)
|
||||
nil)
|
||||
lvlpair)
|
||||
(assq lvl log4e-default-logging-function-name-alist)))))
|
||||
`(progn
|
||||
|
||||
;; Define variable for prefix
|
||||
(defvar ,bufsym (format " *log4e-%s*" ,prefix))
|
||||
(defvar ,logtmplsym ,msgtmpl)
|
||||
(defvar ,timetmplsym ,timetmpl)
|
||||
(defvar ,minlvlsym 'info)
|
||||
(defvar ,maxlvlsym 'fatal)
|
||||
(defvar ,tglsym nil)
|
||||
(defvar ,msgbufsym nil)
|
||||
(defvar ,dbgsym nil)
|
||||
(defvar ,codsyssym nil)
|
||||
(defvar ,addrsym nil)
|
||||
|
||||
;; Define level set function
|
||||
(defun ,(intern (concat prefix "--log-set-level")) (minlevel &optional maxlevel)
|
||||
"Set range for doing logging.
|
||||
|
||||
MINLEVEL is symbol of lowest level for doing logging. its default is 'info.
|
||||
MAXLEVEL is symbol of highest level for doing logging. its default is 'fatal."
|
||||
(setq ,minlvlsym minlevel)
|
||||
(setq ,maxlvlsym maxlevel))
|
||||
|
||||
;; Define logging toggle function
|
||||
(defun ,(intern (concat prefix "--log-enable-logging")) ()
|
||||
"Enable logging by logging functions."
|
||||
(interactive)
|
||||
(setq ,tglsym t))
|
||||
(defun ,(intern (concat prefix "--log-disable-logging")) ()
|
||||
"Disable logging by logging functions."
|
||||
(interactive)
|
||||
(setq ,tglsym nil))
|
||||
|
||||
;; Define messaging toggle function
|
||||
(defun ,(intern (concat prefix "--log-enable-messaging")) (&optional buffer)
|
||||
"Enable dump the log into other buffer by logging functions.
|
||||
|
||||
BUFFER is a buffer dumped log into. nil means *Messages* buffer."
|
||||
(interactive)
|
||||
(setq ,msgbufsym (or buffer t)))
|
||||
(defun ,(intern (concat prefix "--log-disable-messaging")) ()
|
||||
"Disable dump the log into other buffer by logging functions."
|
||||
(interactive)
|
||||
(setq ,msgbufsym nil))
|
||||
|
||||
;; Define debugging toggle function
|
||||
(defun ,(intern (concat prefix "--log-enable-debugging")) ()
|
||||
"Enable debugging and logging.
|
||||
|
||||
`PREFIX--log-debugging-p' will return t."
|
||||
(interactive)
|
||||
(setq ,tglsym t)
|
||||
(setq ,dbgsym t))
|
||||
(defun ,(intern (concat prefix "--log-disable-debugging")) ()
|
||||
"Disable debugging.
|
||||
|
||||
`PREFIX--log-debugging-p' will return nil."
|
||||
(interactive)
|
||||
(setq ,dbgsym nil))
|
||||
(defun ,(intern (concat prefix "--log-debugging-p")) ()
|
||||
,dbgsym)
|
||||
|
||||
;; Define coding system set funtion
|
||||
(defun ,(intern (concat prefix "--log-set-coding-system")) (coding-system)
|
||||
"Set charset and linefeed of LOG-BUFFER.
|
||||
|
||||
CODING-SYSTEM is symbol for setting to `buffer-file-coding-system'.
|
||||
LOG-BUFFER is a buffer which name is \" *log4e-PREFIX*\"."
|
||||
(setq ,codsyssym coding-system))
|
||||
|
||||
;; ;; Define author mail set function
|
||||
;; (defun ,(intern (concat prefix "--log-set-author-mail-address")) (before-atmark after-atmark)
|
||||
;; "Set mail address of author for elisp that has PREFIX. This value is used SEND-REPORT.
|
||||
|
||||
;; BEFORE-ATMARK is string as part of mail address. If your address is \"hoge@example.co.jp\", it is \"hoge\".
|
||||
;; AFTER-ATMARK is string as part of mail address. If your address is \"hoge@example.co.jp\", it is \"example.co.jp\".
|
||||
;; SEND-REPORT is `PREFIX--log-send-report-if-not-debug'."
|
||||
;; (setq ,addrsym (concat before-atmark "@" after-atmark)))
|
||||
|
||||
;; Define log buffer handle function
|
||||
(defun ,(intern (concat prefix "--log-clear-log")) ()
|
||||
"Clear buffer string of buffer which name is \" *log4e-PREFIX*\"."
|
||||
(interactive)
|
||||
(log4e--clear-log ,bufsym))
|
||||
(defun ,(intern (concat prefix "--log-open-log")) ()
|
||||
"Open buffer which name is \" *log4e-PREFIX*\"."
|
||||
(interactive)
|
||||
(log4e--open-log ,bufsym))
|
||||
(defun ,(intern (concat prefix "--log-open-log-if-debug")) ()
|
||||
"Open buffer which name is \" *log4e-PREFIX*\" if debugging is enabled."
|
||||
(log4e--open-log-if-debug ,bufsym ,dbgsym))
|
||||
|
||||
;; ;; Define report send function
|
||||
;; (defun ,(intern (concat prefix "--log-send-report-if-not-debug")) ()
|
||||
;; "Send bug report to author if debugging is disabled.
|
||||
|
||||
;; The author mailaddress is set by `PREFIX--log-set-author-mail-address'.
|
||||
;; About the way of sending bug report, see `reporter-submit-bug-report'."
|
||||
;; (log4e--send-report-if-not-debug ,bufsym ,dbgsym ,addrsym ,prefix))
|
||||
|
||||
;; Define each level logging function
|
||||
(log4e--def-level-logger ,prefix nil nil)
|
||||
(log4e--def-level-logger ,prefix ,(assoc-default 'fatal funcnm-alist) 'fatal)
|
||||
(log4e--def-level-logger ,prefix ,(assoc-default 'error funcnm-alist) 'error)
|
||||
(log4e--def-level-logger ,prefix ,(assoc-default 'warn funcnm-alist) 'warn)
|
||||
(log4e--def-level-logger ,prefix ,(assoc-default 'info funcnm-alist) 'info)
|
||||
(log4e--def-level-logger ,prefix ,(assoc-default 'debug funcnm-alist) 'debug)
|
||||
(log4e--def-level-logger ,prefix ,(assoc-default 'trace funcnm-alist) 'trace)
|
||||
|
||||
))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode log4e-mode view-mode "Log4E"
|
||||
"Major mode for browsing a buffer made by log4e.
|
||||
|
||||
\\<log4e-mode-map>
|
||||
\\{log4e-mode-map}"
|
||||
(define-key log4e-mode-map (kbd "J") 'log4e:next-log)
|
||||
(define-key log4e-mode-map (kbd "K") 'log4e:previous-log))
|
||||
|
||||
(defun log4e:next-log ()
|
||||
"Move to start of next log on log4e-mode."
|
||||
(interactive)
|
||||
(let* ((level))
|
||||
(while (and (not level)
|
||||
(< (point) (point-max)))
|
||||
(forward-line 1)
|
||||
(setq level (log4e--get-current-log-line-level)))
|
||||
level))
|
||||
|
||||
(defun log4e:previous-log ()
|
||||
"Move to start of previous log on log4e-mode."
|
||||
(interactive)
|
||||
(let* ((level))
|
||||
(while (and (not level)
|
||||
(> (point) (point-min)))
|
||||
(forward-line -1)
|
||||
(setq level (log4e--get-current-log-line-level)))
|
||||
level))
|
||||
|
||||
;;;###autoload
|
||||
(defun log4e:insert-start-log-quickly ()
|
||||
"Insert logging statment for trace level log at start of current function/macro."
|
||||
(interactive)
|
||||
(let* ((fstartpt (when (re-search-backward "(\\(?:defun\\|defmacro\\|defsubst\\)\\*? +\\([^ ]+\\) +(\\([^)]*\\))" nil t)
|
||||
(point)))
|
||||
(fncnm (when fstartpt (match-string-no-properties 1)))
|
||||
(argtext (when fstartpt (match-string-no-properties 2)))
|
||||
(prefix (save-excursion
|
||||
(goto-char (point-min))
|
||||
(cl-loop while (re-search-forward "(log4e:deflogger[ \n]+\"\\([^\"]+\\)\"" nil t)
|
||||
for prefix = (match-string-no-properties 1)
|
||||
for currface = (get-text-property (match-beginning 0) 'face)
|
||||
if (not (eq currface 'font-lock-comment-face))
|
||||
return prefix))))
|
||||
(when (and fstartpt prefix)
|
||||
(let* ((fncnm (replace-regexp-in-string (concat "\\`" prefix "[^a-zA-Z0-9]+") "" fncnm))
|
||||
(fncnm (replace-regexp-in-string "-" " " fncnm))
|
||||
(argtext (replace-regexp-in-string "\n" " " argtext))
|
||||
(argtext (replace-regexp-in-string "^ +" "" argtext))
|
||||
(argtext (replace-regexp-in-string " +$" "" argtext))
|
||||
(args (split-string argtext " +"))
|
||||
(args (cl-loop for arg in args
|
||||
if (and (not (string= arg ""))
|
||||
(not (string-match "\\`&" arg)))
|
||||
collect arg))
|
||||
(logtext (cl-loop with ret = (format "start %s." fncnm)
|
||||
for arg in args
|
||||
do (setq ret (concat ret " " arg "[%s]"))
|
||||
finally return ret))
|
||||
(sexpformat (cl-loop with ret = "(%s--log 'trace \"%s\""
|
||||
for arg in args
|
||||
do (setq ret (concat ret " %s"))
|
||||
finally return (concat ret ")")))
|
||||
(inserttext (apply 'format sexpformat prefix logtext args)))
|
||||
(forward-char)
|
||||
(forward-sexp 3)
|
||||
(when (re-search-forward "\\=[ \n]+\"" nil t)
|
||||
(forward-char -1)
|
||||
(forward-sexp))
|
||||
(newline-and-indent)
|
||||
(insert inserttext)))))
|
||||
|
||||
|
||||
(provide 'log4e)
|
||||
;;; log4e.el ends here
|
||||
|
|
@ -1,22 +0,0 @@
|
|||
;;; org-alert-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 "org-alert" "org-alert.el" (0 0 0 0))
|
||||
;;; Generated autoloads from org-alert.el
|
||||
|
||||
(register-definition-prefixes "org-alert" '("org-alert-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; org-alert-autoloads.el ends here
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;;; Generated package description from org-alert.el -*- no-byte-compile: t -*-
|
||||
(define-package "org-alert" "20220721.1721" "Notify org deadlines via notify-send" '((org "9.0") (alert "1.2")) :commit "f1801e061722843329b95409957c7dbd5cc223e9" :authors '(("Stephen Pegoraro" . "spegoraro@tutive.com")) :maintainer '("Stephen Pegoraro" . "spegoraro@tutive.com") :keywords '("org" "org-mode" "notify" "notifications" "calendar") :url "https://github.com/spegoraro/org-alert")
|
||||
|
|
@ -1,169 +0,0 @@
|
|||
;;; org-alert.el --- Notify org deadlines via notify-send
|
||||
|
||||
;; Copyright (C) 2015 Stephen Pegoraro
|
||||
|
||||
;; Author: Stephen Pegoraro <spegoraro@tutive.com>
|
||||
;; Version: 0.2.0
|
||||
;; Package-Version: 20220721.1721
|
||||
;; Package-Commit: f1801e061722843329b95409957c7dbd5cc223e9
|
||||
;; Package-Requires: ((org "9.0") (alert "1.2"))
|
||||
;; Keywords: org, org-mode, notify, notifications, calendar
|
||||
;; URL: https://github.com/spegoraro/org-alert
|
||||
|
||||
;; 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 3 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package provides functions to display system notifications for
|
||||
;; any org-mode deadlines that are due in your agenda. To perform a
|
||||
;; one-shot check call (org-alert-deadlines). To enable repeated
|
||||
;; checking call (org-alert-enable) and to disable call
|
||||
;; (org-alert-disable). You can set the checking interval by changing
|
||||
;; the org-alert-interval variable to the number of seconds you'd
|
||||
;; like.
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'alert)
|
||||
(require 'org-agenda)
|
||||
|
||||
|
||||
(defvar org-alert-interval 300
|
||||
"Interval in seconds to recheck and display deadlines.")
|
||||
|
||||
;; TODO look for a property of the agenda entry as suggested in
|
||||
;; https://github.com/spegoraro/org-alert/issues/20
|
||||
(defvar org-alert-notify-cutoff 10
|
||||
"Time in minutes before a deadline a notification should be sent.")
|
||||
|
||||
(defvar org-alert-notify-after-event-cutoff nil
|
||||
"Time in minutes after a deadline to stop sending notifications.
|
||||
If nil, never stop sending notifications.")
|
||||
|
||||
(defvar org-alert-notification-title "*org*"
|
||||
"Title to be sent with notify-send.")
|
||||
|
||||
(defvar org-alert-match-string
|
||||
"SCHEDULED>=\"<today>\"+SCHEDULED<\"<tomorrow>\"|DEADLINE>=\"<today>\"+DEADLINE<\"<tomorrow>\""
|
||||
"property/todo/tags match string to be passed to `org-map-entries'.")
|
||||
|
||||
(defvar org-alert-time-match-string
|
||||
"\\(?:SCHEDULED\\|DEADLINE\\):.*<.*\\([0-9]\\{2\\}:[0-9]\\{2\\}\\).*>"
|
||||
"regex to find times in an org subtree. The first capture group
|
||||
is used to extract the time")
|
||||
|
||||
(defun org-alert--read-subtree ()
|
||||
"Return the current subtree as a string. Adapted from
|
||||
`org-copy-subtree` from org-mode."
|
||||
(org-preserve-local-variables
|
||||
(let (beg end folded (beg0 (point)))
|
||||
(org-back-to-heading t)
|
||||
(setq beg (point))
|
||||
(skip-chars-forward " \t\r\n")
|
||||
(save-match-data
|
||||
(save-excursion (outline-end-of-heading)
|
||||
(setq folded (org-invisible-p)))
|
||||
(ignore-errors (org-forward-heading-same-level (1- n) t))
|
||||
(org-end-of-subtree t t))
|
||||
;; Include the end of an inlinetask
|
||||
(when (and (featurep 'org-inlinetask)
|
||||
(looking-at-p (concat (org-inlinetask-outline-regexp)
|
||||
"END[ \t]*$")))
|
||||
(end-of-line))
|
||||
(setq end (point))
|
||||
(goto-char beg0)
|
||||
(when (> end beg)
|
||||
(setq org-subtree-clip-folded folded)
|
||||
(buffer-substring-no-properties beg end)))))
|
||||
|
||||
;; I think this is unnecessary now that we're using read-subtree
|
||||
;; instead of copy-subtree
|
||||
(defun org-alert--strip-text-properties (text)
|
||||
"Strip all of the text properties from a copy of TEXT and
|
||||
return the stripped copy"
|
||||
(let ((text (substring text)))
|
||||
(set-text-properties 0 (length text) nil text)
|
||||
text))
|
||||
|
||||
(defun org-alert--grab-subtree ()
|
||||
"Return the current org subtree as a string with the
|
||||
text-properties stripped"
|
||||
(let* ((subtree (org-alert--read-subtree))
|
||||
(text (org-alert--strip-text-properties subtree)))
|
||||
(apply #'concat
|
||||
(cl-remove-if #'(lambda (s) (string= s ""))
|
||||
(cdr (split-string text "\n"))))))
|
||||
|
||||
(defun org-alert--to-minute (hour minute)
|
||||
"Convert HOUR and MINUTE to minutes"
|
||||
(+ (* 60 hour) minute))
|
||||
|
||||
(defun org-alert--check-time (time &optional now)
|
||||
"Check if TIME is less than `org-alert-notify-cutoff` from NOW. If
|
||||
`org-alert-notify-after-event-cutoff` is set, also check that NOW
|
||||
is less than `org-alert-notify-after-event-cutoff` past TIME."
|
||||
(let* ((time (mapcar #'string-to-number (split-string time ":")))
|
||||
(now (or now (decode-time (current-time))))
|
||||
(now (org-alert--to-minute (decoded-time-hour now) (decoded-time-minute now)))
|
||||
(then (org-alert--to-minute (car time) (cadr time)))
|
||||
(time-until (- then now)))
|
||||
(if org-alert-notify-after-event-cutoff
|
||||
(and
|
||||
(<= time-until org-alert-notify-cutoff)
|
||||
;; negative time-until past events
|
||||
(> time-until (- org-alert-notify-after-event-cutoff)))
|
||||
(<= time-until org-alert-notify-cutoff))))
|
||||
|
||||
(defun org-alert--parse-entry ()
|
||||
"Parse an entry from the org agenda and return a list of the
|
||||
heading and the scheduled/deadline time"
|
||||
(let ((head (org-alert--strip-text-properties (org-get-heading t t t t)))
|
||||
(body (org-alert--grab-subtree)))
|
||||
(string-match org-alert-time-match-string body)
|
||||
(list head (match-string 1 body))))
|
||||
|
||||
(defun org-alert--dispatch ()
|
||||
(let* ((entry (org-alert--parse-entry))
|
||||
(head (car entry))
|
||||
(time (cadr entry)))
|
||||
(if time
|
||||
(when (org-alert--check-time time)
|
||||
(alert (concat time ": " head) :title org-alert-notification-title))
|
||||
(alert head :title org-alert-notification-title))))
|
||||
|
||||
(defun org-alert-check ()
|
||||
"Check for active, due deadlines and initiate notifications."
|
||||
(interactive)
|
||||
(org-map-entries 'org-alert--dispatch org-alert-match-string 'agenda
|
||||
'(org-agenda-skip-entry-if 'todo
|
||||
org-done-keywords-for-agenda))
|
||||
t)
|
||||
|
||||
(defun org-alert-enable ()
|
||||
"Enable the notification timer. Cancels existing timer if running."
|
||||
(interactive)
|
||||
(org-alert-disable)
|
||||
(run-at-time 0 org-alert-interval 'org-alert-check))
|
||||
|
||||
(defun org-alert-disable ()
|
||||
"Cancel the running notification timer."
|
||||
(interactive)
|
||||
(dolist (timer timer-list)
|
||||
(if (eq (elt timer 5) 'org-alert-check)
|
||||
(cancel-timer timer))))
|
||||
|
||||
(provide 'org-alert)
|
||||
;;; org-alert.el ends here
|
||||
15
org/init.el
15
org/init.el
|
|
@ -63,24 +63,14 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; additional packages
|
||||
(add-to-list 'package-selected-packages
|
||||
'(ox-hugo org-super-agenda org-alert alert-toast alert)
|
||||
'(ox-hugo org-super-agenda org-alert)
|
||||
)
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; Load misc extensions
|
||||
(require 'org)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; org-alert - windows only
|
||||
(when (eq system-type 'windows-nt)
|
||||
(use-package org-alert)
|
||||
(use-package alert-toast :after alert)
|
||||
(setq alert-default-style 'toast)
|
||||
(setq org-alert-interval 300
|
||||
org-alert-notify-cutoff 15
|
||||
org-alert-notify-after-event-cutoff 86400)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; Update/add auto file handling
|
||||
|
|
@ -224,5 +214,4 @@
|
|||
;; Your init file should contain only one such instance.
|
||||
;; If there is more than one, they won't work right.
|
||||
'(custom-safe-themes
|
||||
'("dde643b0efb339c0de5645a2bc2e8b4176976d5298065b8e6ca45bc4ddf188b7" "bfc0b9c3de0382e452a878a1fb4726e1302bf9da20e69d6ec1cd1d5d82f61e3d" default))
|
||||
)
|
||||
'("dde643b0efb339c0de5645a2bc2e8b4176976d5298065b8e6ca45bc4ddf188b7" "bfc0b9c3de0382e452a878a1fb4726e1302bf9da20e69d6ec1cd1d5d82f61e3d" default)))
|
||||
|
|
|
|||
Reference in a new issue