Code Snippets Common Lisp

Short texts Common Lisp 🧑‍💻 Code snippets Common Lisp ✍️ Reading lists Common Lisp 👀

Update Lisp repos

;; A GUI for fetching all third party git Lisp repos. ;; ;; Kinda silly and limited, but what the hell. (defpackage #:snippets/clim-repos (:use #:clim-lisp #:clim) (:shadow #:merge) (:import-from #:uiop) (:import-from #:alexandria) (:import-from #:legit) (:import-from #:bordeaux-threads) (:export #:run)) (in-package #:snippets/clim-repos) ;;;; Repo (defclass repo () ((directory :initarg :directory :reader repo-directory) (status :initform :idle :accessor repo-status))) […]

Macro to make simple classes

(defmacro define-info-class (name &rest slots) (labels ((make-slot (name slot) (read-from-string (concatenate ‘string (string name) “-” (string slot))))) (flet ((make-slot-list-item (slot) (list slot :accessor (make-slot name slot))) (make-name (name) (read-from-string (concatenate ‘string (string name) “-info”)))) (let* ((class-name (make-name name)) (class-slots (mapcar #’make-slot-list-item slots))) `(defclass ,class-name () ,class-slots))))) (defmacro populate-info-object (name &rest slots) (flet ((get-setter (slot) (let […]

arrow-operator.lisp

(defun inject-value (expr value) (if (not (listp expr)) (list expr value) (cons (first expr) (cons value (rest expr))))) (print (inject-value ‘a ‘b)) ;; => (A B) (print (inject-value ‘(a b) ‘c)) ;; => (A B C) (defmacro -> (acc &rest expressions) (loop for expression in expressions do (setf acc (inject-value expression acc))) acc) (print (macroexpand […]

A reglex example

(defparameter *reglex.lang.c.float* ‘(conc (opt (lits #\+ #\-)) (or (conc (or (conc (plus (inter #\0 #\9)) (lit #\.) (star (inter #\0 #\9))) (conc (lit #\.) (plus (inter #\0 #\9)))) (opt (conc (lits #\e #\E) (opt (lits #\+ #\-)) (plus (inter #\0 #\9))))) (conc (plus (inter #\0 #\9)) (lits #\e #\E) (opt (lits #\+ #\-)) (plus (inter […]

cxr2.lisp

(defun expand-cxr (ads) (labels ((expand (ads) (cond ((null ads) ‘x) ((equalp (car ads) #\a) `(cl:car ,(expand (cdr ads)))) (t `(cl:cdr ,(expand (cdr ads))))))) (let* ((nam (coerce `(#\c ,@ads #\r) ‘string)) (sym (intern (ecase (readtable-case *cxr-readtable*) ((:upcase) (string-upcase nam)) ((:downcase) (string-downcase nam)) ((:invert) (map ‘string (lambda (c) (cond ((upper-case-p c) (char-downcase c)) ((lower-case-p c) (char-upcase c)) […]