From 4da3ad1f569832845b58c3ce35149633a2bb665c Mon Sep 17 00:00:00 2001
From: Uko Kokņevičs
Date: Thu, 9 Oct 2025 21:58:43 +0300
Subject: Initial commit

---
 src/log.lisp | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 85 insertions(+)
 create mode 100644 src/log.lisp

(limited to 'src/log.lisp')

diff --git a/src/log.lisp b/src/log.lisp
new file mode 100644
index 0000000..e6e8661
--- /dev/null
+++ b/src/log.lisp
@@ -0,0 +1,85 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+(defpackage :ukkoclot/log
+  (:use :c2cl)
+  (:export :*output* :deflevel :log-error :log-warn :log-info :log-debug))
+(in-package :ukkoclot/log)
+
+(defparameter *output* *error-output*)
+
+(defvar *max-name-length* 8)
+(defvar *max-level-length* 4)
+
+(defvar *levels* nil)
+
+(defun get-levels ()
+  (unless *levels*
+    (setf *levels* (make-hash-table :test #'eq)))
+  *levels*)
+
+(defun register-level (level value)
+  (setf (gethash level (get-levels)) value)
+  (let ((l (length (symbol-name level))))
+    (when (> l *max-level-length*)
+      (setf *max-level-length* l))))
+
+(defun level-value (level)
+  (let ((value (gethash level (get-levels))))
+    (if value
+        value
+        (progn
+          (format *output* "UKKOLOG INTERNAL WARN: UNKNOWN LEVEL ~A" level)
+          1000))))
+
+(defun level< (lhs rhs)
+  (< (level-value lhs) (level-value rhs)))
+
+(defstruct (logger (:constructor make-logger%))
+  (name (error "No value given for NAME") :type keyword :read-only t)
+  (min-level :debug :type keyword))     ;TODO: Make this :info and make it configurable
+
+(defun make-logger (name)
+  (let ((l (length (symbol-name name))))
+    (when (> l *max-name-length*)
+      (setf *max-name-length* l)))
+  (make-logger% :name name))
+
+(defvar *package-loggers* nil)
+
+(defun get-package-loggers ()
+  (unless *package-loggers*
+    (setf *package-loggers* (make-hash-table :test #'eq)))
+  *package-loggers*)
+
+(defun get-package-logger (package)
+  (let* ((name (package-name package))
+         (name-sym (intern name :keyword))
+         (loggers (get-package-loggers))
+         (logger (gethash name-sym loggers)))
+    (unless logger
+      (setf logger (make-logger name-sym))
+      (setf (gethash name-sym loggers) logger))
+    logger))
+
+(defun perform-log (package level fmt-str &rest args)
+  (let ((logger (get-package-logger package)))
+    (unless (level< level (logger-min-level logger))
+      (apply #'format *output*
+             (concatenate 'string "~&~v@A: ~v@A: " fmt-str "~%")
+             *max-name-length* (logger-name logger)
+             *max-level-length* level
+             args))))
+
+(defmacro p (level fmt-str &rest args)
+  `(perform-log ,*package* ,level ,fmt-str ,@args))
+
+(defmacro deflevel (name value)
+  `(progn
+     (register-level ,name ,value)
+     (defmacro ,(intern (concatenate 'string "LOG-" (symbol-name name))) (fmt-str &rest args)
+       `(p ,,name ,fmt-str ,@args))))
+
+(deflevel :error 700)
+(deflevel :warn 600)
+(deflevel :info 500)
+(deflevel :debug 400)
-- 
cgit v1.2.3