changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: stashed and revert some obj/color changes. added x/wayland feature splits, WITH-TCP-CLIENT and WITH-UDP-CLIENT impl (no tests)

changeset 356: aac665e2f5bf
parent 355: 09f056e9a789
child 357: 7c1383c08493
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 21 May 2024 17:13:34 -0400
files: lisp/bin/skel.lisp lisp/lib/dat/pkg.lisp lisp/lib/dat/xml/xml.lisp lisp/lib/gui/gui.asd lisp/lib/gui/pkg.lisp lisp/lib/gui/wm/pkg.lisp lisp/lib/net/tcp.lisp lisp/lib/net/udp.lisp lisp/lib/obj/meta/pkg.lisp lisp/lib/rt/bench.lisp
description: stashed and revert some obj/color changes. added x/wayland feature splits, WITH-TCP-CLIENT and WITH-UDP-CLIENT impl (no tests)
     1.1--- a/lisp/bin/skel.lisp	Tue May 14 18:33:03 2024 -0400
     1.2+++ b/lisp/bin/skel.lisp	Tue May 21 17:13:34 2024 -0400
     1.3@@ -146,6 +146,7 @@
     1.4 (defcmd skc-make
     1.5   (let ((sk (find-skelfile #P"." :load t)))
     1.6     (sb-ext:enable-debugger)
     1.7+    (setq *no-exit* t)
     1.8     (if $args
     1.9         (loop for a in $args
    1.10               do (debug!
     2.1--- a/lisp/lib/dat/pkg.lisp	Tue May 14 18:33:03 2024 -0400
     2.2+++ b/lisp/lib/dat/pkg.lisp	Tue May 21 17:13:34 2024 -0400
     2.3@@ -133,7 +133,7 @@
     2.4    :element-map-children))
     2.5 
     2.6 (defpackage :dat/xml
     2.7-  (:use :cl :std :dat/proto)
     2.8+  (:use :cl :std :dat/proto :log)
     2.9   (:shadow :read-char :unread-char)
    2.10   (:export
    2.11    :xml-node-name 
     3.1--- a/lisp/lib/dat/xml/xml.lisp	Tue May 14 18:33:03 2024 -0400
     3.2+++ b/lisp/lib/dat/xml/xml.lisp	Tue May 21 17:13:34 2024 -0400
     3.3@@ -532,27 +532,27 @@
     3.4                          (0
     3.5                           (case char
     3.6                             (#\]
     3.7-                             (dbg :cdata "State 0 Match #\], go to state {0,1} = 4.")
     3.8+                             (trace! :cdata "State 0 Match #\], go to state {0,1} = 4.")
     3.9                              (setf state 4))
    3.10                             (otherwise
    3.11-                             (dbg :cdata "State 0 Non-], go to (remain in) state 0."))))
    3.12+                             (trace! :cdata "State 0 Non-], go to (remain in) state 0."))))
    3.13                          (4 ; {0, 1}
    3.14                           (case char
    3.15                             (#\]
    3.16-                             (dbg :cdata "State 4 {0, 1}, match ], go to state {0,1,2} = 5")
    3.17+                             (trace! :cdata "State 4 {0, 1}, match ], go to state {0,1,2} = 5")
    3.18                              (setf state 5))
    3.19                             (otherwise
    3.20-                             (dbg :cdata "State 4 {0, 1}, Non-], go to state 0.")
    3.21+                             (trace! :cdata "State 4 {0, 1}, Non-], go to state 0.")
    3.22                              (setf state 0))))
    3.23                          (5 ; {0, 1, 2}
    3.24                           (case char
    3.25                             (#\]
    3.26-                             (dbg :cdata "State 5 {0, 1, 2}, match ], stay in state 5."))
    3.27+                             (trace! :cdata "State 5 {0, 1, 2}, match ], stay in state 5."))
    3.28                             (#\>
    3.29-                             (dbg :cdata "State 5 {0, 1, 2}, match >, finish match and go to state 3.")
    3.30+                             (trace! :cdata "State 5 {0, 1, 2}, match >, finish match and go to state 3.")
    3.31                              (setf state 3))
    3.32                             (otherwise
    3.33-                             (dbg :cdata "State 5 {0, 1, 2}, find neither ] nor >; go to state 0.")
    3.34+                             (trace! :cdata "State 5 {0, 1, 2}, find neither ] nor >; go to state 0.")
    3.35                              (setf state 0))))
    3.36                          )
    3.37                     until (eql state 3)
    3.38@@ -635,17 +635,17 @@
    3.39               (0
    3.40                (case char
    3.41                  (#\?
    3.42-                  (dbg :pi-contents "State 0 Match #\?, go to state 1.")
    3.43+                  (trace! :pi-contents "State 0 Match #\?, go to state 1.")
    3.44                   (setf state 1))
    3.45                  (otherwise
    3.46-                  (dbg :pi-contents "State 0 ~c, go to (remain in) state 0." char))))
    3.47+                  (trace! :pi-contents "State 0 ~c, go to (remain in) state 0." char))))
    3.48               (1
    3.49                (case char
    3.50                  (#\>
    3.51-                  (dbg :pi-contents "State 1 Match #\>, done.")
    3.52+                  (trace! :pi-contents "State 1 Match #\>, done.")
    3.53                   (setf state 2))
    3.54                  (otherwise
    3.55-                  (dbg :pi-contents "State 1, ~c, do not match #\>, return to 0." char)
    3.56+                  (trace! :pi-contents "State 1, ~c, do not match #\>, return to 0." char)
    3.57                   (setf state 0)))))
    3.58          until (eql state 2)
    3.59          finally (return (coerce
     4.1--- a/lisp/lib/gui/gui.asd	Tue May 14 18:33:03 2024 -0400
     4.2+++ b/lisp/lib/gui/gui.asd	Tue May 21 17:13:34 2024 -0400
     4.3@@ -2,8 +2,8 @@
     4.4 (defsystem :gui
     4.5   :depends-on (:std 
     4.6                :log :obj :xkb :parse
     4.7-               :wayflan :wayflan-client ;;#+wl
     4.8-               :clx :stumpwm) ;; #+x11
     4.9+               (:feature :wl :wayflan) (:feature :wl :wayflan-client)
    4.10+               (:feature :x11 :clx) (:feature :x11 :stumpwm))
    4.11   :components ((:file "pkg")
    4.12                (:file "err")
    4.13                (:file "server")
    4.14@@ -11,11 +11,13 @@
    4.15                (:module "wm"
    4.16                 :components 
    4.17                 ((:file "pkg")
    4.18+                 #+wl 
    4.19                  (:module "wl"
    4.20                   :components 
    4.21                   ((:file "pkg")
    4.22                    (:file "kbd")
    4.23                    (:file "shell")))
    4.24+                 #+x11
    4.25                  (:module "x11"
    4.26                   :components ((:file "pkg")))))
    4.27                (:file "ext"))
     5.1--- a/lisp/lib/gui/pkg.lisp	Tue May 14 18:33:03 2024 -0400
     5.2+++ b/lisp/lib/gui/pkg.lisp	Tue May 21 17:13:34 2024 -0400
     5.3@@ -5,7 +5,7 @@
     5.4    :gui-client-p :gui-server-p))
     5.5 
     5.6 (defpackage :gui/wm
     5.7-  (:use :cl :std :log :gui/core :wayflan)
     5.8+  (:use :cl :std :log :gui/core #+wl :wayflan)
     5.9   (:export
    5.10    :*default-wm*
    5.11    :wm-package))
     6.1--- a/lisp/lib/gui/wm/pkg.lisp	Tue May 14 18:33:03 2024 -0400
     6.2+++ b/lisp/lib/gui/wm/pkg.lisp	Tue May 21 17:13:34 2024 -0400
     6.3@@ -24,18 +24,20 @@
     6.4 ;;; Code:
     6.5 (in-package :gui/wm)
     6.6 
     6.7+#+wl
     6.8 (defpackage :gui/wm/wl
     6.9   (:use :cl :std :gui/core :wayflan)
    6.10   (:nicknames :wl)
    6.11   (:export))
    6.12 
    6.13+#+x11
    6.14 (defpackage :gui/wm/x11
    6.15   (:nicknames :x11)
    6.16   (:shadowing-import-from :std/type :array-index)
    6.17   (:use :cl :std :gui/core :xlib)
    6.18   (:export))
    6.19 
    6.20-(defconstant *default-wm* :x11)
    6.21+(defvar *default-wm* :x11)
    6.22 
    6.23 (defun wm-package (&optional wm)
    6.24   "Return the WM package, either ':x11' for X11 or ':wl' for
     7.1--- a/lisp/lib/net/tcp.lisp	Tue May 14 18:33:03 2024 -0400
     7.2+++ b/lisp/lib/net/tcp.lisp	Tue May 21 17:13:34 2024 -0400
     7.3@@ -12,3 +12,23 @@
     7.4       (multiple-value-bind (buf len addr port) (socket-receive s nil 500)
     7.5         (format t "Received ~A bytes from ~A:~A - ~A ~%"
     7.6                 len addr port (subseq buf 0 (min 10 len)))))))
     7.7+
     7.8+(defvar *tcp-ping-size* 512)
     7.9+
    7.10+(defun tcp-ping-server (port &key (count 16))
    7.11+  (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
    7.12+    (socket-bind s #(0 0 0 0) port)
    7.13+    (loop for i from 0 upto count
    7.14+          do (multiple-value-bind (buf len address port) (socket-receive s nil *tcp-ping-size*)
    7.15+               (format t "(~A) Received ~A bytes from ~A:~A - ~A ~%"
    7.16+                       i len address port (subseq buf 0 (min 10 len))))
    7.17+          finally (socket-close s))))
    7.18+
    7.19+(defmacro with-tcp-client ((socket-var &key (addr #(0 0 0 0)) (port 0) peer) &body body)
    7.20+  `(let ((,socket-var (make-instance 'inet-socket :type :stream :protocol :tcp)))
    7.21+     (unwind-protect
    7.22+          (progn
    7.23+            (socket-bind ,socket-var ,addr ,port)
    7.24+            ,(when peer `(apply #'socket-connect ,socket-var ,peer))
    7.25+            ,@body)
    7.26+       (socket-close ,socket-var))))
     8.1--- a/lisp/lib/net/udp.lisp	Tue May 14 18:33:03 2024 -0400
     8.2+++ b/lisp/lib/net/udp.lisp	Tue May 21 17:13:34 2024 -0400
     8.3@@ -5,13 +5,25 @@
     8.4 ;;; Code:
     8.5 (in-package :net/udp)
     8.6 
     8.7-(defun udp-server (port)
     8.8+(defvar *udp-ping-size* 512)
     8.9+
    8.10+(defun udp-ping-server (port &key (count 16))
    8.11   (let ((s (make-instance 'inet-socket :type :datagram :protocol :udp)))
    8.12     (socket-bind s #(0 0 0 0) port)
    8.13-    (loop
    8.14-      (multiple-value-bind (buf len address port) (socket-receive s nil 500)
    8.15-        (format t "Received ~A bytes from ~A:~A - ~A ~%"
    8.16-                len address port (subseq buf 0 (min 10 len)))))))
    8.17+    (loop for i from 0 upto count
    8.18+          do (multiple-value-bind (buf len address port) (socket-receive s nil *udp-ping-size*)
    8.19+               (format t "(~A) Received ~A bytes from ~A:~A - ~A ~%"
    8.20+                       i len address port (subseq buf 0 (min 10 len))))
    8.21+          finally (socket-close s))))
    8.22+
    8.23+(defmacro with-udp-client ((socket-var &key (addr #(0 0 0 0)) (port 0) peer) &body body)
    8.24+  `(let ((,socket-var (make-instance 'inet-socket :type :datagram :protocol :udp)))
    8.25+     (unwind-protect
    8.26+          (progn
    8.27+            (socket-bind ,socket-var ,addr ,port)
    8.28+            ,(when peer `(apply #'socket-connect ,socket-var ,peer))
    8.29+            ,@body)
    8.30+       (socket-close ,socket-var))))
    8.31 
    8.32 (defmacro with-udp-client-and-server (((socket-class &rest common-initargs)
    8.33                                        (listen-socket-var &rest listen-address)
     9.1--- a/lisp/lib/obj/meta/pkg.lisp	Tue May 14 18:33:03 2024 -0400
     9.2+++ b/lisp/lib/obj/meta/pkg.lisp	Tue May 21 17:13:34 2024 -0400
     9.3@@ -3,16 +3,14 @@
     9.4 ;;
     9.5 
     9.6 ;;; Code:
     9.7-(in-package :obj/meta)
     9.8-
     9.9 (defpackage :obj/meta/stealth
    9.10-  (:use :cl :std))
    9.11+  (:use :cl :std :obj/meta :sb-mop))
    9.12 
    9.13 (defpackage :obj/meta/typed
    9.14-  (:use :cl :std))
    9.15+  (:use :cl :std :obj/meta :sb-mop))
    9.16 
    9.17 (defpackage :obj/meta/filtered
    9.18-  (:use :cl :std)
    9.19+  (:use :cl :std :obj/meta :sb-mop)
    9.20   (:export
    9.21    :define-filtered-function :filtered :filtered-function :filtered-method
    9.22    :generic-function-filter-expression :generic-function-filters :method-filter :simple-filtered-function))
    9.23@@ -76,16 +74,18 @@
    9.24    :potentially-sealable-standard-method))
    9.25 
    9.26 (defpackage :obj/meta/fast
    9.27-  (:use :cl :std :obj/meta/sealed)
    9.28+  (:use :cl :std :obj/meta/sealed :obj/meta)
    9.29   (:import-from :sb-int :gensymify)
    9.30   (:import-from :sb-walker :macroexpand-all)
    9.31   (:export :fast-generic-function :fast-method :inlineable))
    9.32 
    9.33 (defpackage :obj/meta/lazy
    9.34-  (:use :cl :std))
    9.35+  (:use :cl :std :obj/meta))
    9.36 
    9.37 (defpackage :obj/meta/overloaded
    9.38-  (:use :cl :std))
    9.39+  (:use :cl :std :obj/meta))
    9.40+
    9.41+(in-package :obj/meta)
    9.42 
    9.43 (defun class-equalp (c1 c2)
    9.44   (when (symbolp c1) (setf c1 (find-class c1)))
    10.1--- a/lisp/lib/rt/bench.lisp	Tue May 14 18:33:03 2024 -0400
    10.2+++ b/lisp/lib/rt/bench.lisp	Tue May 21 17:13:34 2024 -0400
    10.3@@ -18,7 +18,7 @@
    10.4     (flet ((%do ()
    10.5 	     (if-let ((opt *compile-tests*))
    10.6 	       (progn 
    10.7-		 (when (eq opt t) (setq opt *default-test-opts*))
    10.8+		 (when (eq opt t) (setq opt *test-opts*))
    10.9 		 ;; TODO 2023-09-21: handle failures here
   10.10 		 (let ((fn (compile-test self :declare opt)))
   10.11 		   (bench *bench-count* (funcall fn)))