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