Commit 29e49132 authored by Michael's avatar Michael

Syncing from Monotone at 20140221144551

parent 68cb9662
......@@ -338,6 +338,7 @@ and lsp-LICENSE.txt
Thanks to Edi Weitz for letting me use his code for ESCAPE-FOR-XML.
Thanks to Eitarow Fukamachi for the whitespace-trimming patch.
Thanks to Christoph Finkensiep for making getf* a generic function.
AUTHOR
======
......
......@@ -277,6 +277,7 @@ Functions get called with two parameters: match and list of registers.")
(,(string (code-char 8209)) . "-") ; Non-breaking hyphen
(,(string (code-char 8211)) . "--") ; En-dash
(,(string (code-char 8212)) . "---") ; Em-dash
(,(string (code-char 8470)) . "{\\textnumero}") ; Number sign
)))
(defun escape-for-latex (string)
......@@ -308,7 +309,11 @@ Functions get called with two parameters: match and list of registers.")
(symbol-name (read-from-string string))
(string-upcase (read-from-string string))) :keyword)))
(defun getf* (plist key &optional default)
(defgeneric getf* (thing key &optional default)
(:documentation "Returns a value by a key"))
(defmethod getf* ((plist list) key &optional default)
"Uses getf to get a value from a plist"
(if *case-sensitivity*
(getf plist key default)
(loop for (k v) on plist by #'cddr
......@@ -316,6 +321,19 @@ Functions get called with two parameters: match and list of registers.")
do (return v)
finally (return default))))
(defmethod getf* ((table hash-table) key &optional default)
"Uses gethash to get a value from a hash-table"
(gethash key table default))
(defmethod getf* ((object standard-object) key &optional default)
"Uses slot-value to get a value from a standard object, where the slot name is derived from key"
(let ((slot-name (intern (princ-to-string key)
(symbol-package (class-name (class-of object))))))
(if (and (slot-exists-p object slot-name)
(slot-boundp object slot-name))
(slot-value object slot-name)
default)))
(defmacro getf-emb (key)
"Search either plist TOPENV or ENV according to the search path in KEY. KEY
is a string."
......
......@@ -26,4 +26,5 @@
#:*escape-type*
#:*case-sensitivity*
#:*locking-function*
#:*function-package*))
#:*function-package*
#:getf*))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment