From f393eeebe8cf6a31ecc2160658bee3d2c895a98b Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 22 Mar 2021 09:38:57 -0700 Subject: untabify Signed-off-by: Sean Whitton --- src/util.lisp | 178 +++++++++++++++++++++++++++++----------------------------- 1 file changed, 89 insertions(+), 89 deletions(-) (limited to 'src/util.lisp') diff --git a/src/util.lisp b/src/util.lisp index 242fbdb..7ee7e1a 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -31,13 +31,13 @@ (defmacro symbol-named (name symbol) `(and (symbolp ,symbol) - (string= (symbol-name ',name) (symbol-name ,symbol)))) + (string= (symbol-name ',name) (symbol-name ,symbol)))) (defun normalise-system (system) (etypecase system (string system) (symbol (string-downcase - (symbol-name system))))) + (symbol-name system))))) (defun memstring= (string list) (member string list :test #'string=)) @@ -51,8 +51,8 @@ which fail this assertion." (or (not (member arg - '#.(set-difference lambda-list-keywords - '(&optional &rest &key &allow-other-keys &aux)))) + '#.(set-difference lambda-list-keywords + '(&optional &rest &key &allow-other-keys &aux)))) (simple-program-error "Implementation-specific or non-ordinary lambda list keyword ~A not supported." @@ -60,17 +60,17 @@ supported." (defun ordinary-ll-without-&aux (ll) (loop for arg in ll - do (assert-ordinary-ll-member arg) - if (eq '&aux arg) return accum - else collect arg into accum - finally (return accum))) + do (assert-ordinary-ll-member arg) + if (eq '&aux arg) return accum + else collect arg into accum + finally (return accum))) (defun ordinary-ll-variable-names (ll) (loop for arg in ll - for arg* = (ensure-car arg) - do (assert-ordinary-ll-member arg) - unless (char= #\& (char (symbol-name arg*) 0)) - collect arg*)) + for arg* = (ensure-car arg) + do (assert-ordinary-ll-member arg) + unless (char= #\& (char (symbol-name arg*) 0)) + collect arg*)) (defmacro defun-with-args (name argsym lambda-list &body forms &aux remaining) (multiple-value-bind (required optional rest kwargs aokeys) @@ -80,32 +80,32 @@ supported." "&ALLOW-OTHER-KEYS without &REST in property lambda list not supported.")) (let ((normalisedll (reverse required))) (when optional - (push '&optional normalisedll) - (loop for (name init suppliedp) in optional - for suppliedp* = (or suppliedp (gensym)) - do (push `(,name ,init ,suppliedp*) normalisedll) - do (push `(when ,suppliedp* (push ,name ,argsym)) remaining))) + (push '&optional normalisedll) + (loop for (name init suppliedp) in optional + for suppliedp* = (or suppliedp (gensym)) + do (push `(,name ,init ,suppliedp*) normalisedll) + do (push `(when ,suppliedp* (push ,name ,argsym)) remaining))) (when rest - (push '&rest normalisedll) - (push rest normalisedll) - (push `(dolist (r ,rest) (push r ,argsym)) remaining)) + (push '&rest normalisedll) + (push rest normalisedll) + (push `(dolist (r ,rest) (push r ,argsym)) remaining)) (when kwargs - (push '&key normalisedll) - (loop for ((keyword-name name) init suppliedp) in kwargs - for suppliedp* = (if (or rest suppliedp) suppliedp (gensym)) - do (push `((,keyword-name ,name) ,init ,suppliedp*) - normalisedll) - unless rest do (push `(when ,suppliedp* - (push ,keyword-name ,argsym) - (push ,name ,argsym)) - remaining))) + (push '&key normalisedll) + (loop for ((keyword-name name) init suppliedp) in kwargs + for suppliedp* = (if (or rest suppliedp) suppliedp (gensym)) + do (push `((,keyword-name ,name) ,init ,suppliedp*) + normalisedll) + unless rest do (push `(when ,suppliedp* + (push ,keyword-name ,argsym) + (push ,name ,argsym)) + remaining))) (when aokeys - (push '&allow-other-keys normalisedll)) + (push '&allow-other-keys normalisedll)) `(defun ,name ,(nreverse normalisedll) - (let ((,argsym (list ,@(reverse required)))) - ,@(nreverse remaining) - (nreversef ,argsym) - ,@forms))))) + (let ((,argsym (list ,@(reverse required)))) + ,@(nreverse remaining) + (nreversef ,argsym) + ,@forms))))) (defmacro define-simple-error (name &optional docstring) `(progn @@ -120,12 +120,12 @@ supported." (defun strip-declarations (forms) (loop while (form-beginning-with declare (car forms)) - do (pop forms) - finally (return forms))) + do (pop forms) + finally (return forms))) (defun plist-to-cmd-args (plist &aux args) (doplist (k v plist args) - (push (strcat "--" (string-downcase (symbol-name k)) "=" v) args))) + (push (strcat "--" (string-downcase (symbol-name k)) "=" v) args))) ;;;; Progress & debug printing @@ -143,22 +143,22 @@ supported." "Print something to the user during deploys." (unless (and (numberp level) (> level *consfigurator-debug-level*)) (let ((lines (loop for line in (etypecase output - (cons output) - (string (lines output))) - ;; strip (first part of) prefix added by a remote Lisp - for stripped = (if (string-prefix-p ";; " line) - (subseq line 3) - line) - unless (and strip-empty (re:scan #?/\A\s*\z/ stripped)) - collect stripped))) + (cons output) + (string (lines output))) + ;; strip (first part of) prefix added by a remote Lisp + for stripped = (if (string-prefix-p ";; " line) + (subseq line 3) + line) + unless (and strip-empty (re:scan #?/\A\s*\z/ stripped)) + collect stripped))) (when fresh-line - (fresh-line) - (princ *inform-prefix*)) + (fresh-line) + (princ *inform-prefix*)) (princ (pop lines)) (dolist (line lines) - (fresh-line) - (princ *inform-prefix*) - (princ line))))) + (fresh-line) + (princ *inform-prefix*) + (princ line))))) (defun informat (level control-string &rest format-arguments) "Print something to the user during deploys using FORMAT. @@ -166,11 +166,11 @@ Be sure to begin CONTROL-STRING with ~& unless you want to continue from previous output." (if (string-prefix-p "~&" control-string) (inform level - (apply #'format nil (subseq control-string 2) format-arguments) - :fresh-line t) + (apply #'format nil (subseq control-string 2) format-arguments) + :fresh-line t) (inform level - (apply #'format nil control-string format-arguments) - :fresh-line nil))) + (apply #'format nil control-string format-arguments) + :fresh-line nil))) ;;;; Version numbers @@ -189,14 +189,14 @@ previous output." (defun dpkg-version-compare (x r y) (zerop (nth-value 2 (run-program `("dpkg" "--compare-versions" - ,(etypecase x - (string x) - (number (format nil "~A" x))) - ,r - ,(etypecase y - (string y) - (number (format nil "~A" y)))) - :ignore-error-status t)))) + ,(etypecase x + (string x) + (number (format nil "~A" x))) + ,r + ,(etypecase y + (string y) + (number (format nil "~A" y)))) + :ignore-error-status t)))) ;;;; Encoding of strings to filenames @@ -212,33 +212,33 @@ previous output." (defun string->filename (s) (apply #'concatenate 'string - (loop for c - across (etypecase s (string s) (number (write-to-string s))) - if (or (char= c #\.) - (alpha-char-p c) - (digit-char-p c)) - collect (format nil "~C" c) - else - collect (format nil "_~X_" (char-code c))))) + (loop for c + across (etypecase s (string s) (number (write-to-string s))) + if (or (char= c #\.) + (alpha-char-p c) + (digit-char-p c)) + collect (format nil "~C" c) + else + collect (format nil "_~X_" (char-code c))))) (defun filename->string (s) (loop with decoding - with buffer - with result - for c across s - do (cond - ((and (char= c #\_) (not decoding)) - (setq decoding t)) - ((and (char= c #\_) decoding) - (unless buffer (error "invalid encoding")) - (push (code-char - (read-from-string - (coerce (list* #\# #\x (nreverse buffer)) 'string))) - result) - (setq buffer nil - decoding nil)) - (decoding - (push c buffer)) - (t - (push c result))) - finally (return (coerce (nreverse result) 'string)))) + with buffer + with result + for c across s + do (cond + ((and (char= c #\_) (not decoding)) + (setq decoding t)) + ((and (char= c #\_) decoding) + (unless buffer (error "invalid encoding")) + (push (code-char + (read-from-string + (coerce (list* #\# #\x (nreverse buffer)) 'string))) + result) + (setq buffer nil + decoding nil)) + (decoding + (push c buffer)) + (t + (push c result))) + finally (return (coerce (nreverse result) 'string)))) -- cgit v1.2.3