more kinds of commands

command-client.el

@@ -37,35 +37,72 @@
                       (error "No such file: %s" request-path)
                     (with-temp-buffer
                       (insert-file-contents-literally request-path)
-                      ;(message "-- COMMAND SERVER received request: %s" (buffer-string))
+                      ;; (message "-- COMMAND SERVER received request: %s" (buffer-string))
                       (json-parse-buffer))))
          (command-id (gethash "commandId" request))
          (args (gethash "args" request))
-         (wait-for-finish (gethash "waitForFinish" request))
-         (return-command-output (gethash "returnCommandOutput" request))
+         (wait-for-finish (null (eq :false (gethash "waitForFinish" request))))
+         (return-command-output (null (eq :false (gethash "returnCommandOutput" request))))
          (uuid (gethash "uuid" request)))
-
-    ;; TODO: Eventually I'd like to make it possible to run arbitrary emacs lisp
-    ;; code via the command server. For now, though, I'm just going to
-    ;; special-case cursorless.
-    (cond
-     ((string-equal command-id "cursorless.command")
-      ;; Forward to vscode. TODO: When wait-for-finish is true, we should wait
-      ;; _asynchronously_ to hear back from vscode. So we have to set up a
-      ;; callback which writes to response-path. Maybe fork a thread? or have a
-      ;; dedicated thread?
-      (let ((payload (make-hash-table :size 2)))
-        (puthash "command" "cursorless" payload)
-        (puthash "cursorlessArgs" (json-serialize args) payload)
-        (setq payload (json-serialize payload))
-        (cursorless-send payload))
-      ;; For now write an empty response. FIXME.
-      (with-temp-file response-path
-        (json-insert `(:uuid ,uuid :warnings [] :error :null :returnValue :null))
-        (insert "\n")))
-     (t
-      ;; TODO: write an error response.
-      (error "Unrecognized command id %S" command-id)))))
+    (cl-flet ((respond (value)
+                (with-temp-file response-path
+                  (json-insert `(:uuid ,uuid
+                                 :warnings []
+                                 :error :null
+                                 :returnValue ,value))
+                  (insert "\n"))))
+     ;; TODO: Think more about what the API here should be.
+     ;; I'm piggybacking on cursorless' commandId/args model for now.
+     (cond
+
+      ;; -- CURSORLESS COMMANDS --
+      ((string-equal command-id "cursorless.command")
+       ;; Forward to vscode. TODO: When wait-for-finish is true, we should wait
+       ;; _asynchronously_ to hear back from vscode. So we have to set up a
+       ;; callback which writes to response-path. Maybe fork a thread? or have a
+       ;; dedicated thread?
+       (let ((payload (make-hash-table :size 2)))
+         (puthash "command" "cursorless" payload)
+         (puthash "cursorlessArgs" (json-serialize args) payload)
+         (setq payload (json-serialize payload))
+         (cursorless-send payload))
+       ;; For now write an empty response.
+       ;; TODO: we need this response to implement actions that use, eg, getText,
+       ;; such as "format <formatter> at <target>".
+       (respond :null))
+
+      ;; -- ELISP EVAL --
+      ((string-equal command-id "eval")
+       (unless (eql 1 (seq-length args)) (error "eval takes only one argument"))
+       (let* ((code-string (elt args 0))
+              (res (read-from-string code-string))
+              (code (car res))
+              (_ (unless (eql (cdr res) (length code-string))
+                   (error "code contained unparsed junk"))))
+         ;; Assume the result is json-encodable. TODO: handle case it's not.
+         (respond (eval code))))
+
+      ;; -- ELISP CALL --
+      ((string-equal command-id "call")
+       (let* ((func (intern (elt args 0)))
+              (args (seq-into (seq-drop args 1) 'list)))
+         (respond (apply func args))))
+
+      ;; -- INTERACTIVE ELISP CALL --
+      ((string-equal command-id "call-interactively")
+       (when return-command-output
+         (warn "Requested command output of call-interactively; that is likely to time out, ignoring."))
+       (let ((func (intern (elt args 0))))
+         (unless (fboundp func) (error "Function not bound: %S" func))
+         ;; We issue the response _first_, so that we don't hang if the
+         ;; interactive call takes a while.
+         (respond :null)
+         (call-interactively (intern (elt args 0)))))
+
+      ;; -- UNRECOGNIZED --
+      (t
+       ;; TODO: write an error response.
+       (error "Unrecognized command id %S" command-id))))))
 
 
 ;;; ---------- emacs -> vscode over cursorless socket ----------
@@ -79,8 +116,7 @@
         (warn "Cursorless: unexpected error on communicating with vscode: %s, %s" status event)
       (cursorless-receive
        (with-current-buffer cursorless-socket-buffer
-         ;; (message "-- CURSORLESS received: %s"
-         ;;          (buffer-substring-no-properties (point-min) (point-max)))
+         ;; (message "-- CURSORLESS received: %s" (buffer-substring-no-properties (point-min) (point-max)))
          (goto-char (point-min)) ;; json-parse-buffer parses forward from point.
          (json-parse-buffer))))))
 
