Skip to content
Snippets Groups Projects
Commit e1d5eb63 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Expunge more stuff that's already in asdf.

parent 6a1bfd64
No related branches found
No related tags found
No related merge requests found
......@@ -112,6 +112,7 @@ returning the two lists of the values returned by the function."
(if ny (return nil)
(setf x (cdr x) y (cdr y)))))))
#|
(unless (fboundp 'length=n-p) ; already defined in ASDF
(defun length=n-p (x n)
;(= (length x) n)
......@@ -122,6 +123,7 @@ returning the two lists of the values returned by the function."
(cond
((zerop i) (return (null l)))
((not (consp l)) (return nil))))))
|#
(defun length<-p (x y)
;(= (length x) (length y))
......
......@@ -14,6 +14,7 @@
(when more-strings
(princ sep stream)))))
#| use ASDF:LAST-CHAR and ASDF:FIRST-CHAR
(unless (fboundp 'last-char)
(def*fun last-char (string)
(check-type string string)
......@@ -21,17 +22,18 @@
(unless (zerop l)
(char string (1- l))))))
(def*fun but-last-char (string)
(check-type string string)
(let ((l (length string)))
(unless (zerop l)
(subseq string 0 (1- l)))))
(unless (fboundp 'first-char)
(def*fun first-char (string)
(check-type string string)
(unless (zerop (length string))
(char string 0))))
|#
(def*fun but-last-char (string)
(check-type string string)
(let ((l (length string)))
(unless (zerop l)
(subseq string 0 (1- l)))))
(def*fun string-prefix-p (prefix string)
(let* ((x (string prefix))
......
......@@ -32,7 +32,7 @@
(defun conc-string (&rest rest)
"make a string by concatenating stuff"
(apply #'strcat (mapcar #'->string rest)))
(apply #'asdf:strcat (mapcar #'->string rest)))
))
(eval-now
......@@ -73,6 +73,7 @@
(coerce s 'simple-base-string)
s))))
#| use ASDF:STRCAT
(eval-now
(unless (fboundp 'strcat)
(defun strcat (&rest strings)
......@@ -83,3 +84,4 @@
;; (let ((basicp (every #'string-basic-p strings)))
;; (apply #'concatenate (if basicp 'base-string 'string) strings))
))
|#
......@@ -14,8 +14,10 @@
(defvar +back-path+ (make-pathname :directory '(:relative :back))
"logical parent path")
#| don't use this. Probably use ASDF:PATHNAME-ROOT
(defun pathname-base-pathname (pathname)
(make-pathname :directory nil :defaults pathname))
|#
#| use ASDF:PATHNAME-PARENT-DIRECTORY-PATHNAME
(defun pathname-parent (pathname)
......@@ -39,7 +41,7 @@ of the directory of the given pathname"
(defun directory-name-p (name)
(and (stringp name)
(eql #\/ (last-char name))))
(eql #\/ (asdf:last-char name))))
(defun portable-pathname-string-component-char-p (c)
(declare (type character c))
......@@ -166,7 +168,7 @@ erroring out if some source of non-portability is found"
(make-pathname :directory (unless (equal r '(:relative)) (nreverse r))
:name name :type type)))
#|
#| ;; use ASDF:SUBPATHNAME
(defun subpathname (path string)
(merge-pathnames*
(portable-pathname-from-string string :allow-absolute nil)
......@@ -179,7 +181,7 @@ erroring out if some source of non-portability is found"
(and (consp directory) (eq (car directory) :absolute))))
(defun portable-namestring-absolute-p (namestring)
(eql (first-char namestring) #\/))
(eql (asdf:first-char namestring) #\/))
(defun portable-pathname-absolute-p (name)
(etypecase name
......@@ -218,10 +220,10 @@ erroring out if some source of non-portability is found"
(cond
((equal x "")
(error "empty namestring"))
((eql (last-char x) #\/)
((eql (asdf:last-char x) #\/)
(pathname x))
(t
(pathname (strcat x "/")))))
(pathname (asdf:strcat x "/")))))
(pathname
(if (or (pathname-name x)
(pathname-type x)
......
......@@ -16,7 +16,7 @@
(:export
#:$buffer-size #:*package-misdefinition-warning-hook*
#:*safe-package* #:*standard-readtable*
#:+all-chars-base-feature+ #:absolute-pathname-p
#:+all-chars-base-feature+ ;; #:absolute-pathname-p
#:accessors-equal-p #:acond #:acond2 #:adjust-size #:aif
#:aif2 #:alist->hash-table #:association
#:base-char-p #:binary-heap #:binomial-heap #:boolean
......@@ -53,7 +53,7 @@
#:if-testing #:if2 #:initialize-instance #:insert-item!
#:insert-node! #:integers-below #:integers-between #:it
#:join-strings #:kwote #:least-item #:length<-p #:length<=-p
#:length<=n-p #:length<n-p #:length=-p #:length=n-p
#:length<=n-p #:length<n-p #:length=-p ;; #:length=n-p
#:length>-p #:length>=-p #:length>=n-p #:length>n-p #:let1
#:list->vector #:list-of-integers
#:literalp #:make-collector #:make-defpackage-form
......@@ -71,7 +71,7 @@
#:remove-nth #:rlist* #:safe-read #:safe-write #:search-tree
#:set-container-contents-from-list! #:simplify-string
#:single-arg #:single-arg-form-p #:sized-container-mixin
#:strcat #:string-all-base-char-p #:string-basic-p
#:string-all-base-char-p #:string-basic-p ;; #:strcat
#:->string #:style-warn #:test-form #:test-forms
#:test-only #:the* #:ttest #:ttest* #:unfeaturify
#:vector->list #:vector-container-mixin
......@@ -80,15 +80,15 @@
#:with-magic-special-variables-safely #:with-msv #:with-msv*
#:with-output-stream #:with-input-stream
#:with-user-output-file #:xtime #:_
#:first-char #:last-char #:but-last-char
#:but-last-char ;; #:first-char #:last-char
;; #:proper-list-p
#:form-starting-with-p
#:make-hashset
#:split-list
#:string-prefix-p #:string-suffix-p #:string-enclosed-p
#:string-strip-prefix #:string-strip-suffix
#:+root-path+ #:+back-path+ #:merge-pathnames*
#:pathname-directory-pathname #:pathname-base-pathname
#:+root-path+ #:+back-path+ ;; #:merge-pathnames*
;; #:pathname-directory-pathname #:pathname-base-pathname
;; #:pathname-parent
#:top-level-name #:directory-name-p
#:portable-pathname-string-component-char-p
......@@ -100,7 +100,7 @@
#:portable-pathname-output
#:portable-namestring
#:portable-pathname-from-string
#:subpathname
;; #:subpathname
#:pathname-absolute-p
#:portable-namestring-absolute-p
#:portable-pathname-absolute-p
......@@ -113,7 +113,7 @@
#:unwilden
#:append1 #:append1f #:funcallf ;; #:appendf #:nconcf
#:with-nesting #:nest #:tsen
#:while-collecting
;; #:while-collecting
#:parse-macro-lambda-list
#:list-starts-with-p
;; #:parse-body
......
......@@ -6,7 +6,7 @@
:documentation "Test string functions"))
(deftest test-strcat ()
(is (equal (strcat "foo" "bar" "baz") "foobarbaz")))
(is (equal (asdf:strcat "foo" "bar" "baz") "foobarbaz")))
(deftest test-join-strings ()
(is (equal (join-strings '("/bin" "/usr/bin" "/usr/local/bin") :separator ":")
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment