Editors and Mergetools with drracket

private/find-editor.rkt

@@ -0,0 +1,177 @@
+#lang racket/base
+
+(require racket/path
+         "config.rkt")
+
+(provide find-editor
+         configured-editor
+         set-editor!)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Quote an executable path for use as a Git editor command.
+; pre    : p is a path to an executable.
+; post   : p has only been converted to a string.
+; result : A quoted command path.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (quote-command-path p)
+  (format "\"~a\"" (path->string p)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return an existing executable from a list of candidate paths.
+; pre    : candidates contains paths or #f values.
+; post   : The filesystem has only been inspected.
+; result : The first existing path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (first-existing candidates)
+  (cond
+    ((null? candidates) #f)
+    ((and (car candidates)
+          (file-exists? (car candidates)))
+     (car candidates))
+    (else
+     (first-existing (cdr candidates)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build a path below an environment variable when it is defined.
+; pre    : variable is an environment variable name.
+; post   : The environment has only been inspected.
+; result : The constructed path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (environment-path variable . parts)
+  (let ((base (getenv variable)))
+    (if base
+        (apply build-path base parts)
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find an editor executable on PATH and append its wait arguments.
+; pre    : executable is a pathless executable name.
+; post   : PATH has only been inspected.
+; result : An editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (editor-on-path executable arguments)
+  (let ((p (find-executable-path executable)))
+    (if p
+        (string-append (quote-command-path p) arguments)
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Make an editor command from an existing well-known path.
+; pre    : p is a path or #f; arguments contains the editor wait arguments.
+; post   : p has only been inspected.
+; result : An editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (editor-at p arguments)
+  (if (and p (file-exists? p))
+      (string-append (quote-command-path p) arguments)
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find a well-known GUI editor on Windows.
+; pre    : The current platform is Windows.
+; post   : PATH and standard Windows installation locations were inspected.
+; result : A Git editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-windows-editor)
+  (or (editor-on-path "code.cmd" " --wait")
+      (editor-on-path "code.exe" " --wait")
+      (editor-at
+       (first-existing
+        (list
+         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd")
+         (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd")
+         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd")))
+       " --wait")
+      (editor-at
+       (first-existing
+        (list
+         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "Code.exe")
+         (environment-path "ProgramFiles" "Microsoft VS Code" "Code.exe")
+         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "Code.exe")))
+       " --wait")
+      (editor-on-path "notepad.exe" "")
+      (editor-at
+       (environment-path "SystemRoot" "System32" "notepad.exe")
+       "")
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find a well-known GUI editor on macOS.
+; pre    : The current platform is macOS.
+; post   : PATH and standard application locations were inspected.
+; result : A Git editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-macos-editor)
+  (or (editor-on-path "code" " --wait")
+      (editor-at
+       (string->path
+        "/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code")
+       " --wait")
+      (let ((open
+             (or (find-executable-path "open")
+                 (let ((p (string->path "/usr/bin/open")))
+                   (if (file-exists? p) p #f)))))
+        (if open
+            (format "~a -W -a TextEdit" (quote-command-path open))
+            #f))
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find a well-known GUI editor on Unix/Linux.
+; pre    : The current platform is Unix.
+; post   : PATH and common Linux installation locations were inspected.
+; result : A Git editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-unix-editor)
+  (or (editor-on-path "code" " --wait")
+      (editor-on-path "kate" " --block")
+      (editor-on-path "gedit" " --wait")
+      (editor-on-path "xed" " --wait")
+      (editor-at (string->path "/snap/bin/code") " --wait")
+      (editor-at (string->path "/usr/local/bin/code") " --wait")
+      (editor-at (string->path "/usr/bin/code") " --wait")
+      (editor-at (string->path "/usr/local/bin/kate") " --block")
+      (editor-at (string->path "/usr/bin/kate") " --block")
+      (editor-at (string->path "/usr/bin/gedit") " --wait")
+      (editor-at (string->path "/usr/bin/xed") " --wait")
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the editor explicitly configured for git-cli.
+; pre    : The git-cli configuration is readable.
+; post   : The configuration has not been changed.
+; result : The configured editor command, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (configured-editor)
+  (cfg-get 'git 'editor #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store the editor command used by git-cli.
+; pre    : command is a command string suitable for GIT_EDITOR.
+; post   : The command has been stored in the git-cli configuration.
+; result : The result returned by the configuration layer.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-editor! command)
+  (cfg-set! 'git 'editor command))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the GUI editor that git-cli should offer to Git.
+; pre    : The platform and git-cli configuration are available.
+; post   : No editor has been started.
+; result : A configured or well-known GUI editor command, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-editor)
+  (or (configured-editor)
+      (case (system-type 'os)
+        ((windows) (find-windows-editor))
+        ((macosx) (find-macos-editor))
+        ((unix) (find-unix-editor))
+        (else #f))))