From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Tom Tromey Newsgroups: gmane.emacs.devel Subject: Emacs and the Status Notification Specification Date: Thu, 23 Jun 2011 11:31:59 -0600 Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1308851860 20509 80.91.229.12 (23 Jun 2011 17:57:40 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Thu, 23 Jun 2011 17:57:40 +0000 (UTC) To: Emacs discussions Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Jun 23 19:57:34 2011 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1QZo9l-00014X-MS for ged-emacs-devel@m.gmane.org; Thu, 23 Jun 2011 19:57:34 +0200 Original-Received: from localhost ([::1]:51780 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QZo9k-0007jY-Ge for ged-emacs-devel@m.gmane.org; Thu, 23 Jun 2011 13:57:32 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:59750) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QZnlA-0000k6-Il for emacs-devel@gnu.org; Thu, 23 Jun 2011 13:32:14 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QZnl5-0004pX-SC for emacs-devel@gnu.org; Thu, 23 Jun 2011 13:32:08 -0400 Original-Received: from mx1.redhat.com ([209.132.183.28]:54382) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QZnl5-0004pF-49 for emacs-devel@gnu.org; Thu, 23 Jun 2011 13:32:03 -0400 Original-Received: from int-mx10.intmail.prod.int.phx2.redhat.com (int-mx10.intmail.prod.int.phx2.redhat.com [10.5.11.23]) by mx1.redhat.com (8.14.4/8.14.4) with ESMTP id p5NHW1SN001550 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=OK) for ; Thu, 23 Jun 2011 13:32:01 -0400 Original-Received: from ns3.rdu.redhat.com (ns3.rdu.redhat.com [10.11.255.199]) by int-mx10.intmail.prod.int.phx2.redhat.com (8.14.4/8.14.4) with ESMTP id p5NHW1x7007066; Thu, 23 Jun 2011 13:32:01 -0400 Original-Received: from barimba (ovpn01.gateway.prod.ext.phx2.redhat.com [10.5.9.1]) by ns3.rdu.redhat.com (8.13.8/8.13.8) with ESMTP id p5NHVxqa011229; Thu, 23 Jun 2011 13:32:00 -0400 X-Attribution: Tom User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux) X-Scanned-By: MIMEDefang 2.68 on 10.5.11.23 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 209.132.183.28 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:140927 Archived-At: --=-=-= The Status Notification Specification is a D-Bus spec for what are sometimes called "systray icons". It lets applications create systray icons using just D-Bus, rather than the mix of different things required by the older spec. The spec itself is here: http://www.notmart.org/misc/statusnotifieritem/index.html As far as I know, only KDE currently implements this spec. However, nothing prevents it from being implemented in other desktops. Attached are 2 files to implement the spec for Emacs: * status.el, the basic implementation * erc-status.el, adding an icon for ERC. The icon blinks when someone pings you, and clicking it switches to the appropriate buffer. I'd like to check these in to Emacs. However, I was uncertain where to locate them, so I thought I would post here first. I also have a similar file, emms-status.el, to add an icon for EMMS; and a few bits of elisp to add something similar for the calendar (plus calls to notifications.el for appointments...). I can send those along if anybody cares. Tom --=-=-= Content-Disposition: inline; filename=status.el Content-Description: status.el ;;; status.el --- notification area support for Emacs. ;; Copyright (C) 2007, 2011 Tom Tromey ;; Author: Tom Tromey ;; Version: 0.3 ;; This file is not (yet) part of GNU Emacs. ;; However, it is distributed under the same license. ;; GNU Emacs 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, or (at your option) ;; any later version. ;; GNU Emacs 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;; Commentary: ;; This implements the client side of the Status Notifier Item ;; specification: ;; http://www.notmart.org/misc/statusnotifieritem/index.html ;; There are no user-visible features of this module, only features ;; for Emacs Lisp programs. You may like to use erc-status.el, which ;; provides some nice notification area support for ERC. (require 'dbus) (eval-when-compile (require 'cl)) ;; The next available status ID. Internal. (defvar status--id 0) ;; Structure representing a status icon. ;; For internal use only. (defstruct (status (:conc-name status--)) (service-name nil :read-only t) (icon "dialog-information") (attention-icon "dialog-warning") overlay-icon (tooltip-icon "dialog-information") (tooltip-title "") (tooltip-description "") (category :application :read-only t) (id nil :read-only t) (title "Emacs") (status :passive) activate-callback secondary-activate-callback) ;; Map category keywords to strings from the spec. (defconst status--category-map '((:application . "ApplicationStatus") (:communication . "Communication") (:system . "SystemServices") (:hardware . "Hardware"))) ;; Map status keywords to strings from the spec. (defconst status--status-map '((:passive . "Passive") (:active . "Active") (:needs-attention . "NeedsAttention"))) ;; Properties we don't currently expose to the user, together with ;; their values. (We actually do expose "ToolTip", but it is handled ;; differently below.) (defconst status--properties '(("AttentionIconPixmap" nil) ("IconPixmap" nil) ("OverlayIconPixmap" nil) ("ToolTip" nil) ("WindowId" 0))) ;; Properties we do expose to the user, together with the accessor to ;; use. (defconst status--exposed-properties '(("AttentionIconName" status--attention-icon) ("IconName" status--icon) ("OverlayIconName" status--overlay-icon) ("Category" status--category) ("Id" status--id) ("Title" status--title))) ;; Called when the icon is activated; calls the user-specified ;; function. (defun status--activate (status-icon x y) (let ((callback (status--activate-callback status-icon))) (if callback (funcall callback)) :ignore)) ;; Called when the icon gets a secondary activation event. Calls the ;; user-specified function. (defun status--secondary-activate (status-icon x y) (let ((callback (status--secondary-activate-callback status-icon))) (if callback (funcall callback)) :ignore)) ;; Create the status notifier item via D-Bus. See the specification ;; to understand most of this. (defun status--setup-service (status-icon) (dolist (item status--properties) (dbus-register-property :session (status--service-name status-icon) "/StatusNotifierItem" "org.kde.StatusNotifierItem" (car item) :read (cadr item) t t)) (dolist (item status--exposed-properties) (dbus-register-property :session (status--service-name status-icon) "/StatusNotifierItem" "org.kde.StatusNotifierItem" (car item) :read (funcall (cadr item) status-icon) t t)) (dbus-register-property :session (status--service-name status-icon) "/StatusNotifierItem" "org.kde.StatusNotifierItem" "Status" :read (cdr (assq (status--status status-icon) status--status-map)) t t) (dbus-register-method :session (status--service-name status-icon) "/StatusNotifierItem" "org.kde.StatusNotifierItem" "Activate" `(lambda (&rest args) (apply #'status--activate ,status-icon args)) t) (dbus-register-method :session (status--service-name status-icon) "/StatusNotifierItem" "org.kde.StatusNotifierItem" "SecondaryActivate" `(lambda (&rest args) (apply #'status--secondary-activate ,status-icon args)) t) (dbus-register-service :session (status--service-name status-icon)) ;; Register the item with the watcher. (dbus-call-method-asynchronously :session "org.kde.StatusNotifierWatcher" "/StatusNotifierWatcher" "org.kde.StatusNotifierWatcher" "RegisterStatusNotifierItem" nil (status--service-name status-icon))) (defun status--update-dbus-property (icon property signal new-value &rest extra-args) (dbus-register-property :session (status--service-name icon) "/StatusNotifierItem" "org.kde.StatusNotifierItem" property :read new-value) (apply #'dbus-send-signal :session (status--service-name icon) "/StatusNotifierItem" "org.kde.StatusNotifierItem" signal extra-args)) (defun status-set-icon (icon new-value) "Set the icon displayed in the status area. ICON is that status icon object. NEW-VALUE is the Freedesktop-compliant name of the icon to display." (setf (status--icon icon) new-value) (status--update-dbus-property icon "IconName" "NewIcon" new-value)) (defun status-set-attention-icon (icon new-value) "Set the attention icon displayed in the status area. ICON is that status attention icon object; the attention icon is displayed when the status icon needs attention. It defaults to the ordinary icon. NEW-VALUE is the Freedesktop-compliant name of the icon to display." (setf (status--attention-icon icon) new-value) (status--update-dbus-property icon "AttentionIconName" "NewAttentionIcon" new-value)) (defun status-set-overlay-icon (icon new-value) "Set the overlay icon displayed in the status area. ICON is that status overlay icon object; the overlay icon carries extra information to displayed over the status icon. It defaults to nil. NEW-VALUE is the Freedesktop-compliant name of the icon to display." (setf (status--overlay-icon icon) new-value) (status--update-dbus-property icon "OverlayIconName" "NewOverlayIcon" new-value)) (defun status-set-title (icon new-value) "Set the title of the status icon. ICON is the status icon to modify. NEW-VALUE is the new title." (setf (status--title icon) new-value) (status--update-dbus-property icon "Title" "NewTitle" new-value)) (defun status--compute-tooltip (icon) (list :struct (status--tooltip-icon icon) nil (status--tooltip-title icon) (status--tooltip-description icon))) (defun status-set-tooltip-title (icon new-value) "Set the title of the status icon's tooltip. ICON is the status icon to modify. NEW-VALUE is the new tooltip title." (setf (status--tooltip-title icon) new-value) (status--update-dbus-property icon "ToolTip" "NewToolTip" (status--compute-tooltip icon))) (defun status-set-tooltip-icon (icon new-value) "Set the icon of the status icon's tooltip. ICON is the status icon to modify. NEW-VALUE is the new tooltip icon; it must be a Freedesktop-compliant icon name." (setf (status--tooltip-icon icon) new-value) (status--update-dbus-property icon "ToolTip" "NewToolTip" (status--compute-tooltip icon))) (defun status-set-tooltip-description (icon new-value) "Set the description of the status icon's tooltip. ICON is the status icon to modify. NEW-VALUE is the new description. The description may contain HTML markup." (setf (status--tooltip-description icon) new-value) (status--update-dbus-property icon "ToolTip" "NewToolTip" (status--compute-tooltip icon))) (defun status-set-status (icon new-value) "Set the status of the status icon. ICON is the status icon to modify. NEW-VALUE is the new status; it must be one of the keywords: :passive The application is in a passive state. :active The application is in an active state. :needs-attention The application needs attention from the user." (let ((string-value (cdr (assq new-value status--status-map)))) (unless string-value (error "Invalid status for status-icon")) (setf (status--status icon) new-value) (status--update-dbus-property icon "Status" "NewStatus" string-value string-value))) (defun status-set-activate-callback (status-icon new-value) "Set the activation callback function for STATUS-ICON. NEW-VALUE is a function which will be called when the icon is \"activated\" \(usually this means clicked by the user). If nil, no function will be called." (setf (status--activate-callback status-icon) new-value)) (defun status-set-secondary-activate-callback (status-icon new-value) "Set the activation callback function for STATUS-ICON. NEW-VALUE is a function which will be called when the icon is \"secondarily activated\" (usually this means middle-clicked by the user). If nil, no function will be called." (setf (status--secondary-activate-callback status-icon) new-value)) ;;;###autoload (defun status-new (category id &rest args) "Create a new status icon and return it." (let* ((id status--id) (service-name (concat "org.kde.StatusNotifierItem-" (int-to-string (emacs-pid)) "-" (int-to-string id))) (result (apply #'make-status :service-name service-name :category (cdr (assq category status--category-map)) :id id args))) (setq status--id (1+ status--id)) (status--setup-service result) result)) (defun status-delete (status-icon) "Destroy the status icon." (dbus-unregister-service :session (status--service-name status-icon))) (provide 'status) ;;; status.el ends here --=-=-= Content-Disposition: inline; filename=erc-status.el Content-Description: erc-status.el ;;; erc-status.el --- notification area support for ERC ;; Copyright (C) 2007, 2011 Tom Tromey ;; Author: Tom Tromey ;; Version: 0.2 ;; Keywords: comm ;; This file is not (yet) part of GNU Emacs. ;; However, it is distributed under the same license. ;; GNU Emacs 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, or (at your option) ;; any later version. ;; GNU Emacs 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This provides nice support for the notification area to ERC. In ;; particular it: ;; * Will blink the icon when you get a private message or are paged ;; in a channel. ;; * Left-click on the blinking icon will show the appropriate channel ;; buffer in some frame (which is then raised). If there are ;; multiple pages at once, it will show one and you can click again ;; to go to the next one. ;; * Will show a menu of all the channels on the right button menu. ;; (Though... this doesn't work and I haven't debugged it.) ;; * Will pop up notification bubbles when you connect to or ;; disconnect from a server. ;; This is regular erc module named 'status'; you can enable it as you ;; would any other module. ;;; Change log: ;; 2011-06-23 rewrite for status notifier spec ;; 2007-02-15 raise frame on left click ;; 2007-02-13 make sure priv message added after auto-query ;; 2007-02-08 turn into an ERC module ;; 2007-02-08 another try at private messages ;; 2007-01-29 try to make private messages work. show buffer on click ;; TO DO: ;; - make tool tip show some kind of real status ...? ;; - use a nicer icon ;; - menu? (tried but it isn't working yet) ;; - integrate with auto-query a bit better ;; - let left click use specified frame or make a new frame? (require 'status) (require 'erc) (require 'notifications) ;; The status icon object. (defvar erc-status-status-icon nil) ;; List of ERC buffers that caused the status icon to blink. (defvar erc-status-buffer-list nil) (defun erc-status-remove-buffer (buffer) ;; If the list is not empty, and removing an element makes the list ;; empty, stop blinking. (and erc-status-buffer-list (not (setq erc-status-buffer-list (delq buffer erc-status-buffer-list))) (status-set-state erc-status-status-icon :active))) (defun erc-status-add-buffer (buffer) (unless (erc-buffer-visible buffer) (status-set-state erc-status-status-icon :needs-attention) (unless (memq buffer erc-status-buffer-list) (setq erc-status-buffer-list (cons buffer erc-status-buffer-list))))) (defun erc-status-match-hook (match-type nick message) ;; Look for user's nick and make the icon blink. (if (eq match-type 'current-nick) (erc-status-add-buffer (current-buffer)))) (defun erc-status-buffer-killed () ;; If one of our buffers was killed, remove it. (erc-status-remove-buffer (current-buffer))) (defun erc-status-window-configuration-changed () (let ((new-list)) (dolist (buffer erc-status-buffer-list) (unless (erc-buffer-visible buffer) (setq new-list (cons buffer new-list)))) (unless (setq erc-status-buffer-list new-list) (status-set-state erc-status-status-icon :active)))) (defun erc-status-disconnected (nick ip reason) (notifications-notify :title (concat "Disconnected: " reason) :app-name "ERC" :urgency 'normal)) (defun erc-status-after-connect (server nick) (notifications-notify :title (concat "Connected to " server " as " nick) :app-name "ERC" :urgency 'normal)) (defun erc-status-select-first-buffer () "Switch to the first ERC buffer requiring your attention. If there is no such buffer, do nothing." (when erc-status-buffer-list (switch-to-buffer (car erc-status-buffer-list)) (raise-frame))) ;; From: http://www.emacswiki.org/cgi-bin/wiki/ErcPageMe ;; Then modified to suit. (defun erc-status-PRIVMSG (proc parsed) (let* ((nick (car (erc-parse-user (erc-response.sender parsed)))) (target (car (erc-response.command-args parsed))) (msg (erc-response.contents parsed)) (query (if (not erc-query-on-unjoined-chan-privmsg) nick (if (erc-current-nick-p target) nick target)))) (when (and (erc-current-nick-p target) (not (erc-is-message-ctcp-and-not-action-p msg))) ;; Note: assumes you are using auto-query. (erc-status-add-buffer (erc-get-buffer query proc)))) ;; Always return nil. nil) (define-erc-module status nil "Notification area support for ERC." ;; Enable. ((unless erc-status-status-icon (setq erc-status-status-icon (status-new :communication "Emacs ERC" :icon "user-available")) ;; (status-set-tooltip erc-status-status-icon ;; "ERC - IRC client for Emacs") (status-set-activate-callback erc-status-status-icon 'erc-status-select-first-buffer)) (add-hook 'erc-text-matched-hook 'erc-status-match-hook) (add-hook 'kill-buffer-hook 'erc-status-buffer-killed) (add-hook 'window-configuration-change-hook 'erc-status-window-configuration-changed) (add-hook 'erc-after-connect 'erc-status-after-connect) (add-hook 'erc-disconnected-hook 'erc-status-disconnected) ;; FIXME: Must come *after* erc-auto-query. Some sort of ;; auto-query hook or the like would be good here. (add-hook 'erc-server-PRIVMSG-functions 'erc-status-PRIVMSG t)) ;; Disable. ((when erc-status-status-icon (status-delete erc-status-status-icon) (setq erc-status-status-icon nil)) (remove-hook 'erc-text-matched-hook 'erc-status-match-hook) (remove-hook 'kill-buffer-hook 'erc-status-buffer-killed) (remove-hook 'window-configuration-change-hook 'erc-status-window-configuration-changed) (remove-hook 'erc-after-connect 'erc-status-after-connect) (remove-hook 'erc-disconnected-hook 'erc-status-disconnected) (remove-hook 'erc-server-PRIVMSG-functions 'erc-status-PRIVMSG))) ;;; erc-status.el ends here --=-=-=--