From 3900a1f0b309516ae7228db1f5f93b69cac8400d Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sat, 28 Sep 2013 17:03:09 -0400 Subject: [PATCH] More docstrings. --- uiop/filesystem.lisp | 31 +++++++++++++++++++++++++++++++ uiop/os.lisp | 12 ++++++++++++ uiop/stream.lisp | 25 ++++++++++++++++++++++--- uiop/utility.lisp | 12 ++++++++++-- 4 files changed, 75 insertions(+), 5 deletions(-) diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp index 4fc0783f..0078f684 100644 --- a/uiop/filesystem.lisp +++ b/uiop/filesystem.lisp @@ -63,10 +63,12 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" ;;; Probing the filesystem (with-upgradability () (defun truename* (p) + "Nicer variant of TRUENAME that plays well with NIL and avoids logical pathname contexts" ;; avoids both logical-pathname merging and physical resolution issues (and p (handler-case (with-pathname-defaults () (truename p)) (file-error () nil)))) (defun safe-file-write-date (pathname) + "Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error." ;; If FILE-WRITE-DATE returns NIL, it's possible that ;; the user or some other agent has deleted an input file. ;; Also, generated files will not exist at the time planning is done @@ -133,14 +135,18 @@ or the original (parsed) pathname if it is false (the default)." (file-error () nil))))))) (defun directory-exists-p (x) + "Is X the name of a directory that exists on the filesystem?" (let ((p (probe-file* x :truename t))) (and (directory-pathname-p p) p))) (defun file-exists-p (x) + "Is X the name of a file that exists on the filesystem?" (let ((p (probe-file* x :truename t))) (and (file-pathname-p p) p))) (defun directory* (pathname-spec &rest keys &key &allow-other-keys) + "Return a list of the entries in a directory by calling DIRECTORY. +Try to override the defaults to not resolving symlinks, if implementation allows." (apply 'directory pathname-spec (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil) #+(or clozure digitool) '(:follow-links nil) @@ -169,6 +175,8 @@ or the original (parsed) pathname if it is false (the default)." entries)) (defun directory-files (directory &optional (pattern *wild-file*)) + "Return a list of the files in a directory according to the PATTERN, +which is not very portable to override. Try not resolve symlinks if implementation allows." (let ((dir (pathname directory))) (when (logical-pathname-p dir) ;; Because of the filtering we do below, @@ -263,6 +271,7 @@ or the original (parsed) pathname if it is false (the default)." :finally (return p)))))) (defun resolve-symlinks (path) + "Do a best effort at resolving symlinks in PATH, returning a partially or totally resolved PATH." #-allegro (truenamize path) #+allegro (if (physical-pathname-p path) @@ -274,6 +283,7 @@ or the original (parsed) pathname if it is false (the default)." Defaults to T.") (defun resolve-symlinks* (path) + "RESOLVE-SYMLINKS in PATH iff *RESOLVE-SYMLINKS* is T (the default)." (if *resolve-symlinks* (and path (resolve-symlinks path)) path))) @@ -404,10 +414,14 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." ;;; Pathname defaults (with-upgradability () (defun get-pathname-defaults (&optional (defaults *default-pathname-defaults*)) + "Find the actual DEFAULTS to use for pathnames, including +resolving them with respect to GETCWD if the DEFAULTS were relative" (or (absolute-pathname-p defaults) (merge-pathnames* defaults (getcwd)))) (defun call-with-current-directory (dir thunk) + "call the THUNK in a context where the current directory was changed to DIR, if not NIL. +Note that this operation is usually NOT thread-safe." (if dir (let* ((dir (resolve-symlinks* (get-pathname-defaults (pathname-directory-pathname dir)))) (cwd (getcwd)) @@ -426,13 +440,18 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." ;;; Environment pathnames (with-upgradability () (defun inter-directory-separator () + "What character does the current OS conventionally uses to separate directories?" (if (os-unix-p) #\: #\;)) (defun split-native-pathnames-string (string &rest constraints &key &allow-other-keys) + "Given a string of pathnames specified in native OS syntax, separate them in a list, +check constraints and normalize each one as per ENSURE-PATHNAME." (loop :for namestring :in (split-string string :separator (string (inter-directory-separator))) :collect (apply 'parse-native-namestring namestring constraints))) (defun getenv-pathname (x &rest constraints &key ensure-directory want-directory on-error &allow-other-keys) + "Extract a pathname from a user-configured environment variable, as per native OS, +check constraints and normalize as per ENSURE-PATHNAME." ;; For backward compatibility with ASDF 2, want-directory implies ensure-directory (apply 'parse-native-namestring (getenvp x) :ensure-directory (or ensure-directory want-directory) @@ -440,16 +459,23 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathname ,x)) constraints)) (defun getenv-pathnames (x &rest constraints &key on-error &allow-other-keys) + "Extract a list of pathname from a user-configured environment variable, as per native OS, +check constraints and normalize each one as per ENSURE-PATHNAME." (apply 'split-native-pathnames-string (getenvp x) :on-error (or on-error `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathnames ,x)) constraints)) (defun getenv-absolute-directory (x) + "Extract an absolute directory pathname from a user-configured environment variable, +as per native OS" (getenv-pathname x :want-absolute t :ensure-directory t)) (defun getenv-absolute-directories (x) + "Extract a list of absolute directories from a user-configured environment variable, +as per native OS" (getenv-pathnames x :want-absolute t :ensure-directory t)) (defun lisp-implementation-directory (&key truename) + "Where are the system files of the current installation of the CL implementation?" (declare (ignorable truename)) #+(or clozure ecl gcl mkcl sbcl) (let ((dir @@ -465,6 +491,7 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." dir))) (defun lisp-implementation-pathname-p (pathname) + "Is the PATHNAME under the current installation of the CL implementation?" ;; Other builtin systems are those under the implementation directory (and (when pathname (if-let (impdir (lisp-implementation-directory)) @@ -479,11 +506,14 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." ;;; Simple filesystem operations (with-upgradability () (defun ensure-all-directories-exist (pathnames) + "Ensure that for every pathname in PATHNAMES, we ensure its directories exist" (dolist (pathname pathnames) (when pathname (ensure-directories-exist (translate-logical-pathname pathname))))) (defun rename-file-overwriting-target (source target) + "Rename a file, overwriting any previous file with the TARGET name, +in an atomic way if the implementation allows." #+clisp ;; But for a bug in CLISP 2.48, we should use :if-exists :overwrite and be atomic (posix:copy-file source target :method :rename) #-clisp @@ -491,6 +521,7 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." #+clozure :if-exists #+clozure :rename-and-delete)) (defun delete-file-if-exists (x) + "Delete a file X if it already exists" (when x (handler-case (delete-file x) (file-error () nil)))) (defun delete-empty-directory (directory-pathname) diff --git a/uiop/os.lisp b/uiop/os.lisp index 930c3503..84c3180e 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -20,6 +20,11 @@ ;;; Features (with-upgradability () (defun featurep (x &optional (*features* *features*)) + "Checks whether a feature expression X is true with respect to the *FEATURES* set, +as per the CLHS standard for #+ and #-. Beware that just like the CLHS, +we assume symbols from the KEYWORD package are used, but that unless you're using #+/#- +your reader will not have magically used the KEYWORD package, so you need specify +keywords explicitly." (cond ((atom x) (and (member x *features*) t)) ((eq :not (car x)) (assert (null (cddr x))) (not (featurep (cadr x)))) @@ -50,6 +55,8 @@ (or #+mcl t)) (defun detect-os () + "Detects the current operating system. Only needs be run at compile-time, +except on ABCL where it might change between FASL compilation and runtime." (loop* :with o :for (feature . detect) :in '((:os-unix . os-unix-p) (:os-windows . os-windows-p) (:os-macosx . os-macosx-p) @@ -66,6 +73,9 @@ that is neither Unix, nor Windows, nor Genera, nor even old MacOS.~%Now you port (with-upgradability () (defun getenv (x) + "Query the environment, as in C getenv. +Beware: may return empty string if a variable is present but empty; +use getenvp to return NIL in such a case." (declare (ignorable x)) #+(or abcl clisp ecl xcl) (ext:getenv x) #+allegro (sys:getenv x) @@ -188,6 +198,8 @@ then returning the non-empty string value of the variable" s)))) (defun implementation-identifier () + "Return a string that identifies the ABI of the current implementation, +suitable for use as a directory name to segregate Lisp FASLs, C dynamic libraries, etc." (substitute-if #\_ #'(lambda (x) (find x " /:;&^\\|?<>(){}[]$#`'\"")) (format nil "~(~a~@{~@[-~a~]~}~)" diff --git a/uiop/stream.lisp b/uiop/stream.lisp index 5ded2687..e7deee91 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -258,6 +258,7 @@ Other keys are accepted but discarded." &key element-type external-format if-does-not-exist) &body body) (declare (ignore element-type external-format if-does-not-exist)) + "Evaluate BODY in a context when VAR is bound to an input stream accessing the null device." `(call-with-null-input #'(lambda (,var) ,@body) ,@keys)) (defun call-with-null-output (fun &key (element-type *default-stream-element-type*) @@ -271,6 +272,7 @@ Other keys are accepted but discarded." (defmacro with-null-output ((var &rest keys &key element-type external-format if-does-not-exist if-exists) &body body) + "Evaluate BODY in a context when VAR is bound to an output stream accessing the null device." (declare (ignore element-type external-format if-exists if-does-not-exist)) `(call-with-null-output #'(lambda (,var) ,@body) ,@keys))) @@ -293,6 +295,8 @@ Useful for portably flushing I/O before user input or program exit." (finish-outputs stream)) (defun safe-format! (stream format &rest args) + "Variant of FORMAT that is safe against both +dangerous syntax configuration and errors while printing." (with-safe-io-syntax () (ignore-errors (apply 'format! stream format args)) (finish-outputs stream)))) ; just in case format failed @@ -322,6 +326,7 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE." (when (< end buffer-size) (return)))))) (defun concatenate-files (inputs output) + "create a new OUTPUT file the contents of which a the concatenate of the INPUTS files." (with-open-file (o output :element-type '(unsigned-byte 8) :direction :output :if-exists :rename-and-delete) (dolist (input inputs) @@ -330,6 +335,7 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE." (copy-stream-to-stream i o :element-type '(unsigned-byte 8)))))) (defun copy-file (input output) + "Copy contents of the INPUT file to the OUTPUT file" ;; Not available on LW personal edition or LW 6.0 on Mac: (lispworks:copy-file i f) (concatenate-files (list input) output)) @@ -472,15 +478,18 @@ If a string, repeatedly read and evaluate from it, returning the last values." (with-upgradability () (defun println (x &optional (stream *standard-output*)) + "Variant of PRINC that also calls TERPRI afterwards" (princ x stream) (terpri stream) (values)) (defun writeln (x &rest keys &key (stream *standard-output*) &allow-other-keys) + "Variant of WRITE that also calls TERPRI afterwards" (apply 'write x keys) (terpri stream) (values))) ;;; Using temporary files (with-upgradability () (defun default-temporary-directory () + "Return a default directory to use for temporary files" (or (when (os-unix-p) (or (getenv-pathname "TMPDIR" :ensure-directory t) @@ -489,12 +498,14 @@ If a string, repeatedly read and evaluate from it, returning the last values." (getenv-pathname "TEMP" :ensure-directory t)) (subpathname (user-homedir-pathname) "tmp/"))) - (defvar *temporary-directory* nil) + (defvar *temporary-directory* nil "User-configurable location for temporary files") (defun temporary-directory () + "Return a directory to use for temporary files" (or *temporary-directory* (default-temporary-directory))) (defun setup-temporary-directory () + "Configure a default temporary directory to use." (setf *temporary-directory* (default-temporary-directory)) ;; basic lack fixed after gcl 2.7.0-61, but ending / required still on 2.7.0-64.1 #+(and gcl (not gcl2.6)) (setf system::*tmp-dir* *temporary-directory*)) @@ -504,6 +515,10 @@ If a string, repeatedly read and evaluate from it, returning the last values." prefix keep (direction :io) (element-type *default-stream-element-type*) (external-format *utf-8-external-format*)) + "Call a THUNK with STREAM and PATHNAME arguments identifying a temporary file. +The pathname will be based on appending a random suffix to PREFIX. +This utility will KEEP the file past its extent if and only if explicitly requested. +The file will be open with specified DIRECTION, ELEMENT-TYPE and EXTERNAL-FORMAT." #+gcl2.6 (declare (ignorable external-format)) (check-type direction (member :output :io)) (loop @@ -531,8 +546,10 @@ If a string, repeatedly read and evaluate from it, returning the last values." prefix keep direction element-type external-format) &body body) "Evaluate BODY where the symbols specified by keyword arguments -STREAM and PATHNAME are bound corresponding to a newly created temporary file -ready for I/O. Unless KEEP is specified, delete the file afterwards." +STREAM and PATHNAME (if respectively specified) are bound corresponding +to a newly created temporary file ready for I/O, as per CALL-WITH-TEMPORARY-FILE. +The STREAM will be closed if no binding is specified. +Unless KEEP is specified, delete the file afterwards." (check-type stream symbol) (check-type pathname symbol) `(flet ((think (,stream ,pathname) @@ -550,10 +567,12 @@ ready for I/O. Unless KEEP is specified, delete the file afterwards." ;; Temporary pathnames in simple cases where no contention is assumed (defun add-pathname-suffix (pathname suffix) + "Add a SUFFIX to the name of a PATHNAME, return a new pathname" (make-pathname :name (strcat (pathname-name pathname) suffix) :defaults pathname)) (defun tmpize-pathname (x) + "Return a new pathname modified from X by adding a trivial deterministic suffix" (add-pathname-suffix x "-ASDF-TMP")) (defun call-with-staging-pathname (pathname fun) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index 6981e0c5..91153626 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -194,10 +194,12 @@ Returns two values: \(A B C\) and \(1 2 3\)." ;;; Strings (with-upgradability () (defun base-string-p (string) + "Does the STRING only contain BASE-CHARs?" (declare (ignorable string)) (and #+non-base-chars-exist-p (eq 'base-char (array-element-type string)))) (defun strings-common-element-type (strings) + "What least subtype of CHARACTER can contain all the elements of all the STRINGS?" (declare (ignorable strings)) #-non-base-chars-exist-p 'character #+non-base-chars-exist-p @@ -220,12 +222,16 @@ NIL is interpreted as an empty string. A character is interpreted as a string of :finally (return output))) (defun strcat (&rest strings) + "Concatenate strings. +NIL is interpreted as an empty string, a character as a string of length one." (reduce/strcat strings)) (defun first-char (s) + "Return the first character of a non-empty string S, or NIL" (and (stringp s) (plusp (length s)) (char s 0))) (defun last-char (s) + "Return the last character of a non-empty string S, or NIL" (and (stringp s) (plusp (length s)) (char s (1- (length s))))) (defun split-string (string &key max (separator '(#\Space #\Tab))) @@ -253,6 +259,8 @@ starting the separation from the end, e.g. when called with arguments (defvar *crlf* (coerce #(#\cr #\newline) 'string)) (defun stripln (x) + "Strip a string X from any ending CR, LF or CRLF. +Return two values, the stripped string and the strip that was stripped" (check-type x string) (let* ((len (length x)) (endlfp (equal (last-char x) #\linefeed)) @@ -295,7 +303,7 @@ starting the separation from the end, e.g. when called with arguments (symbol (find-class x errorp environment))))) -;;; stamps: a REAL or boolean where NIL=-infinity, T=+infinity +;;; stamps: a REAL or a boolean where NIL=-infinity, T=+infinity (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) (deftype stamp () '(or real boolean))) (with-upgradability () @@ -489,6 +497,7 @@ or a string describing the format-control of a simple-condition." (loop :for x :in conditions :thereis (match-condition-p x condition))) (defun call-with-muffled-conditions (thunk conditions) + "calls the THUNK in a context where the CONDITIONS are muffled" (handler-bind ((t #'(lambda (c) (when (match-any-condition-p c conditions) (muffle-warning c))))) (funcall thunk))) @@ -496,4 +505,3 @@ or a string describing the format-control of a simple-condition." (defmacro with-muffled-conditions ((conditions) &body body) `(call-with-muffled-conditions #'(lambda () ,@body) ,conditions))) - -- GitLab