diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2023-02-27 12:12:34 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2023-02-27 12:12:34 -0700 |
| commit | cc1835ff316910b8dd641dec091b41e8b5c198cd (patch) | |
| tree | d6f9ca9ed5f6ff25fca605506712ab132a08e123 /src | |
| parent | ba083296c0ad1007fe0ebc13c28f5cb74095d8de (diff) | |
| download | consfigurator-cc1835ff316910b8dd641dec091b41e8b5c198cd.tar.gz | |
factor out ABBREVIATE-CONSFIGURATOR-PACKAGE
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src')
| -rw-r--r-- | src/util.lisp | 23 |
1 files changed, 17 insertions, 6 deletions
diff --git a/src/util.lisp b/src/util.lisp index 3bec7ba..e70bfdf 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -284,6 +284,19 @@ simple collections of readably-printable values." (re:scan-to-strings "^uid=[0-9]+\\(([^)]+)" output) (and match (elt groups 0)))) +(defun abbreviate-consfigurator-package (name) + (with-standard-io-syntax + (let* ((*package* (find-package :consfigurator)) + (name (etypecase name + (string name) + (package (package-name name)) + (symbol (prin1-to-string name))))) + (cond ((string-prefix-p "CONSFIGURATOR.PROPERTY." name) + (subseq name 23)) + ((string-prefix-p "CONSFIGURATOR.DATA." name) + (subseq name 14)) + (t name))))) + ;; not DEFCONSFIG because a consfig is a system not a package (defmacro defpackage-consfig (name &body forms) "Convenience wrapper around DEFPACKAGE for consfigs. @@ -295,12 +308,10 @@ expansion as a starting point for your own DEFPACKAGE form for your consfig." (cons :local-nicknames (loop for package in (list-all-packages) for name = (package-name package) - if (string-prefix-p "CONSFIGURATOR.PROPERTY." name) - collect (list (make-symbol (subseq name 23)) - (make-symbol name)) - else if (string-prefix-p "CONSFIGURATOR.DATA." name) - collect (list (make-symbol (subseq name 14)) - (make-symbol name)))))) + for abbrevd = (abbreviate-consfigurator-package name) + unless (string= abbrevd name) + collect (list (make-symbol abbrevd) + (make-symbol name)))))) (if-let ((form (loop for form on forms when (and (listp (car form)) (eql :local-nicknames (caar form))) |