Function: dbus-property-handler

dbus-property-handler is a byte-compiled function defined in dbus.el.gz.

Signature

(dbus-property-handler &rest ARGS)

Documentation

Default handler for the "org.freedesktop.DBus.Properties" interface.

It will be registered for all objects created by dbus-register-property.

Source Code

;; Defined in /usr/src/emacs/lisp/net/dbus.el.gz
(defun dbus-property-handler (&rest args)
  "Default handler for the \"org.freedesktop.DBus.Properties\" interface.
It will be registered for all objects created by `dbus-register-property'."
  (let* ((last-input-event last-input-event)
         (bus (dbus-event-bus-name last-input-event))
	 (service (dbus-event-service-name last-input-event))
	 (path (dbus-event-path-name last-input-event))
	 (method (dbus-event-member-name last-input-event))
	 (interface (car args))
	 (property (cadr args)))
    (cond
     ;; "Get" returns a variant.
     ((string-equal method "Get")
      (let* ((entry (dbus-get-this-registered-property
                     bus service path interface property))
             (object (car (last (car entry)))))
        (cond
         ((not (consp object))
          `(:error ,dbus-error-unknown-property
            ,(format-message
              "No such property \"%s\" at path \"%s\"" property path)))
         ((eq :write (car object))
          `(:error ,dbus-error-access-denied
            ,(format-message
              "Property \"%s\" at path \"%s\" is not readable" property path)))
	 ;; Return the result.  Since variant is a list, we must embed
	 ;; it into another list.
         (t (list (nth 2 object))))))

     ;; "Set" needs the third typed argument from `last-input-event'.
     ((string-equal method "Set")
      (let* ((value (dbus-flatten-types (nth 12 last-input-event)))
	     (entry (dbus-get-this-registered-property
                     bus service path interface property))
	     (object (car (last (car entry)))))
        (cond
         ((not (consp object))
          `(:error ,dbus-error-unknown-property
            ,(format-message
              "No such property \"%s\" at path \"%s\"" property path)))
         ((eq :read (car object))
          `(:error ,dbus-error-property-read-only
            ,(format-message
              "Property \"%s\" at path \"%s\" is not writable" property path)))
         (t (puthash (list :property bus interface property)
		     (cons (append
                            (butlast (car entry))
                            ;; Reuse ACCESS and EMITS-SIGNAL.
			    (list (append (butlast object) (list value))))
                           (dbus-get-other-registered-properties
                            bus service path interface property))
		     dbus-registered-objects-table)
	    ;; Send the "PropertiesChanged" signal.
	    (when (nth 1 object)
	      (dbus-send-signal
	       bus service path dbus-interface-properties "PropertiesChanged"
               interface
               ;; changed_properties.
	       (if (eq :write (car object))
                   '(:array: :signature "{sv}")
                 `(:array (:dict-entry ,property ,value)))
               ;; invalidated_properties.
               (if (eq :write (car object))
                   `(:array ,property)
                 '(:array))))
            ;; Return empty reply.
	    :ignore))))

     ;; "GetAll" returns "a{sv}".
     ((string-equal method "GetAll")
      (let (result)
	(maphash
	 (lambda (key val)
           (when (consp val)
             (dolist (item val)
               (let ((object (car (last item))))
                 (when (and (equal (butlast key) (list :property bus interface))
                            (string-equal path (nth 2 item))
                            (consp object)
                            (not (eq :write (car object))))
                   (push
                    (list :dict-entry (car (last key)) (nth 2 object))
                    result))))))
	 dbus-registered-objects-table)
	;; Return the result, or an empty array.  An array must be
	;; embedded in a list.
	(list (cons :array (or result '(:signature "{sv}"))))))

     (t `(:error ,dbus-error-unknown-method
          ,(format-message
            "No such method \"%s.%s\" at path \"%s\""
            dbus-interface-properties method path))))))