diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el index 0bbf4efd2..bc9d6ad12 100644 --- a/module/language/elisp/boot.el +++ b/module/language/elisp/boot.el @@ -261,3 +261,50 @@ (defun mapcar (function sequence) (funcall (@ (guile) map) function sequence)) + +;;; Property lists + +(defun %plist-member (plist property test) + (catch 'loop + (while plist + (if (funcall test (car plist) property) + (throw 'loop (cdr plist)) + (setq plist (cddr plist)))))) + +(defun %plist-get (plist property test) + (car (%plist-member plist property test))) + +(defun %plist-put (plist property value test) + (lexical-let ((x (%plist-member plist property test))) + (if x + (progn (setcar x value) plist) + (cons property (cons value plist))))) + +(defun plist-get (plist property) + (%plist-get plist property #'eq)) + +(defun plist-put (plist property value) + (%plist-put plist property value #'eq)) + +(defun plist-member (plist property) + (%plist-member plist property #'eq)) + +(defun lax-plist-get (plist property) + (%plist-get plist property #'equal)) + +(defun lax-plist-put (plist property value) + (%plist-put plist property value #'equal)) + +(defvar plist-function (funcall (@ (guile) make-object-property))) + +(defun symbol-plist (symbol) + (funcall plist-function symbol)) + +(defun setplist (symbol plist) + (funcall (funcall (@ (guile) setter) plist-function) symbol plist)) + +(defun get (symbol propname) + (plist-get (symbol-plist symbol) propname)) + +(defun put (symbol propname value) + (setplist symbol (plist-put (symbol-plist symbol) propname value)))