Add Windows deployment pipeline (icon, installer, GUI subsystem)

lem.asd

@@ -318,4 +318,5 @@
                #+(and os-unix (not os-macosx)) ; workaround: because (adf:make :lem) fails
                "lem-ncurses")
   :pathname "src"
-  :components ((:file "macosx" :if-feature :os-macosx)))
+  :components ((:file "macosx" :if-feature :os-macosx)
+               (:file "windows" :if-feature :os-windows)))

scripts/install/lem.iss

@@ -0,0 +1,115 @@
+; Inno Setup script for Lem.
+; Compiled by scripts\win-deploy.ps1 (which passes /DAppVersion=<version>);
+; expects the deploy-op output in ..\..\bin\.
+
+#ifndef AppVersion
+#define AppVersion "0.0.0"
+#endif
+
+#define AppName "Lem"
+#define AppExe "lem.exe"
+
+[Setup]
+AppId={{7E7DA1D6-40F5-4E4D-9E2A-2C7C2C1E6D5B}
+AppName={#AppName}
+AppVersion={#AppVersion}
+AppPublisher=lem-project
+AppPublisherURL=https://lem-project.github.io/
+AppSupportURL=https://github.com/lem-project/lem
+DefaultDirName={autopf}\{#AppName}
+DefaultGroupName={#AppName}
+UninstallDisplayIcon={app}\{#AppExe}
+SetupIconFile=lem.ico
+LicenseFile=..\..\LICENCE
+OutputBaseFilename=Lem-{#AppVersion}-setup
+Compression=lzma2/max
+SolidCompression=yes
+WizardStyle=modern
+ArchitecturesAllowed=x64compatible
+ArchitecturesInstallIn64BitMode=x64compatible
+PrivilegesRequired=admin
+PrivilegesRequiredOverridesAllowed=dialog
+ChangesEnvironment=yes
+
+[Languages]
+Name: "english"; MessagesFile: "compiler:Default.isl"
+Name: "japanese"; MessagesFile: "compiler:Languages\Japanese.isl"
+
+[Tasks]
+Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; Flags: unchecked
+Name: "addtopath"; Description: "Add Lem to PATH"; Flags: unchecked
+
+[Files]
+Source: "..\..\bin\*"; DestDir: "{app}"; Flags: recursesubdirs ignoreversion
+
+[Icons]
+Name: "{group}\{#AppName}"; Filename: "{app}\{#AppExe}"
+Name: "{group}\{cm:UninstallProgram,{#AppName}}"; Filename: "{uninstallexe}"
+Name: "{autodesktop}\{#AppName}"; Filename: "{app}\{#AppExe}"; Tasks: desktopicon
+
+[Registry]
+; Explorer context menu: "Open with Lem" on any file
+Root: HKA; Subkey: "Software\Classes\*\shell\{#AppName}"; ValueType: string; ValueData: "Open with {#AppName}"; Flags: uninsdeletekey
+Root: HKA; Subkey: "Software\Classes\*\shell\{#AppName}"; ValueType: string; ValueName: "Icon"; ValueData: """{app}\{#AppExe}"""
+Root: HKA; Subkey: "Software\Classes\*\shell\{#AppName}\command"; ValueType: string; ValueData: """{app}\{#AppExe}"" ""%1"""
+
+[Code]
+const
+  EnvKeyMachine = 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment';
+  EnvKeyUser = 'Environment';
+
+function EnvRootKey(): Integer;
+begin
+  if IsAdminInstallMode then
+    Result := HKEY_LOCAL_MACHINE
+  else
+    Result := HKEY_CURRENT_USER;
+end;
+
+function EnvSubKey(): string;
+begin
+  if IsAdminInstallMode then
+    Result := EnvKeyMachine
+  else
+    Result := EnvKeyUser;
+end;
+
+procedure EnvAddPath(const Dir: string);
+var
+  Paths: string;
+begin
+  if not RegQueryStringValue(EnvRootKey, EnvSubKey, 'Path', Paths) then
+    Paths := '';
+  if Pos(';' + Uppercase(Dir) + ';', ';' + Uppercase(Paths) + ';') > 0 then
+    exit;
+  if (Paths <> '') and (Paths[Length(Paths)] <> ';') then
+    Paths := Paths + ';';
+  Paths := Paths + Dir;
+  RegWriteExpandStringValue(EnvRootKey, EnvSubKey, 'Path', Paths);
+end;
+
+procedure EnvRemovePath(const Dir: string);
+var
+  Paths: string;
+  P: Integer;
+begin
+  if not RegQueryStringValue(EnvRootKey, EnvSubKey, 'Path', Paths) then
+    exit;
+  P := Pos(';' + Uppercase(Dir) + ';', ';' + Uppercase(Paths) + ';');
+  if P = 0 then
+    exit;
+  Delete(Paths, P, Length(Dir) + 1);
+  RegWriteExpandStringValue(EnvRootKey, EnvSubKey, 'Path', Paths);
+end;
+
+procedure CurStepChanged(CurStep: TSetupStep);
+begin
+  if (CurStep = ssPostInstall) and WizardIsTaskSelected('addtopath') then
+    EnvAddPath(ExpandConstant('{app}'));
+end;
+
+procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
+begin
+  if CurUninstallStep = usPostUninstall then
+    EnvRemovePath(ExpandConstant('{app}'));
+end;

scripts/win-deploy.lisp

@@ -0,0 +1,38 @@
+;; Windows deployment build: produce bin/lem.exe (webview frontend, GUI
+;; subsystem) plus all required DLLs via the deploy library (deploy-op
+;; declared in lem.asd).
+;;
+;; Run through scripts/win-deploy.ps1, which first embeds the application
+;; icon into a copy of the SBCL runtime.  The icon cannot be added to the
+;; finished executable: rewriting PE resources afterwards corrupts the
+;; Lisp core appended by save-lisp-and-die ("Can't find sbcl.core").
+;;
+;; Uses plain Quicklisp instead of qlot, which does not work on Windows.
+
+;; SBCL bundles an old ASDF (no :local-nicknames in uiop:define-package);
+;; load ASDF 3.3.7 first.  win-deploy.ps1 downloads it (checksum-verified)
+;; into build/windows/.
+(let* ((scripts-dir (make-pathname :name nil :type nil
+                                   :defaults *load-truename*))
+       (root (make-pathname :directory (butlast (pathname-directory scripts-dir))
+                            :defaults scripts-dir)))
+  (load (merge-pathnames "build/windows/asdf-3.3.7.lisp" root)))
+
+(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
+
+(let ((root (uiop:pathname-parent-directory-pathname
+             (uiop:pathname-directory-pathname *load-truename*))))
+  (asdf:initialize-source-registry
+   `(:source-registry
+     (:tree ,root)
+     :inherit-configuration)))
+
+(ql:quickload :lem)
+
+(lem:init-at-build-time)
+
+;; deploy-op dumps the image (with :application-type :gui and
+;; :save-runtime-options t) into bin/ next to lem.asd, together with all
+;; foreign libraries loaded in the image (webview.dll, libasyncprocess.dll).
+;; save-lisp-and-die exits the process, so this form never returns.
+(asdf:make :lem)

scripts/win-deploy.ps1

@@ -0,0 +1,129 @@
+# win-deploy.ps1 - Build and package Lem as a Windows application.
+#
+# Produces:
+#   bin\lem.exe + DLLs                          (deploy-op output, icon embedded)
+#   build\windows\Lem-<version>-windows-x64.zip (portable archive)
+#   build\windows\Lem-<version>-setup.exe       (installer, if Inno Setup is installed)
+#
+# The application icon is embedded into a copy of the SBCL runtime BEFORE
+# the image is dumped: editing PE resources of the finished executable
+# corrupts the appended Lisp core.
+#
+# Usage: powershell -ExecutionPolicy Bypass -File scripts\win-deploy.ps1
+#        [-SkipBuild] [-Sign]
+
+param(
+    [switch]$SkipBuild,   # reuse existing bin\ output, only package
+    [switch]$Sign         # self-sign bin\*.exe/dll via export-and-selfsign.ps1
+)
+
+$ErrorActionPreference = 'Stop'
+
+$root     = (Resolve-Path "$PSScriptRoot\..").Path
+$buildDir = Join-Path $root 'build\windows'
+$binDir   = Join-Path $root 'bin'
+$icon     = Join-Path $root 'scripts\install\lem.ico'
+New-Item -ItemType Directory -Force $buildDir | Out-Null
+
+# --- Version (from defsystem "lem" in lem.asd) -------------------------------
+$asd = Get-Content (Join-Path $root 'lem.asd') -Raw
+if ($asd -notmatch '(?s)\(defsystem "lem"\s+:version "([0-9.]+)"') {
+    throw "Could not find :version of system `"lem`" in lem.asd"
+}
+$version = $Matches[1]
+Write-Host "== Lem $version =="
+
+# --- rcedit (pinned) ----------------------------------------------------------
+$rcedit = Join-Path $buildDir 'rcedit-x64.exe'
+$rceditUrl = 'https://github.com/electron/rcedit/releases/download/v2.0.0/rcedit-x64.exe'
+$rceditSha256 = '3E7801DB1A5EDBEC91B49A24A094AAD776CB4515488EA5A4CA2289C400EADE2A'
+if (-not (Test-Path $rcedit)) {
+    Write-Host "Downloading rcedit..."
+    Invoke-WebRequest -Uri $rceditUrl -OutFile $rcedit
+}
+if ((Get-FileHash $rcedit -Algorithm SHA256).Hash -ne $rceditSha256) {
+    Remove-Item $rcedit -Force
+    throw "rcedit-x64.exe checksum mismatch; delete and retry"
+}
+
+# --- ASDF 3.3.7 (pinned; SBCL 2.6.4 bundles 3.3.1, too old for lem) -----------
+$asdfLisp = Join-Path $buildDir 'asdf-3.3.7.lisp'
+$asdfUrl = 'https://asdf.common-lisp.dev/archives/asdf-3.3.7.lisp'
+$asdfSha256 = '874E8F235EA633A090C7AB2665B1F624D1910EB7F6FC10349A596085C1CBB189'
+if (-not (Test-Path $asdfLisp)) {
+    Write-Host "Downloading ASDF 3.3.7..."
+    Invoke-WebRequest -Uri $asdfUrl -OutFile $asdfLisp
+}
+if ((Get-FileHash $asdfLisp -Algorithm SHA256).Hash -ne $asdfSha256) {
+    Remove-Item $asdfLisp -Force
+    throw "asdf-3.3.7.lisp checksum mismatch; delete and retry"
+}
+
+if (-not $SkipBuild) {
+    # --- SBCL runtime with icon/version resources ----------------------------
+    $sbcl = Get-Command sbcl -ErrorAction SilentlyContinue
+    if ($sbcl) { $sbclDir = Split-Path $sbcl.Source }
+    else       { $sbclDir = 'C:\Program Files\Steel Bank Common Lisp' }
+    $sbclExe  = Join-Path $sbclDir 'sbcl.exe'
+    $sbclCore = Join-Path $sbclDir 'sbcl.core'
+    if (-not (Test-Path $sbclExe))  { throw "sbcl.exe not found in $sbclDir" }
+    if (-not (Test-Path $sbclCore)) { throw "sbcl.core not found in $sbclDir" }
+
+    $runtime = Join-Path $buildDir 'lem-runtime.exe'
+    Copy-Item $sbclExe $runtime -Force
+    Write-Host "Embedding icon and version info into runtime..."
+    & $rcedit $runtime `
+        --set-icon $icon `
+        --set-version-string ProductName 'Lem' `
+        --set-version-string FileDescription 'Lem Editor' `
+        --set-version-string CompanyName 'lem-project' `
+        --set-version-string LegalCopyright 'MIT License' `
+        --set-file-version "$version.0" `
+        --set-product-version "$version.0"
+    if ($LASTEXITCODE -ne 0) { throw "rcedit failed" }
+
+    # --- Build (deploy-op dumps into bin\ and exits the process) -------------
+    if (Test-Path $binDir) { Remove-Item $binDir -Recurse -Force }
+    Write-Host "Building lem.exe (this takes a while)..."
+    # The runtime copy lives outside the SBCL installation; point it back
+    # at the contrib modules (sb-posix etc.).
+    $env:SBCL_HOME = $sbclDir
+    & $runtime --core $sbclCore --no-sysinit --no-userinit --disable-debugger `
+        --load (Join-Path $root 'scripts\win-deploy.lisp')
+    if (-not (Test-Path (Join-Path $binDir 'lem.exe'))) {
+        throw "Build failed: bin\lem.exe was not produced"
+    }
+}
+
+Write-Host "== bin contents =="
+Get-ChildItem $binDir | Format-Table Name, Length -AutoSize | Out-String | Write-Host
+
+if ($Sign) {
+    & powershell -ExecutionPolicy Bypass -File (Join-Path $root 'scripts\export-and-selfsign.ps1')
+}
+
+# --- Portable zip -------------------------------------------------------------
+$zip = Join-Path $buildDir "Lem-$version-windows-x64.zip"
+if (Test-Path $zip) { Remove-Item $zip -Force }
+Compress-Archive -Path "$binDir\*" -DestinationPath $zip
+Write-Host "Portable archive: $zip"
+
+# --- Installer (Inno Setup) ---------------------------------------------------
+$iscc = Get-Command iscc -ErrorAction SilentlyContinue
+if (-not $iscc) {
+    $isccPath = @(
+        "${env:ProgramFiles(x86)}\Inno Setup 6\ISCC.exe",
+        "$env:ProgramFiles\Inno Setup 6\ISCC.exe",
+        "$env:LOCALAPPDATA\Programs\Inno Setup 6\ISCC.exe"
+    ) | Where-Object { Test-Path $_ } | Select-Object -First 1
+} else { $isccPath = $iscc.Source }
+
+if ($isccPath) {
+    Write-Host "Building installer..."
+    & $isccPath "/DAppVersion=$version" "/O$buildDir" (Join-Path $root 'scripts\install\lem.iss')
+    if ($LASTEXITCODE -ne 0) { throw "ISCC failed" }
+    Write-Host "Installer: $buildDir\Lem-$version-setup.exe"
+} else {
+    Write-Host "Inno Setup not found; skipping installer. Install with:"
+    Write-Host "  winget install JRSoftware.InnoSetup"
+}

src/windows.lisp

@@ -0,0 +1,53 @@
+(in-package :lem-core)
+
+;; The Windows executable is built as a GUI-subsystem application
+;; (deploy's default on Windows), so a process launched from Explorer has
+;; no console and the initial stdio handles are invalid; the first write
+;; to *standard-output*/*error-output* would kill the writing thread.
+;; Deploy repairs the streams only when it can attach to a parent console,
+;; and its warm boot writes status output before any :boot hook runs, so
+;; this must be an SBCL init hook that runs before the toplevel function.
+#+sbcl
+(progn
+  (defun redirect-invalid-windows-stdio ()
+    (when (and (deploy:deployed-p)
+               (cffi:null-pointer-p
+                (cffi:foreign-funcall "GetConsoleWindow" :pointer)))
+      (let ((sink (or (ignore-errors
+                        (open (merge-pathnames "lem-stdio.log"
+                                               (uiop:temporary-directory))
+                              :direction :output
+                              :if-exists :supersede
+                              :if-does-not-exist :create
+                              :external-format :utf-8))
+                      (make-broadcast-stream))))
+        (setf sb-sys:*stdout* sink
+              sb-sys:*stderr* sink
+              sb-sys:*stdin* (make-concatenated-stream)))))
+  (pushnew 'redirect-invalid-windows-stdio sb-ext:*init-hooks*))
+
+;; Tell the deploy library not to bundle OS-provided DLLs.  async-process
+;; and winhttp declare them via cffi:define-foreign-library, which makes
+;; deploy treat them as application libraries, but they are part of every
+;; Windows installation and must be loaded from System32.
+(unless (deploy:deployed-p)
+  (loop :for (package-name symbol-name) :in '((:async-process "KERNEL32")
+                                              (:winhttp "WINHTTP"))
+        :for package := (find-package package-name)
+        :for symbol := (and package (find-symbol symbol-name package))
+        :when symbol
+        :do (setf (deploy:library-dont-deploy-p (deploy:ensure-library symbol)) t)))
+
+;; Tell the deploy library not to bundle tree-sitter native libraries.
+;; They are optional and loaded at runtime only when available.
+;; Only relevant while building; skip when running inside the deployed
+;; binary so we don't mutate deploy state on every startup.
+;; (Same workaround as in macosx.lisp.)
+(unless (deploy:deployed-p)
+  (when (find-package :tree-sitter/ffi)
+    (let ((ts (find-symbol "TREE-SITTER" :tree-sitter/ffi))
+          (tw (find-symbol "TS-WRAPPER" :tree-sitter/ffi)))
+      (when ts
+        (setf (deploy:library-dont-deploy-p (deploy:ensure-library ts)) t))
+      (when tw
+        (setf (deploy:library-dont-deploy-p (deploy:ensure-library tw)) t)))))