1.1--- a/lisp/bin/skel.lisp Sat Sep 21 22:58:22 2024 -0400
1.2+++ b/lisp/bin/skel.lisp Sun Sep 22 01:02:49 2024 -0400
1.3@@ -206,10 +206,20 @@
1.4 (required-argument 'name)))
1.5
1.6 (defcmd skc-vc
1.7- (if *args*
1.8- (std/string:string-case ((car *args*) :default (skel-simple-error "invalid command"))
1.9- ("status" (skc-status nil nil)))
1.10- (skc-status nil *opts*)))
1.11+ (let* ((sk (find-skelfile #P"." :load t))
1.12+ (vc (sk-vc-meta-kind (sk-vc sk))))
1.13+ (sb-ext:enable-debugger)
1.14+ (with-open-stream (proc (process-output
1.15+ (if-let ((cmd (pop *args*)))
1.16+ (ecase vc
1.17+ (:hg (run-hg-command cmd *args* :stream))
1.18+ (:git (run-git-command cmd *args* :stream)))
1.19+ (sb-ext:run-program (case vc (:hg *hg-program*) (:git *git-program*))
1.20+ nil
1.21+ :output :stream))))
1.22+ (loop for x = (read-line proc nil)
1.23+ while x
1.24+ do (println x)))))
1.25
1.26 (defcmd skc-shell
1.27 (sb-ext:enable-debugger)
2.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2+++ b/lisp/lib/dat/css.lisp Sun Sep 22 01:02:49 2024 -0400
2.3@@ -0,0 +1,17 @@
2.4+;;; css.lisp --- Cascading Style Sheets
2.5+
2.6+;; https://www.w3.org/Style/CSS/
2.7+
2.8+;;; Commentary:
2.9+
2.10+;; for a list of all properties refer to: https://www.w3.org/Style/CSS/all-properties.en.html
2.11+
2.12+;; for other web data: https://github.com/mdn/data/tree/main
2.13+
2.14+;;; Code:
2.15+(in-package :dat/css)
2.16+
2.17+;; SHEET ::= (BLOCK*)
2.18+;; BLOCK ::= (:BLOCK SELECTOR PROPERTY*)
2.19+;; SELECTOR ::= (string*)
2.20+;; PROPERTY ::= (:PROPERTY string string)
3.1--- a/lisp/lib/dat/pkg.lisp Sat Sep 21 22:58:22 2024 -0400
3.2+++ b/lisp/lib/dat/pkg.lisp Sun Sep 22 01:02:49 2024 -0400
3.3@@ -115,6 +115,19 @@
3.4 #:+decode-table+
3.5 #:+uri-decode-table+))
3.6
3.7+(defpackage :dat/css
3.8+ (:use :cl :std :dat/proto)
3.9+ (:export
3.10+ :parse-css
3.11+ :*minify-css*
3.12+ :*css-indent-offset*
3.13+ :parse-css-selector
3.14+ :parse-css-fragment
3.15+ :generate-css
3.16+ :compile-css-selector
3.17+ :compile-css
3.18+ :compile-css-block))
3.19+
3.20 (defpackage :dat/html
3.21 (:use :cl :std :dat/proto)
3.22 (:import-from :sb-ext :defglobal)
4.1--- a/lisp/lib/net/condition.lisp Sat Sep 21 22:58:22 2024 -0400
4.2+++ b/lisp/lib/net/condition.lisp Sun Sep 22 01:02:49 2024 -0400
4.3@@ -10,9 +10,10 @@
4.4 (define-condition protocol-condition (net-condition) ())
4.5
4.6 (define-condition net-error (net-condition std-error) ())
4.7-
4.8+(define-condition net-warning (net-condition std-warning) ())
4.9 (define-condition codec-error (codec-condition net-error) ())
4.10+(define-condition codec-warning (codec-condition net-warning) ())
4.11+(define-condition protocol-warning (protocol-condition net-warning) ())
4.12 (define-condition protocol-error (protocol-condition net-error) ())
4.13-
4.14 ;; sb-bsd-sockets:socket-error
4.15 ;; sb-thread:thread-error
5.1--- a/lisp/lib/net/pkg.lisp Sat Sep 21 22:58:22 2024 -0400
5.2+++ b/lisp/lib/net/pkg.lisp Sun Sep 22 01:02:49 2024 -0400
5.3@@ -16,7 +16,10 @@
5.4 :server
5.5 :peer
5.6 :proxy
5.7- :tunnel))
5.8+ :tunnel
5.9+ :net-warning
5.10+ :codec-warning
5.11+ :protocol-warning))
5.12
5.13 (defpackage :net/util
5.14 (:use :cl :obj :dat/proto :std :log :net/core :sb-bsd-sockets)
6.1--- a/lisp/lib/net/proto/http.lisp Sat Sep 21 22:58:22 2024 -0400
6.2+++ b/lisp/lib/net/proto/http.lisp Sun Sep 22 01:02:49 2024 -0400
6.3@@ -60,7 +60,6 @@
6.4 (lambda (condition stream)
6.5 (format stream "~A: ~A" (type-of condition) (slot-value condition 'description)))))
6.6
6.7-
6.8 ;;
6.9 ;; Callback-related errors
6.10
7.1--- a/lisp/lib/skel/core/print.lisp Sat Sep 21 22:58:22 2024 -0400
7.2+++ b/lisp/lib/skel/core/print.lisp Sun Sep 22 01:02:49 2024 -0400
7.3@@ -24,15 +24,21 @@
7.4
7.5 (sb-ext:defglobal *sk-print-dispatch-table* (sb-pretty::make-pprint-dispatch-table #() nil nil))
7.6
7.7-(defmethod sk-print ((self skel) &key (stream t) (id t) &allow-other-keys)
7.8+(defmethod sk-print ((self skel) &key (stream t) (id t) exclude &allow-other-keys)
7.9 (if id
7.10 (format stream "~S ~A~%" (keywordicate (class-name (class-of self))) (format-sxhash (obj/id:id self)))
7.11 (format stream "~S~%" (keywordicate (class-name (class-of self)))))
7.12- (mapcar
7.13+ (mapcar
7.14 (lambda (slot)
7.15 (let ((name (sb-mop:slot-definition-name slot)))
7.16 (when (slot-boundp self name)
7.17 (when-let ((val (slot-value self name)))
7.18- (format stream ":~A ~A~%" name val)))))
7.19- (sb-mop:class-direct-slots (class-of self)))
7.20+ (typecase val
7.21+ (sequence (unless (sequence:emptyp val) (format stream ":~A ~A~%" name val)))
7.22+ (hash-table (unless (zerop (hash-table-count val))
7.23+ (format stream ":~A~%" name)
7.24+ (pprint-tabular stream (hash-table-alist val) nil nil 2)
7.25+ (terpri stream)))
7.26+ (t (format stream ":~A ~A~%" name val)))))))
7.27+ (remove-if (lambda (x) (member x exclude)) (sb-mop:class-direct-slots (class-of self))))
7.28 self)
8.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
8.2+++ b/lisp/lib/web/dash.lisp Sun Sep 22 01:02:49 2024 -0400
8.3@@ -0,0 +1,31 @@
8.4+;;; web/dash.lisp --- local user dashboard
8.5+
8.6+;;; Code:
8.7+(uiop:define-package :web/dash
8.8+ (:use :cl :std #+nil :lass #+nil :spinneret :cli/clap)
8.9+ ;; (:import-from :clack :clackup)
8.10+ (:export
8.11+ :main
8.12+ :serve-static-assets
8.13+ :*web-dash-port*))
8.14+
8.15+(in-package :web/dash)
8.16+
8.17+(defparameter *web-dash-port* 8800)
8.18+(defparameter *web-dash-static-directory* #P"/tmp/web/dash/static/")
8.19+
8.20+(defvar *server*)
8.21+
8.22+(defun main (&key (output *standard-output*) (port *web-dash-port*))
8.23+ (let ((*standard-output* output))
8.24+ (print "starting dash server on ~A" port)
8.25+ (handler-case (sb-thread:join-thread (find-if (lambda (th)
8.26+ (search "hunchentoot" (sb-thread:thread-name th)))
8.27+ (sb-thread:list-all-threads)))
8.28+ ;; Catch a user's C-c
8.29+ (#+sbcl sb-sys:interactive-interrupt
8.30+ () (progn
8.31+ (format *error-output* "Aborting.~&")
8.32+ ;; (clack:stop *server*)
8.33+ (uiop:quit)))
8.34+ (error (c) (format t "Woops, an unknown error occured:~&~a~&" c)))))
9.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
9.2+++ b/lisp/lib/web/index.lisp Sun Sep 22 01:02:49 2024 -0400
9.3@@ -0,0 +1,89 @@
9.4+;;; web/index.lisp --- local user index
9.5+
9.6+;;; Code:
9.7+(uiop:define-package :web/index
9.8+ (:use :cl :std :hunchentoot :lass :spinneret)
9.9+ (:export
9.10+ :main
9.11+ :*web-index-port*))
9.12+
9.13+(in-package :web/index)
9.14+
9.15+(defparameter *last-update* (get-universal-time))
9.16+
9.17+(defun current-time () (setq *last-update* (get-universal-time)))
9.18+
9.19+(defparameter *web-index-port* 8888)
9.20+
9.21+(defparameter *server*
9.22+ (make-instance 'easy-acceptor
9.23+ :port 8888
9.24+ :name "index"))
9.25+
9.26+(define-easy-handler (b :uri "/b") (user)
9.27+ (setf (content-type*) "text/plain")
9.28+ (format nil "showing buffers for ~@[ ~A~]." user))
9.29+
9.30+(define-easy-handler (i :uri "/i") (user)
9.31+ (setf (content-type*) "text/plain")
9.32+ (format nil "showing inbox for ~@[ ~A~]." user))
9.33+
9.34+(define-easy-handler (a :uri "/a") (user)
9.35+ (setf (content-type*) "text/plain")
9.36+ (format nil "showing agenda for ~@[ ~A~]." user))
9.37+
9.38+(define-easy-handler (org :uri "/org") (user)
9.39+ (setf (content-type*) "text/plain")
9.40+ (format nil "showing org-files for ~@[ ~A~]." user))
9.41+
9.42+(deftag link (link body)
9.43+ `(:a :href ,@link ,@body))
9.44+
9.45+(defmacro with-index-page (&optional (title "local index") &body body)
9.46+ `(with-html
9.47+ (:doctype)
9.48+ (:html
9.49+ (:head
9.50+ (:title ,title)
9.51+ (:body
9.52+ (:div :class "nav"
9.53+ "( "
9.54+ (link "https://compiler.company" "~")
9.55+ (link "https://compiler.company/blog" "blog")
9.56+ (link "https://compiler.company/docs" "docs")
9.57+ (link "https://compiler.company/code" "code")
9.58+ " )")
9.59+ ,@body
9.60+ (:footer ("Last update: ~A" (current-time))))))))
9.61+
9.62+ (defun tabulate (&rest rows)
9.63+ (with-html
9.64+ (flet ((tabulate ()
9.65+ (loop for row in rows do
9.66+ (:tr (loop for cell in row do
9.67+ (:td cell))))))
9.68+ (if (find :table (get-html-path))
9.69+ (tabulate)
9.70+ (:table (:tbody (tabulate)))))))
9.71+
9.72+(defun inner-section ()
9.73+ "Binds *HTML-PATH* to replicate the depth the output is used in."
9.74+ (with-html-string
9.75+ (let ((*html-path* (append *html-path* '(:section :section))))
9.76+ (:h* "Heading three levels deep"))))
9.77+
9.78+(defun outer-section (html)
9.79+ "Uses HTML from elsewhere and embed it into a section"
9.80+ (with-html-string
9.81+ (:section
9.82+ (:h* "Heading two levels deep")
9.83+ (:section
9.84+ (:raw html)))))
9.85+
9.86+(defun main (&key (output *standard-output*) (port *web-index-port*))
9.87+ (let ((*standard-output* output))
9.88+ (print "starting index server on ~A" port)
9.89+ (start *server*)))
9.90+
9.91+(defun shutdown (&optional (target *server*))
9.92+ (stop target))
10.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2+++ b/lisp/lib/web/pkg.lisp Sun Sep 22 01:02:49 2024 -0400
10.3@@ -0,0 +1,7 @@
10.4+;;; pkg.lisp --- Web Library
10.5+
10.6+;;
10.7+
10.8+;;; Code:
10.9+(defpackage :web/sys
10.10+ (:use :cl :std))
11.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
11.2+++ b/lisp/lib/web/tests.lisp Sun Sep 22 01:02:49 2024 -0400
11.3@@ -0,0 +1,10 @@
11.4+;;; tests.lisp --- Web Tests
11.5+
11.6+;;
11.7+
11.8+;;; Code:
11.9+(defpackage :web/tests
11.10+ (:use :cl :std :rt :web/wasm/binary :web/wasm/text :web/sys))
11.11+(in-package :web/tests)
11.12+(defsuite :web)
11.13+(in-suite :web)
12.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
12.2+++ b/lisp/lib/web/wasm/binary.lisp Sun Sep 22 01:02:49 2024 -0400
12.3@@ -0,0 +1,6 @@
12.4+;;; binary.lisp --- Wasm Binary Format
12.5+
12.6+;; https://webassembly.github.io/spec/core/binary/index.html
12.7+
12.8+;;; Code:
12.9+(in-package :web/wasm/binary)
13.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
13.2+++ b/lisp/lib/web/wasm/pkg.lisp Sun Sep 22 01:02:49 2024 -0400
13.3@@ -0,0 +1,13 @@
13.4+;;; pkg.lisp --- Wasm Packages
13.5+
13.6+;; https://webassembly.github.io/spec/
13.7+
13.8+;;; Code:
13.9+(defpackage :web/wasm/text
13.10+ (:use :cl :std :dat/proto :dat/sxp))
13.11+
13.12+(defpackage :web/wasm/binary
13.13+ (:use :cl :std :dat/proto))
13.14+
13.15+;; (defpackage :web/wasm/vm
13.16+;; (:use :cl :std :web/sys :web/wasm/binary))
14.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
14.2+++ b/lisp/lib/web/wasm/text.lisp Sun Sep 22 01:02:49 2024 -0400
14.3@@ -0,0 +1,6 @@
14.4+;;; text.lisp --- WASM Text (S-Expr)
14.5+
14.6+;; https://webassembly.github.io/spec/core/text/index.html
14.7+
14.8+;;; Code:
14.9+(in-package :web/wasm/text)
15.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
15.2+++ b/lisp/lib/web/web.asd Sun Sep 22 01:02:49 2024 -0400
15.3@@ -0,0 +1,30 @@
15.4+(defsystem :web
15.5+ :depends-on (:std :net :obj :dat :parse :doc :organ :syn :cry :nlp)
15.6+ :components ((:file "pkg")
15.7+ (:module "wasm"
15.8+ :components
15.9+ ((:file "pkg")
15.10+ (:file "text")
15.11+ (:file "binary"))))
15.12+ :in-order-to ((test-op (test-op "web/tests"))))
15.13+
15.14+(defsystem :web/tests
15.15+ :depends-on (:rt :net :web)
15.16+ :components ((:file "tests"))
15.17+ :perform (test-op (o c) (symbol-call :rt :do-tests :web)))
15.18+
15.19+(defsystem :web/index
15.20+ :depends-on (:uiop :cl-ppcre :std :rdb :hunchentoot :parenscript :lass :spinneret :organ)
15.21+ :components ((:file "index"))
15.22+ :in-order-to ((test-op (test-op "web/tests")))
15.23+ :build-operation "program-op"
15.24+ :build-pathname "web-index"
15.25+ :entry-point "web/index::main")
15.26+
15.27+(defsystem :web/dash
15.28+ :depends-on (:uiop :cl-ppcre :std :rdb :parenscript :lass :spinneret :organ)
15.29+ :components ((:file "dash"))
15.30+ :in-order-to ((test-op (test-op "web/tests")))
15.31+ :build-operation "program-op"
15.32+ :build-pathname "web-dash"
15.33+ :entry-point "web/dash::main")
16.1--- a/lisp/std/pkg.lisp Sat Sep 21 22:58:22 2024 -0400
16.2+++ b/lisp/std/pkg.lisp Sun Sep 22 01:02:49 2024 -0400
16.3@@ -269,6 +269,7 @@
16.4 (:import-from :std/list :flatten)
16.5 (:use-reexport :sb-thread)
16.6 (:export
16.7+ :std-thread-error
16.8 :print-top-level :thread-support-p
16.9 :find-thread-by-id :thread-id-list
16.10 :timed-join-thread :kill-thread
17.1--- a/lisp/std/thread.lisp Sat Sep 21 22:58:22 2024 -0400
17.2+++ b/lisp/std/thread.lisp Sun Sep 22 01:02:49 2024 -0400
17.3@@ -12,6 +12,9 @@
17.4 ;; (sb-thread:thread-os-tid sb-thread:*current-thread*)
17.5 ;; sb-thread:interrupt-thread
17.6
17.7+;;; Conditions
17.8+(define-condition std-thread-error (thread-error) ())
17.9+
17.10 ;;; Utils
17.11 (defun thread-support-p () (member :thread-support *features*))
17.12
18.1--- a/lisp/user.asd Sat Sep 21 22:58:22 2024 -0400
18.2+++ b/lisp/user.asd Sun Sep 22 01:02:49 2024 -0400
18.3@@ -5,7 +5,8 @@
18.4 :packy :parse :pod :rdb
18.5 :krypt :gui :aud :net
18.6 :krypt :rt :vc :dat
18.7- :q :box :log :gui)
18.8+ :q :box :log :gui
18.9+ :web)
18.10 :components ((:file "user"))
18.11 :build-operation monolithic-compile-bundle-op
18.12 :build-pathname "user")
19.1--- a/lisp/web/dash.lisp Sat Sep 21 22:58:22 2024 -0400
19.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
19.3@@ -1,31 +0,0 @@
19.4-;;; web/dash.lisp --- local user dashboard
19.5-
19.6-;;; Code:
19.7-(uiop:define-package :web/dash
19.8- (:use :cl :std #+nil :lass #+nil :spinneret :cli/clap)
19.9- ;; (:import-from :clack :clackup)
19.10- (:export
19.11- :main
19.12- :serve-static-assets
19.13- :*web-dash-port*))
19.14-
19.15-(in-package :web/dash)
19.16-
19.17-(defparameter *web-dash-port* 8800)
19.18-(defparameter *web-dash-static-directory* #P"/tmp/web/dash/static/")
19.19-
19.20-(defvar *server*)
19.21-
19.22-(defun main (&key (output *standard-output*) (port *web-dash-port*))
19.23- (let ((*standard-output* output))
19.24- (print "starting dash server on ~A" port)
19.25- (handler-case (sb-thread:join-thread (find-if (lambda (th)
19.26- (search "hunchentoot" (sb-thread:thread-name th)))
19.27- (sb-thread:list-all-threads)))
19.28- ;; Catch a user's C-c
19.29- (#+sbcl sb-sys:interactive-interrupt
19.30- () (progn
19.31- (format *error-output* "Aborting.~&")
19.32- ;; (clack:stop *server*)
19.33- (uiop:quit)))
19.34- (error (c) (format t "Woops, an unknown error occured:~&~a~&" c)))))
20.1--- a/lisp/web/index.lisp Sat Sep 21 22:58:22 2024 -0400
20.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
20.3@@ -1,89 +0,0 @@
20.4-;;; web/index.lisp --- local user index
20.5-
20.6-;;; Code:
20.7-(uiop:define-package :web/index
20.8- (:use :cl :std :hunchentoot :lass :spinneret)
20.9- (:export
20.10- :main
20.11- :*web-index-port*))
20.12-
20.13-(in-package :web/index)
20.14-
20.15-(defparameter *last-update* (get-universal-time))
20.16-
20.17-(defun current-time () (setq *last-update* (get-universal-time)))
20.18-
20.19-(defparameter *web-index-port* 8888)
20.20-
20.21-(defparameter *server*
20.22- (make-instance 'easy-acceptor
20.23- :port 8888
20.24- :name "index"))
20.25-
20.26-(define-easy-handler (b :uri "/b") (user)
20.27- (setf (content-type*) "text/plain")
20.28- (format nil "showing buffers for ~@[ ~A~]." user))
20.29-
20.30-(define-easy-handler (i :uri "/i") (user)
20.31- (setf (content-type*) "text/plain")
20.32- (format nil "showing inbox for ~@[ ~A~]." user))
20.33-
20.34-(define-easy-handler (a :uri "/a") (user)
20.35- (setf (content-type*) "text/plain")
20.36- (format nil "showing agenda for ~@[ ~A~]." user))
20.37-
20.38-(define-easy-handler (org :uri "/org") (user)
20.39- (setf (content-type*) "text/plain")
20.40- (format nil "showing org-files for ~@[ ~A~]." user))
20.41-
20.42-(deftag link (link body)
20.43- `(:a :href ,@link ,@body))
20.44-
20.45-(defmacro with-index-page (&optional (title "local index") &body body)
20.46- `(with-html
20.47- (:doctype)
20.48- (:html
20.49- (:head
20.50- (:title ,title)
20.51- (:body
20.52- (:div :class "nav"
20.53- "( "
20.54- (link "https://compiler.company" "~")
20.55- (link "https://compiler.company/blog" "blog")
20.56- (link "https://compiler.company/docs" "docs")
20.57- (link "https://compiler.company/code" "code")
20.58- " )")
20.59- ,@body
20.60- (:footer ("Last update: ~A" (current-time))))))))
20.61-
20.62- (defun tabulate (&rest rows)
20.63- (with-html
20.64- (flet ((tabulate ()
20.65- (loop for row in rows do
20.66- (:tr (loop for cell in row do
20.67- (:td cell))))))
20.68- (if (find :table (get-html-path))
20.69- (tabulate)
20.70- (:table (:tbody (tabulate)))))))
20.71-
20.72-(defun inner-section ()
20.73- "Binds *HTML-PATH* to replicate the depth the output is used in."
20.74- (with-html-string
20.75- (let ((*html-path* (append *html-path* '(:section :section))))
20.76- (:h* "Heading three levels deep"))))
20.77-
20.78-(defun outer-section (html)
20.79- "Uses HTML from elsewhere and embed it into a section"
20.80- (with-html-string
20.81- (:section
20.82- (:h* "Heading two levels deep")
20.83- (:section
20.84- (:raw html)))))
20.85-
20.86-(defun main (&key (output *standard-output*) (port *web-index-port*))
20.87- (let ((*standard-output* output))
20.88- (print "starting index server on ~A" port)
20.89- (start *server*)))
20.90-
20.91-(defun shutdown (&optional (target *server*))
20.92- (stop target))
21.1--- a/lisp/web/web.asd Sat Sep 21 22:58:22 2024 -0400
21.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
21.3@@ -1,18 +0,0 @@
21.4-(defsystem :web/index
21.5- :depends-on (:uiop :cl-ppcre :std :rdb :hunchentoot :parenscript :lass :spinneret :organ)
21.6- :components ((:file "index"))
21.7- :in-order-to ((test-op (test-op "app/tests")))
21.8- :build-operation "program-op"
21.9- :build-pathname "web-index"
21.10- :entry-point "web/index::main")
21.11-
21.12-(defsystem :web/dash
21.13- :depends-on (:uiop :cl-ppcre :std :rdb :parenscript :lass :spinneret :organ)
21.14- :components ((:file "dash"))
21.15- :in-order-to ((test-op (test-op "app/tests")))
21.16- :build-operation "program-op"
21.17- :build-pathname "web-dash"
21.18- :entry-point "web/dash::main")
21.19-
21.20-(defsystem :web
21.21- :depends-on (:web/dash :web/index))
