From 9910da18376265102558ee7188a6c377426f2c31 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Sun, 20 Mar 2022 12:32:41 +0100
Subject: [PATCH] - added compilation macros to use ECl processes procedures; -
 added compilation macro to skip SBCL specific muffling condition procedures;
 - added purgatory as dependency to installing script.

---
 quick_quicklisp.sh.in |  1 +
 src/constants.lisp    | 10 ++++------
 src/main-window.lisp  |  4 ++--
 src/os-utils.lisp     | 26 ++++++++++++--------------
 4 files changed, 19 insertions(+), 22 deletions(-)

diff --git a/quick_quicklisp.sh.in b/quick_quicklisp.sh.in
index e3caa85..e0fd0cc 100644
--- a/quick_quicklisp.sh.in
+++ b/quick_quicklisp.sh.in
@@ -140,6 +140,7 @@ install_dependency () {
      --eval "(ql:quickload \"babel\")"             \
      --eval "(ql:quickload \"percent-encoding\")"  \
      --eval "(ql:quickload \"trivial-clipboard\")" \
+     --eval "(ql:quickload \"purgatory\")"         \
      --eval "(sb-ext:quit)"
 }
 
diff --git a/src/constants.lisp b/src/constants.lisp
index c7d9575..7c7df5c 100644
--- a/src/constants.lisp
+++ b/src/constants.lisp
@@ -16,12 +16,10 @@
 
 (in-package :constants)
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun actual-program-name ()
-    (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
-    (if (string= +program-name+ "tinmop")
-        "tinmop"
-        (format nil "~a (original name: \"tinmop\")" +program-name+))))
+(defmacro actual-program-name ()
+  `(if (string= +program-name+ "tinmop")
+       +program-name+
+       ,(format nil "~a (original name: \"tinmop\")" +program-name+)))
 
 (define-constant +help-about-message+
     (format nil
diff --git a/src/main-window.lisp b/src/main-window.lisp
index d0aa4d2..f6159dc 100644
--- a/src/main-window.lisp
+++ b/src/main-window.lisp
@@ -77,10 +77,10 @@
 
 (defun parse-subwin-w (w-as-string)
   "Parse a window width, `w-as-string' a fraction of the main window width"
-  (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
   (parse-subwin-size w-as-string (win-width *main-window*)))
 
 (defun parse-subwin-h (h-as-string)
   "Parse a window height, `h-as-string' a fraction of the main window height"
-  (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
   (parse-subwin-size h-as-string (win-height *main-window*)))
diff --git a/src/os-utils.lisp b/src/os-utils.lisp
index 24ef8bd..b5b06cb 100644
--- a/src/os-utils.lisp
+++ b/src/os-utils.lisp
@@ -77,19 +77,17 @@
                              &key
                                (wait t)
                                search
-                               #-win32 pty
                                input
                                output
                                (error :output))
-  #-win32 (sb-ext:run-program program
-                      args
-                      :wait   wait
-                      :search search
-                      :pty    pty
-                      :input  input
-                      :output output
-                      :error  error)
-  #+win32 (sb-ext:run-program program
+  (declare (ignorable search))
+  #+ecl (ext:run-program program
+                         args
+                         :input  input
+                         :output output
+                         :error  error
+                         :wait   wait)
+  #+sbcl (sb-ext:run-program program
                       args
                       :wait   wait
                       :search search
@@ -98,7 +96,8 @@
                       :error  error))
 
 (defun process-exit-code (process)
-  (sb-ext:process-exit-code process))
+  #+ecl  (nth-value 1 (ext:external-process-status process))
+  #+sbcl (sb-ext:process-exit-code process))
 
 (defun process-exit-success-p (process)
   (= (process-exit-code process) 0))
@@ -209,9 +208,8 @@
                                             :search t
                                             :wait   t
                                             :output stream
-                                            :error  :output))
-           (exit-code (sb-ext:process-exit-code process)))
-      (when (/= exit-code 0)
+                                            :error  :output)))
+      (when (not (process-exit-success-p process))
         (error (format nil "File ~s extraction from ~s failed" file-entry zip-file))))))
 
 (defun copy-to-clipboard (text)