@@ -180,3 +216,37 @@
 (global-set-key (kbd "<C-f17>") 'command-server-trigger)
 
 (provide 'command-client)
+
+;; Magical stuff.
+(require 'isearch)
+
+(define-key isearch-mode-map (kbd "<C-f17>") 'command-server-trigger)
+
+;; see also 'with-isearch-suspended
+(defun talon-insert (text)
+  (if isearch-mode
+      (seq-do 'isearch-printing-char text)
+    (insert text)))
+
+(defun talon-insert-between (before after)
+  (insert before)
+  (save-excursion (insert after)))
+
+(defun talon-peek-both ()
+  (let ((left (talon-peek-left)))
+    (vector left (talon-peek-right))))
+
+(defun talon-peek-left ()
+  (save-excursion
+    (let ((end (if (region-active-p)
+                   (goto-char (region-beginning))
+                 (point))))
+      (backward-word 2)
+      (buffer-substring-no-properties (point) end))))
+
+(defun talon-peek-right ()
+  (save-excursion
+    (let ((beg (if (region-active-p)
+                   (goto-char (region-end))
+                 (point))))
+      (buffer-substring-no-properties beg (line-end-position)))))

cursorless-hats.el

@@ -163,22 +163,21 @@
 ;; FIXME: multiplying character width by character offset doesn't work for
 ;; strange-width characters (eg. TABS!).
 (defun cursorless-line-svg (columns hats font-width font-height)
-  (let* ((w font-width)
-         ;; (dia (* w 0.5)) (h (* 0.6 font-height)) (r (/ dia 2)) (ypos (- h (* r 2)))
-         ;; (dia (* w .45)) (h (* w 0.8)) (r (/ dia 2)) (ypos (- h (* r 1.5)))
-         (dia (* w .44)) (r (* 0.5 dia)) (h (+ 2 (round dia))) (ypos (- h (* r 1) 1))
-         (dia (* w .44)) (r (* 0.5 dia)) (h (ceiling dia)) (ypos (- h r))
+  (let* ((h     (* font-height .3333))
+         (xrad  (* .2857 font-width))
+         (yrad  (* .4 h))
+         (ypos  (- h yrad))
          ;; if columns = 0, we still want a 1-pixel-wide image, otherwise we get
          ;; a weird 'empty box' image out of emacs.
-         (svg (svg-create (max 1 (* w columns)) h)))
+         (svg (svg-create (max 1 (* font-width columns)) h)))
     ;; hats is a list of plists with at least the properties :column & :color.
     (dolist (hat hats)
       (let* ((color (plist-get hat :color))
-             (xoffset (* w (plist-get hat :column)))
-             (xcenter (+ xoffset (/ w 2.0))))
+             (xoffset (* font-width (plist-get hat :column)))
+             (xcenter (+ xoffset (/ font-width 2.0))))
         ;(svg-circle svg xcenter ypos r :fill color)
         ;; squashed ellipse to save vertical space.
-        (svg-ellipse svg xcenter ypos r (/ (- h 1) 2.0) :fill color)
+        (svg-ellipse svg xcenter ypos xrad yrad :fill color)
         ;(svg-rectangle svg (- xcenter r) 1 dia dia :fill color)
         ))
     ;; scale 1 because we've already accounted for pixel sizes correctly.

cursorless.el

@@ -1,6 +1,7 @@
 (require 'cl-macs)
 (require 'svg)
 (require 'filenotify)
+(require 'seq)
 
 
 ;; Utilities.

emacs_cursorless.talon

@@ -0,0 +1,20 @@
+app: emacs
+app: Emacs
+-
+
+emacs talon enable: user.emacs_command("talon-enable")
+emacs talon disable: user.emacs_command("talon-disable")
+
+show hats: user.emacs_command("show-hats")
+hide hats: user.emacs_command("hide-hats")
+(cursor less | cursorless) (start [sync] | sync): user.emacs_command("cursorless-enable-sync")
+(cursor less | cursorless) (stop [sync]): user.emacs_command("cursorless-disable-sync")
+command server start: user.emacs_command("command-server-start")
+command server (stop|quit): user.emacs_command("command-server-quit")
+command server trigger: key(ctrl-f17)
+
+emacs rpc test:
+  mode = user.run_rpc_command_get("eval", "isearch-mode")
+  bufname = user.run_rpc_command_get("eval", "(buffer-name (current-buffer))")
+  print("buffer name: {bufname}")
+  print("mode: {mode}")

emacs_rpc.py

@@ -0,0 +1,44 @@
+from talon import Context, actions, ui, Module, app, clip
+from user.knausj.code import dictation
+
+mod = Module()
+ctx = Context()
+ctx.matches = r'''
+os: linux
+app: Emacs
+app: emacs
+'''
+
+INSERT_THRESHOLD = 8
+
+@ctx.action_class('user')
+class UserActions:
+    def dictation_peek(left, right):
+        try:
+            return tuple(actions.user.run_rpc_command_get("call", "talon-peek-both"))
+        except:
+            return actions.next(left, right)
+
+    def insert_between(before, after):
+        if len(before) + 2 * len(after) <= INSERT_THRESHOLD:
+            return actions.next(before, after)
+        try: actions.user.run_rpc_command("call", "talon-insert-between", before, after)
+        except: actions.next(before, after)
+
+    # def paste(text):
+    #     try: actions.user.run_rpc_command("call", "insert", text)
+    #     except: actions.next(text)
+
+    def emacs_command(name, shortname = None):
+        try: actions.user.run_rpc_command("call-interactively", name)
+        except: actions.next(name, shortname)
+
+@ctx.action_class('main')
+class MainActions:
+    # FUCK. this doesn't work while isearch-ing D: D: D:
+    def insert(text):
+        #if len(text) <= INSERT_THRESHOLD: return actions.next(text)
+        try: actions.user.run_rpc_command("call", "talon-insert", text)
+        except: actions.next(text)
+
+