changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/std/path.lisp

changeset 648: 926d95e5fdc7
parent: c40d2a41d7ce
author: Richard Westhaver <ellis@rwest.io>
date: Thu, 12 Sep 2024 16:48:47 -0400
permissions: -rw-r--r--
description: cli/multi and slime-cape fixes 
     1 ;;; std/path.lisp --- Standard Path Library
     2 
     3 ;;
     4 
     5 ;;; Code:
     6 (in-package :std/path)
     7 
     8 (defun symlinkp (pathname)
     9   (sb-posix:s-islnk (sb-posix:stat-mode (sb-posix:lstat pathname))))
    10 
    11 (deftype wild-pathname ()
    12   "A pathname with wild components."
    13   '(and pathname (satisfies wild-pathname-p)))
    14 
    15 (deftype non-wild-pathname ()
    16   "A pathname without wild components."
    17   '(or directory-pathname
    18     (and pathname (not (satisfies wild-pathname-p)))))
    19 
    20 (deftype absolute-pathname ()
    21   '(and pathname (satisfies uiop:absolute-pathname-p)))
    22 
    23 (deftype relative-pathname ()
    24   '(and pathname (satisfies uiop:relative-pathname-p)))
    25 
    26 (deftype directory-pathname ()
    27   '(and pathname (satisfies uiop:directory-pathname-p)))
    28 
    29 (deftype symlink-pathname ()
    30   '(and pathname (satisfies symlinkp)))
    31 
    32 (deftype absolute-directory-pathname ()
    33   '(and absolute-pathname directory-pathname))
    34 
    35 (deftype file-pathname ()
    36   '(and pathname (satisfies uiop:file-pathname-p)))
    37 
    38 ;; logical-pathname is defined in CL.
    39 
    40 (defconstant +pathsep+
    41   #+windows #\; #+unix #\:
    42   "Path separator for this OS.")
    43 
    44 (defconstant +wildfile+ (make-pathname :name :wild :type :wild :version :wild))
    45 
    46 ;; from UIOP:ADD-PATHNAME-SUFFIX
    47 (defun set-pathname-suffix (path suffix &rest keys)
    48   (apply 'make-pathname :name (concatenate 'string (pathname-name path) suffix)
    49                         :defaults path keys))
    50 
    51 (defvar *tmp-suffix* "-tmp")
    52 
    53 ;; based on UIOP:TMPIZE-PATHNAME
    54 (defun tmpize-pathname (path)
    55   "Return a new pathname based on PATH and *TMP-SUFFIX* with a gensym'd integer
    56 appended."
    57   (set-pathname-suffix path (symbol-name
    58                              (gensym *tmp-suffix*))))