cgit.sxemacs.org Git - riece/blob - lisp/riece-desktop-notify.el

   1 ;;; riece-desktop-notify.el --- Display notification to desktop -*- lexical-binding: t -*-
   2 ;; Copyright (C) 2009 OHASHI Akira
   3
   4 ;; Author: OHASHI Akira <bg66@koka-in.org>
   5 ;; Created: 2009-03-29
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; NOTE: This is an add-on module for Riece.
  28
  29 ;; riece-desktop-notify.el needs an external program to notify desktop.
  30 ;; The setting prepared beforehand for most popular OS uses the
  31 ;; following external programs.
  32 ;;
  33 ;; Mac OS X:
  34 ;;   growlnotify <URL:http://growl.info/extras.php#growlnotify>
  35 ;;   (of course you need Growl <URL:http://growl.info>)
  36 ;;
  37 ;; GNU/Linux:
  38 ;;   notify-send (which is included in libnotify)
  39 ;;    <URL:http://www.galago-project.org/news/index.php>
  40 ;;
  41 ;;  If you use Debian, you can install it by the following command:
  42 ;;
  43 ;;    % sudo aptitude install libnotify-bin
  44 ;;
  45 ;; Windows:
  46 ;;   Snarl_CMD.exe <URL:http://tlhan-ghun.de/?q=node/59>
  47 ;;   (of course you need Snarl <URL:http://www.fullphat.net/>)
  48
  49 ;;; Code:
  50
  51 (require 'riece-message)
  52 (eval-when-compile (require 'riece-keyword))
  53
  54 (defconst riece-desktop-notify-description
  55   "Display notification to desktop.")
  56
  57 (defgroup riece-desktop-notify nil
  58   "Display notification to desktop."
  59   :group 'riece)
  60
  61 (defcustom riece-desktop-notify-title-function
  62   #'(lambda (message)
  63       (format "%s said in %s..."
  64               (riece-identity-prefix (riece-message-speaker message))
  65               (riece-identity-prefix (riece-message-target message))))
  66   "*The function which make title.
  67 This function must have only one message object as argument."
  68   :type 'function
  69   :group 'riece-desktop-notify)
  70
  71 (defcustom riece-desktop-notify-message-function 'riece-format-message
  72   "*The function which make message.
  73 This function must have only one message object as argument."
  74   :type 'function
  75   :group 'riece-desktop-notify)
  76
  77 (defcustom riece-desktop-notify-coding-system (terminal-coding-system)
  78   "*Coding system used to notify desktop."
  79   :type 'coding-system
  80   :group 'riece-desktop-notify)
  81
  82 (defcustom riece-desktop-notify-icon
  83   (expand-file-name "riece-notify-icon.png" riece-data-directory)
  84   "*Icon to display in desktop notifications."
  85   :type '(file :must-match t)
  86   :group 'riece-desktop-notify)
  87
  88 (defcustom riece-desktop-notify-type
  89   (if (eq system-type 'linux) 'gnu/linux system-type)
  90   "*The type to notify desktop."
  91   :type '(radio (const :tag "Like Darwin" darwin)
  92                 (const :tag "Like GNU/Linux" gnu/linux)
  93                 (const :tag "Like Windows" windows-nt)
  94                 (symbol :tag "The other type"))
  95   :group 'riece-desktop-notify)
  96
  97 ;; for Darwin
  98 (defcustom riece-desktop-notify-darwin-program "growlnotify"
  99   "*The program name to notify for darwin."
 100   :type 'file
 101   :group 'riece-desktop-notify)
 102
 103 (defcustom riece-desktop-notify-darwin-args
 104   '("-t" title "-m" message "-H" "localhost")
 105   "*The Arguments to notify for darwin."
 106   :type '(repeat (radio (string :tag "Argument")
 107                         (const :tag "Title" title)
 108                         (const :tag "Message" message)))
 109   :group 'riece-desktop-notify)
 110
 111 ;; for GNU/Linux
 112 (defcustom riece-desktop-notify-gnu/linux-program "notify-send"
 113   "*The program name to notify for GNU/Linux."
 114   :type 'file
 115   :group 'riece-desktop-notify)
 116
 117 (defcustom riece-desktop-notify-gnu/linux-args
 118   '("-i" icon "-u" "low" title message)
 119   "*The Arguments to notify for GNU/Linux."
 120   :type '(repeat (radio (string :tag "Argument")
 121                         (const :tag "Title" title)
 122                         (const :tag "Message" message)
 123                         (const :tag "Icon" icon)))
 124   :group 'riece-desktop-notify)
 125
 126 ;; for Windows
 127 (defcustom riece-desktop-notify-windows-nt-program "snarl_cmd.exe"
 128   "*The program name to notify for Windows."
 129   :type 'file
 130   :group 'riece-desktop-notify)
 131
 132 (defcustom riece-desktop-notify-windows-nt-args
 133   '("snShowMessage" "-1" title message)
 134   "*The Arguments string to notify for Windows."
 135   :type '(repeat (radio (string :tag "Argument")
 136                         (const :tag "Title" title)
 137                         (const :tag "Message" message)))
 138   :group 'riece-desktop-notify)
 139
 140 ;; stolen and modified from riece-ruby.el
 141 (defun riece-desktop-notify-substitute-variables (args alist)
 142   "Substitute symbols in ARGS by looking up ALIST."
 143   (setq args (copy-sequence args))
 144   (while alist
 145     (let ((pointer args))
 146       (while pointer
 147         (setq pointer (memq (car (car alist)) args))
 148         (if pointer
 149             (setcar pointer (cdr (car alist))))))
 150     (setq alist (cdr alist)))
 151   args)
 152
 153 (defsubst riece-desktop-notify-make-symbol (symbol)
 154   (intern (format "riece-desktop-notify-%s-%s"
 155                   (symbol-name riece-desktop-notify-type)
 156                   (symbol-name symbol))))
 157
 158 (defvar riece-desktop-notify-last-message nil
 159   "The previous message we have seen in
 160 `riece-desktop-notify-keyword-notify-function'.")
 161
 162 (defun riece-desktop-notify-keyword-notify-function (_keyword message)
 163   ;; Don't send notification multiple times for a single message.
 164   (unless (eq riece-desktop-notify-last-message message)
 165     (let ((program-symbol (riece-desktop-notify-make-symbol 'program))
 166           (args-symbol (riece-desktop-notify-make-symbol 'args)))
 167       (when (and (boundp program-symbol) (boundp args-symbol))
 168         (let ((program (eval program-symbol))
 169               (args (eval args-symbol)))
 170           (when (fboundp 'executable-find)
 171             (setq program (executable-find program)))
 172           (when (stringp program)
 173             (let ((title (funcall riece-desktop-notify-title-function message))
 174                   (message (funcall riece-desktop-notify-message-function
 175                                     message)))
 176               (condition-case nil
 177                   (apply #'call-process program nil 0 nil
 178                          (riece-desktop-notify-substitute-variables
 179                           args
 180                           (list (cons 'title
 181                                       (encode-coding-string
 182                                        title
 183                                        riece-desktop-notify-coding-system))
 184                                 (cons 'message
 185                                       (encode-coding-string
 186                                        message
 187                                        riece-desktop-notify-coding-system))
 188                                 (cons 'icon
 189                                       riece-desktop-notify-icon))))
 190                 (file-error nil))))))))
 191   (setq riece-desktop-notify-last-message message))
 192
 193 (defun riece-desktop-notify-requires ()
 194   '(riece-keyword))
 195
 196 (defun riece-desktop-notify-insinuate ()
 197   (add-hook 'riece-keyword-notify-functions
 198             'riece-desktop-notify-keyword-notify-function))
 199
 200 (defun riece-desktop-notify-uninstall ()
 201   (remove-hook 'riece-keyword-notify-functions
 202                'riece-desktop-notify-keyword-notify-function))
 203
 204 (provide 'riece-desktop-notify)
 205
 206 ;;; riece-desktop-notify.el ends here