slot-values.lisp

(defpackage #:snippets/slot-values
  (:use #:cl))

(in-package #:snippets/slot-values)

(defun slot-values* (object &rest slot-names)
  (mapcar (lambda (slot-name) (slot-value object slot-name))
          slot-names))

(defun (setf slot-values*) (new-values object &rest slot-names)
  (mapc (lambda (new-value slot-name)
          (setf (slot-value object slot-name) new-value))
        new-values
        slot-names))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun quotify (object)
    (list 'quote object)))

(defmacro slot-values (object &rest slot-names)
  `(slot-values* ,object ,@(mapcar (lambda (slot-name) (quotify slot-name)) slot-names)))

(defclass employee ()
  ((name :initarg :name :accessor name)
   (age :initarg :age :accessor age)
   (company :initarg :company :accessor company)
   (title :initarg :title :accessor title)))

(defun new-employee ()
  (make-instance 'employee
                 :name "Steve"
                 :age 39
                 :company "Google"
                 :title "Janitor"))

(defun test-slot-values ()
  (let ((e (new-employee)))
    (setf (slot-values e name age company title)
          '("ApproxSteve" (around 39) "Goog1e" "Putzfrau"))
    (slot-values e name age company title)))

(defun test-slot-values* ()
  (let ((e (new-employee)))
    (setf (slot-values* e 'name 'age 'company 'title)
          '("NotSteve" (not 39) "NotGoogle" "NonJanitor"))
    (slot-values* e 'name 'age 'company 'title)))