cl-notify.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Notes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; This is a binding to libnotify, wrapping some of the functionality.
   4 ;;
   5 ;; Not wrapped yet:
   6 ;; ‣ GTK specific stuff, such as:
   7 ;;   • The GtkWidget* attach argument in notify_notification_new
   8 ;;   • notify_notification_new_with_status_icon (takes a GtkStatusIcon*)
   9 ;;   • notify_notification_attach_to_widget (takes a GtkWidget*)
  10 ;;   • notify_notification_attach_to_status_icon (takes a GtkStatusIcon*)
  11 ;;   • notify_notification_set_geometry_hints (takes a GtkScreen*)
  12 ;;   • notify_notification_set_icon_from_pixbuf (takes a GdkPixbuf*)
  13 ;;
  14 ;; ‣ Callback actions
  15 ;;   • notify_notification_add_action
  16 ;;   • notify_notification_clear_actions
  17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18
  19 (in-package :cl-notify)
  20
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Public Interface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22
  23 (defclass notification ()
  24   ((summary  :initarg  :summary)
  25    (body     :initarg  :body)
  26    (icon     :initarg  :icon    :initform nil)
  27    (category :initform nil)
  28    (urgency  :initform :normal)
  29
  30    (c-object :initform nil)))
  31
  32 (defgeneric show-notification (notification))
  33 (defgeneric close-notification (notification))
  34
  35
  36 ;;;;;;;;;;;;;;;;;;;;;;; Generic class and library funcs. ;;;;;;;;;;;;;;;;;;;;;;;
  37
  38 (defun notify-init ()
  39   "Initialize libnotify."
  40   (if (= 0 (notify_init "cl-notify")) nil t))
  41
  42 (defmethod initialize-instance :after ((n notification)
  43                                        &key summary body icon)
  44   (setf (slot-value n 'c-object)
  45         (notify-notification-new summary
  46                                  (or body (null-pointer))
  47                                  (or icon (null-pointer))
  48                                  (null-pointer)))
  49   (when (null-pointer-p (slot-value n 'c-object))
  50     (error "Could not create notification object.")))
  51
  52
  53 ;;;;;;;;;;;;;;;;;;;; Creating and destroying notifications ;;;;;;;;;;;;;;;;;;;;;
  54
  55 (defun destroy-notification (n)
  56   "Unref the C object in the background. Consider using `with-notification'."
  57
  58   (unless (null-pointer-p (slot-value n 'c-object))
  59     (g-object-unref (slot-value n 'c-object))))
  60
  61 (defmacro with-notification (sym (summary &key body icon timeout urgency)
  62                              &body forms)
  63   "Evaluate the forms in FORMS with SYM bound to a notification object created
  64   with a summary of SUMMARY and a body of BODY. If ICON, TIMEOUT and/or URGENCY
  65   are set, use them too."
  66   `(let ((,sym (make-instance 'notification
  67                               :summary ,summary
  68                               :body ,body
  69                               :icon ,icon)))
  70      (unwind-protect
  71           (progn
  72
  73             ,(when timeout
  74                    `(setf (timeout ,sym) ,timeout))
  75             ,(when urgency
  76                    `(setf (urgency ,sym) ,urgency))
  77
  78             ,@forms)
  79
  80        (destroy-notification ,sym))))
  81
  82 (defmacro dispatch-notification (summary &key body icon timeout urgency)
  83   "Create and display a notification. For more complicated cases when you need
  84 the symbol to stick around, use `with-notification'."
  85   `(with-notification n (,summary
  86                          ,@(when body (list :body body))
  87                          ,@(when icon (list :icon icon))
  88                          ,@(when timeout (list :timeout timeout))
  89                          ,@(when urgency (list :urgency urgency)))
  90      (show-notification n)))
  91
  92 (defmethod show-notification ((n notification))
  93   (unless (= 1 (notify-notification-show (slot-value n 'c-object)
  94                                          (null-pointer)))
  95     (error "Unknown error. TODO: Read the GError!"))
  96   (values))
  97
  98 ;;;;;;;;;;;;;;;;;;;;; Modify attributes of a notification. ;;;;;;;;;;;;;;;;;;;;;
  99
 100
 101 (defmethod (setf timeout) (timeout (n notification))
 102   (notify-notification-set-timeout (slot-value n 'c-object)
 103                                    timeout))
 104
 105 (defmethod update-notification ((n notification)
 106                                 &key summary body icon
 107                                 (re-show t))
 108   "Update the notification N with a new summary, body and/or icon. If RE-SHOW,
 109   then call show-notification afterwards to make the changes visible."
 110
 111   (when (= 0 (notify-notification-update (slot-value n 'c-object)
 112                                          (or summary (slot-value n 'summary))
 113                                          (or body (null-pointer))
 114                                          (or icon (null-pointer))))
 115     (error "Couldn't update the notification."))
 116   (when re-show
 117     (show-notification n)))
 118
 119 (defmethod (setf summary) (summary (n notification)
 120                            &optional (re-show t))
 121   (update-notification n :summary summary :re-show re-show))
 122
 123 (defmethod (setf body) (body (n notification)
 124                         &optional (re-show t))
 125   (update-notification n :body body :re-show re-show))
 126
 127 (defmethod (setf icon) (icon (n notification)
 128                         &optional (re-show t))
 129   (update-notification n :icon icon :re-show re-show))
 130
 131 (defmethod (setf urgency) (urgency (n notification))
 132   (notify-notification-set-urgency (slot-value n 'c-object)
 133                                    urgency))
 134
 135 ;;;;;;;;;;;;;;;;;;;; General server/connection information. ;;;;;;;;;;;;;;;;;;;;
 136
 137 (defmacro with-foreign-string-pointers (syms freeing-func &body body)
 138   "Execute BODY with the symbols in the list SYMS bound to foreign pointers,
 139   each of which has been set to null. Once BODY has finished, release any
 140   strings that aren't null with FREEING-FUNC. Evaluate to (progn BODY)."
 141
 142   `(with-foreign-objects
 143        ,(loop
 144            for s in syms
 145            collecting `(,s :pointer))
 146
 147      ,@(loop
 148           for s in syms
 149           collecting `(setf (mem-ref ,s :pointer) (null-pointer)))
 150
 151      (prog1
 152          (progn ,@body)
 153
 154        ,@(loop
 155             for s in syms
 156             collecting `(unless (null-pointer-p (mem-ref ,s :pointer))
 157                           (funcall ,freeing-func
 158                                    (mem-ref ,s :pointer)))))))
 159
 160 (defun server-info ()
 161   (with-foreign-string-pointers
 162       (name vendor version spec-version)
 163       #'g-free
 164
 165     (notify-get-server-info name vendor version spec-version)
 166
 167     (mapcar (lambda (pptr)
 168               (foreign-string-to-lisp (mem-ref pptr :pointer)))
 169             (list name vendor version spec-version))))