let's do ugly versioning in my playground

2024-07-07 17:31:51 +00:00
commit 70de7c4491
11 changed files with 1113 additions and 0 deletions
--- a/maybe-screencast.lisp
+++ b/maybe-screencast.lisp
@@ -0,0 +1,119 @@
+(load (sb-ext:posix-getenv "ASDF"))
+(asdf:load-system 'dbus)
+
+(defpackage #:screencasting (:use #:cl))
+(in-package #:screencasting)
+
+;; https://flatpak.github.io/xdg-desktop-portal/docs/doc-org.freedesktop.portal.ScreenCast.html
+(defconstant +screen-cast-interface+ "org.freedesktop.portal.ScreenCast")
+(defconstant +request-interface+ "org.freedesktop.portal.ScreenCast")
+
+;; i'm not sure how to do interactive calls,
+;; since maybe i need to "publish objects"
+;; and that means the callbacks are set in stone?
+;; i guess i could try to do a Notification call in the callback on screenshot request?
+(with-open-bus (bus (session-server-addresses))
+  (with-introspected-object (notification bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")
+	 (notification "org.freedesktop.Notifications" "Notify"
+						"Test" 0 "" "Test" "This is a test; I repeat, this is a test." '() '() -1)
+	 ))
+
+(defun send-notification (bus message)
+  (dbus:with-introspected-object (notification bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")
+	 (notification "org.freedesktop.Notifications" "Notify"
+						"Test" 0 "" "Test" (or message "This is a test; I repeat, this is a test.") '() '() -1)))
+
+;; i guess i could pass both bus and 
+
+(defun call-screencast ()
+  (handler-case
+		(dbus:with-open-bus (bus (dbus:session-server-addresses))
+		  (let*
+				((requester-name (cl-ppcre:regex-replace "\\." (dbus:bus-name bus) "_" :start 1))
+				 (request-name "yayay")
+				 (resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
+												 requester-name
+												 "/"
+												 request-name)))
+			 (dbus:define-dbus-object request-object
+				(:path resp-path))
+
+			 (dbus:define-dbus-signal-handler (request-object response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT)))) 
+				(:interface +request-interface+)
+				(format t "Got response  ~S with results ~S~%" id results)
+				(send-notification bus "yayaya from the first response"))
+			 
+			 (format T "Will try to listen on ~A~%" resp-path)
+			 (format T "Bus connection name ~A~%" (dbus:bus-name bus))
+			 (dbus:add-match bus :type :signal
+										:interface "org.freedesktop.portal.Request")
+			 (dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
+				(desktop +screen-cast-interface+ "CreateSession"
+							'(("handle_token" ((:string) "yayay"))
+							  ("session_handle_token" ((:string) "hohoyyy")))))
+			 (dbus:publish-objects bus)))
+	 (end-of-file ()
+      :disconnected-by-bus)))
+
+;; let's then try to move macroses that define 'request' to outside?
+;; they would take bus, create expected request-response listener
+
+(alexandria:with-gensyms (lala)
+  (format nil "i-got-gensym-~S" lala))
+
+;; well this notification library has interactive "register callback"
+;; for multiple callbacks on Notification signals
+;; https://github.com/Lautaro-Garcia/cl-notify/blob/main/src/signals.lisp
+;; basicly loop starts and one signal-handler that calls all currently registered
+;; i guess for my case i'll want separate with-open-bus?
+;; how would i then exit the publish-objects loop?
+;; am i really expected to exit it?
+;; alright, let's try to start publish objects and after that registering stuff
+;; to do the call?
+(defun do-request (bus)
+  (let*
+			 ((requester-name (cl-ppcre:regex-replace "\\." (dbus:bus-name bus) "_" :start 1))
+			  (request-name "yayay")
+			  (resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
+											  requester-name
+											  "/"
+											  request-name)))
+		  (dbus:define-dbus-object request-object
+			 (:path resp-path))
+		  (dbus:define-dbus-signal-handler (request-object response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT)))) 
+			 (:interface "org.freedesktop.portal.Request")
+			 (format t "Got response  ~A with results ~A~%" id results)
+			 (send-notification bus "yayaya from the first response"))
+		  (format T "Will try to make a call for ~A~%" resp-path)
+		  (format T "Bus connection name ~A~%" (dbus:bus-name bus))
+		  (dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
+			 (desktop "org.freedesktop.portal.Screenshot" "Screenshot"
+						 ""
+						 '(("handle_token" ((:string) "yayay")))))
+		  (dbus:add-match bus :type :signal
+									 :interface "org.freedesktop.portal.Request")
+		  (dbus:publish-objects bus)))
+
+(defvar *running-bus*)
+(do-request *running-bus*)
+
+(defun run-bus ()
+  (handler-case
+		(dbus:with-open-bus (bus (dbus:session-server-addresses))
+		  (format T "Bus connection name ~A~%" (dbus:bus-name bus))
+		  (setq *running-bus* bus)
+		  (dbus:publish-objects bus))
+	 (end-of-file ()
+      :disconnected-by-bus)))
+
+;; well, i suppose i would need to open multiple connections?
+;; let's do something like this https://github.com/Lautaro-Garcia/cl-notify/blob/main/src/dbus-protocol.lisp#L27
+;; (defmacro with-dbus-method-inovaction ((result-var method &rest args) &body body)
+;;   (alexandria:with-gensyms (bus notifications-object)
+;;     `(dbus:with-open-bus (,bus (dbus:session-server-addresses))
+;;        (dbus:with-introspected-object (,notifications-object ,bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")
+;;          (let ((,result-var (,notifications-object "org.freedesktop.Notifications" ,method ,@args)))
+;;           ,@body)))))
+
+;; but. this supposes result-var being a resulting value
+;; and i'd want to what? pass in a callback to register?