<commit_before>;;; remote.lisp --- remote gui interface

;; We prefix all functions communicating over RPC with "%%".

(in-package :next)

(defclass window ()
  ((id :accessor id :initarg :id)
   (active-buffer :accessor active-buffer :initform nil)
   (minibuffer-active :accessor minibuffer-active :initform nil)
   (minibuffer-callbacks :accessor minibuffer-callbacks
                         :initform (make-hash-table :test #'equal))
   (minibuffer-closed-height :accessor minibuffer-closed-height :initform 0
                             :documentation "The height of the minibuffer when closed.")
   (minibuffer-open-height :accessor minibuffer-open-height :initform 200
                           :documentation "The height of the minibuffer when open.")
   (minibuffer-echo-height :accessor minibuffer-echo-height :initform 25
                           :documentation "The height of the minibuffer when echoing.")
   (history-db-path :accessor history-db-path :initform (xdg-data-home "history.db")
                    :documentation "The path where the system will create/save the history database.")
   (bookmark-db-path :accessor bookmark-db-path :initform (xdg-data-home "bookmark.db")
                     :documentation "The path where the system will create/save the bookmark database.")
   (search-engines :accessor search-engines :initform '(("default" . "https://duckduckgo.com/?q=~a")
                                                        ("wiki" . "https://en.wikipedia.org/w/index.php?search=~a"))
                   :documentation "An association list of all the search engines you can use in the minibuffer.
The 'default' engine is used when the query is not a valid URL, or the first
keyword is not recognized.")))

(defclass buffer ()
  ((id :accessor id :initarg :id)
   (name :accessor name :initarg :name)
   (mode :accessor mode :initarg :mode
         ;; TODO: This is rather clunky.  Use separate slot for the class symbol?
         :initform 'document-mode
         :documentation "The :initform and :initarg must be the class symbol.
The mode is instantiated on buffer initialization.")
   (view :accessor view :initarg :view)
   (modes :accessor modes :initarg :modes)
   (resource-query-functions :accessor resource-query-functions
                             :initarg :resource-query-functions
                             :initform nil)
   (callbacks :accessor callbacks
              :initform (make-hash-table :test #'equal))
   (default-new-buffer-url :accessor default-new-buffer-url :initform "https://next.atlas.engineer/start"
                           :documentation "The URL set to a new blank buffer opened by Next.")
   (scroll-distance :accessor scroll-distance :initform 50
                    :documentation "The distance scroll-down or scroll-up will scroll.")
   (horizontal-scroll-distance :accessor horizontal-scroll-distance :initform 50
                               :documentation "Horizontal scroll distance. The
distance scroll-left or scroll-right will scroll.")
   (current-zoom-ratio :accessor current-zoom-ratio :initform 1.0
                       :documentation "The current zoom relative to the default zoom.")
   (zoom-ratio-step :accessor zoom-ratio-step :initform 0.2
                    :documentation "The step size for zooming in and out.")
   (zoom-ratio-min :accessor zoom-ratio-min :initform 0.2
                   :documentation "The minimum zoom ratio relative to the default.")
   (zoom-ratio-max :accessor zoom-ratio-max :initform 5.0
                   :documentation "The maximum zoom ratio relative to the default.")
   (zoom-ratio-default :accessor zoom-ratio-default :initform 1.0
                       :documentation "The default zoom ratio.")
   (cookies-path :accessor cookies-path :initform (xdg-data-home "cookies.txt")
                 :documentation "The path where cookies are stored.  Not all
platform ports might support this.")))

(defmethod initialize-instance :after ((buffer buffer) &key)
  (when (symbolp (mode buffer))
    (setf (mode buffer) (make-instance (mode buffer)))))

;; A struct used to describe a key-chord
(defstruct key-chord
  key-code
  key-string
  modifiers
  position
  low-level-data)

(defmethod did-commit-navigation ((buffer buffer) url)
  (setf (name buffer) url)
  (did-commit-navigation (mode buffer) url))

(defmethod did-finish-navigation ((buffer buffer) url)
  (did-finish-navigation (mode buffer) url))

(defclass remote-interface ()
  ((port :accessor port :initform (make-instance 'port)
         :documentation "The CLOS object responible for handling the platform port.")
   (platform-port-poll-interval :accessor platform-port-poll-interval :initform 0.015
                                :documentation "The speed at which to poll the
RPC endpoint of a platform-port to see if it is ready to begin accepting RPC
commands.")
   (active-connection :accessor active-connection :initform nil)
   (minibuffer :accessor minibuffer :initform (make-instance 'minibuffer)
               :documentation "The minibuffer object.")
   (windows :accessor windows :initform (make-hash-table :test #'equal))
   (total-window-count :accessor total-window-count :initform 0)
   (last-active-window :accessor last-active-window :initform nil)
   (buffers :accessor buffers :initform (make-hash-table :test #'equal))
   (total-buffer-count :accessor total-buffer-count :initform 0)
   (start-page-url :accessor start-page-url :initform "https://next.atlas.engineer/quickstart"
                   :documentation "The URL of the first buffer opened by Next when started.")
   (key-chord-stack :accessor key-chord-stack :initform '()
                    :documentation "A stack that keeps track of the key chords a user has inputted.")))

(defmethod initialize-instance :after ((interface remote-interface)
                                       &key &allow-other-keys)
  "Start the RPC server."
  (let ((lock (bt:make-lock))
        (condition (bt:make-condition-variable)))
    (setf (active-connection interface)
          (bt:make-thread
           (lambda ()
             (dbus:with-open-bus (bus (session-server-addresses))
               (let ((status (dbus:request-name bus +core-name+ :do-not-queue)))
                 (when (eq status :exists)
                   (let ((url-list (or *free-args*
                                       (list (get-default 'buffer 'default-new-buffer-url)))))
                     (log:info  "Next already started, requesting to open URL(s) ~a." url-list)
                     (%rpc-send-self "make_buffers" "as" url-list)
                     (uiop:quit))))
               (log:info "Bus connection name: ~A" (dbus:bus-name bus))
               (bt:condition-notify condition)
               (dbus:publish-objects bus)))))
    (bt:acquire-lock lock)
    (bt:condition-wait condition lock)))

(defun session-server-addresses ()
  (let ((server-addresses (dbus:session-server-addresses)))
    (if server-addresses
        server-addresses
        ;; Check for MacOS dbus session address.
        (dbus:parse-server-addresses-string
         (format nil "unix:path=~a"
                 (uiop:getenv "DBUS_LAUNCHD_SESSION_BUS_SOCKET"))))))

(defmethod kill-interface ((interface remote-interface))
  "Stop the RPC server."
  (when (active-connection interface)
    (log:debug "Stopping server")
    ;; TODO: How do we close the connection?
    (bt:destroy-thread (active-connection interface))))

(defun %rpc-send-self (method-name signature &rest args)
  "Call METHOD over ARGS.
SIGNATURE must be the D-Bus encoded type string of ARGS.
For an array of string, that would be \"as\"."
  (dbus:with-open-bus (bus (session-server-addresses))
    (dbus:invoke-method (dbus:bus-connection bus) method-name
                        :path +core-object-path+
                        :destination +core-name+
                        :interface +core-interface+
                        :signature signature
                        :arguments args)))

(defmethod %rpc-send ((interface remote-interface) (method string) &rest args)
  ;; TODO: Make %rpc-send asynchronous?
  ;; If the platform port ever hangs, the next %rpc-send will hang the Lisp core too.
  ;; Always ensure we send the auth token as the first argument
  ;; TODO: Catch connection errors and execution errors.
  (dbus:with-open-bus (bus (session-server-addresses))
    (dbus:with-introspected-object (platform-port bus +platform-port-object-path+ +platform-port-name+)
      (apply #'platform-port +platform-port-interface+ method args))))

;; TODO: Move to separate packages:
;; - next-rpc
;; - next-script (?)
(defmethod %%list-methods ((interface remote-interface))
  "Return the unsorted list of RPC methods supported by the platform port."
  ;; TODO: Find the right way to do this in dbus.
  (%rpc-send interface "listMethods"))

(defmethod get-unique-window-identifier ((interface remote-interface))
  (incf (total-window-count interface))
  (format nil "~a" (total-window-count interface)))

(defmethod get-unique-buffer-identifier ((interface remote-interface))
  (incf (total-buffer-count interface))
  (format nil "~a" (total-buffer-count interface)))

(defmethod %%window-make ((interface remote-interface))
  "Create a window and return the window object."
  (let* ((window-id (get-unique-window-identifier interface))
         (window (make-instance 'window :id window-id)))
    (setf (gethash window-id (windows interface)) window)
    (%rpc-send interface "window_make" window-id)
    (unless (last-active-window interface)
      ;; When starting from a REPL, it's possible that the window is spawned in
      ;; the background and %%window-active would then return nil.
      (setf (last-active-window interface) window))
    window))

(defmethod %%window-set-title ((interface remote-interface) (window window) title)
  "Set the title for a given window."
  (%rpc-send interface "window_set_title" (id window) title))

(defmethod %%window-delete ((interface remote-interface) (window window))
  "Delete a window object and remove it from the hash of windows."
  (%rpc-send interface "window_delete" (id window))
  (with-slots (windows) interface
    (remhash (id window) windows)))

(defmethod %%window-active ((interface remote-interface))
  "Return the window object for the currently active window."
  (with-slots (windows) interface
    (let ((window (gethash (%rpc-send interface "window_active")
                           windows)))
      (when window
        (setf (last-active-window interface) window))
      (last-active-window interface))))

(defmethod %%window-exists ((interface remote-interface) (window window))
  "Return if a window exists."
  (%rpc-send interface "window_exists" (id window)))

(defun list-windows (interface)
  "List the windows of the given interface. For dev purposes."
  (maphash (lambda (key val)
             (format t "~a ~a~&" key val))
          (windows interface)))
<commit_msg>remote.lisp: delete window with a string id<commit_after>;;; remote.lisp --- remote gui interface

;; We prefix all functions communicating over RPC with "%%".

(in-package :next)

(defclass window ()
  ((id :accessor id :initarg :id)
   (active-buffer :accessor active-buffer :initform nil)
   (minibuffer-active :accessor minibuffer-active :initform nil)
   (minibuffer-callbacks :accessor minibuffer-callbacks
                         :initform (make-hash-table :test #'equal))
   (minibuffer-closed-height :accessor minibuffer-closed-height :initform 0
                             :documentation "The height of the minibuffer when closed.")
   (minibuffer-open-height :accessor minibuffer-open-height :initform 200
                           :documentation "The height of the minibuffer when open.")
   (minibuffer-echo-height :accessor minibuffer-echo-height :initform 25
                           :documentation "The height of the minibuffer when echoing.")
   (history-db-path :accessor history-db-path :initform (xdg-data-home "history.db")
                    :documentation "The path where the system will create/save the history database.")
   (bookmark-db-path :accessor bookmark-db-path :initform (xdg-data-home "bookmark.db")
                     :documentation "The path where the system will create/save the bookmark database.")
   (search-engines :accessor search-engines :initform '(("default" . "https://duckduckgo.com/?q=~a")
                                                        ("wiki" . "https://en.wikipedia.org/w/index.php?search=~a"))
                   :documentation "An association list of all the search engines you can use in the minibuffer.
The 'default' engine is used when the query is not a valid URL, or the first
keyword is not recognized.")))

(defclass buffer ()
  ((id :accessor id :initarg :id)
   (name :accessor name :initarg :name)
   (mode :accessor mode :initarg :mode
         ;; TODO: This is rather clunky.  Use separate slot for the class symbol?
         :initform 'document-mode
         :documentation "The :initform and :initarg must be the class symbol.
The mode is instantiated on buffer initialization.")
   (view :accessor view :initarg :view)
   (modes :accessor modes :initarg :modes)
   (resource-query-functions :accessor resource-query-functions
                             :initarg :resource-query-functions
                             :initform nil)
   (callbacks :accessor callbacks
              :initform (make-hash-table :test #'equal))
   (default-new-buffer-url :accessor default-new-buffer-url :initform "https://next.atlas.engineer/start"
                           :documentation "The URL set to a new blank buffer opened by Next.")
   (scroll-distance :accessor scroll-distance :initform 50
                    :documentation "The distance scroll-down or scroll-up will scroll.")
   (horizontal-scroll-distance :accessor horizontal-scroll-distance :initform 50
                               :documentation "Horizontal scroll distance. The
distance scroll-left or scroll-right will scroll.")
   (current-zoom-ratio :accessor current-zoom-ratio :initform 1.0
                       :documentation "The current zoom relative to the default zoom.")
   (zoom-ratio-step :accessor zoom-ratio-step :initform 0.2
                    :documentation "The step size for zooming in and out.")
   (zoom-ratio-min :accessor zoom-ratio-min :initform 0.2
                   :documentation "The minimum zoom ratio relative to the default.")
   (zoom-ratio-max :accessor zoom-ratio-max :initform 5.0
                   :documentation "The maximum zoom ratio relative to the default.")
   (zoom-ratio-default :accessor zoom-ratio-default :initform 1.0
                       :documentation "The default zoom ratio.")
   (cookies-path :accessor cookies-path :initform (xdg-data-home "cookies.txt")
                 :documentation "The path where cookies are stored.  Not all
platform ports might support this.")))

(defmethod initialize-instance :after ((buffer buffer) &key)
  (when (symbolp (mode buffer))
    (setf (mode buffer) (make-instance (mode buffer)))))

;; A struct used to describe a key-chord
(defstruct key-chord
  key-code
  key-string
  modifiers
  position
  low-level-data)

(defmethod did-commit-navigation ((buffer buffer) url)
  (setf (name buffer) url)
  (did-commit-navigation (mode buffer) url))

(defmethod did-finish-navigation ((buffer buffer) url)
  (did-finish-navigation (mode buffer) url))

(defclass remote-interface ()
  ((port :accessor port :initform (make-instance 'port)
         :documentation "The CLOS object responible for handling the platform port.")
   (platform-port-poll-interval :accessor platform-port-poll-interval :initform 0.015
                                :documentation "The speed at which to poll the
RPC endpoint of a platform-port to see if it is ready to begin accepting RPC
commands.")
   (active-connection :accessor active-connection :initform nil)
   (minibuffer :accessor minibuffer :initform (make-instance 'minibuffer)
               :documentation "The minibuffer object.")
   (windows :accessor windows :initform (make-hash-table :test #'equal))
   (total-window-count :accessor total-window-count :initform 0)
   (last-active-window :accessor last-active-window :initform nil)
   (buffers :accessor buffers :initform (make-hash-table :test #'equal))
   (total-buffer-count :accessor total-buffer-count :initform 0)
   (start-page-url :accessor start-page-url :initform "https://next.atlas.engineer/quickstart"
                   :documentation "The URL of the first buffer opened by Next when started.")
   (key-chord-stack :accessor key-chord-stack :initform '()
                    :documentation "A stack that keeps track of the key chords a user has inputted.")))

(defmethod initialize-instance :after ((interface remote-interface)
                                       &key &allow-other-keys)
  "Start the RPC server."
  (let ((lock (bt:make-lock))
        (condition (bt:make-condition-variable)))
    (setf (active-connection interface)
          (bt:make-thread
           (lambda ()
             (dbus:with-open-bus (bus (session-server-addresses))
               (let ((status (dbus:request-name bus +core-name+ :do-not-queue)))
                 (when (eq status :exists)
                   (let ((url-list (or *free-args*
                                       (list (get-default 'buffer 'default-new-buffer-url)))))
                     (log:info  "Next already started, requesting to open URL(s) ~a." url-list)
                     (%rpc-send-self "make_buffers" "as" url-list)
                     (uiop:quit))))
               (log:info "Bus connection name: ~A" (dbus:bus-name bus))
               (bt:condition-notify condition)
               (dbus:publish-objects bus)))))
    (bt:acquire-lock lock)
    (bt:condition-wait condition lock)))

(defun session-server-addresses ()
  (let ((server-addresses (dbus:session-server-addresses)))
    (if server-addresses
        server-addresses
        ;; Check for MacOS dbus session address.
        (dbus:parse-server-addresses-string
         (format nil "unix:path=~a"
                 (uiop:getenv "DBUS_LAUNCHD_SESSION_BUS_SOCKET"))))))

(defmethod kill-interface ((interface remote-interface))
  "Stop the RPC server."
  (when (active-connection interface)
    (log:debug "Stopping server")
    ;; TODO: How do we close the connection?
    (bt:destroy-thread (active-connection interface))))

(defun %rpc-send-self (method-name signature &rest args)
  "Call METHOD over ARGS.
SIGNATURE must be the D-Bus encoded type string of ARGS.
For an array of string, that would be \"as\"."
  (dbus:with-open-bus (bus (session-server-addresses))
    (dbus:invoke-method (dbus:bus-connection bus) method-name
                        :path +core-object-path+
                        :destination +core-name+
                        :interface +core-interface+
                        :signature signature
                        :arguments args)))

(defmethod %rpc-send ((interface remote-interface) (method string) &rest args)
  ;; TODO: Make %rpc-send asynchronous?
  ;; If the platform port ever hangs, the next %rpc-send will hang the Lisp core too.
  ;; Always ensure we send the auth token as the first argument
  ;; TODO: Catch connection errors and execution errors.
  (dbus:with-open-bus (bus (session-server-addresses))
    (dbus:with-introspected-object (platform-port bus +platform-port-object-path+ +platform-port-name+)
      (apply #'platform-port +platform-port-interface+ method args))))

;; TODO: Move to separate packages:
;; - next-rpc
;; - next-script (?)
(defmethod %%list-methods ((interface remote-interface))
  "Return the unsorted list of RPC methods supported by the platform port."
  ;; TODO: Find the right way to do this in dbus.
  (%rpc-send interface "listMethods"))

(defmethod get-unique-window-identifier ((interface remote-interface))
  (incf (total-window-count interface))
  (format nil "~a" (total-window-count interface)))

(defmethod get-unique-buffer-identifier ((interface remote-interface))
  (incf (total-buffer-count interface))
  (format nil "~a" (total-buffer-count interface)))

(defmethod %%window-make ((interface remote-interface))
  "Create a window and return the window object."
  (let* ((window-id (get-unique-window-identifier interface))
         (window (make-instance 'window :id window-id)))
    (setf (gethash window-id (windows interface)) window)
    (%rpc-send interface "window_make" window-id)
    (unless (last-active-window interface)
      ;; When starting from a REPL, it's possible that the window is spawned in
      ;; the background and %%window-active would then return nil.
      (setf (last-active-window interface) window))
    window))

(defmethod %%window-set-title ((interface remote-interface) (window window) title)
  "Set the title for a given window."
  (%rpc-send interface "window_set_title" (id window) title))

(defmethod %%window-delete ((interface remote-interface) (window window))
  "Delete a window object and remove it from the hash of windows."
  (%rpc-send interface "window_delete" (id window))
  (with-slots (windows) interface
    (remhash (id window) windows)))

(defmethod %%window-delete ((interface remote-interface) (window_id string))
  "Delete a window given its id (string)."
  (%rpc-send interface "window_delete" window_id)
  (with-slots (windows) interface
    (remhash window_id windows)))

(defmethod %%window-active ((interface remote-interface))
  "Return the window object for the currently active window."
  (with-slots (windows) interface
    (let ((window (gethash (%rpc-send interface "window_active")
                           windows)))
      (when window
        (setf (last-active-window interface) window))
      (last-active-window interface))))

(defmethod %%window-exists ((interface remote-interface) (window window))
  "Return if a window exists."
  (%rpc-send interface "window_exists" (id window)))

(defun list-windows (interface)
  "List the windows of the given interface. For dev purposes."
  (maphash (lambda (key val)
             (format t "~a ~a~&" key val))
          (windows interface)))

{'fraction_non_alphanumeric': 0.11306974437581714, 'fraction_numerical': 0.002344348766962716, 'mean_word_length': 2.874585152838428, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 8, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1259518', 'n_tokens_mistral': 6285, 'n_tokens_neox': 6088, 'n_words': 2029}