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-type
  83   (if (eq system-type 'linux) 'gnu/linux system-type)
  84   "*The type to notify desktop."
  85   :type '(radio (const :tag "Like Darwin" darwin)
  86                 (const :tag "Like GNU/Linux" gnu/linux)
  87                 (const :tag "Like Windows" windows-nt)
  88                 (symbol :tag "The other type"))
  89   :group 'riece-desktop-notify)
  90
  91 ;; for Darwin
  92 (defcustom riece-desktop-notify-darwin-program "growlnotify"
  93   "*The program name to notify for darwin."
  94   :type 'file
  95   :group 'riece-desktop-notify)
  96
  97 (defcustom riece-desktop-notify-darwin-args
  98   '("-t" title "-m" message "-H" "localhost")
  99   "*The Arguments to notify for darwin."
 100   :type '(repeat (radio (string :tag "Argument")
 101                         (const :tag "Title" title)
 102                         (const :tag "Message" message)))
 103   :group 'riece-desktop-notify)
 104
 105 ;; for GNU/Linux
 106 (defcustom riece-desktop-notify-gnu/linux-program "notify-send"
 107   "*The program name to notify for GNU/Linux."
 108   :type 'file
 109   :group 'riece-desktop-notify)
 110
 111 (defcustom riece-desktop-notify-gnu/linux-args '("-u" "low" title message)
 112   "*The Arguments to notify for GNU/Linux."
 113   :type '(repeat (radio (string :tag "Argument")
 114                         (const :tag "Title" title)
 115                         (const :tag "Message" message)))
 116   :group 'riece-desktop-notify)
 117
 118 ;; for Windows
 119 (defcustom riece-desktop-notify-windows-nt-program "snarl_cmd.exe"
 120   "*The program name to notify for Windows."
 121   :type 'file
 122   :group 'riece-desktop-notify)
 123
 124 (defcustom riece-desktop-notify-windows-nt-args
 125   '("snShowMessage" "-1" title message)
 126   "*The Arguments string to notify for Windows."
 127   :type '(repeat (radio (string :tag "Argument")
 128                         (const :tag "Title" title)
 129                         (const :tag "Message" message)))
 130   :group 'riece-desktop-notify)
 131
 132 ;; stolen and modified from riece-ruby.el
 133 (defun riece-desktop-notify-substitute-variables (args alist)
 134   "Substitute symbols in ARGS by looking up ALIST."
 135   (setq args (copy-sequence args))
 136   (while alist
 137     (let ((pointer args))
 138       (while pointer
 139         (setq pointer (memq (car (car alist)) args))
 140         (if pointer
 141             (setcar pointer (cdr (car alist))))))
 142     (setq alist (cdr alist)))
 143   args)
 144
 145 (defsubst riece-desktop-notify-make-symbol (symbol)
 146   (intern (format "riece-desktop-notify-%s-%s"
 147                   (symbol-name riece-desktop-notify-type)
 148                   (symbol-name symbol))))
 149
 150 (defvar riece-desktop-notify-last-message nil
 151   "The previous message we have seen in
 152 `riece-desktop-notify-keyword-notify-function'.")
 153
 154 (defun riece-desktop-notify-keyword-notify-function (_keyword message)
 155   ;; Don't send notification multiple times for a single message.
 156   (unless (eq riece-desktop-notify-last-message message)
 157     (let ((program-symbol (riece-desktop-notify-make-symbol 'program))
 158           (args-symbol (riece-desktop-notify-make-symbol 'args)))
 159       (when (and (boundp program-symbol) (boundp args-symbol))
 160         (let ((program (eval program-symbol))
 161               (args (eval args-symbol)))
 162           (when (fboundp 'executable-find)
 163             (setq program (executable-find program)))
 164           (when (stringp program)
 165             (let ((title (funcall riece-desktop-notify-title-function message))
 166                   (message (funcall riece-desktop-notify-message-function
 167                                     message)))
 168               (condition-case nil
 169                   (apply #'call-process program nil 0 nil
 170                          (riece-desktop-notify-substitute-variables
 171                           args
 172                           (list (cons 'title
 173                                       (encode-coding-string
 174                                        title
 175                                        riece-desktop-notify-coding-system))
 176                                 (cons 'message
 177                                       (encode-coding-string
 178                                        message
 179                                        riece-desktop-notify-coding-system)))))
 180                 (file-error nil))))))))
 181   (setq riece-desktop-notify-last-message message))
 182
 183 (defun riece-desktop-notify-requires ()
 184   '(riece-keyword))
 185
 186 (defun riece-desktop-notify-insinuate ()
 187   (add-hook 'riece-keyword-notify-functions
 188             'riece-desktop-notify-keyword-notify-function))
 189
 190 (defun riece-desktop-notify-uninstall ()
 191   (remove-hook 'riece-keyword-notify-functions
 192                'riece-desktop-notify-keyword-notify-function))
 193
 194 (provide 'riece-desktop-notify)
 195
 196 ;;; riece-desktop-notify.el ends here