# HG changeset patch
# User naryl <naryl+rhodecode@ave.maria.si>
# Date 2020-06-26 22:14:32
# Node ID 029b6e027bb6fed5c4eff4f8f3cf7a7e2d3fa5a1
# Parent  9d4e6d28e54a88d6fd2ca5bbff79e1b90d95a18f

Bugfixes

diff --git a/src/intrinsics.ps b/src/intrinsics.ps
--- a/src/intrinsics.ps
+++ b/src/intrinsics.ps
@@ -230,6 +230,10 @@
      :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)
diff --git a/src/main.lisp b/src/main.lisp
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -56,7 +56,7 @@
                (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))
diff --git a/src/parser.lisp b/src/parser.lisp
--- a/src/parser.lisp
+++ b/src/parser.lisp
@@ -59,11 +59,15 @@
             (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 @@
 
 ;;; 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 @@
   (countobj t   0 0)
   (getobj   t   1 1)
   (selobj   t   0 0)
+  (unsel    nil 0 0 "unsel" "unselect")
   ;; Menu
   (menu     nil 1 1)
   ;; Images
diff --git a/src/ps-macros.lisp b/src/ps-macros.lisp
--- a/src/ps-macros.lisp
+++ b/src/ps-macros.lisp
@@ -228,6 +228,12 @@
 (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 @@
 
 (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))))))