diff options
author | Yuri D'Elia <wavexx@users.noreply.github.com> | 2017-01-30 14:43:28 +0100 |
---|---|---|
committer | GitHub <noreply@github.com> | 2017-01-30 14:43:28 +0100 |
commit | 66bfa697c49973f3bbc47bcde2304b1f16d30309 (patch) | |
tree | e1eebcb982399727bf02840fdecd959f77c36553 /gnus-desktop-notify.el | |
parent | 6eea368514eb38bc36aee0bc5d948a214784a90c (diff) | |
parent | c1d0d5504e67588796897ed8f15aa7c9839e8944 (diff) |
Merge pull request #5 from basil-conto/master
Remove obsolete assoc library and refactor
Diffstat (limited to 'gnus-desktop-notify.el')
-rw-r--r-- | gnus-desktop-notify.el | 105 |
1 files changed, 60 insertions, 45 deletions
diff --git a/gnus-desktop-notify.el b/gnus-desktop-notify.el index 1179d21..271d7f5 100644 --- a/gnus-desktop-notify.el +++ b/gnus-desktop-notify.el @@ -78,9 +78,9 @@ ;; Feel free to send suggestions and patches to wavexx AT thregr.org ;;; Code: -(require 'assoc) -(require 'gnus-group) + (require 'format-spec) +(require 'gnus-group) (unless (require 'alert nil t) (require 'notifications nil t)) (eval-when-compile @@ -117,7 +117,8 @@ details." (remove-hook 'gnus-started-hook 'gnus-desktop-notify-check)))) -;; Custom variables +;;; Custom variables + (defcustom gnus-desktop-notify-function (cond ((featurep 'alert) 'gnus-desktop-notify-alert) ((featurep 'notifications) 'gnus-desktop-notify-dbus) @@ -202,8 +203,8 @@ the `gnus-parameters' variable, or interactively by pressing 'G c' in the group buffer." :type 'symbol) +;;; Group parameters -;; Group parameters (gnus-define-group-parameter group-notify :type bool @@ -211,12 +212,23 @@ c' in the group buffer." the notification of new messages (depending on the value of `gnus-desktop-notify-groups')." t)) -;; Functions +;;; Internals + +(defvar gnus-desktop-notify-counts () + "Map Gnus group names to their total number of articles.") + +(defvar gnus-desktop-notify-html-lut + '(("&" . "&") + ("<" . "<" ) + (">" . ">" )) + "Map special characters to their HTML entities.") + (defun gnus-desktop-notify-escape-html-entities (str) - (setq str (replace-regexp-in-string "&" "&" str)) - (setq str (replace-regexp-in-string "<" "<" str)) - (setq str (replace-regexp-in-string ">" ">" str)) - str) + "Escape HTML character entity references." + (let* ((lut gnus-desktop-notify-html-lut) + (chars (format "[%s]" (mapconcat #'car lut "")))) + (replace-regexp-in-string + chars (lambda (s) (cdr (assoc-string s lut))) str))) (defun gnus-desktop-notify-arg (group) (format-spec gnus-desktop-notify-format @@ -224,6 +236,45 @@ the notification of new messages (depending on the value of ?n (cdr group) ?G (gnus-desktop-notify-escape-html-entities (car group))))) +(defun gnus-desktop-notify-read-count (group) + (let* ((range (gnus-range-normalize (gnus-info-read group))) + (count (gnus-last-element range))) + (or (cdr-safe count) count))) + +(defun gnus-desktop-short-group-name (group) + "Collapse GROUP name. +See `gnus-desktop-notify-uncollapsed-levels' for ways to control +collapsing." + (if gnus-desktop-notify-uncollapsed-levels + (gnus-short-group-name group gnus-desktop-notify-uncollapsed-levels) + group)) + +(defun gnus-desktop-notify-check (&rest _ignored) + (interactive) + (let ((updated-groups ())) + (dolist (g gnus-newsrc-alist) + (let* ((name (gnus-info-group g)) + (read (gnus-desktop-notify-read-count g)) + (unread (gnus-group-unread name))) + (when (and (numberp read) (numberp unread)) + (let* ((count (+ read unread)) + (old-count (lax-plist-get gnus-desktop-notify-counts name)) + (delta (- count (or old-count count))) + (notify (gnus-group-find-parameter name 'group-notify))) + (when (eq gnus-desktop-notify-groups + (if notify + 'gnus-desktop-notify-explicit + 'gnus-desktop-notify-all-except)) + (setq gnus-desktop-notify-counts + (lax-plist-put gnus-desktop-notify-counts name count)) + (when (and (> unread 0) (> delta 0)) + (push (cons (gnus-desktop-short-group-name name) delta) + updated-groups))))))) + (when (and updated-groups (not (called-interactively-p 'any))) + (funcall gnus-desktop-notify-function updated-groups)))) + +;;; Notification functions + (defun gnus-desktop-notify-exec (groups) "Call a program defined by `gnus-desktop-notify-exec-program'. with each argument being a group formatted according to @@ -285,41 +336,5 @@ the behavior defined by `gnus-desktop-notify-behavior'." (alert (mapconcat 'identity groups "\n") :title gnus-desktop-notify-send-subject))))) - -;; Internals -(setq gnus-desktop-notify-counts '()) - -(defun gnus-desktop-notify-read-count (group) - (let ( (count (gnus-last-element (gnus-range-normalize (gnus-info-read group)))) ) - (if (listp count) (cdr count) count))) - -(defun gnus-desktop-notify-check (&rest ignored) - (interactive) - (let ( (updated-groups '()) ) - (dolist (g gnus-newsrc-alist) - (let* ( (name (gnus-info-group g)) - (read (gnus-desktop-notify-read-count g)) - (unread (gnus-group-unread name)) ) - (when (and (numberp read) (numberp unread)) - (let ( (count (+ read unread)) - (old-count (cdr (assoc name gnus-desktop-notify-counts))) - (notify (gnus-group-find-parameter name 'group-notify)) ) - (when (or - (and (eq gnus-desktop-notify-groups 'gnus-desktop-notify-all-except) (not notify)) - (and (eq gnus-desktop-notify-groups 'gnus-desktop-notify-explicit) notify)) - (aput 'gnus-desktop-notify-counts name count) - (when (and - unread (> unread 0) - old-count (> count old-count)) - (setq updated-groups - (cons (cons (if gnus-desktop-notify-uncollapsed-levels - (gnus-short-group-name name gnus-desktop-notify-uncollapsed-levels) - name) - (- count old-count)) - updated-groups)))))))) - (when (and updated-groups (not (called-interactively-p 'any))) - (funcall gnus-desktop-notify-function updated-groups)))) - - (provide 'gnus-desktop-notify) ;;; gnus-desktop-notify.el ends here |