X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/2a8a526029dbdcfd8bd5a4c40bc5c63ed2a44cf5..4ee476bc29b80fca2faabb4bd286ca70c98f7a44:/src/pset-proto.lisp diff --git a/src/pset-proto.lisp b/src/pset-proto.lisp index 0238f41..2620585 100644 --- a/src/pset-proto.lisp +++ b/src/pset-proto.lisp @@ -86,52 +86,6 @@ :location (file-location location) :seenp seenp))) -(defun string-to-symbol - (string &key (package *package*) (swap-case t) (swap-hyphen t)) - "Convert STRING to a symbol in PACKAGE. - - Parse off a `PACKAGE:' prefix from STRING if necessary, to identify the - package; PACKAGE is used if there isn't a prefix. A doubled colon allows - access to internal symbols, and will intern if necessary. Note that - escape characters are /not/ processed; don't put colons in package names - if you want to use them from SOD property sets. - - The portions of the string are modified by `frob-identifier'; the - arguments SWAP-CASE and SWAP-HYPHEN are passed to `frob-identifier' to - control this process." - - (let* ((length (length string)) - (colon (position #\: string))) - (multiple-value-bind (start internalp) - (cond ((not colon) (values 0 t)) - ((and (< (1+ colon) length) - (char= (char string (1+ colon)) #\:)) - (values (+ colon 2) t)) - (t - (values (1+ colon) nil))) - (when colon - (let* ((package-name (if (zerop colon) "KEYWORD" - (frob-identifier (subseq string 0 colon) - :swap-case swap-case - :swap-hyphen swap-hyphen))) - (found (find-package package-name))) - (unless found - (error "Unknown package `~A'" package-name)) - (setf package found))) - (let ((name (frob-identifier (subseq string start) - :swap-case swap-case - :swap-hyphen swap-hyphen))) - (multiple-value-bind (symbol status) - (funcall (if internalp #'intern #'find-symbol) name package) - (cond ((or internalp (eq status :external)) - symbol) - ((not status) - (error "Symbol `~A' not found in package `~A'" - name (package-name package))) - (t - (error "Symbol `~A' not external in package `~A'" - name (package-name package))))))))) - (export 'coerce-property-value) (defgeneric coerce-property-value (value type wanted) (:documentation