aboutsummaryrefslogtreecommitdiff
path: root/src/interp/pathname.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-20 04:57:39 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-20 04:57:39 +0000
commitc75b5923cb35d83910e45f13e9d15c981ea25387 (patch)
treea6c3a03b1ac5fef72e01fe1d60873d277222a52b /src/interp/pathname.boot.pamphlet
parent516d3e4928185c380ffee8249454fe76ab6f2851 (diff)
downloadopen-axiom-c75b5923cb35d83910e45f13e9d15c981ea25387.tar.gz
remove pamphlets - part 7
Diffstat (limited to 'src/interp/pathname.boot.pamphlet')
-rw-r--r--src/interp/pathname.boot.pamphlet165
1 files changed, 0 insertions, 165 deletions
diff --git a/src/interp/pathname.boot.pamphlet b/src/interp/pathname.boot.pamphlet
deleted file mode 100644
index 300d2c41..00000000
--- a/src/interp/pathname.boot.pamphlet
+++ /dev/null
@@ -1,165 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp pathname.boot}
-\author{The Axiom Team}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
--- - Redistributions of source code must retain the above copyright
--- notice, this list of conditions and the following disclaimer.
---
--- - Redistributions in binary form must reproduce the above copyright
--- notice, this list of conditions and the following disclaimer in
--- the documentation and/or other materials provided with the
--- distribution.
---
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--- names of its contributors may be used to endorse or promote products
--- derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-@
-<<*>>=
-<<license>>
-
-)package "BOOT"
-
--- This file implements the Common Lisp pathname functions for
--- Lisp/VM. On VM, a filename is 3-list consisting of the filename,
--- filetype and filemode. We also UPCASE everything.
-
--- This file also contains some other VM specific functions for
--- dealing with files.
-
---% Common Lisp Pathname Functions
-
-pathname? p == p=[] or PATHNAMEP p
-
-pathname p ==
- p = [] => p
- PATHNAMEP p => p
- not PAIRP p => PATHNAME p
- if #p>2 then p:=[p.0,p.1]
- PATHNAME APPLY(FUNCTION MAKE_-FILENAME, p)
-
-namestring p == NAMESTRING pathname p
-
-pathnameName p == PATHNAME_-NAME pathname p
-
-pathnameType p == PATHNAME_-TYPE pathname p
-
-pathnameTypeId p == UPCASE object2Identifier pathnameType p
-
-pathnameDirectory p ==
- NAMESTRING MAKE_-PATHNAME(LispKeyword '"DIRECTORY",PATHNAME_-DIRECTORY pathname p)
-
-deleteFile f == _$ERASE pathname f
-
-isExistingFile f ==
--- p := pathname f
- --member(p,$existingFiles) => true
- if MAKE_-INPUT_-FILENAME f
- then
- --$existingFiles := [p,:$existingFiles]
- true
- else false
-
---% Scratchpad II File Name Functions
-
-makePathname(name,type,dir) ==
- -- Common Lisp version of this will have to be written
- -- using MAKE-PATHNAME and the optional args.
- pathname [object2String name,object2String type]
-
-mergePathnames(a,b) ==
- (fn := pathnameName(a)) = '"*" => b
- fn ^= pathnameName(b) => a
- (ft := pathnameType(a)) = '"*" => b
- ft ^= pathnameType(b) => a
- (fm := pathnameDirectory(a)) = ['"*"] => b
- a
-
-isSystemDirectory dir == EVERY(function CHAR_=,$SPADROOT,dir)
-
--- the next function is an improved version of the one in DEBUG LISP
-
-_/MKINFILENAM(infile) == CATCH('FILNAM, newMKINFILENAM infile)
-
-newMKINFILENAM(infile) ==
- NULL infile => nil
- file := infile := pathname infile
- repeat
- fn := pathnameName file
- nfile := $FINDFILE (file,$sourceFileTypes)
- null nfile =>
- nfile := file
- if fn = '"*" or fn = '"NIL" then sayKeyedMsg("S2IL0016",NIL)
- else sayKeyedMsg("S2IL0003",[namestring file])
- ans := queryUserKeyedMsg("S2IL0017",NIL)
- if (SIZE(ans) > 0) and ('")" = SUBSTRING(ans,0,1)) then n := 2
- else n := 1
- nfn := UPCASE STRING2ID_-N(ans,n)
- (nfn = 0) or (nfn = 'QUIT) =>
- sayKeyedMsg("S2IL0018",NIL)
- THROW('FILENAM,NIL)
- nfn = 'CREATE => return 'fromThisLoop
- file := pathname ans
- return 'fromThisLoop
- if nfile then pathname nfile
- else NIL
-
-
-getFunctionSourceFile fun ==
- null (f := getFunctionSourceFile1 fun) => NIL
- if MAKE_-INPUT_-FILENAME(f) then updateSourceFiles f
- f
-
-getFunctionSourceFile1 fun ==
- -- returns NIL or [fn,ft,fm]
- (file := KDR GETL(fun,'DEFLOC)) => pathname file
- null ((fileinfo := FUNLOC fun) or
- (fileinfo := FUNLOC unabbrev fun)) =>
- u := bootFind fun => getFunctionSourceFile1 SETQ($FUNCTION,INTERN u)
- NIL
- 3 = #fileinfo =>
- [fn,ft,$FUNCTION] := fileinfo
- newMKINFILENAM pathname [fn,ft]
- [fn,$FUNCTION] := fileinfo
- newMKINFILENAM pathname [fn]
-
-updateSourceFiles p ==
- p := pathname p
- p := pathname [pathnameName p, pathnameType p, '"*"]
- if MAKE_-INPUT_-FILENAME p and pathnameTypeId p in '(BOOT LISP META) then
- $sourceFiles := insert(p, $sourceFiles)
- p
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}