diff options
author | BT Templeton <bpt@hcoop.net> | 2011-07-10 19:17:08 -0400 |
---|---|---|
committer | BT Templeton <bpt@hcoop.net> | 2012-02-03 18:53:49 -0500 |
commit | 12ca82caa2e52cceeb2981399da9f661ca4e784e (patch) | |
tree | 495e16f9aa4a52058657ee93e90c1ab837504347 /module/language | |
parent | 0c5fe7d804e3735c592edd92722697751c40aedb (diff) | |
download | guile-12ca82caa2e52cceeb2981399da9f661ca4e784e.tar.gz |
elisp property lists
* module/language/elisp/boot.el (%plist-member, %plist-get, %plist-put)
(plist-get, plist-put, plist-member, lax-plist-get, lax-plist-put)
(symbol-plist, setplist, get, put): New functions.
(plist-function): New variable.
Diffstat (limited to 'module/language')
-rw-r--r-- | module/language/elisp/boot.el | 47 |
1 files changed, 47 insertions, 0 deletions
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))) |