changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/std/path.lisp

changeset 431: c40d2a41d7ce
parent: 45889d307d7f
child: 926d95e5fdc7
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 09 Jun 2024 02:04:18 -0400
permissions: -rw-r--r--
description: source concatenating std.lisp, more systems, got zstd simple working, IO work, added dat/tar 
     1 ;;; std/path.lisp --- Standard Path Library
     2 
     3 ;;
     4 
     5 ;;; Code:
     6 (in-package :std/path)
     7 
     8 (deftype wild-pathname ()
     9   "A pathname with wild components."
    10   '(and pathname (satisfies wild-pathname-p)))
    11 
    12 (deftype non-wild-pathname ()
    13   "A pathname without wild components."
    14   '(or directory-pathname
    15     (and pathname (not (satisfies wild-pathname-p)))))
    16 
    17 (deftype absolute-pathname ()
    18   '(and pathname (satisfies uiop:absolute-pathname-p)))
    19 
    20 (deftype relative-pathname ()
    21   '(and pathname (satisfies uiop:relative-pathname-p)))
    22 
    23 (deftype directory-pathname ()
    24   '(and pathname (satisfies uiop:directory-pathname-p)))
    25 
    26 (deftype absolute-directory-pathname ()
    27   '(and absolute-pathname directory-pathname))
    28 
    29 (deftype file-pathname ()
    30   '(and pathname (satisfies uiop:file-pathname-p)))
    31 
    32 ;; logical-pathname is defined in CL.
    33 
    34 (defconstant +pathsep+
    35   #+windows #\; #+unix #\:
    36   "Path separator for this OS.")
    37 
    38 (defconstant +wildfile+ (make-pathname :name :wild :type :wild :version :wild))
    39 
    40 ;; from UIOP:ADD-PATHNAME-SUFFIX
    41 (defun set-pathname-suffix (path suffix &rest keys)
    42   (apply 'make-pathname :name (concatenate 'string (pathname-name path) suffix)
    43                         :defaults path keys))
    44 
    45 (defvar *tmp-suffix* "-tmp")
    46 
    47 ;; based on UIOP:TMPIZE-PATHNAME
    48 (defun tmpize-pathname (path)
    49   "Return a new pathname based on PATH and *TMP-SUFFIX* with a gensym'd integer
    50 appended."
    51   (set-pathname-suffix path (symbol-name
    52                              (gensym *tmp-suffix*))))