Bugfixes

src/intrinsics.ps

@@ -230,6 +230,10 b''
      :do (when (@ v :selected)
            (return-from selobj (@ v :name)))))
 
+(defun unsel ()
+  (loop :for (k v) :of *objs
+     :do (setf (@ v :selected) nil)))
+
 ;;; 16menu
 
 (defun menu (menu-name)

src/main.lisp

@@ -56,7 +56,7 b''
                (alexandria:read-file-into-string filename))
     (p:esrap-parse-error (e)
       (format t "~A~%" e)
-      (uiop:quit 1))))
+      (throw :terminate nil))))
 
 (defun report-error (fmt &rest args)
   (format t "ERROR: ~A~%" (apply #'format nil fmt args))

src/parser.lisp

@@ -59,11 +59,15 b''
             (do-binop% (append left-op (list right-op)) rest-ops)
             (do-binop% (list operator left-op right-op) rest-ops)))))
 
+(walker:deftransform parser-qspmod mod (&rest args)
+  (list* 'qspmod (mapcar #'walker:walk-continue args)))
+
 (defun do-binop (list)
-  (destructuring-bind (left-op rest-ops)
-      list
-    (do-binop% left-op
-      (mapcar #'binop-rest rest-ops))))
+  (walker:walk 'parser-qspmod
+               (destructuring-bind (left-op rest-ops)
+                   list
+                 (do-binop% left-op
+                   (mapcar #'binop-rest rest-ops)))))
 
 (p:defrule line-continuation (and #\_ #\newline)
   (:constant nil))
@@ -109,7 +113,7 b''
 
 ;;; Identifiers
 
-(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr counter countobj curact curacts curloc debug delact dellib delobj desc disablescroll disablesubex dynamic dyneval else elseif end exit for freelib func getobj gosub goto gs gt if iif img *img inclib input instr isnum isplay jump killall killobj killqst killvar lcase lcolor len let loc local maintxt max menu mid min mod msecscount msg nl *nl no nosave obj opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt step str strcomp strfind strpos to trim ucase unsel unselect usercom user_text usrtxt val view wait xgoto xgt))
+(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr countobj curact curacts curloc debug delact dellib delobj desc disablescroll disablesubex dynamic dyneval else elseif end exit for freelib func getobj gosub goto gs gt if iif img *img inclib input instr isnum isplay jump killall killobj killqst killvar lcase len let loc local maintxt max menu mid min mod msecscount msg nl *nl no nosave obj opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt step str strcomp strfind strpos to trim ucase unsel unselect user_text usrtxt val view wait xgoto xgt))
 
 (defun trim-$ (str)
   (if (char= #\$ (elt str 0))
@@ -517,6 +521,7 b''
   (countobj t   0 0)
   (getobj   t   1 1)
   (selobj   t   0 0)
+  (unsel    nil 0 0 "unsel" "unselect")
   ;; Menu
   (menu     nil 1 1)
   ;; Images

src/ps-macros.lisp

@@ -228,6 +228,12 b''
 (defpsmacro ! (op1 op2)
   `(not (equal ,op1 ,op2)))
 
+(defpsmacro qspmod (&rest ops)
+  (case (length ops)
+    (1 (first ops))
+    (2 `(mod ,@ops))
+    (t `(mod ,(first ops) (qspmod ,@(rest ops))))))
+
 ;;; 4code
 
 (defpsmacro exec (&body body)
@@ -244,7 +250,10 b''
 
 (defpsmacro qspcond (&rest clauses)
   `(cond ,@(loop :for clause :in clauses
-              :collect (list (first clause)
+              :for f := (if (eq 'txt2web::else (first clause))
+                            't
+                            (first clause))
+              :collect (list f
                              `(tagbody
                                  ,@(rest clause))))))