Draft: Copilot panel

clients/lsp-copilot.el

@@ -55,7 +55,7 @@ lsp-install-server to fetch an emacs-local version of the LSP."
   :type 'string
   :group 'lsp-copilot)
 
-(defcustom lsp-copilot-applicable-fn (-const t)
+(defcustom lsp-copilot-applicable-fn (lambda (&rest _) lsp-copilot-enabled)
   "A function which returns whether the copilot is applicable for the buffer.
 The input are the file name and the major mode of the buffer."
   :type 'function
@@ -178,6 +178,231 @@ automatically, browse to %s." user-code verification-uri))
         :name "emacs"
         :version "0.1.0"))
 
+
+(defcustom lsp-copilot-progress-handlers nil
+  "Handler functions for the $/progress callback. These handlers must
+expect two parameters: the current workspace and notification
+parameters."
+  :type 'hook
+  :group 'lsp-copilot)
+
+
+(defun lsp-copilot--progress-callback (workspace params)
+  (when lsp-progress-function
+    (funcall lsp-progress-function workspace params))
+
+  (run-hook-with-args 'lsp-copilot-progress-handlers workspace params))
+
+;;; Panel Completion
+
+(defvar-local lsp-copilot-panel-completion-items nil
+  "A list of completion items returned by the Panel Completion call")
+
+(defvar-local lsp-copilot-panel-completion-token nil
+  "The per-request token")
+
+(defvar-local lsp-copilot-panel-modification-tick nil
+  "Modification tick when the panel was called")
+
+(defun lsp-copilot--panel-accept-item (completing-buffer-name original-tick item)
+  (when (buffer-live-p (get-buffer completing-buffer-name))
+    (with-current-buffer completing-buffer-name
+      (unless (= original-tick (buffer-chars-modified-tick))
+        (user-error "Can not accept the suggestion on a modified buffer. Try copying it"))
+
+      (-let* (((&copilot-ls:PanelCompletionItem? :insert-text :range? :command?) item)
+              ((start . end) (when range?
+                               (-let (((&RangeToPoint :start :end) range?)) (cons start end)))))
+
+        (unless (and start end)
+          (error "Server did not provide a range -- Can not insert"))
+
+        (lsp-with-undo-amalgamate
+          (delete-region start end)
+          (goto-char start)
+          (insert insert-text))
+
+        ;; Post command
+        (when command?
+          (lsp--execute-command command?))))))
+
+(defun lsp-copilot--panel-accept-suggestion-at-point ()
+  (interactive)
+  (let ((completing-buffer-name (get-text-property (point) 'lsp-panel-completing-buffer-name))
+        (original-tick (get-text-property (point) 'lsp-original-tick))
+        (item (get-text-property (point) 'lsp-panel-item)))
+    (lsp-copilot--panel-accept-item completing-buffer-name original-tick item)
+    (quit-window)))
+
+(defun lsp-copilot--panel-accept-button-click (b)
+  (when-let* ((item (overlay-get b 'lsp-panel-item))
+              (completing-buffer-name (overlay-get b 'lsp-panel-completing-buffer-name))
+              (original-tick (overlay-get b 'lsp-original-tick)))
+    (lsp-copilot--panel-accept-item completing-buffer-name original-tick item)
+
+    (quit-window)))
+
+(defun lsp-copilot--panel-copy-button-click (b)
+
+  (kill-new (lsp:copilot-ls-panel-completion-item-insert-text (overlay-get b 'lsp-panel-item)))
+  (quit-window))
+
+(defun lsp-copilot--panel-forward-suggestion (arg)
+  (interactive "p")
+  (org-forward-heading-same-level arg)
+  (recenter-top-bottom 0)
+  (org-down-element))
+
+(defun lsp-copilot--panel-backward-suggestion (arg)
+  (interactive "p")
+  (org-backward-heading-same-level arg)
+  (recenter-top-bottom 0)
+  (org-down-element))
+
+(define-derived-mode lsp-copilot-panel-buffer-mode org-mode "CopilotPanel"
+  "A major mode for completions "
+  :group 'lsp-copilot)
+
+
+(let ((key-bindings '(("C-n" . lsp-copilot--panel-forward-suggestion)
+                      ("C-p" . lsp-copilot--panel-backward-suggestion)
+                      ("C-<return>" . lsp-copilot--panel-accept-suggestion-at-point)
+                      ("q" . quit-window))))
+  (dolist (binding key-bindings)
+    (bind-key (kbd (car binding)) (cdr binding) 'lsp-copilot-panel-buffer-mode-map)))
+
+
+(defcustom lsp-copilot-panel-display-fn #'pop-to-buffer
+  "Function used to display the panel completions buffer"
+  :type 'function
+  :group 'lsp-copilot)
+
+
+(defun lsp-copilot--panel-display-buffer (completing-buffer-name items original-tick)
+  "Builds and display the panel buffer"
+  ;; TODO: maybe receive accept-fn / cancell-fn / copy-fn as parameters, so we
+  ;; can use panel on other contexts...
+  (if (lsp-inline-completion--active-and-visible-p)
+    (progn
+      (message "Cancelling inlnie completion")
+      (lsp-inline-completion-cancel)))
+
+  ;; Maybe use hooks to better integrate with other completions, create a
+  ;; panel-company-integration-mode as we do in inline completions
+  (when (and (bound-and-true-p company-mode)
+             (company--active-p))
+    (company-cancel))
+
+  (let ((buf (get-buffer-create (format "*lsp-copilot-panel-results-%s*" completing-buffer-name) )))
+    (with-current-buffer buf
+      (read-only-mode -1)
+      (erase-buffer)
+      (fundamental-mode)
+
+      ;; (insert "#+STARTUP: noindent\n\n")
+      (setq-local org-startup-indented nil)
+      (cl-loop for item in items
+               for i from 1
+               do
+               (-let* ((start-point (point))
+                       ((&copilot-ls:PanelCompletionItem? :insert-text) item)
+                       (heading (format "* Solution %d" i))
+                       (src (format "#+begin_src %s\n%s\n#+end_src\n" "python" insert-text)))
+
+                 (insert heading)
+                 (insert ?\n ?\n)
+                 (insert-button "Accept"
+                                'action #'lsp-copilot--panel-accept-button-click
+                                'lsp-original-tick original-tick
+                                'lsp-panel-item item
+                                'lsp-panel-completing-buffer-name completing-buffer-name)
+
+                 (insert ?\s)
+
+                 (insert-button "Copy"
+                                'action #'lsp-copilot--panel-copy-button-click
+                                'lsp-original-tick original-tick
+                                'lsp-panel-item item
+                                'lsp-panel-completing-buffer-name completing-buffer-name)
+
+                 (insert ?\n)
+                 (insert src)
+                 (insert ?\n ?\n)
+
+                 (put-text-property start-point (point) 'lsp-original-tick original-tick)
+                 (put-text-property start-point (point) 'lsp-panel-item item)
+                 (put-text-property start-point (point) 'lsp-panel-completing-buffer-name completing-buffer-name)))
+
+      (delete-all-space t)
+      (lsp-copilot-panel-buffer-mode)
+      (read-only-mode +1)
+
+      (goto-char (point-min))
+      (org-down-element))
+
+    (if (get-buffer-window completing-buffer-name 'visible)
+        (progn
+          (select-window (get-buffer-window completing-buffer-name 'visible))
+          (funcall lsp-copilot-panel-display-fn buf))
+      (user-error "The original buffer for completions was not active; not showing panel"))))
+
+
+(defun lsp-copilot-panel-display-buffer ()
+  "Displays a completion panel with the items collected by the last call of lsp-copilot-panel-completion"
+  (interactive)
+
+  (if lsp-copilot-panel-completion-items
+      (lsp-copilot--panel-display-buffer (buffer-name) lsp-copilot-panel-completion-items lsp-copilot-panel-modification-tick)
+    (lsp--error "No completions to display")))
+
+(defun lsp-copilot--panel-completions-progress-handler (workspace params)
+  (-let* (((&ProgressParams :token :value) params)
+          ((action completing-buffer-name panel-completion-token) (string-split token " /// " )))
+    (pcase action
+      ;; copilot sends results in the report
+      ("PANEL-PARTIAL-RESULT"
+       (when (and (lsp-copilot-ls-panel-completion-items? value)
+                  (buffer-live-p (get-buffer completing-buffer-name)))
+         (with-current-buffer completing-buffer-name
+           (when (string-equal panel-completion-token lsp-copilot-panel-completion-token)
+             (setq-local lsp-copilot-panel-completion-items
+                         (nconc lsp-copilot-panel-completion-items
+                                (seq-into (lsp:copilot-ls-panel-completion-items-items value) 'list)))))))
+      ("PANEL-WORK-DONE"
+       (when (and (lsp-work-done-progress-end? value)
+                  (buffer-live-p (get-buffer completing-buffer-name))
+                  (string-equal (lsp:work-done-progress-end-kind value) "end"))
+         (with-current-buffer completing-buffer-name
+           (when (string-equal panel-completion-token lsp-copilot-panel-completion-token)
+             (lsp-copilot-panel-display-buffer))))))))
+
+;; TODO: Maybe find a way to inhibit the inline completion timer ... probably
+;; we can cancel it here
+(defun lsp-copilot-panel-completion ()
+  "Use a Completion Panel to provide suggestions at point"
+  (interactive)
+
+  (setq lsp-inline-completion--inhibit-timer t)
+  (when lsp-inline-completion--idle-timer
+    (cancel-timer lsp-inline-completion--idle-timer))
+
+  (let* ((token (uuidgen-1))
+         (partial-token (format "PANEL-PARTIAL-RESULT /// %s /// %s" (buffer-name) token))
+         (done-token (format "PANEL-WORK-DONE /// %s /// %s"  (buffer-name) token))
+         (params (lsp-make-copilot-ls-panel-completion-params :text-document (lsp--text-document-identifier)
+                                                              :position (lsp--cur-position)
+                                                              :partial-result-token partial-token
+                                                              :work-done-token done-token)))
+    (setq-local lsp-copilot-panel-modification-tick (buffer-chars-modified-tick))
+    (setq-local lsp-copilot-panel-completion-token token)
+    (setq-local lsp-copilot-panel-completion-items nil)
+    (add-to-list 'lsp-copilot-progress-handlers #'lsp-copilot--panel-completions-progress-handler)
+
+    ;; call the complation and do not wait for any result -- the completions
+    ;; will be provided via $/progress notifications
+    (lsp-request-async "textDocument/copilotPanelCompletion" params #'ignore)))
+
+
 (defun lsp-copilot--server-initialized-fn (workspace)
   ;; Patch capabilities -- server may respond with an empty dict. In plist,
   ;; this would become nil
@@ -204,7 +429,7 @@ automatically, browse to %s." user-code verification-uri))
   :download-server-fn (lambda (_client callback error-callback _update?)
                         (lsp-package-ensure 'copilot-ls callback error-callback))
   :notification-handlers (lsp-ht
-                          ("$/progress" (lambda (&rest args) (lsp-message "$/progress with %S" args)))
+                          ("$/progress" #'lsp-copilot--progress-callback)
                           ("featureFlagsNotification" #'ignore)
                           ("statusNotification" #'ignore)
                           ("window/logMessage" #'lsp--window-log-message)