unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Emacs and the Status Notification Specification
@ 2011-06-23 17:31 Tom Tromey
  2011-06-23 18:28 ` Ted Zlatanov
  2011-06-26  9:25 ` Michael Albinus
  0 siblings, 2 replies; 28+ messages in thread
From: Tom Tromey @ 2011-06-23 17:31 UTC (permalink / raw)
  To: Emacs discussions

[-- Attachment #1: Type: text/plain, Size: 1043 bytes --]

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


[-- Attachment #2: status.el --]
[-- Type: text/plain, Size: 10303 bytes --]

;;; status.el --- notification area support for Emacs.

;; Copyright (C) 2007, 2011 Tom Tromey <tromey@redhat.com>

;; Author: Tom Tromey <tromey@redhat.com>
;; 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

[-- Attachment #3: erc-status.el --]
[-- Type: text/plain, Size: 6490 bytes --]

;;; erc-status.el --- notification area support for ERC

;; Copyright (C) 2007, 2011 Tom Tromey <tromey@redhat.com>

;; Author: Tom Tromey <tromey@redhat.com>
;; 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)))

\f

;; 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)

\f

(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

^ permalink raw reply	[flat|nested] 28+ messages in thread
end of thread, other threads:[~2011-07-02  8:11 UTC | newest]

Thread overview: 28+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-06-23 17:31 Emacs and the Status Notification Specification Tom Tromey
2011-06-23 18:28 ` Ted Zlatanov
2011-06-24  8:54   ` Philipp Haselwarter
2011-06-24 11:59     ` Ted Zlatanov
2011-06-24 17:00   ` Tom Tromey
2011-06-26  9:31     ` Michael Albinus
2011-06-26 16:18       ` Richard Stallman
2011-06-27  7:22         ` Stephen J. Turnbull
2011-06-27 16:06     ` Ted Zlatanov
2011-06-27 23:02       ` Richard Stallman
2011-06-28 11:52         ` Ted Zlatanov
2011-06-29 23:14           ` Richard Stallman
2011-06-30 12:38             ` Ted Zlatanov
2011-06-30 13:38               ` Juanma Barranquero
2011-06-30 14:58               ` John Yates
2011-06-30 15:27                 ` Juanma Barranquero
2011-06-30 17:41                   ` John Yates
2011-07-01  0:18               ` Richard Stallman
2011-07-01  1:46                 ` Ted Zlatanov
2011-07-01  1:57                   ` David De La Harpe Golden
2011-07-01  3:07                   ` Stefan Monnier
2011-07-01 11:40                     ` Richard Stallman
2011-07-01 13:11                       ` Ted Zlatanov
2011-07-01 14:16                         ` Stefan Monnier
2011-07-01 14:17                       ` Stefan Monnier
2011-07-02  8:11                         ` Richard Stallman
2011-06-30 16:07             ` Chong Yidong
2011-06-26  9:25 ` Michael Albinus

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).