diff --git a/sbcl/.quicklisp/dists/quicklisp/archives/cl-fad-20190813-git.tgz b/sbcl/.quicklisp/dists/quicklisp/archives/cl-fad-20190813-git.tgz new file mode 100644 index 0000000..20a48b7 Binary files /dev/null and b/sbcl/.quicklisp/dists/quicklisp/archives/cl-fad-20190813-git.tgz differ diff --git a/sbcl/.quicklisp/dists/quicklisp/archives/html-template-20171227-git.tgz b/sbcl/.quicklisp/dists/quicklisp/archives/html-template-20171227-git.tgz new file mode 100644 index 0000000..85845a0 Binary files /dev/null and b/sbcl/.quicklisp/dists/quicklisp/archives/html-template-20171227-git.tgz differ diff --git a/sbcl/.quicklisp/dists/quicklisp/archives/quickproject-1.4.1.tgz b/sbcl/.quicklisp/dists/quicklisp/archives/quickproject-1.4.1.tgz new file mode 100644 index 0000000..d32d03e Binary files /dev/null and b/sbcl/.quicklisp/dists/quicklisp/archives/quickproject-1.4.1.tgz differ diff --git a/sbcl/.quicklisp/dists/quicklisp/installed/releases/cl-fad.txt b/sbcl/.quicklisp/dists/quicklisp/installed/releases/cl-fad.txt new file mode 100644 index 0000000..d6146bd --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/installed/releases/cl-fad.txt @@ -0,0 +1 @@ +dists/quicklisp/software/cl-fad-20190813-git/ diff --git a/sbcl/.quicklisp/dists/quicklisp/installed/releases/html-template.txt b/sbcl/.quicklisp/dists/quicklisp/installed/releases/html-template.txt new file mode 100644 index 0000000..4e46f0d --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/installed/releases/html-template.txt @@ -0,0 +1 @@ +dists/quicklisp/software/html-template-20171227-git/ diff --git a/sbcl/.quicklisp/dists/quicklisp/installed/releases/quickproject.txt b/sbcl/.quicklisp/dists/quicklisp/installed/releases/quickproject.txt new file mode 100644 index 0000000..b205a9a --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/installed/releases/quickproject.txt @@ -0,0 +1 @@ +dists/quicklisp/software/quickproject-1.4.1/ diff --git a/sbcl/.quicklisp/dists/quicklisp/installed/systems/cl-fad.txt b/sbcl/.quicklisp/dists/quicklisp/installed/systems/cl-fad.txt new file mode 100644 index 0000000..40c6425 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/installed/systems/cl-fad.txt @@ -0,0 +1 @@ +dists/quicklisp/software/cl-fad-20190813-git/cl-fad.asd diff --git a/sbcl/.quicklisp/dists/quicklisp/installed/systems/html-template.txt b/sbcl/.quicklisp/dists/quicklisp/installed/systems/html-template.txt new file mode 100644 index 0000000..1c624d9 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/installed/systems/html-template.txt @@ -0,0 +1 @@ +dists/quicklisp/software/html-template-20171227-git/html-template.asd diff --git a/sbcl/.quicklisp/dists/quicklisp/installed/systems/quickproject.txt b/sbcl/.quicklisp/dists/quicklisp/installed/systems/quickproject.txt new file mode 100644 index 0000000..0ab4bbc --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/installed/systems/quickproject.txt @@ -0,0 +1 @@ +dists/quicklisp/software/quickproject-1.4.1/quickproject.asd diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/CHANGELOG b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/CHANGELOG new file mode 100644 index 0000000..56cda02 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/CHANGELOG @@ -0,0 +1,121 @@ +Version 0.7.6 +2019-07-28 +Clisp has renamed ext:delete-dir to ext:delete-directory. +Fix get-default-temporary-directory on lispworks. + +Version 0.7.5 +2017-12-10 +Fix FILE-EXISTS-P to return directory truename in CLISP (chaitanyagupta) +Added support for Common Lisp implementation CLASP. (dg1sbg) + +Version 0.7.4 +2016-07-10 +Merge pull request #13 from vibs29/master (Hans Hübner) +Make copy-stream work for CMUCL Gray Streams (vibs29) + +Version 0.7.3 +2014-11-28 +remove version from cl-fad-test system (Hans Huebner) +update support information (Hans Huebner) + +Version 0.7.2 +2013-07-03 +Fix documentation glitch (inconsistent download link) (Luís Oliveira) + +Version 0.7.1 +2013-02-18 +Fix for LispWorks (R. Wilker) +Add :description to .asd file + +Version 0.7.0 +2013-01-23 +Tests, pathname manipulation functions (Marco Baringer) +Temporary files (merged by Marco Baringer) +Fix symlink behaviour for some platforms (Mihai Bazon and Janis Dzerins) + +Version 0.6.4 +2010-11-18 +Adapt to newer ClozureCL version (patch from Zach Beane, thanks to Chun Tian and Ralph Moritz as well) + +Version 0.6.3 +2009-09-30 +Removed dependency on :SB-EXECUTABLE (thanks to Attila Lendvai and Tobias Rittweiler) + +Version 0.6.2 +2008-03-12 +Never version of OpenMCL have %RMDIR (thanks to Dmitri Hrapof) + +Version 0.6.1 +2007-12-29 +Integrated CLISP patch for LIST-DIRECTORY sent by Dan Muller + +Version 0.6.0 +2007-05-28 +Support for Scieneer CL (patch from Douglas Crosher) + +Version 0.5.2 +2007-05-15 +Fix for (newer versions of) ECL (patch from Dustin Long) + +Version 0.5.1 +2006-08-11 +Added CHECKP to COPY-STREAM + +Version 0.5.0 +2006-04-21 +Added :BREADTH-FIRST option to WALK-DIRECTORY (thanks to Mac Chan) + +Version 0.4.3 +2006-03-15 +For CMUCL use TRUENAME with UNIX-RMDIR to cope with search lists (reported by Pawel Ostrowski) + +Version 0.4.2 +2006-01-04 +WALK-DIRECTORY now catches circular symbolic links (thanks to Gary King) + +Version 0.4.1 +2006-01-03 +Be more careful in DIRECTORY-WILDCARD (thanks to Gary King) +Patches for MCL (thanks to Gary King) + +Version 0.4.0 +2005-12-10 +Exported COPY-STREAM (suggested by Chris Dean) + +Version 0.3.3 +2005-11-14 +Fixed %RMDIR for newer versions of OpenMCL (thanks to James Bielman) + +Version 0.3.2 +2005-09-11 +Fixed docs (correct name DELETE-DIRECTORY-AND-FILES) +Fixed docs (OVERWRITE was missing in COPY-FILE signature) +Added Debian link + +Version 0.3.1 +2005-06-02 +Fixed typo in fad.lisp (thanks to Jack D. Unrue) + +Version 0.3.0 +2005-06-01 +Support for ABCL (thanks to Jack D. Unrue) + +Version 0.2.0 +2005-05-29 +Support for ECL (thanks to Maciek Pasternacki) + +Version 0.1.3 +2005-04-27 +Changed implementation of DIRECTORY-EXISTS-P for LispWorks + +Version 0.1.2 +2005-03-17 +Fixed typo in cl-fad.system (tanks to Andrew Philpot) + +Version 0.1.1 +2005-01-22 +Fixed typos and versioning + +Version 0.1.0 +2005-01-22 +Initial release diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/LICENSE b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/LICENSE new file mode 100644 index 0000000..1ca070d --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/LICENSE @@ -0,0 +1,26 @@ +;;; Copyright (c) 2004, Peter Seibel. All rights reserved. +;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/README b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/README new file mode 100644 index 0000000..3cb156f --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/README @@ -0,0 +1,38 @@ +Complete documentation for CL-FAD can be found in the 'docs' +directory or at . + +CL-FAD also supports Nikodemus Siivola's HYPERDOC, see + and +. + +1. Installation + +1.1. Probably the easiest way is + + (load "/path/to/cl-fad/load.lisp") + + This should compile and load CL-FAD on most Common Lisp + implementations. + +1.2. With MK:DEFSYSTEM you can make a symbolic link from + 'cl-fad.system' and 'cl-fad-test.system' to your central registry + (which by default is in '/usr/local/lisp/Registry/') and then issue + the command + + (mk:compile-system "cl-fad") + + Note that this relies on TRUENAME returning the original file a + symbolic link is pointing to. This will only work with AllegroCL + 6.2 if you've applied all patches with (SYS:UPDATE-ALLEGRO). + +1.3. You can also use ASDF instead of MK:DEFSYSTEM in a similar way + (use the .asd files instead of the .system files). + +1.4. Via QuickLisp: + + (ql:quickload :cl-fad) + +2. Test + +CL-FAD comes with a small test suite. To start it just load the file +"test.lisp" and evaluate (CL-FAD-TEST:TEST). diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/cl-fad.asd b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/cl-fad.asd new file mode 100644 index 0000000..c6f43a8 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/cl-fad.asd @@ -0,0 +1,50 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/cl-fad/cl-fad.asd,v 1.21 2009/09/30 14:23:09 edi Exp $ + +;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +#+:allegro (cl:require :osi) + +(asdf:defsystem #:cl-fad + :version "0.7.6" + :description "Portable pathname library" + :serial t + :license "BSD-2-Clause" + :components ((:file "packages") + #+:cormanlisp (:file "corman") + #+:openmcl (:file "openmcl") + (:file "fad") + (:file "path" :depends-on ("fad")) + (:file "temporary-files" :depends-on ("fad"))) + :depends-on (#+sbcl :sb-posix :bordeaux-threads :alexandria)) + +(asdf:defsystem #:cl-fad-test + :serial t + :components ((:file "packages.test") + (:file "fad.test" :depends-on ("packages.test")) + (:file "temporary-files.test" :depends-on ("packages.test"))) + :depends-on (:cl-fad :unit-test :cl-ppcre)) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/cl-fad.system b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/cl-fad.system new file mode 100644 index 0000000..de147f8 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/cl-fad.system @@ -0,0 +1,48 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/cl-fad/cl-fad.system,v 1.8 2008/03/12 00:10:43 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:cl-user) + +(defparameter *cl-fad-base-directory* + (make-pathname :name nil :type nil :version nil + :defaults (parse-namestring *load-truename*))) + +#+:allegro (require :osi) +#+:sbcl (require :sb-executable) +#+:sbcl (require :sb-posix) + +(mk:defsystem #:cl-fad + :source-pathname *cl-fad-base-directory* + :source-extension "lisp" + :components ((:file "packages") + #+:cormanlisp (:file "corman" :depends-on ("packages")) + #+:openmcl (:file "openmcl" :depends-on ("packages")) + (:file "fad" :depends-on ("packages" + #+:cormanlisp "corman" + #+:openmcl "openmcl")))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/corman.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/corman.lisp new file mode 100644 index 0000000..fa9e90d --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/corman.lisp @@ -0,0 +1,86 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/cl-fad/corman.lisp,v 1.5 2009/09/30 14:23:09 edi Exp $ + +;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package :cl) + +(defun wild-pathname-p (pathspec &optional field) + (unless (pathnamep pathspec) + (setq pathspec (pathname pathspec))) + (labels ((name-wild-p (name) + (or (eq :wild name) + (and (stringp name) + (string= "*" name)))) + (dir-wild-p (dir) + (or (find :wild dir) + (find :wild-inferiors dir) + (find "*" dir :test #'string=)))) + (case field + ((:name) + (name-wild-p (pathname-name pathspec))) + ((:type) + (name-wild-p (pathname-type pathspec))) + ((:directory) + (dir-wild-p (pathname-directory pathspec))) + ((nil) + (or (name-wild-p (pathname-name pathspec)) + (name-wild-p (pathname-type pathspec)) + (dir-wild-p (pathname-directory pathspec)))) + (t nil)))) + +(defun file-namestring (pathspec) + (flet ((string-list-for-component (component) + (cond ((eq component :wild) + (list "*")) + (component + (list component)) + (t nil)))) + (let* ((pathname (pathname pathspec)) + (name (pathnames::pathname-internal-name pathname)) + (type (pathnames::pathname-internal-type pathname))) + (format nil "~{~A~}~{.~A~}" + (string-list-for-component name) + (string-list-for-component type))))) + +(in-package :win32) + +(defwinapi RemoveDirectory + ((lpPathName LPCSTR)) + :return-type BOOL + :library-name "Kernel32" + :entry-name "RemoveDirectoryA" + :linkage-type :pascal) + +(defun delete-directory (pathspec) + "Deletes the empty directory denoted by the pathname designator +PATHSPEC. Returns true if successful, NIL otherwise." + (win:RemoveDirectory + (ct:lisp-string-to-c-string + (namestring (pathname pathspec))))) + +(export 'delete-directory) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/docs/index.html b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/docs/index.html new file mode 100644 index 0000000..22afad5 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/docs/index.html @@ -0,0 +1,700 @@ + + + + + + CL-FAD - A portable pathname library for Common Lisp + + + + + +

CL-FAD - A portable pathname library for Common Lisp

+ +
+
 

Abstract

+ +CL-FAD (for "Files and +Directories") is a thin layer atop Common +Lisp's standard pathname functions. It is intended to provide some +unification between current CL implementations on Windows, OS X, +Linux, and Unix. Most of the code was written by Peter Seibel for his book Practical Common Lisp. + +

+ +CL-FAD comes with a BSD-style +license so you can basically do with it whatever you want. + +

+Download shortcut: http://weitz.de/files/cl-fad.tar.gz. +

+ +
 

Contents

+
    +
  1. Download and installation +
  2. Supported Lisp implementations +
  3. The CL-FAD dictionary +
      +
    1. Querying files, directories and pathnames +
        +
      1. directory-exists-p [function] +
      2. directory-pathname-p [function] +
      3. file-exists-p [function] +
      4. pathname-absolute-p [function] +
      5. pathname-equal [function] +
      6. pathname-relative-p [function] +
      7. pathname-root-p [function] +
      2. +
    2. Manipulating pathnames +
        +
      1. canonical-pathname [function] +
      2. merge-pathnames-as-directory [function] +
      3. merge-pathnames-as-file [function] +
      4. pathname-as-directory [function] +
      5. pathname-as-file [function] +
      6. pathname-directory-pathname [function] +
      7. pathname-parent-directory [function] +
      3. +
    3. Traversing directories +
        +
      1. list-directory [function] +
      2. walk-directory [function] +
      4. +
    4. Temporary Files +
        +
      1. open-temporary [function] +
      2. with-output-to-temporary-file [macro] +
      3. with-open-temporary-file [macro] +
      4. *default-template* [variable] +
      5. cannot-create-temporary-file [condition] +
      6. invalid-temporary-pathname-template [condition] +
      7. missing-temp-environment-variable [condition] +
      8. temporary-files [logical pathname host] +
      +
      5. +
    5. Modifying the file system +
        +
      1. copy-file [function] +
      2. copy-stream [function] +
      3. delete-directory-and-files [function] +
      6. +
    6. path [package] +
    +
  4. Acknowledgements +
+ + + +
 

Download and installation

+ +CL-FAD together with this documentation can be downloaded from https://github.com/edicl/cl-fad/releases/latest. The +current version is 0.7.6. +

+CL-FAD comes with simple system definitions for MK:DEFSYSTEM and asdf so you can either adapt it +to your needs or just unpack the archive and from within the CL-FAD +directory start your Lisp image and evaluate the form +(mk:compile-system "cl-fad") - or (asdf:oos 'asdf:load-op :cl-fad) for asdf - which should compile and load the whole +system. +Installation via asdf-install should as well +be possible. Plus, there are ports +for Gentoo Linux thanks to Matthew Kennedy +and for Debian Linux thanks to René van Bevern. +

+If for some reason you can't or don't want to use MK:DEFSYSTEM or asdf you +can just LOAD the file load.lisp. +

+The latest version of the source code lives in the github repository edicl/cl-fad. + +If you want to send patches, +please read this first. +Please submit your changes +as GitHub pull +request". + +
 

Supported Lisp implementations

+ +

+The following Common Lisp implementations are currently supported: +

+ +I'll gladly accepts patches to make CL-FAD work on other platforms. + + +
 

The CL-FAD dictionary

+ +

Querying files, directories and pathnames

+ +


[Function] +
directory-exists-p pathspec => generalized-boolean + +


+Checks whether the file named by the pathname designator pathspec +exists and if it is a directory. Returns its truename if this is the +case, NIL otherwise. The truename is returned in directory form as if +by PATHNAME-AS-DIRECTORY. +
+ +


[Function] +
directory-pathname-p pathspec => generalized-boolean + +


+Returns NIL if pathspec (a pathname designator) does not designate +a directory, pathspec otherwise. It is irrelevant whether the file or +directory designated by pathspec does actually exist. +
+ +


[Function] +
file-exists-p pathspec => generalized-boolean + +


+Checks whether the file named by the pathname designator pathspec +exists and returns its truename if this is the case, NIL otherwise. +The truename is returned in "canonical" form, i.e. the truename of a +directory is returned in directory form as if by PATHNAME-AS-DIRECTORY. +
+ +


[Function]
pathname-absolute-p a => result +

+

Returns true if a is an absolute pathname. This simply +tests if a's directory list starts with :ABSOLUTE

+
+ +


[Function]
pathname-equal a b => result +

+ +

Returns true if a and b +represent the same pathname. This function does not access the +filesystem, it only looks at the components of the two pathnames to +test if they are the same (though by passing both a +and b to probe-file one can make this function test for +file 'sameness'.

+ +

Equality is defined as:

+ +
    +
  • strings that are string= +
  • symbols (including nil and keywords) which are eql +
  • lists of the same length with equal (as per these rules) elements. +
+ +

If any of these tree conditions is false for any of the components in +a and b then a +and b are different, otherwise they are the same.

+ +

NB: This function does not convert name strings to pathnames. So +"foo.txt" and #P"foo.txt" are different pathnames.

+ +
+ +


[Function]
pathname-relative-p a => result +

+

Returns true if a is a relative pathname. This simply +tests if a's directory starts +with :RELATIVE.

+
+ +


[Function]
pathname-root-p a => result +

+

Returns true if pathname is the root +directory (in other words, a directory which is its own parent).

+
+ +

Manipulating pathnames

+ +


[Function]
canonical-pathname pathname => result +

+

Remove redundant information from PATHNAME.

+ +

This simply walks down PATHNAME's +pathname-directory and drops "." directories, removes :back +and its preceding element.

+ +

NB: This function does not access the filesystem, it only looks at the +values in the pathname and works on their known (or assumed) +meanings.

+ +

NB: Since this function does not access the filesystem it will only +remove :BACK elements from the path (not :UP +elements). Since some lisps, ccl/sbcl/clisp convert ".." in +pathnames to :UP, and not :BACK, the actual +utility of the function is limited.

+
+ +


[Function]
merge-pathnames-as-directory &rest pathnames => result +

+

Given a list of (probably relative) pathnames, this returns a single +directory pathname containing the logical concatenation of them all.

+ +

The returned value is the current directory if one were to cd into +each of pathnames in order. For this reason an +absolute pathname will, effectively, cancel the affect of any previous +relative pathnames.

+ +

The returned value's defaults are taken from the first element of +pathnames (host, version and device).

+ +

NB: Since this function only looks at directory names the name and +type of the elements of pathnames are ignored. Make sure to properly +use either trailing #\/s, or pathname-as-directory, to get the +expected results.

+ +

Examples:

+ +
+  (merge-pathnames-as-directory #P"foo/" #P"bar/") == #P"foo/bar/"
+
+  (merge-pathnames-as-directory #P"foo/" #P"./bar/") == #P"foo/./bar/"
+
+  (merge-pathnames-as-directory #P"foo/" #P"/bar/") == #P"/bar/"
+
+  (merge-pathnames-as-directory #P"foo/" #P"/bar/" #P'quux/file.txt) == #P"/bar/quux/"
+
+ +
+ +


[Function]
merge-pathnames-as-file &rest pathnames => result +

+

Given a list of, probably relative, pathnames returns a single +filename pathname containing the logical concatenation of them all.

+ +

The returned value's defaults are taken from the first element of +pathnames (host, version and device). The returned +values's name, type and version are taken from the last element +of pathnames. The intervening elements are used only for +their pathname-directory values.

+ +Examples: + +
+  (merge-pathnames-as-file #P"foo/" #P"bar.txt") == #P"foo/bar.txt"
+
+  (merge-pathnames-as-file #P"foo/" #P"./bar.txt") == #P"foo/./bar.txt"
+
+  (merge-pathnames-as-file #P"foo/" #P"/bar/README") == #P"/bar/README"
+
+  (merge-pathnames-as-file #P"/foo/" #P"/bar/" #P'quux/file.txt) == #P"/bar/quux/file.txt"
+
+ +
+ +


[Function] +
pathname-as-directory pathspec => pathname +


+Converts the non-wild pathname designator pathspec to directory form, i.e. it returns a pathname which would return a true value if fed to DIRECTORY-PATHNAME-P. +
+ +


[Function] +
pathname-as-file pathspec => pathname + +


+Converts the non-wild pathname designator pathspec to file form, i.e. it returns a pathname which would return a NIL value if fed to DIRECTORY-PATHNAME-P. +
+ +


[Function]
pathname-directory-pathname pathname => result +

+

Returns a complete pathname representing the directory of +pathname. If pathname is +already a directory pathname +(name nil, type +nil) returns a pathname equal (as +per pathname-equal) to it.

+
+ +


[Function]
pathname-parent-directory pathname => result +

+ +

Returns a pathname which would, by name at least, +contain pathname as one of its direct +children. Symlinks can make the parent/child relationship a like +opaque, but generally speaking the value returned by this function is +a directory name which contains pathname.

+ +

The root directory, #P"/", is its own parent. The parent +directory of a filename is the parent of the filename's +dirname.

+ +
+ +

Traversing directories

+ +


[Function] +
list-directory dirname &key follow-symlinks => list + +


+

+Returns a fresh list of pathnames corresponding to +all files within the directory named by the non-wild pathname designator dirname. The pathnames of sub-directories are returned in +directory form - see PATHNAME-AS-DIRECTORY. +

+

+ If follow-symlinks is true (which is the + default), then the returned list contains truenames (symlinks will + be resolved) which essentially means that it might also return files + from outside the directory. This works on all platforms. +

+

+ When follow-symlinks is NIL, it should return the actual directory + contents, which might include symlinks. (This is currently implemented only on SBCL and CCL.) +

+
+ +


[Function] +
walk-directory dirname fn &key directories if-does-not-exist test follow-symlinks => | + +


+

+ Recursively applies the function designated by the function + designator fn to all files within the directory named + by the non-wild pathname + designator dirname and all of its sub-directories. fn + will only be applied to files for which the function test + returns a true value. (The default value for test + always returns true.) If directories is not NIL, + fn and test are applied to directories + as well. If directories is :DEPTH-FIRST, fn + will be applied to the directory's contents first. If directories + is :BREADTH-FIRST and test returns NIL, the + directory's content will be skipped. if-does-not-exist must + be one of :ERROR or :IGNORE where :ERROR + (the default) means that an error will be signaled if the directory dirname + does not exist. +

+

+ If follow-symlinks is true (which is + the default), then your callback will receive truenames. Otherwise + you should get the actual directory contents, which might include + symlinks. This might not be supported on all platforms. See + LIST-DIRECTORY. +

+
+ +

Temporary Files

+ +
Synopsis
+ +

+ Create a temporary file and return its name: +

CL-USER> (temporary-file:with-output-to-temporary-file (foo)
+           (print "hello" foo))
+#P"/var/folders/Yu/YuNMNBNPGoqs9G-1Wmj1dk+++TI/-Tmp-/temp-yjck024x"
+

+

+ Create a temporary file, read and write it, have it be deleted + automatically: +

CL-USER> (temporary-file:with-open-temporary-file (foo :direction :io)
+           (print "hello" foo)
+           (file-position foo 0)
+           (read foo))
+"hello"
+

+ +
Default temporary file directory
+ By default, temporary files are created in a system specific + directory that defaults based on operating system conventions. On + Unix and Unix-like systems, the directory /tmp/ is used + by default. It can be overridden by setting the TMPDIR + environment variable. On Windows, the value of the environment + variable TEMP is used. If it is not set, temporary file + creation will fail. + +
Defining the temporary file directory
+

+ The Lisp application can set the default directory in which + temporary files are created by the way of the + temporary-files logical pathname host: + +

(setf (logical-pathname-translations "temporary-files") '(("*.*.*" "/var/tmp/")))
+ + This would set the directory for temporary files to + /var/tmp/. For more information about logical + pathnames, please refer to Common + Lisp the Language, 2nd Edition and the Common Lisp + HyperSpec. +

+

+ Physical path names have restrictions regarding the permitted + character in file names. If these restrictions conflict with + your desired naming scheme, you can pass a physical pathname as + TEMPLATE parameter to the temporary file generation function. +

+

+ Here are a few examples: +

CL-USER> (logical-pathname-translations "temporary-files")
+(("*.*.*" #P"/var/folders/Yu/YuNMNBNPGoqs9G-1Wmj1dk+++TI/-Tmp-/"))
+CL-USER> (temporary-file:with-open-temporary-file (foo)
+           (pathname foo))
+#P"/var/folders/Yu/YuNMNBNPGoqs9G-1Wmj1dk+++TI/-Tmp-/temp-6rdqdkd1"
+ + This used the temporary directory established in the TMPDIR + environment variable, by the way of the definition of the + temporary-files logical host definition. + +
CL-USER> (temporary-file:with-open-temporary-file (foo :template "/tmp/file.with.dots.in.name.%.txt")
+           (pathname foo))
+#P"/tmp/file.with.dots.in.name.2EF04KUJ.txt"
+ + Here, a physical pathname was used for the + :template keyword argument so that a + filename containing multiple dots could be generated. + +
CL-USER> (temporary-file:with-open-temporary-file (foo :template "temporary-files:blah-%.txt")
+           (pathname foo))
+#P"/var/folders/Yu/YuNMNBNPGoqs9G-1Wmj1dk+++TI/-Tmp-/blah-72mj450d.txt"
+ + This used the temporary-files logical pathname host, but changed + the filename slightly. + +
CL-USER> *default-pathname-defaults*
+#P"/Users/hans/"
+CL-USER> (temporary-file:with-open-temporary-file (foo :template "blah-%.txt")
+           (pathname foo))
+#P"/Users/hans/blah-5OEJELG2.txt"
+ + Here, a relative pathname was used in the template, which + caused the file to be generated in the directory established + by *default-pathname-defaults*. +

+

+ Alternatively, the *default-template* + special variable can be set to define a custom default template + for generating names. +

+ +
Security
+ The TEMPORARY-FILE library does not directly address security + issues. The application that uses it needs to take additional + measures if it is important that files created by one process + cannot be accessed by other, unrelated processes. This can be + done by using the system dependent security mechanisms like + default file permissions or access control lists. + +
Dictionary
+ + +

[Function]
open-temporary &rest open-arguments &key template generate-random-string max-tries &allow-other-keys + => + stream

+

+ Create a file with a randomly generated name and return the + opened stream. The resulting pathname is generated from + template, which is a string + representing a pathname template. A percent sign (%) in + that string is replaced by a randomly generated string to + make the filename unique. The default for + template places temporary files in the + temporary-files logical pathname host, + which is automatically set up in a system specific manner. + The file name generated from template + is merged with *default-pathname-defaults*, + so random pathnames relative to that directory can be + generated by not specifying a directory in + template. +

+

+ generate-random-string can be passed to + override the default function that generates the random name + component. It should return a random string consisting of + characters that are permitted in a pathname (logical or + physical, depending on template). +

+

+ The name of the temporary file can be accessed calling the + pathname + function on stream. For convenience, + the temporary file is opened on the physical pathname, + i.e. if the template designate a + logical pathname the translation to a physical pathname is + performed before opening the stream. +

+

+ In order to create a unique file name, + open-temporary may loop internally up + to max-tries times before giving up and + signalling a + cannot-create-temporary-file condition. +

+

+ Any unrecognized keyword arguments are passed to the call to + open. +

+

+

[Macro]
with-output-to-temporary-file (stream &rest args) &body body + => + pathname

+ Create a temporary file using + open-temporary with + args and run body + with stream bound to the temporary file + stream. Returns the pathname of the file that has been + created. See open-temporary for + permitted options. +

+

[Macro]
with-open-temporary-file (stream &rest args &key keep &allow-other-keys) &body body + => + values

+ Create a temporary file using + open-temporary with + args and run body + with stream bound to the temporary file + stream. Returns the values returned by + body. By default, the file is deleted + when body is exited. If a true value is + passed in keep, the file is not deleted + when the body is exited. See + open-temporary for more permitted + options. +

+

+ [Special variable]
*default-template*

+ This variable can be set to a string representing the desired + default template for temporary file name generation. See + open-temporary for a description of the + template string format. +

+

+ [Condition type]
cannot-create-temporary-file

+ Signalled when an attempt to create unique temporary file name + failed after the established number of retries. +

+

+ [Condition type]
invalid-temporary-pathname-template

+ Signalled when the template argument to + open-temporary does not contain a valid + template string. The template string must contain a percent + sign, which is replaced by the generated random string to + yield the filename. +

+

+ [Condition type]
missing-temp-environment-variable

+ (Windows only) Signalled when the TEMP environment variable is + not set. +

+

+ [Logical Pathname Host]
temporary-files

+ This logical pathname host defines where temporary files are + stored by default. It is initialized in a suitable system + specific fashion: On Unix and Unix-like systems, the directory + specified in the TMPDIR environment variable is used. If that + variable is not set, /tmp is used as the default. On Windows, + the directory specified in the TEMP environment variable is + used. If it is not set, a + missing-temp-environment-variable error + is signalled. +

+ + +

Modifying the file system

+ +


[Function] +
copy-file from to &key overwrite => | + +


+Copies the file designated by the non-wild pathname designator from to the +file designated by the non-wild pathname designator to. If overwrite is true (the default is NIL) +overwrites the file designated by to if it exists. +
+ +


[Function] +
copy-stream from to &optional checkp => | + +


Copies into to (a stream) +from from (also a stream) until the end +of from is reached. The streams should have the +same element +type unless they are bivalent. If checkp is +true (which is the default), the function will signal an error if the +element types aren't the same. +
+


[Function] +
delete-directory-and-files dirname &key if-does-not-exist => | + +


+

+Recursively deletes all files and directories within the directory +designated by the non-wild pathname designator dirname including +dirname itself. if-does-not-exist must be one of :ERROR or :IGNORE +where :ERROR (the default) means that an error will be signaled if the directory +dirname does not exist. +

+

+ Warning: this function might remove files from outside the + directory, if the directory that you are deleting contains links to + external files. This is currently fixed for SBCL and CCL. +

+
+ +

The PATH package

+ +


[Package] +
(defpackage path) + +

+Provides a set of short names for commonly used pathname manipulation +functions (these are all functions from the cl-fad +package which are being exported under different names): +
+
dirname
pathname-as-directory
+
basename
cl:file-namestring
+
-e
file-exists-p
+
-d
directory-exists-p
+
catfile
merge-pathnames-as-file
+
catdir
merge-pathnames-as-directory
+
rm-r
delete-directory-and-files
+
=
pathname-equal
+
absolute-p
pathname-absolute-p
+
relative-p
pathname-relative-p
+
root-p
pathname-root-p
+
+
+ + +
 

Acknowledgements

+ +The original code for this library was written by Peter Seibel for his +book Practical Common +Lisp. I added some stuff and made sure it worked properly on +Windows, specifically with CCL. Thanks to James Bielman, Maciek +Pasternacki, Jack D. Unrue, Gary King, and Douglas Crosher who sent +patches for OpenMCL, ECL, ABCL, MCL, and Scieneer CL. + +

+$Header: /usr/local/cvsrep/cl-fad/doc/index.html,v 1.33 2009/09/30 14:23:12 edi Exp $ +

BACK TO MY HOMEPAGE + + + + diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/fad.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/fad.lisp new file mode 100644 index 0000000..e00c686 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/fad.lisp @@ -0,0 +1,570 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-FAD; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/cl-fad/fad.lisp,v 1.35 2009/09/30 14:23:10 edi Exp $ + +;;; Copyright (c) 2004, Peter Seibel. All rights reserved. +;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package :cl-fad) + +(defun component-present-p (value) + "Helper function for DIRECTORY-PATHNAME-P which checks whether VALUE + is neither NIL nor the keyword :UNSPECIFIC." + (and value (not (eql value :unspecific)))) + +(defun directory-pathname-p (pathspec) + "Returns NIL if PATHSPEC \(a pathname designator) does not designate +a directory, PATHSPEC otherwise. It is irrelevant whether file or +directory designated by PATHSPEC does actually exist." + (and + (not (component-present-p (pathname-name pathspec))) + (not (component-present-p (pathname-type pathspec))) + pathspec)) + +(defun pathname-as-directory (pathspec) + "Converts the non-wild pathname designator PATHSPEC to directory +form." + (let ((pathname (pathname pathspec))) + (when (wild-pathname-p pathname) + (error "Can't reliably convert wild pathnames.")) + (cond ((not (directory-pathname-p pathspec)) + (make-pathname :directory (append (or (pathname-directory pathname) + (list :relative)) + (list (file-namestring pathname))) + :name nil + :type nil + :defaults pathname)) + (t pathname)))) + +(defun directory-wildcard (dirname) + "Returns a wild pathname designator that designates all files within +the directory named by the non-wild pathname designator DIRNAME." + (when (wild-pathname-p dirname) + (error "Can only make wildcard directories from non-wildcard directories.")) + (make-pathname :name #-:cormanlisp :wild #+:cormanlisp "*" + :type #-(or :clisp :cormanlisp) :wild + #+:clisp nil + #+:cormanlisp "*" + :defaults (pathname-as-directory dirname))) + +#+:clisp +(defun clisp-subdirectories-wildcard (wildcard) + "Creates a wild pathname specifically for CLISP such that +sub-directories are returned by DIRECTORY." + (make-pathname :directory (append (pathname-directory wildcard) + (list :wild)) + :name nil + :type nil + :defaults wildcard)) + +(defun list-directory (dirname &key (follow-symlinks t)) + "Returns a fresh list of pathnames corresponding to all files within + the directory named by the non-wild pathname designator DIRNAME. + The pathnames of sub-directories are returned in directory form - + see PATHNAME-AS-DIRECTORY. + + If FOLLOW-SYMLINKS is true, then the returned list contains +truenames (symlinks will be resolved) which essentially means that it +might also return files from *outside* the directory. This works on +all platforms. + + When FOLLOW-SYMLINKS is NIL, it should return the actual directory +contents, which might include symlinks. Currently this works on SBCL +and CCL." + (declare (ignorable follow-symlinks)) + (when (wild-pathname-p dirname) + (error "Can only list concrete directory names.")) + #+(or :ecl :clasp) + (let ((dir (pathname-as-directory dirname))) + (concatenate 'list + (directory (merge-pathnames (pathname "*/") dir)) + (directory (merge-pathnames (pathname "*.*") dir)))) + #-(or :ecl :clasp) + (let ((wildcard (directory-wildcard dirname))) + #+:abcl (system::list-directory dirname) + #+:sbcl (directory wildcard :resolve-symlinks follow-symlinks) + #+(or :cmu :scl :lispworks) (directory wildcard) + #+(or :openmcl :digitool) (directory wildcard :directories t :follow-links follow-symlinks) + #+:allegro (directory wildcard :directories-are-files nil) + #+:clisp (nconc (directory wildcard :if-does-not-exist :keep) + (directory (clisp-subdirectories-wildcard wildcard))) + #+:cormanlisp (nconc (directory wildcard) + (cl::directory-subdirs dirname))) + #-(or :sbcl :cmu :scl :lispworks :openmcl :allegro :clisp :cormanlisp :ecl :abcl :digitool :clasp) + (error "LIST-DIRECTORY not implemented")) + +(defun pathname-as-file (pathspec) + "Converts the non-wild pathname designator PATHSPEC to file form." + (let ((pathname (pathname pathspec))) + (when (wild-pathname-p pathname) + (error "Can't reliably convert wild pathnames.")) + (cond ((directory-pathname-p pathspec) + (let* ((directory (pathname-directory pathname)) + (name-and-type (pathname (first (last directory))))) + (make-pathname :directory (butlast directory) + :name (pathname-name name-and-type) + :type (pathname-type name-and-type) + :defaults pathname))) + (t pathname)))) + +(defun file-exists-p (pathspec) + "Checks whether the file named by the pathname designator PATHSPEC +exists and returns its truename if this is the case, NIL otherwise. +The truename is returned in `canonical' form, i.e. the truename of a +directory is returned as if by PATHNAME-AS-DIRECTORY." + #+(or :sbcl :lispworks :openmcl :ecl :digitool clasp) (probe-file pathspec) + #+:allegro (or (excl:probe-directory (pathname-as-directory pathspec)) + (probe-file pathspec)) + #+(or :cmu :scl :abcl) (or (probe-file (pathname-as-directory pathspec)) + (probe-file pathspec)) + #+:cormanlisp (or (and (ccl:directory-p pathspec) + (pathname-as-directory pathspec)) + (probe-file pathspec)) + #+:clisp (or (ignore-errors + (let ((directory-form (pathname-as-directory pathspec))) + (when (ext:probe-directory directory-form) + (truename directory-form)))) + (ignore-errors + (probe-file (pathname-as-file pathspec)))) + #-(or :sbcl :cmu :scl :lispworks :openmcl :allegro :clisp :cormanlisp :ecl :abcl :digitool :clasp) + (error "FILE-EXISTS-P not implemented")) + +(defun directory-exists-p (pathspec) + "Checks whether the file named by the pathname designator PATHSPEC +exists and if it is a directory. Returns its truename if this is the +case, NIL otherwise. The truename is returned in directory form as if +by PATHNAME-AS-DIRECTORY." + #+:allegro + (and (excl:probe-directory pathspec) + (pathname-as-directory (truename pathspec))) + #+:lispworks + (and (lw:file-directory-p pathspec) + (pathname-as-directory (truename pathspec))) + #-(or :allegro :lispworks) + (let ((result (file-exists-p pathspec))) + (and result + (directory-pathname-p result) + result))) + +(defun walk-directory (dirname fn &key directories + (if-does-not-exist :error) + (test (constantly t)) + (follow-symlinks t)) + "Recursively applies the function FN to all files within the +directory named by the non-wild pathname designator DIRNAME and all of +its sub-directories. FN will only be applied to files for which the +function TEST returns a true value. If DIRECTORIES is not NIL, FN and +TEST are applied to directories as well. If DIRECTORIES +is :DEPTH-FIRST, FN will be applied to the directory's contents first. +If DIRECTORIES is :BREADTH-FIRST and TEST returns NIL, the directory's +content will be skipped. IF-DOES-NOT-EXIST must be one of :ERROR +or :IGNORE where :ERROR means that an error will be signaled if the +directory DIRNAME does not exist. If FOLLOW-SYMLINKS is T, then your +callback will receive truenames. Otherwise you should get the actual +directory contents, which might include symlinks. This might not be +supported on all platforms. See LIST-DIRECTORY." + (labels ((walk (name) + (cond + ((directory-pathname-p name) + ;; the code is written in a slightly awkward way for + ;; backward compatibility + (cond ((not directories) + (dolist (file (list-directory name :follow-symlinks follow-symlinks)) + (walk file))) + ((eql directories :breadth-first) + (when (funcall test name) + (funcall fn name) + (dolist (file (list-directory name :follow-symlinks follow-symlinks)) + (walk file)))) + ;; :DEPTH-FIRST is implicit + (t (dolist (file (list-directory name :follow-symlinks follow-symlinks)) + (walk file)) + (when (funcall test name) + (funcall fn name))))) + ((funcall test name) + (funcall fn name))))) + (let ((pathname-as-directory (pathname-as-directory dirname))) + (case if-does-not-exist + ((:error) + (cond ((not (file-exists-p pathname-as-directory)) + (error "File ~S does not exist." + pathname-as-directory)) + (t (walk pathname-as-directory)))) + ((:ignore) + (when (file-exists-p pathname-as-directory) + (walk pathname-as-directory))) + (otherwise + (error "IF-DOES-NOT-EXIST must be one of :ERROR or :IGNORE.")))) + (values))) + +(defvar *stream-buffer-size* 8192) + +(defun copy-stream (from to &optional (checkp t)) + "Copies into TO \(a stream) from FROM \(also a stream) until the end +of FROM is reached, in blocks of *stream-buffer-size*. The streams +should have the same element type. If CHECKP is true, the streams are +checked for compatibility of their types." + (when checkp + (unless (subtypep (stream-element-type to) (stream-element-type from)) + (error "Incompatible streams ~A and ~A." from to))) + (let ((buf (make-array *stream-buffer-size* + :element-type (stream-element-type from)))) + (loop + (let ((pos #-:clisp (read-sequence buf from) + #+:clisp (ext:read-byte-sequence buf from :no-hang nil))) + (when (zerop pos) (return)) + (write-sequence buf to :end pos)))) + (values)) + +(defun copy-file (from to &key overwrite) + "Copies the file designated by the non-wild pathname designator FROM +to the file designated by the non-wild pathname designator TO. If +OVERWRITE is true overwrites the file designated by TO if it exists." + #+:allegro (excl.osi:copy-file from to :overwrite overwrite) + #-:allegro + (let ((element-type #-:cormanlisp '(unsigned-byte 8) + #+:cormanlisp 'unsigned-byte)) + (with-open-file (in from :element-type element-type) + (with-open-file (out to :element-type element-type + :direction :output + :if-exists (if overwrite + :supersede + #-:cormanlisp :error + #+:cormanlisp nil)) + #+:cormanlisp + (unless out + (error (make-condition 'file-error + :pathname to + :format-control "File already exists."))) + (copy-stream in out)))) + (values)) + +(defun delete-directory-and-files (dirname &key (if-does-not-exist :error)) + "Recursively deletes all files and directories within the directory +designated by the non-wild pathname designator DIRNAME including +DIRNAME itself. IF-DOES-NOT-EXIST must be one of :ERROR or :IGNORE +where :ERROR means that an error will be signaled if the directory +DIRNAME does not exist. + +NOTE: this function is dangerous if the directory that you are +removing contains symlinks to files outside of it - the target files +might be removed instead! This is currently fixed for SBCL and CCL." + + #+:allegro (excl.osi:delete-directory-and-files dirname + :if-does-not-exist if-does-not-exist) + + #+:sbcl + (if (directory-exists-p dirname) + (sb-ext:delete-directory dirname :recursive t) + (ecase if-does-not-exist + (:error (error "~S is not a directory" dirname)) + (:ignore nil))) + + #+:ccl-has-delete-directory + (if (directory-exists-p dirname) + (ccl:delete-directory dirname) + (ecase if-does-not-exist + (:error (error "~S is not a directory" dirname)) + (:ignore nil))) + + #-(or :allegro :sbcl :ccl-has-delete-directory) + (walk-directory dirname + (lambda (file) + (cond ((directory-pathname-p file) + #+:lispworks (lw:delete-directory file) + #+:cmu (multiple-value-bind (ok err-number) + (unix:unix-rmdir (namestring (truename file))) + (unless ok + (error "Error number ~A when trying to delete ~A" + err-number file))) + #+:scl (multiple-value-bind (ok errno) + (unix:unix-rmdir (ext:unix-namestring (truename file))) + (unless ok + (error "~@" + file (unix:get-unix-error-msg errno)))) + #+:clisp (ext:delete-directory file) + #+:openmcl (cl-fad-ccl:delete-directory file) + #+:cormanlisp (win32:delete-directory file) + #+:ecl (si:rmdir file) + #+:clasp (core:rmdir file) + #+(or :abcl :digitool) (delete-file file)) + (t (delete-file file)))) + :follow-symlinks nil + :directories t + :if-does-not-exist if-does-not-exist) + (values)) + +(defun pathname-directory-pathname (pathname) + "Returns a complete pathname representing the directory of +PATHNAME. If PATHNAME is already a directory pathname (name NIL, type +NIL) returns a pathname equal (as per pathname=) to it." + (make-pathname :defaults pathname + :name nil :type nil)) + +(defun pathname-parent-directory (pathname) + "Returns a pathname which would, by name at least, contain PATHNAME +as one of its direct children. Symlinks can make the parent/child +relationship a like opaque, but generally speaking the value returned +by this function is a directory name which contains PATHNAME. + +The root directory, #P\"/\", is its own parent. The parent directory +of a filename is the parent of the filename's dirname." + (canonical-pathname + (make-pathname :defaults pathname + :directory (if (pathname-root-p pathname) + (list :absolute) + (append (or (pathname-directory pathname) + (list :relative)) + (list :back)))))) + +(defun canonical-pathname (pathname) + "Remove redundant information from PATHNAME. + +This simply walks down PATHNAME's pathname-directory and drops \".\" +directories, removes :back and its preceding element. + +NB: This function does not access the filesystem, it only looks at the +values in the pathname and works on their known (or assumed) +meanings. + +NB: Since this function does not access the filesystem it will only +remove :BACK elements from the path (not :UP elements). Since some +lisps, ccl/sbcl/clisp convert \"..\" in pathnames to :UP, and +not :BACK, the actual utility of the function is limited." + (let ((pathname (pathname pathname))) ;; just make sure to get a pathname object + (loop + with full-dir = (or (pathname-directory pathname) + (list :relative)) + with canon-dir = (if (member (first full-dir) '(:relative :absolute)) + (list (pop full-dir)) + (list :relative)) + while full-dir + do (cond + ((string= "." (first full-dir)) + (pop full-dir)) + ((eql :back (second full-dir)) + (pop full-dir) + (pop full-dir)) + (t (push (pop full-dir) canon-dir))) + finally (return (make-pathname :defaults pathname :directory (nreverse canon-dir)))))) + +(defun merge-pathnames-as-directory (&rest pathnames) + "Given a list of (probably relative) pathnames, this returns a single +directory pathname containing the logical concatenation of them all. + +The returned value is the current directory if one were to cd into +each of PATHNAMES in order. For this reason an absolute pathname will, +effectively, cancel the affect of any previous relative pathnames. + +The returned value's defaults are taken from the first element of +PATHNAMES (host, version and device). + +NB: Since this function only looks at directory names the name and +type of the elements of PATHNAMES are ignored. Make sure to properly +use either trailing #\\/s, or pathname-as-directory, to get the +expected results. + +Examples: + + (merge-pathnames-as-directory #P\"foo/\" #P\"bar/\") == #P\"foo/bar/\" + (merge-pathnames-as-directory #P\"foo/\" #P\"./bar/\") == #P\"foo/./bar/\" + (merge-pathnames-as-directory #P\"foo/\" #P\"/bar/\") == #P\"/bar/\" + (merge-pathnames-as-directory #P\"foo/\" #P\"/bar/\" #P\"quux/file.txt\") == #P\"/bar/quux/\" +" + (if pathnames + (let* ((pathnames (mapcar #'pathname pathnames)) + (defaults (first pathnames)) + (dir (pathname-directory defaults))) + (loop for pathname in (rest pathnames) + for directory = (pathname-directory pathname) + do (ecase (first directory) + ;; this is equivalent to (:relative) == ".", so, + ;; for this function, just do nothing. + ((nil)) + (:absolute + (setf dir directory)) + (:relative + (setf dir (append dir (rest directory)))))) + (make-pathname :defaults defaults :directory dir :name nil :type nil)) + (make-pathname))) + +(defun merge-pathnames-as-file (&rest pathnames) + "Given a list of, probably relative, pathnames returns a single +filename pathname containing the logical concatenation of them all. + +The returned value's defaults are taken from the first element of +PATHNAMES (host, version and device). The returned values's name, type +and version are taken from the last element of PATHNAMES. The +intervening elements are used only for their pathname-directory +values. + +Examples: + + (merge-pathnames-as-file #P\"foo/\" #P\"bar.txt\") == #P\"foo/bar.txt\" + (merge-pathnames-as-file #P\"foo/\" #P\"./bar.txt\") == #P\"foo/./bar.txt\" + (merge-pathnames-as-file #P\"foo/\" #P\"/bar/README\") == #P\"/bar/README\" + (merge-pathnames-as-file #P\"/foo/\" #P\"/bar/\" #P\"quux/file.txt\") == #P\"/bar/quux/file.txt\" +" + (cond ((null pathnames) + (make-pathname)) + ((null (cdr pathnames)) + (pathname-as-file (first pathnames))) + (t + (let ((file-name-part (first (last pathnames)))) + (make-pathname :defaults (apply #'merge-pathnames-as-directory pathnames) + :name (pathname-name file-name-part) + :type (pathname-type file-name-part) + :version (pathname-version file-name-part)))))) + +(defmacro with-component-testers ((a b key) &body body) + (let ((k (gensym))) + `(let* ((,k ,key) + (,a (funcall ,k ,a)) + (,b (funcall ,k ,b))) + (labels ((components-are (test) + (and (funcall test ,a) (funcall test ,b))) + (components-are-member (values) + (and (member ,a values :test #'eql) + (member ,b values :test #'eql) + (eql ,a ,b))) + (components-are-string= () + (and (stringp ,a) (stringp ,b) (string= ,a ,b))) + (components-are-every (test) + (and (consp ,a) + (consp ,b) + (every test ,a ,b)))) + (declare (ignorable #'components-are #'components-are-member + #'components-are-string= #'components-are-every)) + (if (or ,@body) + (values t ,a ,b) + nil))))) + +(defun pathname-host-equal (a b) + (with-component-testers (a b #'pathname-host) + (eq a b) + (components-are-member '(nil :unspecific)) + (components-are-string=) + (components-are-every #'string=))) + +(defun pathname-device-equal (a b) + (with-component-testers (a b #'pathname-device) + (components-are-member '(nil :unspecific)) + (components-are-string=))) + +(defun pathname-directory-equal (a b) + (with-component-testers (a b #'pathname-directory) + (and (null a) (null b)) + (and (= (length a) (length b)) + (every (lambda (a b) + (or (and (stringp a) (stringp b) (string= a b)) + (and (null a) (null b)) + (and (keywordp a) (keywordp b) (eql a b)))) + a b)))) + +(defun pathname-name-equal (a b) + (with-component-testers (a b #'pathname-name) + (components-are-member '(nil :wild :unspecific)) + (components-are-string=))) + +(defun pathname-type-equal (a b) + (with-component-testers (a b #'pathname-type) + (components-are-member '(nil :wild :unspecific)) + (components-are-string=))) + +(defun pathname-version-equal (a b) + (with-component-testers (a b #'pathname-version) + (and (null a) (null b)) + (components-are-member '(:wild :newest :unspecific)) + (and (integerp a) (integerp b) (= a b)))) + +(defun pathname-equal (a b) + "Returns T if A and B represent the same pathname. This function +does not access the filesystem, it only looks at the components of the +two pathnames to test if they are the same (though by +passing both A and B to probe-file one can make this function test for file 'sameness'. + +Equality is defined as: + + - strings that are string equal + - symbol (including nil) or keywords which are eql + - lists of the same length with equal (as per these rules) elements. + +if any of these tree conditions is false for any of the components in +A and B then A and B are different, otherwise they are the same. + +NB: This function does not convert name strings to pathnames. So +\"foo.txt\" and #P\"foo.txt\" are different pathnames." + (if (and a b) + (if (and (pathname-host-equal a b) + (pathname-device-equal a b) + (pathname-directory-equal a b) + (pathname-name-equal a b) + (pathname-type-equal a b) + (pathname-version-equal a b)) + (values t a b) + (values nil)) + (values nil))) + +(defun pathname-absolute-p (a) + "Returns true if A is an absolute pathname. + +This simply tests if A's directory list starts with :ABSOLUTE" + (eql :absolute (first (pathname-directory (pathname a))))) + +(defun pathname-relative-p (a) + "Returns true if A is a relative pathname. + +This simply tests if A's directory starts with :RELATIVE." + (let ((dir (pathname-directory (pathname a)))) + (or (null dir) (eql :relative (first dir))))) + +(defun pathname-root-p (a) + (let ((dir (pathname-directory (pathname a)))) + (and (eql :absolute (first dir)) + (= 1 (length dir))))) + +(pushnew :cl-fad *features*) + +;; stuff for Nikodemus Siivola's HYPERDOC +;; see +;; and +;; also used by LW-ADD-ONS + +#-:abcl +(defvar *hyperdoc-base-uri* "http://weitz.de/cl-fad/") + +#-:abcl +(let ((exported-symbols-alist + (loop for symbol being the external-symbols of :cl-fad + collect (cons symbol + (concatenate 'string + "#" + (string-downcase symbol)))))) + (defun hyperdoc-lookup (symbol type) + (declare (ignore type)) + (cdr (assoc symbol + exported-symbols-alist + :test #'eq)))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/fad.test.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/fad.test.lisp new file mode 100644 index 0000000..8f547e1 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/fad.test.lisp @@ -0,0 +1,157 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-FAD-TEST; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/cl-fad/test.lisp,v 1.12 2009/09/30 14:23:10 edi Exp $ + +;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:cl-fad-test) + +(defparameter *tmp-dir* + #+(or :win32 :mswindows :windows) "c:\\tmp\\" + #-(or :win32 :mswindows :windows) "/tmp/") + +(defvar *test-counter* 0) + +(defmacro assert* (form) + `(progn + (format t "Trying to assert ~A~%" ',form) + (assert ,form) + (format t "Test ~A passed.~%" (incf *test-counter*)))) + +(defun test () + (setq *test-counter* 0) + + (assert* (path:= (path:catdir) #P"")) + (assert* (path:= (path:catdir #P"/") #P"/")) + (assert* (path:= (path:catdir #P"a/" #P"b/") #P"a/b/")) + (assert* (path:= (path:catdir #P"/a/" #P"/b/" #P"c/" #P"./d/" #P"e" #P"f/") #P"/b/c/./d/f/")) + + (assert* (path:= (path:catfile) #P"")) + (assert* (path:= (path:catfile #P"R.txt") #P"R.txt")) + (assert* (path:= (path:catfile #P"a/" #P"/b/" #P"R.txt") #P"/b/R.txt")) + + + (let ((fad-dir (merge-pathnames (pathname-as-directory "fad-test") + *tmp-dir*))) + (delete-directory-and-files fad-dir :if-does-not-exist :ignore) + (assert* (directory-pathname-p fad-dir)) + (assert* (directory-pathname-p (pathname *tmp-dir*))) + (let ((foo-file (merge-pathnames "foo.lisp" + fad-dir))) + (assert* (not (directory-pathname-p foo-file))) + (assert* (not (file-exists-p foo-file))) + (assert* (not (file-exists-p fad-dir))) + (with-open-file (out (ensure-directories-exist foo-file) + :direction :output + :if-does-not-exist :create) + (write-string "NIL" out)) + (assert* (file-exists-p foo-file)) + (assert* (not (directory-exists-p foo-file))) + (assert* (file-exists-p fad-dir)) + (assert* (directory-exists-p fad-dir)) + (assert* (equal fad-dir + (pathname-as-directory fad-dir))) + (assert* (equal foo-file + (pathname-as-file foo-file))) + (assert* (not (equal fad-dir + (pathname-as-file fad-dir)))) + (assert* (not (equal foo-file + (pathname-as-directory foo-file)))) + (dolist (name '("bar" "baz")) + (let ((dir (merge-pathnames (pathname-as-directory name) + fad-dir))) + (dolist (name '("foo.text" "bar.lisp")) + (let ((file (merge-pathnames name dir))) + (with-open-file (out (ensure-directories-exist file) + :direction :output + :if-does-not-exist :create) + (write-string "NIL" out)))))) + ;; /tmp/fad-test/foo.lisp + ;; /tmp/fad-test/bar/bar.lisp + ;; /tmp/fad-test/bar/foo.text + ;; /tmp/fad-test/baz/bar.lisp + ;; /tmp/fad-test/baz/foo.text + ;; files : 5 + ;; dirs : 3 + (let ((file-counter 0) + (file-and-dir-counter 0) + (bar-counter 0)) + (walk-directory fad-dir + (lambda (file) + (declare (ignore file)) + (incf file-counter))) + ;; file-counter => 5 + (walk-directory fad-dir + (lambda (file) + (declare (ignore file)) + (incf file-and-dir-counter)) + :directories t) + ;; file-and-dir-counter => 5 + 3 + (walk-directory fad-dir + (lambda (file) + (declare (ignore file)) + (incf bar-counter)) + :test (lambda (file) + (string= (pathname-name file) + "bar")) + :directories t) + ;; do not traverse the baz directory + (walk-directory fad-dir + (lambda (file) + (declare (ignore file)) + (incf file-and-dir-counter)) + :test (lambda (file) + (not (and (directory-pathname-p file) + (string= (first (last (pathname-directory file))) + "baz")))) + :directories :breadth-first) + ;; file-and-dir-counter => 5 + 3 + 2 dirs + 3 files + (assert* (= 5 file-counter)) + (assert* (= 13 file-and-dir-counter)) + (assert* (= 2 bar-counter))) + (let ((bar-file (merge-pathnames "bar.lisp" fad-dir))) + (copy-file foo-file bar-file) + (assert* (file-exists-p bar-file)) + (with-open-file (foo-stream foo-file :element-type '(unsigned-byte 8)) + (with-open-file (bar-stream bar-file :element-type '(unsigned-byte 8)) + (assert* (= (file-length foo-stream) + (file-length bar-stream))) + (loop for foo-byte = (read-byte foo-stream nil nil) + for bar-byte = (read-byte bar-stream nil nil) + while (and foo-byte bar-byte) + do (assert* (eql foo-byte bar-byte)))))) + (let ((baz-dir (merge-pathnames (pathname-as-directory "baz") + fad-dir)) + (list (mapcar #'namestring (list-directory fad-dir)))) + (assert* (find (namestring (truename foo-file)) list :test #'string=)) + (assert* (find (namestring (truename baz-dir)) list :test #'string=)) + (assert* (not (find (namestring (pathname-as-file baz-dir)) + list + :test #'string=))))) + (delete-directory-and-files fad-dir :if-does-not-exist :error) + (assert* (not (file-exists-p fad-dir))) + (assert* (not (directory-exists-p fad-dir)))) + (format t "All tests passed.~%")) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/load.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/load.lisp new file mode 100644 index 0000000..0fd1a15 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/load.lisp @@ -0,0 +1,62 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/cl-fad/load.lisp,v 1.9 2009/09/30 14:23:10 edi Exp $ + +;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package :cl-user) + +(defparameter *cl-fad-base-directory* + (make-pathname :name nil :type nil :version nil + :defaults (parse-namestring *load-truename*))) + +#+:allegro (require :osi) +#+:sbcl (require :sb-executable) +#+:sbcl (require :sb-posix) + +(let ((cl-fad-base-directory + (make-pathname :name nil :type nil :version nil + :defaults (parse-namestring *load-truename*)))) + (let (must-compile) + #+:cormanlisp (declare (ignore must-compile)) + (dolist (file '("packages" + #+:cormanlisp "corman" + #+:openmcl "openmcl" + "fad")) + (let ((pathname (make-pathname :name file :type "lisp" :version nil + :defaults cl-fad-base-directory))) + ;; don't use COMPILE-FILE in Corman Lisp, it's broken - LOAD + ;; will yield compiled functions anyway + #-:cormanlisp + (let ((compiled-pathname (compile-file-pathname pathname))) + (unless (and (not must-compile) + (probe-file compiled-pathname) + (< (file-write-date pathname) + (file-write-date compiled-pathname))) + (setq must-compile t) + (compile-file pathname)) + (setq pathname compiled-pathname)) + (load pathname))))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/openmcl.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/openmcl.lisp new file mode 100644 index 0000000..ae99f77 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/openmcl.lisp @@ -0,0 +1,72 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CCL; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/cl-fad/openmcl.lisp,v 1.6 2009/09/30 14:23:10 edi Exp $ + +;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package :cl-fad) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (flet ((ccl-function-feature (symbol-name feature) + (let ((symbol (find-symbol symbol-name :ccl))) + (when (and symbol (fboundp symbol)) + (pushnew feature *features*))))) + (ccl-function-feature "%RMDIR" :ccl-has-%rmdir) + (ccl-function-feature "DELETE-DIRECTORY" :ccl-has-delete-directory))) + +(defpackage :cl-fad-ccl + (:use :cl) + (:export delete-directory) + (:import-from :ccl + :%realpath + :signal-file-error + :native-translated-namestring + :with-cstrs) + #+ccl-has-%rmdir + (:import-from :ccl :%rmdir) + #+ccl-has-delete-directory + (:import-from :ccl :delete-directory)) + +(in-package :cl-fad-ccl) + +#-ccl-has-%rmdir +(defun %rmdir (name) + (with-cstrs ((n name)) + (#_rmdir n))) + +;;; ClozureCL 1.6 introduced ccl:delete-directory with semantics that +;;; are acceptably similar to this "legacy" definition. +;;; +;;; Except this legacy definition is not recursive, hence this function is +;;; used only if there is no :CCL-HAS-DELETE-DIRECTORY feature. + +#-ccl-has-delete-directory +(defun delete-directory (path) + (let* ((namestring (native-translated-namestring path))) + (when (%realpath namestring) + (let* ((err (%rmdir namestring))) + (or (eql 0 err) (signal-file-error err path)))))) + diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/packages.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/packages.lisp new file mode 100644 index 0000000..1514c99 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/packages.lisp @@ -0,0 +1,87 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/cl-fad/packages.lisp,v 1.12 2009/09/30 14:23:10 edi Exp $ + +;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:cl-user) + +(defpackage :cl-fad + (:nicknames :fad) + (:use :cl) + #+:allegro + (:shadow :copy-file + :delete-directory-and-files) + #+:abcl + (:shadow :list-directory) + (:export :copy-file + :copy-stream + :delete-directory-and-files + :directory-exists-p + :directory-pathname-p + :file-exists-p + :list-directory + :pathname-as-directory + :pathname-as-file + :pathname-directory-pathname + :pathname-equal + :pathname-parent-directory + :pathname-absolute-p + :pathname-relative-p + :pathname-root-p + + :canonical-pathname + :merge-pathnames-as-directory + :merge-pathnames-as-file + + :walk-directory + + :open-temporary + :with-output-to-temporary-file + :with-open-temporary-file + :*default-template* + :invalid-temporary-pathname-template + :cannot-create-temporary-file + #+win32 #:missing-temp-environment-variable)) + +(defpackage :path + (:use) + (:documentation "Rexporting certain functions from the cl-fad package with shorter names. + +This package provides no functionality, it serves only to make file +system intensive code easier to read (for unix people at least).") + (:export #:dirname + #:basename + #:-e + #:-d + #:catfile + #:catdir + #:rm-r + #:= + + #:absolute-p + #:relative-p + #:root-p)) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/packages.test.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/packages.test.lisp new file mode 100644 index 0000000..90736df --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/packages.test.lisp @@ -0,0 +1,5 @@ +(in-package :common-lisp-user) + +(defpackage :cl-fad-test + (:use :cl :cl-fad :unit-test) + (:export :test)) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/path.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/path.lisp new file mode 100644 index 0000000..c94a0c2 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/path.lisp @@ -0,0 +1,32 @@ +(in-package :cl-fad) + +(defmacro defalias (name args realname) + `(progn + (defun ,name ,args + ,(if (eql '&rest (first args)) + `(apply #',realname ,(second args)) + `(,realname ,@args))) + (define-compiler-macro ,name (&rest args) + (list* ',realname args)))) + +(defalias path:dirname (pathname) cl-fad:pathname-directory-pathname) + +(defun path:basename (pathname) (pathname (file-namestring pathname))) + +(defalias path:-e (pathname) cl-fad:file-exists-p) + +(defalias path:-d (directory) cl-fad:directory-exists-p) + +(defalias path:catfile (&rest pathnames) cl-fad:merge-pathnames-as-file) + +(defalias path:catdir (&rest pathnames) cl-fad:merge-pathnames-as-directory) + +(defalias path:= (a b) cl-fad:pathname-equal) + +(defalias path:absolute-p (pathname) cl-fad:pathname-absolute-p) + +(defalias path:relative-p (pathname) cl-fad:pathname-relative-p) + +(defalias path:root-p (pathname) cl-fad:pathname-root-p) + +(defalias path:rm-r (pathname) cl-fad:delete-directory-and-files) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/temporary-files.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/temporary-files.lisp new file mode 100644 index 0000000..7e8e7f1 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/temporary-files.lisp @@ -0,0 +1,173 @@ +(in-package :cl-fad) + +(defparameter *default-template* "TEMPORARY-FILES:TEMP-%") + +(defparameter *max-tries* 10000) + +(defvar *name-random-state* (make-random-state t)) + +;; from XCVB +(eval-when (:load-toplevel :execute) + (defun getenv (x) + "Query the libc runtime environment. See getenv(3)." + (declare (ignorable x)) + #+(or abcl clisp xcl) (ext:getenv x) + #+allegro (sys:getenv x) + #+clozure (ccl:getenv x) + #+(or cmu scl) (cdr (assoc x ext:*environment-list* :test #'string=)) + #+cormanlisp + (let* ((buffer (ct:malloc 1)) + (cname (ct:lisp-string-to-c-string x)) + (needed-size (win:getenvironmentvariable cname buffer 0)) + (buffer1 (ct:malloc (1+ needed-size)))) + (prog1 (if (zerop (win:getenvironmentvariable cname buffer1 needed-size)) + nil + (ct:c-string-to-lisp-string buffer1)) + (ct:free buffer) + (ct:free buffer1))) + #+ecl (si:getenv x) + #+gcl (system:getenv x) + #+lispworks (lispworks:environment-variable x) + #+mcl (ccl:with-cstrs ((name x)) + (let ((value (_getenv name))) + (unless (ccl:%null-ptr-p value) + (ccl:%get-cstring value)))) + #+sbcl (sb-ext:posix-getenv x) + #+clasp (ext:getenv x) + #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl clasp) + (error "~S is not supported on your implementation" 'getenv)) + + (defun directory-from-environment (environment-variable-name) + (let ((string (getenv environment-variable-name))) + (when (plusp (length string)) + (pathname-as-directory string)))) + + #+win32 + (define-condition missing-temp-environment-variable (error) + () + (:report (lambda (condition stream) + (declare (ignore condition)) + (format stream "the TEMP environment variable has not been found, cannot continue")))) + + #+win32 + (defun get-default-temporary-directory () + (or (directory-from-environment "TEMP") + (error 'missing-temp-environment-variable))) + + #-win32 + (defun get-default-temporary-directory () + (or (directory-from-environment "TMPDIR") + (and #-clisp (probe-file #P"/tmp/") + #+clisp (ext:probe-directory #P"/tmp/") + #P"/tmp/"))) + + (handler-case + (logical-pathname-translations "TEMPORARY-FILES") + (error () + (alexandria:if-let (default-temporary-directory (get-default-temporary-directory)) + (setf (logical-pathname-translations "TEMPORARY-FILES") `(("*.*.*" ,default-temporary-directory))) + (warn "could not automatically determine a default mapping for TEMPORARY-FILES"))))) + +;; locking for multi-threaded operation with unsafe random function + +(defvar *create-file-name-lock* (bordeaux-threads:make-lock "Temporary File Name Creation Lock")) + +(defmacro with-file-name-lock-held (() &body body) + `(bordeaux-threads:with-lock-held (*create-file-name-lock*) + ,@body)) + +(defun generate-random-string () + (with-file-name-lock-held () + (format nil "~:@(~36,8,'0R~)" (random (expt 36 8) *name-random-state*)))) + +(define-condition invalid-temporary-pathname-template (error) + ((string :initarg :string)) + (:report (lambda (condition stream) + (with-slots (string) condition + (format stream "invalid temporary file name template ~S, must contain a percent sign that is to be replaced by a random string" string))))) + +(defun generate-random-pathname (template random-string-generator) + (let ((percent-position (or (position #\% template) + (error 'invalid-temporary-pathname-template :string template)))) + (merge-pathnames (concatenate 'string + (subseq template 0 percent-position) + (funcall random-string-generator) + (subseq template (1+ percent-position)))))) + +(define-condition cannot-create-temporary-file (error) + ((template :initarg :template) + (max-tries :initarg :max-tries)) + (:report (lambda (condition stream) + (with-slots (template max-tries) condition + (format stream "cannot create temporary file with template ~A, giving up after ~D attempt~:P" + template max-tries))))) + +(defun open-temporary (&rest open-arguments + &key + (template *default-template*) + (generate-random-string 'generate-random-string) + (max-tries *max-tries*) + (direction :output) + &allow-other-keys) + "Create a file with a randomly generated name and return the opened + stream. The resulting pathname is generated from TEMPLATE, which + is a string representing a pathname template. A percent sign (%) + in that string is replaced by a randomly generated string to make + the filename unique. The default for TEMPLATE places temporary + files in the TEMPORARY-FILES logical pathname host, which is + automatically set up in a system specific manner. The file name + generated from TEMPLATE is merged with *DEFAULT-PATHNAME-DEFAULTS*, + so random pathnames relative to that directory can be generated by + not specifying a directory in TEMPLATE. + + GENERATE-RANDOM-STRING can be passed to override the default + function that generates the random name component. It should + return a random string consisting of characters that are permitted + in a pathname (logical or physical, depending on TEMPLATE). + + The name of the temporary file can be accessed calling the PATHNAME + function on STREAM. For convenience, the temporary file is opened + on the physical pathname, i.e. if the TEMPLATE designate a logical + pathname the translation to a physical pathname is performed before + opening the stream. + + In order to create a unique file name, OPEN-TEMPORARY may loop + internally up to MAX-TRIES times before giving up and signalling a + CANNOT-CREATE-TEMPORARY-FILE condition." + (loop thereis (apply #'open + (translate-logical-pathname (generate-random-pathname template generate-random-string)) + :direction direction + :if-exists nil + (alexandria:remove-from-plist open-arguments :template :generate-random-string :max-tries)) + repeat max-tries + finally (error 'cannot-create-temporary-file + :template template + :max-tries max-tries))) + +(defmacro with-output-to-temporary-file ((stream &rest args) &body body) + "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY + with STREAM bound to the temporary file stream. Returns the + pathname of the file that has been created. See OPEN-TEMPORARY for + permitted options." + `(with-open-stream (,stream (open-temporary ,@args)) + ,@body + (pathname ,stream))) + +(defmacro with-open-temporary-file ((stream &rest args &key keep &allow-other-keys) &body body) + "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY + with STREAM bound to the temporary file stream. Returns the values + returned by BODY. By default, the file is deleted when BODY is + exited. If a true value is passed in KEEP, the file is not deleted + when the body is exited. See OPEN-TEMPORARY for more permitted + options." + `(with-open-stream (,stream (open-temporary ,@(alexandria:remove-from-plist args :keep))) + #+sbcl + (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note)) + ,(if (and (constantp keep) + keep) + `(progn ,@body) + `(unwind-protect + (progn ,@body) + (unless ,keep + (close ,stream) + (delete-file (pathname ,stream))))))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/temporary-files.test.lisp b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/temporary-files.test.lisp new file mode 100644 index 0000000..80d4403 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/cl-fad-20190813-git/temporary-files.test.lisp @@ -0,0 +1,49 @@ +(in-package :cl-fad-test) + +(deftest 'temporary-file 'with-output-to-temporary-file () + (let ((pathname (with-output-to-temporary-file (f) + (write-string "hello" f)))) + (test-assert (probe-file pathname)) + (test-equal (alexandria:read-file-into-string pathname) "hello") + (delete-file pathname))) + +(deftest 'temporary-file 'with-open-temporary-file-keep () + + (let ((pathname (with-open-temporary-file (f :keep nil) + (pathname f)))) + (test-assert (null (probe-file pathname)))) + (let ((pathname (with-open-temporary-file (f :keep t) + (pathname f)))) + (test-assert (probe-file pathname)) + (delete-file pathname)) + + (let* ((keep nil) + (pathname (with-open-temporary-file (f :keep keep) + (pathname f)))) + (test-assert (null (probe-file pathname)))) + (let* ((keep t) + (pathname (with-open-temporary-file (f :keep keep) + (pathname f)))) + (test-assert (probe-file pathname)) + (delete-file pathname))) + +(deftest 'temporary-file 'template-tests () + ;; error is signalled when template does not contain a percent sign. + (let ((*default-template* "foo")) + (test-condition (with-open-temporary-file (f :keep nil)) + 'invalid-temporary-pathname-template)) + ;; file name template occurs in generated file name (for logical path name) + (let* ((*default-template* "temporary-files:bla%.txt") + (pathname (with-open-temporary-file (f :keep nil) + (pathname f)))) + (test-assert (cl-ppcre:scan "(?i)bla.*\\.txt$" (namestring pathname)))) + ;; file name template occurs in generated file name (for pysical path name) + (let* ((*default-template* (concatenate 'string + (namestring (translate-logical-pathname "temporary-files:")) + "bla%.txt")) + (pathname (with-open-temporary-file (f :keep nil) + (pathname f)))) + (test-assert (cl-ppcre:scan "(?i)bla.*\\.txt$" (namestring pathname))))) + + + diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/CHANGELOG b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/CHANGELOG new file mode 100644 index 0000000..ed86844 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/CHANGELOG @@ -0,0 +1,71 @@ +Version 0.9.2 +2015-05-21 +Fixed bug in READ-UNTIL (thanks to Michael Malis) +Fixed typo in documentation (thanks to Atif Haider) + +Version 0.9.1 +2007-11-16 +Fixed bug in SKIP-LEADING-WHITESPACE (thanks to Chaitanya Gupta) + +Version 0.9.0 +2007-03-09 +Hand down external format to included files (suggested by Igor Plekhov) + +Version 0.8.0 +2006-12-12 +Added TMPL_CALL (thanks to Marijn Haverbeke) + +Version 0.7.0 +2006-09-30 +Added TMPL_REPEAT + +Version 0.6.0 +2006-09-14 +Changed default for *VALUE-ACCESS-FUNCTION* +Added *STRING-MODIFIER* +Added ESCAPE-xxx functions (from CL-WHO) +Fixed docs for hyperdoc support +General documentation enhancements +Fixed test.lisp w.r.t. *FORMAT-NON-STRINGS* + +Version 0.5.0 +2006-09-08 +Added *FORMAT-NON-STRINGS* + +Version 0.4.0 +2006-04-03 +Added TMPL_UNLESS (requested by Igor Plekhov) + +Version 0.3.1 +2005-08-05 +Introduced *FORCE-DEFAULT* + +Version 0.3.0 +2005-07-03 +Introduced *TEMPLATE-OUTPUT* so template printers don't interfer with *STANDARD-OUTPUT* (proposed by Norman Werner) +Small enhancements to docs + +Version 0.2.0 +2005-06-09 +Added :DO-NOT-CACHE option to CREATE-TEMPLATE-PRINTER +Added clever DEFMETHOD trick by Peter Seibel +Fixed bug in READ-UNTIL which doesn't affect HTML-TEMPLATE +Better example in docs inspired by Bruce R. Lewis' critique on lisp-web +Mention asdf-install in docs +Added hyperdoc support +Added :HTML-TEMPLATE to *FEATURES* + +Version 0.1.2 +2003-07-15 +Argh, typo in index.html... :( + +Version 0.1.1 +2003-07-15 +Cleaner use of restarts thanks to James Anderson and Kent M. Pitman +Updated docs accordingly (removed stuff about OTHER-VALUE) +Removed ECL specific stuff (no longer necessary due to recent ECL fixes by Juan Jose Garcia Ripoll) +Corrected date of 0.1.0 release in CHANGELOG (don't laugh!) + +Version 0.1.0 +2003-07-15 +Initial release diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/INSTALLATION b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/INSTALLATION new file mode 100644 index 0000000..a3ca80b --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/INSTALLATION @@ -0,0 +1,33 @@ +Installation of HTML-TEMPLATE + +1. Probably the easiest way is + + (load "/path/to/html-template/load.lisp") + + This should compile and load HTML-TEMPLATE on most Common Lisp + implementations. + +2. With MK:DEFSYSTEM you can make a symlink from 'html-template.system' + to your central registry and then issue the command + + (mk:compile-system "html-template") + + Note that this relies on TRUENAME returning the original file a + symbolic link is pointing to. With AllegroCL 6.2 this will only + work if you've applied all patches with (SYS:UPDATE-ALLEGRO). + +3. You can also use ASDF instead of MK:DEFSYSTEM in a similar way: + + (asdf:operate 'asdf:compile-op :html-template) + (asdf:operate 'asdf:load-op :html-template) + +After installing HTML-TEMPLATE you can LOAD the file "test.lisp" to +check if everything works as expected. + +Complete documentation for HTML-TEMPLATE can be found in the 'doc' +directory. + +HTML-TEMPLATE also supports Nikodemus Siivola's HYPERDOC, see + and +. + diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/README.md b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/README.md new file mode 100644 index 0000000..5b193e1 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/README.md @@ -0,0 +1,21 @@ +--------------------------------------------------- +HTML-TEMPLATE - Use HTML templates from Common Lisp +--------------------------------------------------- + +HTML-TEMPLATE is a portable library for Common Lisp which can be used +to fill templates with arbitrary (string) values at runtime. +(Actually, it doesn't matter whether the result is HTML. It's just +very likely that this will be what the library is mostly used for.) + +It is loosely modeled after the Perl module HTML::Template and +partially compatible with a its syntax, though both libraries contain +some extensions that the other does not support. + +HTML-TEMPLATE translates templates into efficient closures which can +be re-used as often as needed. It uses an intelligent cache mechanism +so you can nevertheless update templates while your program is running +and have the changes take effect immediately. + +Complete documentation for HTML-TEMPLATE can be found in the `docs` +directory or at the [project documentation +site](https://edicl.github.io/html-template/). \ No newline at end of file diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/api.lisp b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/api.lisp new file mode 100644 index 0000000..4f52ce4 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/api.lisp @@ -0,0 +1,160 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/api.lisp,v 1.22 2007-03-09 13:09:16 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:html-template) + +(defgeneric create-template-printer (template + &key force + element-type + if-does-not-exist + external-format) + (:documentation "Creates a template printer from TEMPLATE which is +an open input stream, a string, or a pathname. If FORCE is true a +printer will be newly created no matter what the state of the cache +is. If FORCE is :DO-NOT-CACHE the newly created printer won't be +cached. Other keyword arguments will be given to WITH-OPEN-FILE. +Keyword arguments will only be accepted if TEMPLATE is a PATHNAME.")) + +(defmethod create-template-printer ((input-stream stream) &rest rest) + (when rest + (signal-template-invocation-error + "This method doesn't accept keyword arguments")) + (let ((*standard-input* input-stream)) + (%create-template-printer-aux nil nil))) + +(defmethod create-template-printer ((string string) &rest rest) + (when rest + (signal-template-invocation-error + "This method doesn't accept keyword arguments")) + (with-input-from-string (*standard-input* string) + (%create-template-printer-aux nil nil))) + +(defmethod create-template-printer ((pathname pathname) + &key (force *force-default*) + (element-type #-:lispworks 'character + #+:lispworks 'lw:simple-char) + (if-does-not-exist :error) + (external-format *external-format*)) + (let* ((merged-pathname (merge-pathnames pathname + *default-template-pathname*)) + (file-write-date (or *no-cache-check* + (file-write-date merged-pathname)))) + (destructuring-bind (hashed-printer . creation-date) + ;; see if a printer for this pathname is in the cache + (or (gethash merged-pathname *printer-hash*) + '(nil . nil)) + (when (and hashed-printer + ;; and if we may use it + (not force) + ;; and if it's not too old (or maybe we don't have to + ;; check) + (or *no-cache-check* + (and file-write-date + (<= file-write-date creation-date)))) + (return-from create-template-printer hashed-printer)) + (let ((new-printer + ;; push this pathname onto stack of included files (so + ;; to say) to make sure a file can't include itself + ;; recursively + (let ((*included-files* (cons merged-pathname + *included-files*)) + (*external-format* external-format)) + (with-open-file (*standard-input* merged-pathname + :direction :input + :if-does-not-exist if-does-not-exist + :element-type element-type + :external-format external-format) + (%create-template-printer-aux nil nil))))) + ;; cache newly created printer (together with current time) + (unless (eq force :do-not-cache) + (setf (gethash merged-pathname *printer-hash*) + (cons new-printer (get-universal-time)))) + ;; optionally issue a warning + (when *warn-on-creation* + (warn "New template printer for ~S created" merged-pathname)) + new-printer)))) + +(defgeneric fill-and-print-template (template/printer values + &key stream + &allow-other-keys) + (:documentation "Fills the template denoted by TEMPLATE/PRINTER with +VALUES and print it to STREAM. If TEMPLATE/PRINTER is a function uses +it as if it were a template printer, otherwise creates a printer \(or +pull one out of the cache) with CREATE-TEMPLATE-PRINTER. Optional +keyword arguments are given to CREATE-TEMPLATE printer and can only be +used if TEMPLATE/PRINTER is a pathname.")) + +(defmethod fill-and-print-template ((function function) values + &rest rest + &key (stream *default-template-output*)) + (remf rest :stream) + (when rest + (signal-template-invocation-error + "This method doesn't accept keyword arguments other than STREAM")) + (let ((*template-output* stream)) + (funcall function values))) + +(defmethod fill-and-print-template ((string string) values + &rest rest + &key (stream *default-template-output*)) + (remf rest :stream) + (when rest + (signal-template-invocation-error + "This method doesn't accept keyword arguments other than STREAM")) + (let ((*template-output* stream)) + (funcall (create-template-printer string) values))) + +(defmethod fill-and-print-template ((input-stream stream) values + &rest rest + &key (stream *default-template-output*)) + (remf rest :stream) + (when rest + (signal-template-invocation-error + "This method doesn't accept keyword arguments other than STREAM")) + (let ((*template-output* stream)) + (funcall (create-template-printer input-stream) values))) + +(defmethod fill-and-print-template ((pathname pathname) values + &rest rest + &key (stream *default-template-output*)) + (remf rest :stream) + (let ((*template-output* stream)) + (funcall (apply #'create-template-printer pathname rest) values))) + +(defun clear-template-cache () + "Complete clears all template printers from the cache." + (clrhash *printer-hash*) + (values)) + +(defun delete-from-template-cache (pathname) + "Deletes the template printer denoted by PATHNAME from the +cache. Returns true if such a printer existed, false otherwise." + (remhash (merge-pathnames pathname + *default-template-pathname*) + *printer-hash*)) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/docs/index.html b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/docs/index.html new file mode 100644 index 0000000..a4344ae --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/docs/index.html @@ -0,0 +1,1472 @@ + + + + + + HTML-TEMPLATE - Use HTML templates from Common Lisp + + + + + +

HTML-TEMPLATE - Use HTML templates from Common Lisp

+ +
+
 

Abstract

+ +HTML-TEMPLATE is a portable library for Common Lisp which can be used +to fill templates with arbitrary (string) values at runtime. +(Actually, it doesn't matter whether the result is HTML. It's just +very likely that this will be what the library is mostly used +for.) +

+It is loosely modeled after the Perl module HTML::Template and partially +compatible with a its syntax, though both libraries contain some +extensions that the other does not support. +

+HTML-TEMPLATE translates templates into efficient closures which +can be re-used as often as needed. It uses an intelligent cache +mechanism so you can nevertheless update templates while your program +is running and have the changes take effect immediately. +

+The rationale behind something like HTML-TEMPLATE or HTML::Template is +that you want to separate code and layout (I think in Newspeak these +are called the "Business Layer" and the "Presentation +Layer") as much as possible when generating HTML, especially if +you work with graphical artists who are responsible for the visual +appearance of your site but aren't programmers. Matter of fact, you +can't separate code and layout completely. I've worked (or +had to work) with several different approaches over the years, +including emitting HTML from CGI scripts directly, using tools like Embperl, Mason, PHP (yuk!), or Java/XML/XLST stuff, or +employing different Lisp markup +languages but found that HTML::Template's approach usually works +best for me: The graphical designers only need to learn a minimal set +of new tags and can update their templates independently from the work +done on the backend. It is simple and it just works. YMMV, of +course... +

+HTML-TEMPLATE is intended to be portable and should work with all +conforming Common Lisp implementations but is mainly tested and +deployed with LispWorks. Let us know if you encounter any +problems. +

+It comes with a BSD-style +license so you can basically do with it whatever you want. +

+HTML-TEMPLATE is used by Planet Lisp, Booble, and Heike Stephan. +

+Download shortcut: http://weitz.de/files/html-template.tar.gz. +

+ +
 

Contents

+
    +
  1. Simple example +
  2. Download and installation +
  3. Support and mailing lists +
  4. Syntax +
  5. Semantics +
  6. The HTML-TEMPLATE dictionary +
      +
    1. Creating and using printers +
        +
      1. create-template-printer +
      2. fill-and-print-template +
      +
    2. The template cache +
        +
      1. clear-template-cache +
      2. delete-from-template-cache +
      3. *no-cache-check* +
      +
    3. Customization +
        +
      1. *template-start-marker* +
      2. *template-end-marker* +
      3. *default-template-pathname* +
      4. *default-template-output* +
      5. *convert-nil-to-empty-string* +
      6. *format-non-strings* +
      7. *sequences-are-lists* +
      8. *upcase-attribute-strings* +
      9. *string-modifier* +
      10. *template-symbol-package* +
      11. *force-default* +
      12. *value-access-function* +
      13. *call-template-access-function* +
      14. *call-value-access-function* +
      15. *ignore-empty-lines* +
      16. *warn-on-creation* +
      +
    4. Conditions +
        +
      1. template-error +
      2. template-invocation-error +
      3. template-missing-value-error +
      4. template-not-a-string-error +
      5. template-not-a-string-error-value +
      6. template-syntax-error +
      7. template-syntax-error-stream +
      8. template-syntax-error-line +
      9. template-syntax-error-col +
      +
    5. Escaping +
        +
      1. escape-string +
      2. *escape-char-p* +
      3. escape-string-minimal +
      4. escape-string-minimal-plus-quotes +
      5. escape-string-iso-8859-1 +
      6. escape-string-all +
      +
    +
  7. Acknowledgements +
+ +
 

Simple example

+ +Although there's a wealth of functions, special variables, condition +types, and restarts listed below, most of +the time you'll just have to deal with one function and the syntax of the +templates should be quite easy to grasp. +Here's a small example. +

+If you have a text file +#p"/tmp/foo.tmpl" like this + +

+<table border=1>
+  <!-- TMPL_LOOP rows -->
+    <tr>
+      <!-- TMPL_LOOP cols -->
+        <!-- TMPL_IF colorful-style -->
+          <td align="right" bgcolor="pink"><!-- TMPL_VAR content --></td>
+        <!-- TMPL_ELSE -->
+          <td align="right" ><!-- TMPL_VAR content --></td>
+        <!-- /TMPL_IF -->
+      <!-- /TMPL_LOOP -->
+    </tr>
+  <!-- /TMPL_LOOP -->
+</table>
+
+ +then the following code + +
+(let* ((rows (loop for i below 49 by 7
+                   collect (list :cols
+                                 (loop for j from i below (+ i 7)
+                                       for string = (format nil "~R" j)
+                                       collect (list :content string
+                                                     :colorful-style (oddp j))))))
+       (values (list :rows rows)))
+  (fill-and-print-template #p"/tmp/foo.tmpl" values))
+
+ +will produce this HTML table: + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
zeroonetwothreefourfivesix
seveneightnineteneleventwelvethirteen
fourteenfifteensixteenseventeeneighteennineteentwenty
twenty-onetwenty-twotwenty-threetwenty-fourtwenty-fivetwenty-sixtwenty-seven
twenty-eighttwenty-ninethirtythirty-onethirty-twothirty-threethirty-four
thirty-fivethirty-sixthirty-seventhirty-eightthirty-ninefortyforty-one
forty-twoforty-threeforty-fourforty-fiveforty-sixforty-sevenforty-eight
+ +
 

Download and installation

+ +HTML-TEMPLATE together with this documentation can be downloaded from http://weitz.de/files/html-template.tar.gz. The +current version is 0.9.2. +

+If you're on Debian you should +probably use the cl-html-template +Debian package which is available thanks to Peter van Eynde and Kevin +Rosenberg. There's also a port +for Gentoo Linux thanks to Matthew Kennedy. +

+HTML-TEMPLATE comes with simple system definitions for MK:DEFSYSTEM and ASDF so you can either adapt it +to your needs or just unpack the archive and from within the HTML-TEMPLATE +directory start your Lisp image and evaluate the form +(mk:compile-system "html-template") (or the +equivalent one for asdf) which should compile and load the whole +system. Installation via asdf-install should also +be possible. +

+If for some reason you don't want to use MK:DEFSYSTEM or asdf you +can just LOAD the file load.lisp or you +can also get away with something like this: + +

+(loop for name in '("packages" "specials" "errors" "util" "template" "api")
+      do (compile-file (make-pathname :name name
+                                      :type "lisp"))
+         (load name))
+
+ +Note that on CL implementations which use the Python compiler +(i.e. CMUCL, SBCL, SCL) you can concatenate the compiled object files +to create one single object file which you can load afterwards: + +
+cat {packages,specials,errors,util,template,api}.x86f > html-template.x86f
+
+ +(Replace ".x86f" with the correct suffix for +your platform.) +

+The distribution includes a test file +"test.lisp" which you can LOAD +after loading HTML-TEMPLATE itself to check if everything works as +intended. If all is well you should just see these two messages: + +

+Please wait a couple of seconds.
+All tests passed...
+
+ +Some of the tests assume the existence of a directory +#p"/tmp/" where you can create files. If you're on +Windows you should probably change this - see the variable +TMP-DIR in test.lisp. + +

+Note that there is no public CVS repository for HTML-TEMPLATE - the repository at common-lisp.net is out of date and not in sync with the (current) version distributed from weitz.de. +

+Luís Oliveira maintains a darcs +repository of HTML-TEMPLATE +at http://common-lisp.net/~loliveira/ediware/. + +
 

Support and mailing lists

+ +For questions, bug reports, feature requests, improvements, or patches +please use the html-template-devel +mailing list. If you want to be notified about future releases +subscribe to the html-template-announce +mailing list. These mailing lists were made available thanks to +the services of common-lisp.net. +

+If you want to send patches, please read this first. + +
 

Syntax

+ +A template is just ordinary text (a file or a string) interspersed +with template tags. A template tag looks like + +
+  <!-- name [attribute] -->
+
+ +where name is one of TMPL_VAR, +TMPL_LOOP, TMPL_REPEAT, TMPL_CALL, TMPL_IF, TMPL_UNLESS, +TMPL_INCLUDE, /TMPL_LOOP, /TMPL_REPEAT, +/TMPL_IF, /TMPL_UNLESS, or TMPL_ELSE. Case doesn't matter, +i.e. tmpl_var or Tmpl_Var would also be +legal names. +

+If name is one of the first seven listed above then +attribute must follow, otherwise it must not follow where +attribute is any sequence of characters delimited by +", ', or by whitespace. There's +currently no way to escape the delimiters, i.e. if the attribute +starts with " then the next " (and +nothing else) will end it. +

+Any amount (including the empty string) of whitespace directly after +'<!--' and directly before '-->' is +optional and will be ignored. However, at least one whitespace +character between name and attribute (if present) is +mandatory. But note that if attribute is not delimited by +" or ' then there must be whitespace to +separate attribute from the closing '-->'. +

+The following are examples for legal template tags + +

+  <!-- TMPL_VAR foo -->
+  <!--TMPL_LOOP 'foo'-->
+  <!-- tmpl_include "/tmp/foo.html" -->
+  <!-- Tmpl_Else -->
+  <!-- /TMPL_LOOP -->
+  <!-- TMPL_LOOP foo--><!-- -->
+
+ +But note that in the last example the attribute is 'foo--><!--' which is probably not what you expected... +

+These are not legal: + +

+  <!-- TMPL_VAR -->
+  <!-- Tmpl_Else baz -->
+  <!-- TMPL_VARfoo -->
+  <!--TMPL_LOOP 'foo\'bar'-->
+  <tmpl_include "/tmp/foo.html">
+  <!-- TMPL_VAR NAME="foo" -->
+
+ +TMPL_VAR must always be followed by an attribute (1st +example) while TMPL_ELSE must not (2nd example). The +third one isn't recognized as a template tag because of the missing +whitespace behind TMPL_VAR. The tag will simply be +ignored and the parser will look for the next occurence of +'<!--'. +

+The fourth example doesn't work because the second apostrophe +isn't escaped by the backslash as you might have thought. Instead, the +parser will think the attribute ends there and will complain about the +string "bar'" following it. The next example +fails because, other than with HTML::Template, the HTML comment +markers are mandatory. (But note that you can change that by setting +the variables *TEMPLATE-START-MARKER* +and *TEMPLATE-END-MARKER*.) +The last example uses HTML::Template's optional +"NAME=" notation which is not supported by +HTML-TEMPLATE. +

+The TMPL_VAR, TMPL_INCLUDE, and +TMPL_CALL tags can appear anywhere and as often as you +like in your templates while the other tags must obey certain rules - +they must follow one of these patterns + +

+  <!-- TMPL_IF attribute --> text <!-- /TMPL_IF -->
+  <!-- TMPL_IF attribute --> text <!-- TMPL_ELSE --> text' <!-- /TMPL_IF -->
+  <!-- TMPL_LOOP attribute --> text <!-- /TMPL_LOOP -->
+  <!-- TMPL_REPEAT attribute --> text <!-- /TMPL_REPEAT -->
+
+ +where text and text' themselves must be valid +templates. In other words: These constructs must nest properly. +

+Note that, despite of its name, HTML-TEMPLATE knows absolutely nothing +about HTML syntax so you can use it for other texts as well. Also, +because the templates are filled in before they're sent to the +browser, you can use template tags anywhere you like and not only in +places where HTML comments would be legal. These two examples, e.g., will work: + +

+  <!-- Start of comment <!-- TMPL_VAR foo --> End of comment -->
+  <A HREF="<!-- TMPL_VAR link -->">foobar</A>
+
+ + +
 

Semantics

+The generic function CREATE-TEMPLATE-PRINTER +will convert a template into a template printer. A +template printer is a function which accepts one argument - a +template structure - which describes how the template should +be filled and prints the filled template to the stream bound to the +internal variable *TEMPLATE-OUTPUT*. You can +FUNCALL a template printer, but the preferred way to use +it is to invoke it with FILL-AND-PRINT-TEMPLATE +(which can also create template printers as needed). Note that +template printers are compiled closures but although you'll usually +create them at runtime the Lisp compiler isn't invoked for this task +so you can safely excise it from your image if you so wish. +

+For the rest of this document we will make a distinction between +generation time which is the time the template printer is +created (either explicitly by CREATE-TEMPLATE-PRINTER +or implicitly by FILL-AND-PRINT-TEMPLATE) +and invocation time which is the time the printer is used (by +FUNCALL or FILL-AND-PRINT-TEMPLATE) +to fill and print a template. +

+Each of the template tags TMPL_VAR, TMPL_IF, TMPL_UNLESS, +TMPL_LOOP, TMPL_CALL, and TMPL_REPEAT is associated with a particular symbol at +generation time. This symbol is the result of INTERNing +the tag's attribute string into the package *TEMPLATE-SYMBOL-PACKAGE*. The +template structure - the argument given to the template +printer - associates these symbols with values. By default this is +done by means of a property list but this can be changed at template invocation +time by changing the contents of the variable *VALUE-ACCESS-FUNCTION*. (Note +that the name structure doesn't imply that template structures are structures in +the sense of Common Lisp. Usually they aren't.) +

+The template tags work as follows: +


<!-- TMPL_VAR symbol --> + +

+This tag will be replaced by the value associated with symbol +which should be (see *FORMAT-NON-STRINGS*) a string (or maybe NIL - see *CONVERT-NIL-TO-EMPTY-STRING*). *STRING-MODIFIER* is applied to the string before it is output. + +
+* (let ((tp (create-template-printer "Hello <!-- TMPL_VAR foo -->!")))
+    (fill-and-print-template tp '(:foo "World"))
+    (terpri)
+    (fill-and-print-template tp '(:foo "Folks"))
+    (terpri)
+    (fill-and-print-template tp '(:foo symbol)))
+Hello World!
+Hello Folks!
+Hello SYMBOL!
+
+
+ +

<!-- TMPL_IF symbol -->text<!-- /TMPL_IF --> +
<!-- TMPL_UNLESS symbol -->text<!-- /TMPL_UNLESS --> + +

+In the first case, if the value associated with +symbol is not NIL the (sub-)template +text will be filled and printed. Otherwise, the whole +construct will be replaced by an empty string. In the second case, +it's the other way around. + +
+* (let ((tp (create-template-printer "The <!-- TMPL_IF fast -->quick <!-- /TMPL_IF -->brown fox")))
+    (fill-and-print-template tp '(:fast t))
+    (terpri)
+    (fill-and-print-template tp '(:fast nil)))
+The quick brown fox
+The brown fox
+
+
+ +

<!-- TMPL_IF symbol -->text<!-- TMPL_ELSE -->text'<!-- /TMPL_IF --> +
<!-- TMPL_UNLESS symbol -->text<!-- TMPL_ELSE -->text'<!-- /TMPL_UNLESS --> + +

+In the first case, if the value associated with symbol is +not NIL, the (sub-)template text will be filled +and printed. Otherwise, +text' is used instead. In the second case, it's the other +way around. + +
+* (let ((tp (create-template-printer "The <!-- TMPL_IF fast -->quick<!-- TMPL_ELSE -->slow<!-- /TMPL_IF --> brown fox")))
+    (fill-and-print-template tp '(:fast t))
+    (terpri)
+    (fill-and-print-template tp '(:fast nil)))
+The quick brown fox
+The slow brown fox
+
+
+ +

<!-- TMPL_LOOP symbol -->text<!-- /TMPL_LOOP --> + +

+The value associated with symbol should be +a sequence (see *SEQUENCES-ARE-LISTS*) of +template structures. For each element of this sequence the +(sub-)template text is filled and printed using the +corresponding template structure. +

+Note that each template (sub-)structure which is used to fill +text introduces a new set of associations between symbols and +their values. While the template printer is within text the +outer template structure is temporarily "forgotten" +unless *VALUE-ACCESS-FUNCTION* +(note the in-loop-p paramter in particular) takes +care of that. + +

+* (defparameter *tp*
+    (create-template-printer
+     "<!-- TMPL_LOOP foo -->[<!-- TMPL_VAR bar -->,<!-- TMPL_VAR baz -->]<!-- /TMPL_LOOP -->"))
+
+*TP*
+* (fill-and-print-template *tp*
+                           '(:foo ((:bar "EINS" :baz "ONE")
+                                   (:bar "ZWEI" :baz "TWO"))))
+[EINS,ONE][ZWEI,TWO]
+* (let ((*value-access-function*
+         (lambda (symbol values &optional in-loop-p)
+           (declare (ignore in-loop-p))
+           (getf values symbol))))
+    (fill-and-print-template *tp* '(:baz "ONE"
+                                    :foo ((:bar "EINS")
+                                          (:bar "UNO")))))
+[EINS,][UNO,]
+* (fill-and-print-template *tp* '(:baz "ONE"
+                                  :foo ((:bar "EINS")
+                                        (:bar "UNO"))))
+[EINS,ONE][UNO,ONE]
+
+
+ +

<!-- TMPL_REPEAT symbol -->text<!-- /TMPL_REPEAT --> + +

+If the value associated with symbol is a positive integer N, then the (sub-)template text will be filled and printed N times. Otherwise, the whole construct will be replace with an empty string. + +
+* (let ((tp (create-template-printer "The <!-- TMPL_REPEAT three -->very <!-- /TMPL_REPEAT -->fast brown fox")))
+    (fill-and-print-template tp '(:three 3))
+    (terpri)
+    (fill-and-print-template tp '(:three "3")))
+The very very very fast brown fox
+The fast brown fox
+
+ +Note that the original HTML::Template library doesn't have the TMPL_REPEAT tag - if that matters to you. + +
+ +

<!-- TMPL_INCLUDE pathname --> + +

+The string pathname +should be a valid pathname for an existing textfile. This textfile is +implicitly converted into a template printer at generation +time as if it were explicitly converted by a call to CREATE-TEMPLATE-PRINTER. At +invocation time the tag will be replaced by the result +of FUNCALLing this template printer with the current +template structure. (Note that this implies that the included file has +to be a valid template, i.e. you can't, say, have a +TMPL_IF tag in your main file and put the closing +/TMPL_IF into the included file.) + +
+* (with-open-file (s "/tmp/foo" :direction :output :if-exists :supersede)
+    (write-string "The <!-- TMPL_IF fast -->quick <!-- /TMPL_IF -->brown fox" s))
+"The <!-- TMPL_IF fast -->quick <!-- /TMPL_IF -->brown fox"
+* (fill-and-print-template "<!-- TMPL_INCLUDE '/tmp/foo' --> jumps over the lazy dog" '(:fast t))
+Warning:  New template printer for #p"/tmp/foo" created
+The quick brown fox jumps over the lazy dog
+* (fill-and-print-template "<!-- TMPL_INCLUDE '/tmp/foo' --> jumps over the lazy dog" '(:fast nil))
+The brown fox jumps over the lazy dog
+
+

+These tags can be nested, i.e. included files can themselves include +other files. Included template printers are always taken from the cache at +invocation time which means you can update them seperately from the +including printer. +

+ +

<!-- TMPL_CALL symbol --> + +

+The value associated with symbol should be a sequence (as +specified by *SEQUENCES-ARE-LISTS*) +of template calls, each of which specifies a substructure and a +template to apply to that. By default, calls are just lists, with the +car specifying the template name and the cdr containing the +substructure. (See *CALL-TEMPLATE-ACCESS-FUNCTION* +and *CALL-VALUE-ACCESS-FUNCTION* +for ways to customize what calls look like.) +

+TMPL_CALL combines aspects of TMPL_LOOP and +TMPL_INCLUDE - it iterates over a sequence of values the +way loops do, but instead of using part of the current template to +print the values each value contains its own information about which +subtemplate should be applied to it. + +

+* (with-open-file (s "/tmp/paragraph" :direction :output :if-exists :supersede)
+    (write-string "<p class='fancy'><!-- TMPL_VAR text --></p>" s))
+"<p class='fancy'><!-- TMPL_VAR text --></p>"
+* (with-open-file (s "/tmp/header" :direction :output :if-exists :supersede)
+    (write-string "<h1><!-- TMPL_VAR text --></h1>" s))
+"<h1><!-- TMPL_VAR text --></h1>"
+* (fill-and-print-template "<body><!-- TMPL_CALL parts --></body>"
+                           '(:parts ((#P"/tmp/header" :text "Chapter 1")
+                                     (#P"/tmp/paragraph" :text "There once was a platypus...")
+                                     (#P"/tmp/header" :text "Chapter 5")
+                                     (#P"/tmp/paragraph" :text "And lived happily ever after."))))
+<h1>Chapter 1</h1><p class='fancy'>There once was a platypus...</p><h1>Chapter 5</h1><p class='fancy'>And lived happily ever after.</p></body>
+
+

+Note that you do not have to include full pathnames in the call +structures. You can use *DEFAULT-TEMPLATE-PATHNAME* +to specify most of it, or set *CALL-TEMPLATE-ACCESS-FUNCTION* +to a function that creates pathnames any way you like. +

+

+Also note that the original HTML::Template library doesn't have the TMPL_CALL tag - if that matters to you. + +
 

The HTML-TEMPLATE dictionary

+ +HTML-TEMPLATE exports the following symbols (some of which are also +exported by CL-WHO, by the way, +so beware if you're using both libraries): + +

Creating and using template printers

+ +If you're OK with the default settings you will probably only use the +two functions described in this section. + +


[Generic function] +
create-template-printer template &key force element-type if-does-not-exist external-format => printer + +


+This function will create and return a template printer printer created from the template denoted by +template. The behaviour of this function depends on the +type of template. +
    +
  • If template is a stream, it should be an open character input stream which is read character by character with READ-CHAR and the resulting text is used as the template. +
  • If template is a string, it is converted into a string stream which is again fed into CREATE-TEMPLATE-PRINTER. +
  • If template is a pathname, it should denote an existing text file. The file is opened by WITH-OPEN-FILE and the resulting stream is again fed into CREATE-TEMPLATE-PRINTER. All keyword arguments except force are used as keyword arguments for WITH-OPEN-FILE. The pathname will be merged with *DEFAULT-TEMPLATE-PATHNAME* before it is used. +

    HTML-TEMPLATE maintains a cache of previously created template printers. If the (merged) pathname can be found in this cache and the file denoted by this pathname hasn't changed since the associated cached template printer was created (which is tested by FILE-WRITE-DATE) the cached value will be used and no new template printer will be created. This can be overriden by the keyword argument force, i.e. when force is true a new template printer will unconditionally be created (and cached unless force is the keyword :DO-NOT-CACHE). The default value for force is the value of *FORCE-DEFAULT*. (See also *NO-CACHE-CHECK*.) Note that you may have to use force if you've changed one of the customization variables described below and want to create a template printer based on these new settings although the template file itself hasn't changed. Also note that FILE-WRITE-DATE might not be able to see a difference if the newer version of a file is only fractions of a second newer than the older one. +

+ +This function will signal an error of type TEMPLATE-INVOCATION-ERROR if template is not a pathname and one of the keyword arguments is provided. + +
+* (with-input-from-string (stream "The <!-- TMPL_VAR speed --> brown fox")
+    (funcall (create-template-printer stream) '(:speed "quick")))
+The quick brown fox
+* (funcall (create-template-printer "The <!-- TMPL_VAR speed --> brown fox") '(:speed "slow"))
+The slow brown fox
+* (with-open-file (stream "/tmp/foo.tmpl" :direction :output)
+    (write-string "The <!-- TMPL_VAR speed --> brown fox" stream))
+
+"The <!-- TMPL_VAR speed --> brown fox"
+* (funcall (create-template-printer #p"/tmp/foo.tmpl") '(:speed "fast"))
+Warning:  New template printer for #p"/tmp/foo.tmpl" created
+The fast brown fox
+* (funcall (create-template-printer #p"/tmp/foo.tmpl") '(:speed "extremely fast"))
+The extremely fast brown fox
+* (funcall (create-template-printer #p"/tmp/foo.tmpl" :force t) '(:speed "very fast"))
+Warning:  New template printer for #p"/tmp/foo.tmpl" created
+The very fast brown fox
+* (probe-file "/tmp/bar.tmpl")
+
+NIL
+* (funcall (create-template-printer #p"/tmp/bar.tmpl" :if-does-not-exist :create) '(:foo "foo"))
+Warning:  New template printer for #p"/tmp/bar.tmpl" created
+
+* (probe-file "/tmp/bar.tmpl")
+
+#p"/tmp/bar.tmpl"
+
+ +
+ +


[Generic function] +
fill-and-print-template template/printer values &key stream &allow-other-keys => | + +


+This function will fill the template denoted by template/printer with the values provided by values and print the resulting text to stream which defaults to *DEFAULT-TEMPLATE-OUTPUT*. The value of values should be a template structure matching the current value of *VALUE-ACCESS-FUNCTION*. +

+If template/printer is a function, it will be used as if it were a template printer. Otherwise, template/printer will first be fed into CREATE-TEMPLATE-PRINTER and the resulting template printer will be used. Note that this implies that the caching mechanism described above is in effect here as well. +

+If template/printer is a pathname, all keyword arguments except for stream will be used as keyword arguments for CREATE-TEMPLATE-PRINTER. If it is not a pathname, keyword arguments other than stream will result in an error of type TEMPLATE-INVOCATION-ERROR. + +

+* (fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox" '(:speed "slow"))
+The slow brown fox
+* (with-input-from-string (stream "The <!-- TMPL_VAR speed --> brown fox")
+    (fill-and-print-template stream '(:speed "quick")))
+The quick brown fox
+* (with-open-file (stream "/tmp/foo.tmpl" :direction :output :if-exists :supersede)
+    (write-string "The <!-- TMPL_VAR speed --> brown fox" stream))
+
+"The <!-- TMPL_VAR speed --> brown fox"
+* (fill-and-print-template #p"/tmp/foo.tmpl" '(:speed "fast"))
+Warning:  New template printer for #p"/tmp/foo.tmpl" created
+The fast brown fox
+* (fill-and-print-template #p"/tmp/foo.tmpl" '(:speed "very fast"))
+The very fast brown fox
+* (let ((tp (create-template-printer "The <!-- TMPL_VAR speed --> brown fox")))
+    (fill-and-print-template tp '(:speed "tardy")))
+The tardy brown fox
+
+
+ +

Template cache

+ +The functions and variables in this section are related to the cache mechanism described in the entry for CREATE-TEMPLATE-PRINTER. + +


[Function] +
clear-template-cache => | + +


+This function will completely clear the cache used by HTML-TEMPLATE. +
+ +


[Function] +
delete-from-template-cache pathname => result + +


+This function will remove the template printer associated with pathname from HTML-TEMPLATE's cache. result is true if there was such a template printer, or NIL otherwise. +
+ +


[Special variable] +
*no-cache-check* + +


+If the value of this variable is true (the default is +NIL) CREATE-TEMPLATE-PRINTER +and FILL-AND-PRINT-TEMPLATE +won't check whether a template file has changed since it has been +cached, but instead will always use the cached template printer if there is +one, i.e. there will be no more disk I/O once all template printers +are generated. This option is intended to be used for sites with heavy +traffic when you don't expect your templates to change anymore. +
+ +

Customizations

+ +This section assembles more than a +dozen special +variables which can be used to customize HTML-TEMPLATE's behaviour. + +


[Special variable] +
*template-start-marker* + +


+This should be a string (the default is "<!--") which is used at generation time to determine the start of a template tag. +
+ +


[Special variable] +
*template-end-marker* + +


+This should be a string (the default is +"-->") which is used at generation time to determine the end of +a template tag. + +
+* (let ((*template-start-marker* "<")
+        (*template-end-marker* ">"))
+    (fill-and-print-template "The <TMPL_VAR 'speed'> <brown> fox" '(:speed "quick")))
+The quick <brown> fox
+
+
+ +


[Special variable] +
*default-template-pathname* + +


+This should be a pathname (the default is the result of calling MAKE-PATHNAME +with no arguments) which is merged with the sole argument of CREATE-TEMPLATE-PRINTER +if this argument is a pathname. + +
+* (with-open-file (stream "/tmp/foo.tmpl" :direction :output :if-exists :supersede)
+    (write-string "The <!-- TMPL_VAR speed --> brown fox" stream))
+
+"The <!-- TMPL_VAR speed --> brown fox"
+* (setq *default-template-pathname* #p"/tmp/")
+
+#p"/tmp/"
+* (fill-and-print-template #p"foo.tmpl" '(:speed "very fast"))
+Warning:  New template printer for #p"/tmp/foo.tmpl" created
+The very fast brown fox
+
+
+ +


[Special variable] +
*default-template-output* + +


+This should be a stream (the default is the value of +*STANDARD-OUTPUT* +when HTML-TEMPLATE is loaded) which is used as the output stream of +FILL-AND-PRINT-TEMPLATE +if no stream keyword argument was provided. + +
+* (fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox" '(:speed "slow"))
+The slow brown fox
+* (with-output-to-string (*default-template-output*)
+    (fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox" '(:speed "slow")))
+
+"The slow brown fox"
+
+
+ +


[Special variable] +
*convert-nil-to-empty-string* + +


+If the values of this variable is true (which is the default), TMPL_VAR +tags will be replaced by the empty string if the associated value is +NIL, otherwise an error of type TEMPLATE-MISSING-VALUE-ERROR +is signaled. This variable takes +effect at invocation time. + +
+* (let ((tp (create-template-printer "The <!-- TMPL_VAR speed --> brown fox")))
+    (handler-bind
+      ((template-missing-value-error (lambda (condition)
+                                       (declare (ignore condition))
+                                       (use-value "slow"))))
+      (let ((*convert-nil-to-empty-string* nil))
+        (fill-and-print-template tp '(:foo "bar")))))
+The slow brown fox
+
+
+ +


[Special variable] +
*format-non-strings* + +


If the value of this variable is true (which +is the default), TMPL_VAR will accept non-string values +and convert them to strings +using (FORMAT NIL "~A" ...). Note that +the check +for *CONVERT-NIL-TO-EMPTY-STRING* +will happen first, though. +This variable takes effect at invocation time. + +
+* (fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox" '(:speed :tardy))
+The TARDY brown fox
+
+
+ +


[Special variable] +
*sequences-are-lists* + +


+If the values of this variable is true (which is the default) +the code generated by a TMPL_LOOP tag expects its +associated value to be a list, otherwise it expects it to be a +vector. This variable takes effect at generation time. + +
+* (fill-and-print-template "<!-- TMPL_LOOP list -->[<!-- TMPL_VAR item -->]<!-- /TMPL_LOOP -->"
+                           '(:list ((:item "1")
+                                    (:item "2")
+                                    (:item "3"))))
+[1][2][3]
+* (let ((*sequences-are-lists* nil))
+    (fill-and-print-template "<!-- TMPL_LOOP vector -->[<!-- TMPL_VAR item -->]<!-- /TMPL_LOOP -->"
+                             '(:vector #((:item "1")
+                                         (:item "2")
+                                         (:item "3")))))
+[1][2][3]
+
+
+ +


[Special variable] +
*upcase-attribute-strings* + +


+If the values of this variable is true (which is the default) +attribute strings are fed to +STRING-UPCASE before they are interned. This variable +takes effect at generation time. + +
+* (let ((*upcase-attribute-strings* nil))
+    (fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox" '(:speed "quick" :|speed| "slow")))
+The slow brown fox
+
+
+ +


[Special variable] +
*string-modifier* + +


A designator for the function which is applied to strings which +replace TMPL_VAR tags. The default +is #'ESCAPE-STRING-ISO-8859-1. Use #'CL:IDENTITY if you want to leave the string as is. + +
+* (fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox" '(:speed "<quick>"))
+The &lt;quick&gt; brown fox
+
+* (let ((*string-modifier* #'identity))
+    (fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox" '(:speed "<quick>")))
+The <quick> brown fox
+
+
+ +


[Special variable] +
*template-symbol-package* + +


The value of this variable should be +a package +designator designating the package attribute +strings are interned into. The default is the KEYWORD +package. This variable takes effect at generation +time. + +
+* *package*
+
+#<The COMMON-LISP-USER package, 20/21 internal, 0/9 external>
+* (let ((*template-symbol-package* (find-package :common-lisp-user)))
+    (fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox" '(:speed "quick" speed "slow")))
+The slow brown fox
+
+
+ +


[Special variable] +
*force-default* + +


+The default value for the force keyword argument to +CREATE-TEMPLATE-PRINTER. Its initial value is NIL. +
+ +


[Special variable] +
*value-access-function* + +


The value of this variable should be +a designator +for a function with +the lambda +list (symbol values &optional in-loop-p) which is +used to associate symbols with their values when a template printer is +invoked. in-loop-p is true whenever this +function is called from within a TMPL_LOOP or TMPL_CALL tag. +

+The default +value is +

+(lambda (symbol values &optional in-loop-p)
+  (let ((result (getf values symbol)))
+    (cond (in-loop-p
+           (loop for element in result
+                 when (listp element)
+                   ;; keep values from upper levels
+                   collect (append element values)
+                 else
+                   collect element))
+          (t result))))
+
+This variable takes effect at invocation +time. + +
+* (let ((tp (create-template-printer "The <!-- TMPL_VAR speed --> brown fox"))
+        ;; for brevity, we'll ignore the third argument here
+        (*value-access-function* #'gethash)
+        (hash (make-hash-table :test #'eq)))
+    (setf (gethash :speed hash) "fast")
+    (fill-and-print-template tp hash))
+The fast brown fox
+
+
+ +


[Special variable] +
*call-template-access-function* + +


The value of this variable should be a designator +for a function which takes one argument (the call structure) and +returns either a template printer or a value that can be used as the +first argument to create-template-printer. +This function will be used to determine the template that should be +used for a call in a TMPL_CALL tag. +

The default value +is #'CAR. +This variable takes effect at invocation +time.

+ +


[Special variable] +
*call-value-access-function* + +


The value of this variable should be a designator +for a function which takes one argument (the call structure) and +returns a structure to use as the value for a call in a +TMPL_CALL tag.

The default value is #'CDR. +This variable takes effect at invocation +time.

+ +


[Special variable] +
*ignore-empty-lines* + +


+If the value of this variable is true (the default is +NIL), template printers will suppress any whitespace in +front of template tags up to (but excluding) the first +#\Newline and any whitespace behind template tags up to +(and including) the first #\Newline. This holds for all +tags except TMPL_VAR. The idea is that you might want to +put tags like TMPL_LOOP on lines of their own in order to +increase the legibility of your template files without creating +unnecessary empty lines in your output. This variable takes effect at +generation time. + +
+* (with-open-file (s "/tmp/foo.tmpl" :direction :input)
+    (loop for line = (read-line s nil nil)
+          while line
+          do (print line))
+    (values))
+
+"<table>"
+"  <!-- TMPL_LOOP row-loop -->"
+"  <tr>"
+"    <!-- TMPL_LOOP col-loop -->"
+"    <td><!-- TMPL_VAR item --></td>"
+"    <!-- /TMPL_LOOP -->"
+"  </tr>"
+"  <!-- /TMPL_LOOP -->"
+"</table>"
+* (let ((values (list :row-loop
+                      (loop for row in '((1 2 3 4) (2 3 4 5) (3 4 5 6))
+                            collect (list :col-loop
+                                          (loop for col in row
+                                                collect (list :item
+                                                              (format nil "~A" col)))))))
+      (*ignore-empty-lines* t))
+  (fill-and-print-template #p"/tmp/foo.tmpl" values :force t))
+Warning:  New template printer for #p"/tmp/foo.tmpl" created
+<table>
+  <tr>
+    <td>1</td>
+    <td>2</td>
+    <td>3</td>
+    <td>4</td>
+  </tr>
+  <tr>
+    <td>2</td>
+    <td>3</td>
+    <td>4</td>
+    <td>5</td>
+  </tr>
+  <tr>
+    <td>3</td>
+    <td>4</td>
+    <td>5</td>
+    <td>6</td>
+  </tr>
+</table>
+
+
+ +


[Special variable] +
*warn-on-creation* + +


+ +If this variable is true (which is the default), CREATE-TEMPLATE-PRINTER +will warn +you whenever a template printer is newly created from a pathname +argument instead of being taken from the cache. +
+ +

Conditions

+ +This section lists +the conditions +signaled by HTML-TEMPLATE and the corresponding accessors. + +


[Condition type] +
template-error + +


+Every error signaled by HTML-TEMPLATE is of type +TEMPLATE-ERROR. This is a direct subtype of SIMPLE-ERROR +without any additional slots or options. +
+ +


[Condition type] +
template-invocation-error + +


+Errors of type TEMPLATE-INVOCATION-ERROR are signaled if +CREATE-TEMPLATE-PRINTER +or FILL-AND-PRINT-TEMPLATE +are called with wrong keyword arguments. This is a direct subtype of +TEMPLATE-ERROR without any +additional slots or options. +
+ +


[Condition type] +
template-missing-value-error + +


+An error of type TEMPLATE-MISSING-VALUE-ERROR is signaled +if a template printer for TMPL_VAR is provided with a +NIL value although *CONVERT-NIL-TO-EMPTY-STRING* +is false. This is a direct subtype of TEMPLATE-ERROR without any +additional slots or options. Whenever a +TEMPLATE-MISSING-VALUE-ERROR is signaled, an associated +USE-VALUE restart is available. +
+ +


[Condition type] +
template-not-a-string-error + +


+An error of type TEMPLATE-NOT-A-STRING-ERROR is signaled +if a template printer for TMPL_VAR is provided with a +value which is neither a string nor NIL and *FORMAT-NON-STRINGS* is false. This is a +direct subtype of TEMPLATE-ERROR with one +additional slot for the value which can be read by TEMPLATE-NOT-A-STRING-ERROR-VALUE. +Whenever a TEMPLATE-NOT-A-STRING-ERROR is signaled, an +associated USE-VALUE restart is available. +
+ +


[Generic function] +
template-not-a-string-error-value condition => value + +


+If condition is a condition of type TEMPLATE-NOT-A-STRING-ERROR, +this function will return the (non-string) value causing the error. + +
+* (let ((tp (create-template-printer "A square has <!-- TMPL_VAR number --> corners")))
+    (handler-bind
+      ((template-not-a-string-error (lambda (condition)
+                                      (use-value
+                                        (format nil "~R"
+                                                (template-not-a-string-error-value condition))))))
+      (let ((*format-non-strings* nil))
+        (fill-and-print-template tp '(:number 4)))))
+A square has four corners
+
+
+ +


[Condition type] +
template-syntax-error + +


+An error of type TEMPLATE-SYNTAX-ERROR is signaled at generation time when HTML-TEMPLATE is +not able to create a template printer due to syntax errors in the +template. This is a direct subtype of TEMPLATE-ERROR with three +additional slots. These denote the stream from which HTML-TEMPLATE was +reading when it encountered the error and a line and column within +this stream. (See the next three entries on how to access these +slots.) +

+As many syntax errors can't be detected before the parser is at the +end of the stream, the row and column usually denote the last position +where the parser was happy and not the position where it gave up. + +

+* (handler-case
+    (fill-and-print-template "A square has <!-- TMPL_VAR number--> corners"
+                             '(:number "four"))
+    (template-syntax-error (condition)
+      (format t "Houston, we've got a problem on stream ~A:~%~
+                 Looks like something went wrong after line ~A, column ~A.~%~
+                 The last message we received was '~?'."
+              (template-syntax-error-stream condition)
+              (template-syntax-error-line condition)
+              (template-syntax-error-col condition)
+              (simple-condition-format-control condition)
+              (simple-condition-format-arguments condition))
+      (values)))
+Houston, we've got a problem on stream #<String-Input Stream>:
+Looks like something went wrong after line 1, column 26.
+The last message we received was 'Unexpected EOF'.
+
+ +Note that column 26 is the position directly behind "TMPL_VAR". +
+ +


[Generic function] +
template-syntax-error-stream condition => stream + +


+If condition is a condition of type TEMPLATE-SYNTAX-ERROR, +this function will return the stream the parser was reading from when +the error was encountered. +
+ +


[Generic function] +
template-syntax-error-line condition => number + +


+If condition is a condition of type TEMPLATE-SYNTAX-ERROR, +this function will return the line number which was associated with +this error. As in Emacs, lines are counted beginning +with 1. HTML-TEMPLATE increases the line counter whenever it reads a #\Newline from its input stream. +
+ +


[Generic function] +
template-syntax-error-col condition => number + +


+If condition is a condition of type TEMPLATE-SYNTAX-ERROR, +this function will return the column number which was associated with +this error. As in Emacs, columns are counted beginning +with 0. +
+ +

Escaping

+ +Functions and variables which can be used to encode characters for +HTML documents - +see *STRING-MODIFIER*. + +


[Function] +
escape-string string &key test => escaped-string + +


+This function will accept a string string and will replace every character for which test returns true with its (decimal) character entity. test must be a designator for a function of one argument which accepts a character and returns a generalized boolean. The default is the value of *ESCAPE-CHAR-P*. +
+* (escape-string "<Hühner> 'naïve'")
+"&lt;H&#252;hner&gt; &#039;na&#239;ve&#039;"
+
+
+ +


[Special variable] +
*escape-char-p* + +


+This is the default for the test keyword argument to ESCAPE-STRING. Its initial value is + +
+#'(lambda (char)
+    (or (find char "<>&'\"")
+        (> (char-code char) 127)))
+
+
+ +


[Function] +
escape-string-minimal string => escaped-string +
[Function] +
escape-string-minimal-plus-quotes string => escaped-string +
[Function] +
escape-string-iso-8859-1 string => escaped-string +
[Function] +
escape-string-all string => escaped-string + +


+These are convenience function based on ESCAPE-STRING. They are defined as follows: + +
+(defun escape-string-minimal (string)
+  "Escape only #\<, #\>, and #\& in STRING."
+  (escape-string string :test #'(lambda (char) (find char "<>&"))))
+
+(defun escape-string-minimal-plus-quotes (string)
+  "Like ESCAPE-STRING-MINIMAL but also escapes quotes."
+  (escape-string string :test #'(lambda (char) (find char "<>&'\""))))
+
+(defun escape-string-iso-8859-1 (string)
+  "Escapes all characters in STRING which aren't defined in ISO-8859-1."
+  (escape-string string :test #'(lambda (char)
+                                  (or (find char "<>&'\"")
+                                      (> (char-code char) 255)))))
+
+(defun escape-string-all (string)
+  "Escapes all characters in STRING which aren't in the 7-bit ASCII
+character set."
+  (escape-string string :test #'(lambda (char)
+                                  (or (find char "<>&'\"")
+                                      (> (char-code char) 127)))))
+
+
+ +
 

Acknowledgements

+ +Thanks to Sam Tregar for HTML::Template which I've used +successfully for many years together with mod_perl and which inspired +me to write HTML-TEMPLATE. +

+Thanks to James Anderson and Kent M. Pitman who helped to de-confuse +me about restarts. +

+Thanks to Marijn Haverbeke for a very clean and comprehensive patch +for the TMPL_CALL code. +

+$Header: /usr/local/cvsrep/html-template/doc/index.html,v 1.59 2015-05-21 21:00:01 edi Exp $ +

BACK TO MY HOMEPAGE + + + diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/errors.lisp b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/errors.lisp new file mode 100644 index 0000000..0464229 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/errors.lisp @@ -0,0 +1,106 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE-LISP; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/errors.lisp,v 1.8 2007-01-01 23:49:16 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:html-template) + +(defstruct syntax-error-location + "Structure to store parser locations consisting of a stream, a line +number, and a column number." + line col stream) + +(defvar *syntax-error-location* (make-syntax-error-location) + "Used internally to remember the last position which made sense to +the parser.") + +(define-condition template-error (simple-error) + () + (:documentation "All errors signaled by HTML-TEMPLATE are of +this type.")) + +(define-condition template-invocation-error (template-error) + () + (:documentation "Signaled when HTML-TEMPLATE functions are +invoked with wrong arguments.")) + +(define-condition template-missing-value-error (template-error) + () + (:documentation "Signaled when a TMPL_VAR printer is provided +with a NIL value and *CONVERT-NIL-TO-EMPTY-STRING* is false.")) + +(define-condition template-not-a-string-error (template-error) + ((value :initarg :value + :reader template-not-a-string-error-value)) + (:documentation "Signaled when a TMPL_VAR printer is provided +with a non-string value.")) + +(define-condition template-syntax-error (template-error) + ((line :initarg :line + :reader template-syntax-error-line) + (col :initarg :col + :reader template-syntax-error-col) + (stream :initarg :stream + :reader template-syntax-error-stream)) + (:default-initargs + :line (syntax-error-location-line *syntax-error-location*) + :col (syntax-error-location-col *syntax-error-location*) + :stream (syntax-error-location-stream *syntax-error-location*)) + (:report (lambda (condition stream) + (format stream "~?~%[Line ~A, column ~A, stream ~A]" + (simple-condition-format-control condition) + (simple-condition-format-arguments condition) + (template-syntax-error-line condition) + (template-syntax-error-col condition) + (template-syntax-error-stream condition)))) + (:documentation "Signaled when a syntax error occurs while +parsing a template.")) + +(defmacro signal-template-invocation-error (format-control &rest format-arguments) + `(error 'template-invocation-error + :format-control ,format-control + :format-arguments (list ,@format-arguments))) + +(defmacro signal-template-missing-value-error (format-control &rest format-arguments) + `(error 'template-missing-value-error + :format-control ,format-control + :format-arguments (list ,@format-arguments))) + +(defmacro signal-template-syntax-error (format-control &rest format-arguments) + `(error 'template-syntax-error + :format-control ,format-control + :format-arguments (list ,@format-arguments))) + +(defmacro with-syntax-error-location ((&rest rest) &body body) + "This is wrapped around forms in order to remember a meaningful +position within the stream in case an error has to be signaled." + (declare (ignore rest)) + `(let ((*syntax-error-location* (make-syntax-error-location + :line *current-line* + :col *current-column* + :stream *standard-input*))) + ,@body)) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/html-template.asd b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/html-template.asd new file mode 100644 index 0000000..0134de0 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/html-template.asd @@ -0,0 +1,38 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/html-template.asd,v 1.16 2015-05-21 20:59:59 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(asdf:defsystem :html-template + :version "0.9.2" + :serial t + :components ((:file "packages") + (:file "specials") + (:file "errors") + (:file "util") + (:file "template") + (:file "api"))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/html-template.system b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/html-template.system new file mode 100644 index 0000000..979efe9 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/html-template.system @@ -0,0 +1,44 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/html-template.system,v 1.5 2007-01-01 23:49:16 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:cl-user) + +(defparameter *html-template-base-directory* + (make-pathname :name nil :type nil :version nil + :defaults (parse-namestring *load-truename*))) + +(mk:defsystem #:html-template + :source-pathname *html-template-base-directory* + :source-extension "lisp" + :components ((:file "packages") + (:file "specials" :depends-on ("packages")) + (:file "errors" :depends-on ("specials")) + (:file "util" :depends-on ("errors")) + (:file "template" :depends-on ("util")) + (:file "api" :depends-on ("template")))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/load.lisp b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/load.lisp new file mode 100644 index 0000000..f315dbf --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/load.lisp @@ -0,0 +1,54 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/load.lisp,v 1.7 2007-01-01 23:49:16 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:cl-user) + +(let ((html-template-base-directory + (make-pathname :name nil :type nil :version nil + :defaults (parse-namestring *load-truename*))) + must-compile) + (with-compilation-unit () + (loop for file in '("packages" + "specials" + "errors" + "util" + "template" + "api") + do (let ((pathname (make-pathname :name file :type "lisp" :version nil + :defaults html-template-base-directory))) + #-:cormanlisp + (let ((compiled-pathname (compile-file-pathname pathname))) + (unless (and (not must-compile) + (probe-file compiled-pathname) + (< (file-write-date pathname) + (file-write-date compiled-pathname))) + (setq must-compile t) + (compile-file pathname)) + (setq pathname compiled-pathname)) + (load pathname))))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/packages.lisp b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/packages.lisp new file mode 100644 index 0000000..c3a4a54 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/packages.lisp @@ -0,0 +1,72 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/packages.lisp,v 1.19 2007-01-01 23:49:16 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package :cl-user) + +(defpackage :html-template + (:nicknames :template) + (:use :cl) + (:export :*call-template-access-function* + :*call-values-access-function* + :*convert-nil-to-empty-string* + :*default-template-output* + :*default-template-pathname* + :*escape-char-p* + :*force-default* + :*format-non-strings* + :*ignore-empty-lines* + :*no-cache-check* + :*sequences-are-lists* + :*string-modifier* + :*template-end-marker* + :*template-start-marker* + :*template-symbol-package* + :*upcase-attribute-strings* + :*value-access-function* + :*warn-on-creation* + :clear-template-cache + :create-template-printer + :delete-from-template-cache + :escape-string + :escape-string-all + :escape-string-iso-8859-1 + :escape-string-minimal + :escape-string-minimal-plus-quotes + :fill-and-print-template + :template-error + :template-invocation-error + :template-missing-value-error + :template-not-a-string-error + :template-not-a-string-error-value + :template-syntax-error + :template-syntax-error-col + :template-syntax-error-line + :template-syntax-error-stream)) + +(pushnew :html-template *features*) \ No newline at end of file diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/specials.lisp b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/specials.lisp new file mode 100644 index 0000000..1422d77 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/specials.lisp @@ -0,0 +1,151 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/specials.lisp,v 1.24 2007-03-09 13:09:16 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:html-template) + +(defvar *find-string-hash* (make-hash-table :test #'equal) + "Hash tables used internally by READ-UNTIL to cache offset arrays.") + +(defvar *template-start-marker* "" + "The string template tags must end with") + +(defvar *printer-hash* (make-hash-table :test #'equal) + "The cache for template printers. +Each entry is of the form (PRINTER . WRITE-DATE).") + +(defvar *default-template-pathname* (make-pathname) + "Each pathname is merged with this value before it is used by +CREATE-TEMPLATE-PRINTER.") + +(defvar *default-template-output* *standard-output* + "The output stream used by FILL-AND-PRINT-TEMPLATE when no STREAM +keyword was provided.") + +(defvar *template-output* nil + "The output stream that's used internally.") + +(defvar *convert-nil-to-empty-string* t + "Controls whether NIL values should resolve to empty strings or +raise an error.") + +(defvar *format-non-strings* t + "Controls whether TMPL_VAR will accept values which aren't +strings and convert them using \(FORMAT NIL \"~A\" ...).") + +(defvar *sequences-are-lists* t + "Controls whether TMPL_LOOP printers expect lists or vectors.") + +(defvar *upcase-attribute-strings* t + "Controls whether attribute strings associated with template tags +are upcased before they are interned.") + +(defvar *no-cache-check* nil + "Controls whether the FILE-WRITE-DATE check will be circumvented +when using FILL-AND-PRINT-TEMPLATE.") + +(defvar *template-symbol-package* (find-package '#:keyword) + "The package symbols are interned into.") + +(defvar *ignore-empty-lines* nil + "Controls whether template tags on their own lines produce empty +lines or not.") + +(defvar *warn-on-creation* t + "Controls whether a warning should be signaled if a new template +printer is created from a pathname argument.") + +(defvar *current-line* 1 + "Internal line counter of the parser.") +(defvar *current-column* 0 + "Internal column counter of the parser.") + +(defvar *included-files* nil + "Internally used by CREATE-TEMPLATE-PRINTER-AUX to avoid infinite +TMPL_INCLUDE loops.") + +(defvar *external-format* :default + "The external format used when opening files.") + +(defvar *value-access-function* + (lambda (symbol values &optional in-loop-p) + (let ((result (getf values symbol))) + (cond ((and in-loop-p *sequences-are-lists*) + (loop for element in result + when (and element (listp element)) + ;; keep values from upper levels + collect (append element values) + else + collect element)) + (t result)))) + "The function which associates \(attribute) symbols with their +values.") + +(defvar *call-template-access-function* #'car + "Accessor function for extracting the called template from a +TMPL_CALL form.") + +(defvar *call-value-access-function* #'cdr + "Accessor function for extracting the values from a TMPL_CALL +form.") + +(defvar *force-default* nil + "The default value for the FORCE keyword argument to +CREATE-TEMPLATE-PRINTER.") + +(defvar *string-modifier* 'escape-string-iso-8859-1 + "The function which is applied to strings which replace +TMPL_VAR tags. Use #'CL:IDENTITY if you don't want to change the +strings.") + +(defparameter *escape-char-p* + #'(lambda (char) + (or (find char "<>&'\"") + (> (char-code char) 127))) + "Used by ESCAPE-STRING to test whether a character should be escaped.") + +;; stuff for Nikodemus Siivola's HYPERDOC +;; see +;; and +;; also used by LW-ADD-ONS + +(defvar *hyperdoc-base-uri* "http://weitz.de/html-template/") + +(let ((exported-symbols-alist + (loop for symbol being the external-symbols of :html-template + collect (cons symbol + (concatenate 'string + "#" + (string-downcase symbol)))))) + (defun hyperdoc-lookup (symbol type) + (declare (ignore type)) + (cdr (assoc symbol + exported-symbols-alist + :test #'eq)))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/template.lisp b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/template.lisp new file mode 100644 index 0000000..dd58aa8 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/template.lisp @@ -0,0 +1,474 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/template.lisp,v 1.24 2007-01-01 23:49:16 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:html-template) + +(defmacro with-use-value-restart ((symbol) error-form) + "Provide a USE-VALUE restart for ERROR-FORM in case the value +associated with SYMBOL isn't to our liking." + `(restart-case + ,error-form + (use-value (other-value) + :report (lambda (stream) + (format stream + "Use another value for symbol ~S: " + ,symbol)) + :interactive (lambda () + (format t + "Enter another value for symbol ~S: " + ,symbol) + (multiple-value-list (eval (read)))) + other-value))) + +;; indentation for LispWorks editor +#+:lispworks +(editor:setup-indent "with-use-value-restart" 1 2 4) + +(defun create-simple-printer (string-list &optional (next-fn #'no-values)) + "Used internally to create template printers for strings which don't +include template tags. NEXT-FN is the next function to be called in +the chain of closures. STRING-LIST is a list of strings in reverse +order to be printed first." + (let ((string (list-to-string string-list))) + (lambda (values) + (write-string string *template-output*) + (funcall next-fn values)))) + +(defun create-var-printer (string-list symbol next-fn) + "Used internally to create template printers for TMPL_VAR. SYMBOL is +the symbol associated with the tag. NEXT-FN is the next function to be +called in the chain of closures. STRING-LIST is a list of strings in +reverse order to be printed first." + (let ((string (list-to-string string-list))) + (lambda (values) + (write-string string *template-output*) + (let* ((value (funcall *value-access-function* symbol values)) + (string (typecase value + (null + (if *convert-nil-to-empty-string* + "" + (with-use-value-restart (symbol) + (signal-template-missing-value-error + "Value for symbol ~S is NIL" + symbol)))) + (string value) + (otherwise + (cond (*format-non-strings* (format nil "~A" value)) + (t (with-use-value-restart (symbol) + (error 'template-not-a-string-error + :value value + :format-control "Value ~S for symbol ~S is not a string" + :format-arguments (list value symbol))))))))) + (write-string (funcall *string-modifier* string) *template-output*)) + (funcall next-fn values)))) + +(defun create-include-printer (string-list pathname next-fn) + "Used internally to create template printers for TMPL_INCLUDE. +PATHNAME is the pathname associated with the tag. NEXT-FN is the next +function to be called in the chain of closures. STRING-LIST is a list +of strings in reverse order to be printed first." + (let ((string (list-to-string string-list))) + (lambda (values) + (write-string string *template-output*) + (funcall (car (gethash pathname *printer-hash*)) values) + (funcall next-fn values)))) + +(defun create-if-printer (string-list symbol if-fn else-fn next-fn unlessp) + "Used internally to create template printers for TMPL_IF and +TMPL_UNLESS tags. SYMBOL is the symbol associated with the tag. IF-FN +is the printer for the IF branch, ELSE-FN is the printer for the ELSE +branch. NEXT-FN is the next function to be called in the chain of +closures. STRING-LIST is a list of strings in reverse order to be +printed first. If UNLESSP is true, IF-FN and ELSE-FN are switched." + (let ((string (list-to-string string-list))) + (when unlessp + (rotatef if-fn else-fn)) + (lambda (values) + (write-string string *template-output*) + (if (funcall *value-access-function* symbol values) + (funcall if-fn values) + (funcall else-fn values)) + (funcall next-fn values)))) + +(defun create-loop-printer (string-list symbol body-fn next-fn) + "Used internally to create template printers for TMPL_LOOP +tags. SYMBOL is the symbol associated with the tag. BODY-FN is the +template printer for the body of the loop. NEXT-FN is the next +function to be called in the chain of closures. STRING-LIST is a list +of strings in reverse order to be printed first." + (let ((string (list-to-string string-list))) + (cond (*sequences-are-lists* + (lambda (values) + (write-string string *template-output*) + (dolist (value (funcall *value-access-function* + symbol values t)) + (funcall body-fn value)) + (funcall next-fn values))) + (t + (lambda (values) + (write-string string *template-output*) + (loop for value across (funcall *value-access-function* + symbol values t) + do (funcall body-fn value)) + (funcall next-fn values)))))) + +(defun create-repeat-printer (string-list symbol body-fn next-fn) + "Used internally to create template printers for TMPL_REPEAT +tags. SYMBOL is the symbol associated with the tag. BODY-FN is the +template printer for the body of the loop. NEXT-FN is the next +function to be called in the chain of closures. STRING-LIST is a list +of strings in reverse order to be printed first." + (let ((string (list-to-string string-list))) + (lambda (values) + (write-string string *template-output*) + (let ((factor (funcall *value-access-function* symbol values))) + (when (and (integerp factor) (plusp factor)) + (loop repeat factor + do (funcall body-fn values)))) + (funcall next-fn values)))) + +(defun create-call-printer (string-list symbol next-fn) + "Used internally to create template printers for TMPL_CALL tags. +SYMBOL is the symbol associated with the tag. BODY-FN is the template +printer for the body of the loop. NEXT-FN is the next function to be +called in the chain of closures. STRING-LIST is a list of strings in +reverse order to be printed first." + (let ((string (list-to-string string-list))) + (cond (*sequences-are-lists* + (lambda (values) + (write-string string *template-output*) + (dolist (call (funcall *value-access-function* + symbol values t)) + (fill-and-print-template + (funcall *call-template-access-function* call) + (funcall *call-value-access-function* call) + :stream *template-output*)) + (funcall next-fn values))) + (t + (lambda (values) + (write-string string *template-output*) + (loop for call across (funcall *value-access-function* + symbol values t) + do (fill-and-print-template + (funcall *call-template-access-function* call) + (funcall *call-value-access-function* call) + :stream *template-output*)) + (funcall next-fn values)))))) + +(defun create-template-printer-aux (string-stack end-token) + "Reads from *STANDARD-INPUT* and returns a template printer from +what it reads. When this function is entered the stream pointer must +not be inside a template tag. STRING-STACK is a list of strings (in +reverse order) read so far which haven't been used to build a template +printer. END-TOKEN is either NIL or one of :LOOP, :REPEAT, :IF, +:IF-ELSE, or :UNLESS-ELSE denoting that we expect certain tags to +close open TMPL_LOOP, TMPL_REPEAT, TMPL_IF, or TMPL_UNLESS tags. This +function returns a second value which is true if, after reading +TMPL_IF or TMPL_UNLESS, a corresponding TMPL_ELSE was seen." + (let* ((string + ;; read text up to the next template start marker + (read-until *template-start-marker* + ;; don't skip it, return it + :skip nil + :eof-action (lambda (collector) + (when end-token + ;; make sure we don't accept + ;; EOF if there are still tags + ;; waiting to be closed + (signal-template-syntax-error + "Unexpected EOF, ~A tag is missing" + (case end-token + ((:loop) "") + ((:repeat) "") + ((:if :if-else) "") + ((:unless :unless-else) "")))) + ;; otherwise (EOF before another + ;; start marker was seen) just + ;; return a template printer + ;; which unconditionally prints + ;; the rest of the stream + (return-from create-template-printer-aux + (create-simple-printer + (cons collector string-stack)))))) + (whitespace + ;; skip whitespace but keep it in case this turns out not + ;; to be a template tag + (skip-whitespace :skip nil)) + (token + ;; read what could be a template token's name + (with-syntax-error-location () + (read-while (lambda (c) + (or (alpha-char-p c) + (char= c #\_) + (char= c #\/))) + :skip nil + :eof-action (lambda (collector) + (declare (ignore collector)) + ;; complain about tags which + ;; haven't been closed + (signal-template-syntax-error + "EOF while inside of tag starting with ~S" + *template-start-marker*)))))) + (cond ((string-equal token "TMPL_INCLUDE") + ;; TMPL_INCLUDE tag - first read the pathname which has to + ;; follow and merge it with *DEFAULT-TEMPLATE-PATHNAME* + (let* ((pathname (read-tag-rest :read-attribute t :intern nil)) + (merged-pathname + (merge-pathnames pathname + *default-template-pathname*))) + (when (member merged-pathname *included-files* + :test #'equal) + ;; raise an error if this file has been included + ;; before - infinite recursion ahead! + (with-syntax-error-location () + (signal-template-syntax-error + "Infinite recursion - file ~S includes itself" + merged-pathname))) + ;; otherwise create (and cache) a template printer + (create-template-printer merged-pathname) + (multiple-value-bind (next-fn else-follows) + ;; first we recursively create the template printer + ;; for the rest of the stream + (create-template-printer-aux (skip-trailing-whitespace) + end-token) + ;; then we combine it with the strings before the tag + ;; to create a template printer for TMPL_INCLUDE + (values + (create-include-printer (cons (skip-leading-whitespace string) + string-stack) + merged-pathname + next-fn) + else-follows)))) + ((string-equal token "TMPL_VAR") + ;; TMPL_VAR tag - first read the symbol which has to + ;; follow and intern it + (let ((symbol (read-tag-rest :read-attribute t))) + (multiple-value-bind (next-fn else-follows) + ;; first we recursively create the template printer + ;; for the rest of the stream + (create-template-printer-aux nil end-token) + (values + ;; then we combine it with the strings before the tag + ;; to create a template printer for TMPL_VAR - note + ;; that we don't skip leading and trailing whitespace + ;; here + (create-var-printer (cons string string-stack) + symbol + next-fn) + else-follows)))) + ((or (string-equal token "TMPL_LOOP") + (string-equal token "TMPL_REPEAT")) + ;; TMPL_LOOP or TMPL_REPEAT tag - first read the symbol + ;; which has to follow and intern it + (let* ((kind (if (string-equal token "TMPL_LOOP") :loop :repeat)) + (symbol (read-tag-rest :read-attribute t)) + ;; then read the stream up to the corresponding + ;; end tag and create a template printer for the + ;; loop body + (body-fn (with-syntax-error-location () + (create-template-printer-aux + (skip-trailing-whitespace) + ;; this argument denotes that we expect + ;; to see /TMPL_LOOP or /TMPL_REPEAT and + ;; want to stop there + kind)))) + (multiple-value-bind (next-fn else-follows) + ;; now we recursively create the template printer + ;; for the rest of the stream + (create-template-printer-aux (skip-trailing-whitespace) + end-token) + (values + ;; then we combine it with the strings before the tag + ;; and the body printer to create a template printer + ;; for TMPL_LOOP + (funcall (case kind + (:loop #'create-loop-printer) + (:repeat #'create-repeat-printer)) + (cons (skip-leading-whitespace string) + string-stack) + symbol + body-fn + next-fn) + else-follows)))) + ((string-equal token "TMPL_CALL") + ;; TMPL_CALL tag - first read the symbol which has to + ;; follow and intern it + (let ((symbol (read-tag-rest :read-attribute t))) + (multiple-value-bind (next-fn else-follows) + ;; recursively create the template printer for the + ;; rest of the stream + (create-template-printer-aux (skip-trailing-whitespace) + end-token) + ;; create the printer that will output the strings + ;; before this tag and call the templates stored under + ;; SYMBOL + (values (funcall #'create-call-printer + (cons (skip-leading-whitespace string) + string-stack) + symbol + next-fn) + else-follows)))) + ((string-equal token "/TMPL_LOOP") + (unless (eq end-token :loop) + ;; check if we expected /TMPL_LOOP here, i.e. if an open + ;; TMPL_LOOP was pending + (with-syntax-error-location () + (signal-template-syntax-error "Unexpected /TMPL_LOOP"))) + ;; read the rest of the tag but ignore it - no attributes + ;; expected + (read-tag-rest) + ;; just create a simple template printer for strings - + ;; this is the end of some TMPL_LOOP body + (create-simple-printer (cons (skip-leading-whitespace string) + string-stack))) + ((string-equal token "/TMPL_REPEAT") + (unless (eq end-token :repeat) + ;; check if we expected /TMPL_REPEAT here, i.e. if an open + ;; TMPL_REPEAT was pending + (with-syntax-error-location () + (signal-template-syntax-error "Unexpected /TMPL_REPEAT"))) + ;; read the rest of the tag but ignore it - no attributes + ;; expected + (read-tag-rest) + ;; just create a simple template printer for strings - + ;; this is the end of some TMPL_REPEAT body + (create-simple-printer (cons (skip-leading-whitespace string) + string-stack))) + ((or (string-equal token "TMPL_IF") + (string-equal token "TMPL_UNLESS")) + ;; TMPL_IF or TMPL_UNLESS tag - first read the symbol + ;; which has to follow and intern it + (let ((symbol (read-tag-rest :read-attribute t)) + (unlessp (string-equal token "TMPL_UNLESS"))) + (multiple-value-bind (if-fn else-follows) + (with-syntax-error-location () + ;; then read the stream up to the corresponding + ;; TMPL_ELSE, /TMPL_IF, or /TMPL_UNLESS and create + ;; a template printer for the "if" (or "unless") part + (create-template-printer-aux + (skip-trailing-whitespace) + ;; this argument denotes that we expect to see + ;; TMPL_ELSE _or_ one of /TMPL_IF, /TMPL_UNLESS and, + ;; in the second case, want to stop there + (if unlessp :unless-else :if-else))) + (let ((else-fn (if else-follows + ;; if we encountered TMPL_ELSE read + ;; the stream up to the corresponding + ;; /TMPL_IF or /TMPL_UNLESS and + ;; create a template printer for the "else" part + (with-syntax-error-location () + (create-template-printer-aux + (skip-trailing-whitespace) + ;; this argument denotes that we + ;; expect to see /TMPL_IF or /TMPL_UNLESS + ;; (but not TMPL_ELSE) and want to stop + ;; there + (if unlessp :unless :if))) + ;; use a dummy printer for the "else" + ;; part if we didn't see TMPL_ELSE + #'no-values))) + (multiple-value-bind (next-fn else-follows) + ;; now we recursively create the template printer + ;; for the rest of the stream + (create-template-printer-aux (skip-trailing-whitespace) + end-token) + (values + ;; then we combine it with the strings before the + ;; tag and the "if" and "else" parts to create a + ;; template printer for TMPL_IF or TMPL_UNLESS + (create-if-printer (cons (skip-leading-whitespace string) + string-stack) + symbol + if-fn + else-fn + next-fn + unlessp) + else-follows)))))) + ((string-equal token "TMPL_ELSE") + (unless (member end-token '(:if-else :unless-else)) + ;; check if we expected /TMPL_ELSE here, i.e. if an open + ;; TMPL_IF or TMPL_UNLESS was pending and we haven't + ;; seen TMPL_ELSE before + (with-syntax-error-location () + (signal-template-syntax-error "Unexpected TMPL_ELSE"))) + ;; read the rest of the tag but ignore it - no attributes + ;; expected + (read-tag-rest) + ;; just create a simple template printer for strings - + ;; this is the end of some "if" part + (values + (create-simple-printer (cons (skip-leading-whitespace string) + string-stack)) + ;; return a true second value to denote that we've seen + ;; TMPL_ELSE + t)) + ((string-equal token "/TMPL_IF") + (unless (or (eq end-token :if) (eq end-token :if-else)) + ;; check if we expected /TMPL_IF here, i.e. if an open + ;; TMPL_IF was pending + (with-syntax-error-location () + (signal-template-syntax-error "Unexpected /TMPL_IF"))) + ;; read the rest of the tag but ignore it - no attributes + ;; expected + (read-tag-rest) + ;; just create a simple template printer for strings - + ;; this is the end of some "if" or "else" part + (create-simple-printer (cons (skip-leading-whitespace string) + string-stack))) + ((string-equal token "/TMPL_UNLESS") + (unless (or (eq end-token :unless) (eq end-token :unless-else)) + ;; check if we expected /TMPL_UNLESS here, i.e. if an open + ;; TMPL_UNLESS was pending + (with-syntax-error-location () + (signal-template-syntax-error "Unexpected /TMPL_UNLESS"))) + ;; read the rest of the tag but ignore it - no attributes + ;; expected + (read-tag-rest) + ;; just create a simple template printer for strings - + ;; this is the end of some "unless" or "else" part + (create-simple-printer (cons (skip-leading-whitespace string) + string-stack))) + (t + ;; we couldn't identify a valid tag, so we treat + ;; everything we've read so far as a literal string and + ;; carry on - if we're lucky our CL implementation will + ;; optimize this tail call into an iterative loop + (create-template-printer-aux + (cons token + (cons whitespace + (cons *template-start-marker* + (cons string string-stack)))) + end-token))))) + +(defun %create-template-printer-aux (&rest args) + "Wrapper for CREATE-TEMPLATE-PRINTER-AUX to initialize +*CURRENT-COLUMN* and *CURRENT-LINE*." + (let ((*current-column* 0) + (*current-line* 1)) + (apply #'create-template-printer-aux args))) \ No newline at end of file diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/test.lisp b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/test.lisp new file mode 100644 index 0000000..4389c30 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/test.lisp @@ -0,0 +1,291 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE-TEST; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/test.lisp,v 1.13 2007-01-01 23:49:16 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:cl-user) + +#-:cormanlisp +(defpackage #:html-template-test + (:use #:cl #:html-template)) + +#+:cormanlisp +(defpackage "HTML-TEMPLATE-TEST" + (:use "CL" "HTML-TEMPLATE")) + +(in-package #:html-template-test) + +(format t "~&Please wait a couple of seconds.") +(force-output) + +(defvar tmp-dir #p"/tmp/") + +(defmacro failedp (&body body) + `(handler-case + (progn ,@body nil) + (condition () t))) + +(defmacro warnedp (&body body) + `(handler-case + (progn ,@body nil) + (warning () t))) + +(defmacro test (result &rest args) + (cond (result + `(assert (string= ,result + (with-output-to-string (*default-template-output*) + (fill-and-print-template ,@args))))) + (`(assert (failedp (fill-and-print-template ,@args)))))) + +(test "abc" "" '(:foo "abc")) +(test "abc" "" '(:foo "abc")) +(test "" "" '(:foo "abc")) +(test "xabcy" "xy" '(:foo "abc")) +(test "" "" nil) +(test "" "" '(foo "abc")) +(test "" "" '(:bar "abc")) +(test "abc" "" '(:foo "abc")) +(test "abc" "" '(:foo "abc")) +(test nil "" '(:foo "abc")) +(test "" "abc" nil) +(test "" "abc" '(:foo nil)) +(test "abc" "abc" '(:foo t)) +(test "abc" "abc" '(:foo t :bar 42)) +(test nil "abc" nil) +(test nil "abc" nil) +(test "def" "abcdef" nil) +(test nil "abcdef" nil) +(test "def" "abcdef" '(:foo nil)) +(test "abc" "abcdef" '(:foo t)) +(test "abc" "abcdef" '(:foo nil)) +(test "def" "abcdef" '(:foo t)) +(test nil "abcdef" '(:foo t)) +(test "abc" "def" '(:foo "abc")) +(test "def" "def" '(:foo nil)) +(test "abcabcabc" "abcdef" '(:foo "abc")) +(test "defdefdef" "abcdef" '(:bar "def")) +(test "[]" "[[x]]" '(:foo nil)) +(test "[xxx]" "[x]" '(:foo 3)) +(test "[]" "[x]" '(:foo 0)) +(test "[]" "[x]" '(:foo "foo")) +(test nil "[x]" '(:foo 3)) +(test nil "[x]" '(:foo 3)) +(test "[[x][x][x]]" "[[x]]" '(:foo (1 2 3))) +(test "[[1][2][3]]" "[[]]" '(:foo ((:bar "1") (:bar "2") (:bar "3")))) +(test "[[][][]]" "[[]]" '(:foo (() () ()))) +(test "[[1][2][3]]" "[[]]" '(:foo ((:bar "1") (:bar "2") (:bar "3")))) +(test "[[1][][3]]" "[[]]" '(:foo ((:bar "1") () (:bar "3")))) +(test "[[1][2][3]]" "[[2]]" '(:foo ((:bar "1") () (:bar "3")))) +(test "[[123][456][789]]" "[[]]" '(:foo ((:bar ((:bar "1") (:bar "2") (:bar "3"))) + (:bar ((:bar "4") (:bar "5") (:bar "6"))) + (:bar ((:bar "7") (:bar "8") (:bar "9")))))) +(test "[[123][baz][789]]" "[[baz]]" '(:foo ((:baz ((:bar "1") (:bar "2") (:bar "3"))) + () + (:baz ((:bar "7") (:bar "8") (:bar "9")))))) +(test nil "" nil) +(test "" "" nil) +(test nil "" nil) +(test nil "" nil) +(test nil "" nil) +(test nil "" nil) +(test nil "" nil) +(test nil "" nil) +(test nil "" nil) +(test nil "" nil) +(test nil "1234" nil) +(test "1" "1234" '(:foo t :bar t)) +(test "2" "1234" '(:foo t :bar nil)) +(test "3" "1234" '(:foo nil :baz t)) +(test "4" "1234" '(:foo nil :baz nil)) +(test "X" "" '(:foo (("X")))) +(test "QUUX" "" '(:baz "Q" + :foo (("" :bar "U") + ("X" :bar "U")))) +(test "" "" '(:foo (("---")))) +(test nil "" '(:foo 57)) + +(let ((temp-name (make-pathname :name (format nil "template-test-~A" (random 1000000)) + :defaults tmp-dir))) + (with-open-file (stream temp-name :direction :output :if-exists :error) + (write-string "" stream)) + (let ((*warn-on-creation* nil)) + (test "abc" temp-name '(:foo "abc"))) + (with-open-file (stream temp-name :direction :input) + (test "def" stream '(:foo "def"))) + (with-open-file (stream temp-name :direction :input) + (let ((tp (create-template-printer stream))) + (test "ghi" tp '(:foo "ghi")))) + (let ((tp (create-template-printer temp-name))) + (test "jkl" tp '(:foo "jkl"))) + (let ((tp (create-template-printer ""))) + (test "mno" tp '(:foo "mno"))) + (delete-file temp-name) + ;; sleep because of FILE-WRITE-DATE + (sleep 2) + (with-open-file (stream temp-name :direction :output :if-exists :error) + (write-string "" stream)) + (assert (warnedp (create-template-printer temp-name))) + (assert (not (warnedp (create-template-printer temp-name)))) + (assert (warnedp (create-template-printer temp-name :force t))) + (delete-from-template-cache temp-name) + (assert (warnedp (create-template-printer temp-name))) + (clear-template-cache) + (assert (warnedp (create-template-printer temp-name))) + (delete-file temp-name)) + +(let ((*template-start-marker* "<") + (*template-end-marker* ">")) + (test "The quick fox" "The fox" + '(:speed "quick"))) + +(let* ((random-string (format nil "template-test-~A" (random 1000000))) + (temp-name (merge-pathnames random-string tmp-dir)) + (*default-template-pathname* tmp-dir)) + (with-open-file (stream temp-name :direction :output :if-exists :error) + (write-string "The brown fox" stream)) + (let ((*warn-on-creation* nil)) + (test "The very fast brown fox" + (make-pathname :name random-string) + '(:speed "very fast"))) + (delete-file temp-name) + ;; sleep because of FILE-WRITE-DATE + (sleep 2) + (with-open-file (stream temp-name :direction :output :if-exists :error) + (write-string "The brown fox" stream)) + (let ((*warn-on-creation* nil)) + (test "The very fast brown fox" + (format nil "" random-string) + '(:speed "very fast"))) + (delete-file temp-name)) + +(let* ((random-string (format nil "template-test-~A" (random 1000000))) + (temp-name (merge-pathnames random-string tmp-dir)) + (random-string-2 (format nil "template-test-2-~A" (random 1000000))) + (temp-name-2 (merge-pathnames random-string-2 tmp-dir)) + (*default-template-pathname* tmp-dir)) + (with-open-file (stream temp-name :direction :output :if-exists :error) + (format stream "" random-string-2)) + (with-open-file (stream temp-name-2 :direction :output :if-exists :error) + (format stream "" random-string)) + (test nil (format nil "" random-string) nil) + (delete-file temp-name) + (delete-file temp-name-2)) + +(assert (string= "The slow brown fox" + (with-output-to-string (stream) + (let ((*default-template-output* stream)) + (fill-and-print-template "The brown fox" + '(:speed "slow")))))) + +(let* ((tp (create-template-printer "The brown fox")) + (*convert-nil-to-empty-string* nil)) + (with-output-to-string (*default-template-output*) + (test nil tp '(:foo "bar")))) + +(let ((tp (create-template-printer "The brown fox"))) + (handler-bind + ((template-missing-value-error (lambda (condition) + (declare (ignore condition)) + (use-value "slow")))) + (let ((*convert-nil-to-empty-string* nil)) + (test "The slow brown fox" tp '(:foo "bar"))))) + +(let ((*sequences-are-lists* nil)) + (test "[1][2][3]" + "[]" + '(:vector #((:item "1") + (:item "2") + (:item "3")))) + (test "QUUX" "" + '(:baz "Q" + :foo #(("" :bar "U") + ("X" :bar "U"))))) + +(let ((*upcase-attribute-strings* nil)) + (test "The slow brown fox" + "The brown fox" + '(:speed "quick" :|speed| "slow"))) + +(let ((*template-symbol-package* *package*)) + (test "The slow brown fox" + "The brown fox" + '(:speed "quick" speed "slow"))) + +(let ((tp (create-template-printer "The brown fox")) + (*value-access-function* #'gethash) + (hash (make-hash-table :test #'eq))) + (setf (gethash :speed hash) "fast") + (test "The fast brown fox" tp hash)) + +(let ((values (list :row-loop + (loop for row in '((1 2 3 4) (2 3 4 5) (3 4 5 6)) + collect (list :col-loop + (loop for col in row + collect (list :item + (format nil "~A" col))))))) + (template " + + + + + + + +
") + (result " + + + + + + + + + + + + + + + + + + +
1234
2345
3456
") + (*ignore-empty-lines* t)) + (test result template values)) + +(let ((tp (create-template-printer "A square has corners")) + (*format-non-strings* nil)) + (handler-bind + ((template-not-a-string-error (lambda (condition) + (use-value + (format nil "~R" + (template-not-a-string-error-value condition)))))) + (test "A square has four corners" tp '(:number 4)))) + +(format t "~&All tests passed...") \ No newline at end of file diff --git a/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/util.lisp b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/util.lisp new file mode 100644 index 0000000..c4ad4c9 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/html-template-20171227-git/util.lisp @@ -0,0 +1,342 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/html-template/util.lisp,v 1.21 2015-05-21 20:59:59 edi Exp $ + +;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. 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. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; 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 AUTHOR 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. + +(in-package #:html-template) + +(defun no-values (&rest rest) + "A function which does not return any values. This is always the +last function in a chain of template printer closures." + (declare (ignore rest)) + (values)) + +(defun list-to-string (string-list) + "Concatenates a list of strings to one string in reverse order. The +list is destructively modified." + ;; note that we can't use APPLY with CONCATENATE here because of + ;; CALL-ARGUMENTS-LIMIT + (let ((total-size 0)) + (dolist (string string-list) + (incf total-size (length string))) + (let ((result-string (make-string total-size + #+:lispworks #+:lispworks + :element-type 'lw:simple-char)) + (curr-pos 0)) + (dolist (string (nreverse string-list)) + (replace result-string string :start1 curr-pos) + (incf curr-pos (length string))) + result-string))) + +(defun %read-char () + "Like READ-CHAR but updates the line and column counters." + (let ((char (read-char))) + (cond ((char= char #\Newline) + (setf *current-column* 0) + (incf *current-line*)) + (t (incf *current-column*))) + char)) + +(defmacro whitespacep (char) + "Checks whether CHAR is whitespace." + `(find ,char + '(#\Space #\Tab #\Newline #\Linefeed #\Return #\Page))) + +(defun read-while (predicate &key (skip t) (eof-action t)) + "Reads characters from *STANDARD-INPUT* while PREDICATE returns a +true value for each character. Returns the string which was read +unless SKIP is true. On reading EOF an error is signaled if +EOF-ACTION is T, NIL is silently returned if EOF-ACTION is NIL, or the +function EOF-ACTION is called with one argument - the string read so +far." + (let ((collector (or skip + (make-array 0 + :element-type 'character + :fill-pointer t + :adjustable t)))) + (handler-case + (loop for c = (peek-char) + while (funcall predicate c) + do (cond (skip (%read-char)) + (t (vector-push-extend (%read-char) collector))) + finally (return collector)) + (end-of-file () + (cond ((eq eof-action t) + (signal-template-syntax-error "Unexpected EOF")) + ((null eof-action) + nil) + (t (funcall eof-action collector))))))) + +(defun read-delimited-string (&key (eof-action t)) + "Reads and returns a string from *STANDARD-INPUT*. The string is +either delimited by ' or \" in which case the delimiters aren't +returned or it is assumed to extend to the next whitespace +character. See READ-WHILE's docstring for EOF-ACTION." + (handler-case + (let* ((peek-char (peek-char)) + (delimiter (find peek-char '(#\' #\")))) + (when delimiter + (%read-char)) + (prog1 + (read-while (if delimiter + (lambda (c) (char/= c delimiter)) + (lambda (c) (not (whitespacep c)))) + :skip nil + :eof-action eof-action) + (when delimiter + (%read-char)))) + (end-of-file () + (cond ((eq eof-action t) + (signal-template-syntax-error + "Unexpected EOF while reading (delimited) string")) + ((null eof-action) + nil) + (t (funcall eof-action "")))))) + +(defun skip-whitespace (&key assert (skip t) (eof-action t)) + "Read characters from *STANDARD-INPUT* as long as they are +whitespace. Signals an error if the first character read isn't +whitespace and ASSERT is true. Return the string which was read unless +SKIP is true. See READ-WHILE's docstring for EOF-ACTION." + (handler-case + (progn + (when assert + (with-syntax-error-location () + (unless (whitespacep (peek-char)) + (signal-template-syntax-error "Whitespace expected but read ~S" (peek-char))))) + (read-while (lambda (c) + (whitespacep c)) + :skip skip + :eof-action eof-action)) + (end-of-file () + (cond ((eq eof-action t) + (signal-template-syntax-error "EOF while skipping whitespace")) + ((null eof-action) + nil) + (t (funcall eof-action "")))))) + +(defun skip-trailing-whitespace () + "Reads and skips whitespace from *STANDARD-INPUT* until a #\Newline +characters is seen if *IGNORE-EMPTY-LINES* is true. If there is no +#\Newline before the first non-whitespace character the string read so +far is returned \(wrapped in a list)." + (cond (*ignore-empty-lines* + (let ((string (read-while (lambda (c) + (and (whitespacep c) + (char/= #\Newline c))) + :skip nil + :eof-action nil))) + (case (peek-char nil nil nil nil) + ((#\Newline) + nil) + (otherwise + (list string))))) + (t nil))) + +(defun read-until (string &key (skip t) (eof-action t)) + "Reads characters from *STANDARD-INPUT* up to and including STRING. +Returns the string which was read \(excluding STRING) unless SKIP is +true. See READ-WHILE's docstring for EOF-ACTION." + (let* ((length (length string)) + (offsets + ;; we first check whether some substring which starts + ;; STRING can be found again later in STRING - this is + ;; necessary because we only peek one character ahead + (cond ((gethash string *find-string-hash*)) + (t (setf (gethash string *find-string-hash*) + ;; the resulting array of offsets is + ;; cached in *FIND-STRING-HASH* so we can + ;; use it again in case READ-UNTIL is + ;; called with the same STRING argument + (loop with offsets = (make-array length + :initial-element nil) + for i from 1 below length + ;; check if STRING starting from 0 + ;; has something in common with + ;; STRING starting from I + for mismatch = (mismatch string string + :start1 i :test #'char=) + when (> mismatch i) + ;; if this is the case remember the + ;; length of the match plus the + ;; character which must follow in + ;; OFFSETS + do (push (cons (char string (- mismatch i)) + (1+ (- mismatch i))) + (svref offsets mismatch)) + finally (return offsets)))))) + (collector (or skip + (make-array 0 + :element-type 'character + :fill-pointer t + :adjustable t)))) + (handler-case + (loop for i = 0 then (cond (match (1+ i)) + ;; if there is an offset (see above) + ;; we don't have to start from the + ;; beginning of STRING + ((cdr (assoc c (svref offsets i)))) + (t 0)) + for c = (peek-char) + for match = (char= c (char string i)) + while (or (not match) + (< (1+ i) length)) + do (cond (skip (%read-char)) + (t (vector-push-extend (%read-char) collector))) + finally (%read-char) + (unless skip + ;; decrement the fill pointer because collector now also + ;; contains STRING itself + (decf (fill-pointer collector) (1- length))) + (return collector)) + (end-of-file () + (cond ((eq eof-action t) + (signal-template-syntax-error "Unexpected EOF")) + ((null eof-action) + nil) + (t (funcall eof-action collector))))))) + +(defun skip-leading-whitespace (string) + "Removes whitespace from the end of STRING up to and including a +#\Newline. If there is no #\Newline before the first non-whitespace +character is seen nothing is removed. STRING must have a fill +pointer." + (when *ignore-empty-lines* + (let ((old-fill-pointer (fill-pointer string))) + (loop for fill-pointer = (fill-pointer string) + for char = (and (plusp fill-pointer) + (char string (1- fill-pointer))) + while (and char + (whitespacep char) + (char/= #\Newline char)) + do (decf (fill-pointer string))) + (cond ((let ((fill-pointer (fill-pointer string))) + (and (plusp fill-pointer) + (char= #\Newline (char string (1- fill-pointer))))) + (decf (fill-pointer string))) + (t + (setf (fill-pointer string) + old-fill-pointer))))) + string) + +(defun read-tag-rest (&key read-attribute (intern t) (eof-action t)) + "Reads the rest of a template tag from *STANDARD-INPUT* after the +name of the tag has been read. Reads and returns the tag's attribute +if READ-ATTRIBUTE is true. Optionally also interns the attribute +string if INTERN is true. See READ-WHILE's docstring for EOF-ACTION." + (with-syntax-error-location () + (let (rest) + (handler-case + (let ((attribute (and read-attribute + (progn + (skip-whitespace :assert t) + (let ((string (with-syntax-error-location () + (read-delimited-string :eof-action + (lambda (collector) + (declare (ignore collector)) + (signal-template-syntax-error + "EOF while reading tag attribute")))))) + (if intern + (intern + (funcall (if *upcase-attribute-strings* + #'string-upcase + #'identity) + string) + *template-symbol-package*) + string)))))) + (skip-whitespace) + (setq rest (read-until *template-end-marker* + :skip nil + :eof-action eof-action)) + (when (plusp (length rest)) + (signal-template-syntax-error "Expected ~S but read ~S" + *template-end-marker* + rest)) + attribute) + (end-of-file () + (cond ((eq eof-action t) + (signal-template-syntax-error "Unexpected EOF")) + ((null eof-action) + nil) + (t (funcall eof-action rest)))))))) + +(defun escape-string (string &key (test *escape-char-p*)) + (declare (optimize speed)) + "Escape all characters in STRING which pass TEST. This function is +not guaranteed to return a fresh string. Note that you can pass NIL +for STRING which'll just be returned." + (let ((first-pos (position-if test string))) + (if (not first-pos) + ;; nothing to do, just return STRING + string + (with-output-to-string (s) + (loop with len = (length string) + for old-pos = 0 then (1+ pos) + for pos = first-pos + then (position-if test string :start old-pos) + ;; now the characters from OLD-POS to (excluding) POS + ;; don't have to be escaped while the next character has to + for char = (and pos (char string pos)) + while pos + do (write-sequence string s :start old-pos :end pos) + (case char + ((#\<) + (write-sequence "<" s)) + ((#\>) + (write-sequence ">" s)) + ((#\&) + (write-sequence "&" s)) + ((#\') + (write-sequence "'" s)) + ((#\") + (write-sequence """ s)) + (otherwise + (format s "&#~d;" (char-code char)))) + while (< (1+ pos) len) + finally (unless pos + (write-sequence string s :start old-pos))))))) + +(defun escape-string-minimal (string) + "Escape only #\<, #\>, and #\& in STRING." + (escape-string string :test #'(lambda (char) (find char "<>&")))) + +(defun escape-string-minimal-plus-quotes (string) + "Like ESCAPE-STRING-MINIMAL but also escapes quotes." + (escape-string string :test #'(lambda (char) (find char "<>&'\"")))) + +(defun escape-string-iso-8859-1 (string) + "Escapes all characters in STRING which aren't defined in ISO-8859-1." + (escape-string string :test #'(lambda (char) + (or (find char "<>&'\"") + (> (char-code char) 255))))) + +(defun escape-string-all (string) + "Escapes all characters in STRING which aren't in the 7-bit ASCII +character set." + (escape-string string :test #'(lambda (char) + (or (find char "<>&'\"") + (> (char-code char) 127))))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/.gitignore b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/.gitignore new file mode 100644 index 0000000..e4e5f6c --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/.gitignore @@ -0,0 +1 @@ +*~ \ No newline at end of file diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/LICENSE.txt b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/LICENSE.txt new file mode 100644 index 0000000..3263f84 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/LICENSE.txt @@ -0,0 +1,19 @@ +Copyright (c) 2010 Zachary Beane + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/README.txt b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/README.txt new file mode 100644 index 0000000..73031b0 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/README.txt @@ -0,0 +1,8 @@ +Quickproject creates the skeleton of a Common Lisp project. + +For full documentation, see doc/index.html. + +Quickproject is licensed under the MIT license; see LICENSE.txt for +details. + +For questions or comments, please email Zach Beane . diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/README.md b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/README.md new file mode 100644 index 0000000..97588dd --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/README.md @@ -0,0 +1,12 @@ +# (#| TMPL_VAR name |#) +### _(#| TMPL_VAR author |#)_ + +This is a project to do ... something. + +## License + +(#| TMPL_VAR license |#) +(#| TMPL_IF copyright |#) + +(#| TMPL_VAR copyright |#) +(#| /TMPL_IF |#) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/application.lisp b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/application.lisp new file mode 100644 index 0000000..564d244 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/application.lisp @@ -0,0 +1,5 @@ +;;;; (#| TMPL_VAR name |#).lisp(#| TMPL_IF copyright |#) +;; +;;;; (#| TMPL_VAR copyright |#)(#| /TMPL_IF |#) + +(in-package #:(#| TMPL_VAR name |#)) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/package.lisp b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/package.lisp new file mode 100644 index 0000000..ae60d64 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/package.lisp @@ -0,0 +1,6 @@ +;;;; package.lisp(#| TMPL_IF copyright |#) +;; +;;;; (#| TMPL_VAR copyright |#)(#| /TMPL_IF |#) + +(defpackage #:(#| TMPL_VAR name |#) + (:use #:cl)) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/system.asd b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/system.asd new file mode 100644 index 0000000..186db66 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/default-template/system.asd @@ -0,0 +1,13 @@ +;;;; (#| TMPL_VAR name |#).asd(#| TMPL_IF copyright |#) +;; +;;;; (#| TMPL_VAR copyright |#)(#| /TMPL_IF |#) + +(asdf:defsystem #:(#| TMPL_VAR name |#) + :description "Describe (#| TMPL_VAR name |#) here" + :author "(#| TMPL_VAR author |#)" + :license "(#| TMPL_VAR license |#)" + :version "0.0.1" + :serial t(#| TMPL_IF depends-on |#) + :depends-on (#| TMPL_VAR dependencies-string |#)(#| /TMPL_IF |#) + :components ((:file "package") + (:file "(#| TMPL_VAR name |#)"))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/LICENSE.txt b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/LICENSE.txt new file mode 100644 index 0000000..e5624cf --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/LICENSE.txt @@ -0,0 +1,19 @@ +Copyright (c) 2012 Zachary Beane + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/index.html b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/index.html new file mode 100644 index 0000000..296e844 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/index.html @@ -0,0 +1,265 @@ + + + + + Quickproject - create a Common Lisp project skeleton + + + +

+

Quickproject - create a Common Lisp project skeleton

+ +

Quickproject is a library for creating a Common Lisp project + skeleton. It is available under a BSD-style license; + see LICENSE.txt for details. + +The latest version is 1.4.1, released on December 26th, 2019. + + +

Download + shortcut: http://www.xach.com/lisp/quickproject.tgz + +

Contents

+ + + +

Overview

 + +

Quickproject provides a quick way to make a Common Lisp + project. After creating a project, it extends the ASDF registry so + the project may be immediately loaded. + +

Examples

+ +
+* (quickproject:make-project #p"~/src/myproject/" :depends-on '(drakma cxml))
+"myproject"
+
+* (asdf:load-system "myproject")
+load output
+
+ +
+* (quickproject:make-project #p"~/src/websnarf/" :name "cl-websnarf")
+"cl-websnarf"
+
+* (directory #p"~/src/websnarf/*.*")
+(#p"~/src/websnarf/README.txt"
+ #p"~/src/websnarf/package.lisp"
+ #p"~/src/websnarf/cl-websnarf.asd"
+ #p"~/src/websnarf/cl-websnarf.lisp")
+
+ +

Dictionary

 + +

The following symbols are exported from the quickproject + package. + +

+
[Function]
+
+ make-project + + pathname &key + depends-on + author + include-copyright + license + name + template-directory + template-parameters + + => project-name +
+ +
+

Create the skeleton of a Common Lisp project + in directory. If given, name is used as the + name of the project. Otherwise, the name is taken from the last + component in + the pathname-directory + of the pathname. For example, the last directory component + of #p"src/lisp/myproject/" is "myproject". +

The project skeleton consists of the following files: + +

    +
  • README.txt +
  • package.lisp — defines a package named after the project +
  • name.asd — defines an ASDF system named after + the project, with a :depends-on list as given in the + function call +
  • name.lisp +
+ +

If provided, author and license are used + to initialize certain parts of the default files with extra + information. The default values are taken + from *AUTHOR* + and *LICENSE*, respectively. + +

If provided, the boolean argument to include-copyright + will determine whether copyright notices will be printed in the + header of each file. + +

If provided, each file in template-directory is + rewritten + with HTML-TEMPLATE + into the new directory. The options are as follows: + +

    +
  • The template markers are (#| and |#) +
  • No escaping is done in template values +
  • Template parameters are created by + appending template-parameters with the lists returned by + calling each entry + in *TEMPLATE-PARAMETER-FUNCTIONS* +
+ +

After rewriting templates, each element + in *AFTER-MAKE-PROJECT-HOOKS* + is called. + +

After the project has been created, its pathname is added + to ASDF:*CENTRAL-REGISTRY*, so the project is immediately + loadable via ASDF:LOAD-SYSTEM. +

+
+ + +
+
[Special variable]
+
+ *author* +
+ +
+

This string is used to initialize the :author argument + in the project system definition. The default initial value + is "Your Name <your.name@example.com>". +

+
+ +
+
[Special variable]
+
+ *include-copyright* +
+ +
+

This variable is used to control whether a copyright notice (with + the author's name and the current year) should appear in the header + of each file.. +

+
+ +
+
[Special variable]
+
+ *license* +
+ +
+

This string is used to initialize the :description + argument in the project system definition. The default initial + value is "Specify license here". +

+
+ +
+
[Special variable]
+
+ *template-directory* +
+ +
+

If non-NIL, this variable should be bound to a pathname used as + the default value of template-directory + in MAKE-PROJECT. +

+
+ +
+
[Function]
+
+ default-template-parameters + + + => parameters +
+ +
+

Return a plist with values for :name, :license, + and :author for the current project being created + via MAKE-PROJECT. This + function is in the default value + of *TEMPLATE-PARAMETER-FUNCTIONS*. + +

+
+ + +
+
[Special variable]
+
+ *template-parameter-functions* +
+ +
+

A list of functions that are called to produce template + parameters when rewriting templates + in MAKE-PROJECT. Each + function is called with no arguments and should produce a list + of keyword/value pairs. The resulting lists are appended + together for use as template parameters + in HTML-TEMPLATE:FILL-AND-PRINT-TEMPLATE. + +

The default value is (default-template-parameters). +

+
+ + +
+
[Special variable]
+
+ *after-make-project-hooks* +
+ +
+

A list of designators for functions to be called after a + project has been created. Each function should accept one required + argument, the pathname given + to MAKE-PROJECT, and two + keyword arguments, :name and :depends-on, which + correspond to the name of the project (whether explicitly supplied + to MAKE-PROJECT or derived from the pathname) and the + :depends-on argument, + respectively. *default-pathname-defaults* is bound to the + newly created project pathname when hooks are called. +

+
+ + +

Feedback

 + +

For questions or comments about Quickproject, please email me, Zach + Beane <xach@xach.com>. + +

+


+ + diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/style.css b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/style.css new file mode 100644 index 0000000..71346c9 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/doc/style.css @@ -0,0 +1,83 @@ + +body { + margin-left: 4em; + font: medium/1.45em "Lucida Grande", "Trebuchet MS", "Bitstream Vera Sans", Verdana, Helvetica, sans-serif; + +} + +p.copyright { + font-size: 75%; + font-weight: bold; +} + +#content { + margin-left: 4em; + margin-right: 4em; + max-width: 50em; +} + +h2, h3 { + margin-bottom: 0em; + margin-top: 2em; +} + +p.html { + margin-left: 1em; + font-family: monospace; +} + +.type { + color: #999; +} + +.signature { + color: #A01; + margin-left: 1em; +} + +.signature span.result { + color: black; +} + +.signature code.llkw { + font-family: monospace; +} + +.signature span.result var { + color: #A01; +} + +div.signature { + margin-left: 1.5em; + text-indent: -1.5em; +} + +.signature code.name { + font-weight: bold; +} + +.signature code { + font-family: sans-serif; +} + +blockquote.description { + margin-left: 1em; +} + +a[href] { + text-decoration: none; + border-bottom: dotted 1px #CCC; + color: #600; +} + +a:hover[href] { + text-decoration: none; + border-bottom: solid 1px #F00; + color: #F00; +} + +pre.code { + border: solid 1px #DDD; + padding: 0.5em; + background: #EEE; +} \ No newline at end of file diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/package.lisp b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/package.lisp new file mode 100644 index 0000000..9244391 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/package.lisp @@ -0,0 +1,23 @@ +;;;; package.lisp + +(defpackage #:quickproject + (:documentation "The Quickproject package.") + (:use #:cl) + (:export #:make-project + #:*after-make-project-hooks* + #:*author* + #:*license* + #:*template-directory* + #:*include-copyright* + #:default-template-parameters + #:*template-parameter-functions*) + (:shadowing-import-from #:html-template + #:fill-and-print-template + #:*template-start-marker* + #:*template-end-marker*) + (:shadowing-import-from #:cl-fad + #:pathname-as-directory + #:walk-directory)) + +(in-package #:quickproject) + diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/quickproject.asd b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/quickproject.asd new file mode 100644 index 0000000..2e90cc8 --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/quickproject.asd @@ -0,0 +1,12 @@ +;;;; quickproject.asd + +(asdf:defsystem #:quickproject + :description "Creates the skeleton of a new Common Lisp project" + :version "1.4.1" + :author "Zach Beane " + :license "MIT" + :depends-on (#:cl-fad + #:html-template) + :serial t + :components ((:file "package") + (:file "quickproject"))) diff --git a/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/quickproject.lisp b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/quickproject.lisp new file mode 100644 index 0000000..522767e --- /dev/null +++ b/sbcl/.quicklisp/dists/quicklisp/software/quickproject-1.4.1/quickproject.lisp @@ -0,0 +1,144 @@ +;;;; quickproject.lisp + +(in-package #:quickproject) + +(defvar *name*) +(setf (documentation '*name* 'variable) + "The name of the project currently being created.") + +(defvar *template-directory* (asdf:system-relative-pathname :quickproject "default-template") + "A directory to use as a source of template files.") + +(defvar *depends-on* nil + "Dependencies specified at project creation") + +(defvar *author* + "Your Name " + "Set this variable to your contact information.") + +(defvar *license* + "Specify license here") + +(defvar *include-copyright* nil ; This gives default behavior. + "Include a copyright notice at the top of files.") + +(defun pathname-project-name (pathname) + "Return a project name based on PATHNAME by taking the last element +in the pathname-directory list. E.g. returns \"awesome-project\" for +#p\"src/awesome-project/\"." + (first (last (pathname-directory pathname)))) + +(defmacro with-new-file ((stream file) &body body) + "Like WITH-OPEN-FILE, but specialized for output to a file that must +not already exist." + `(with-open-file (,stream ,file + :direction :output + :if-exists :error) + (let ((*print-case* :downcase)) + ,@body))) + +(defun current-year () + (nth-value 5 (decode-universal-time (get-universal-time)))) + +(defvar *after-make-project-hooks* nil + "A list of functions to call after MAKE-PROJECT is finished making a +project. Each function is called with the same arguments passed to +MAKE-PROJECT, except that NAME is canonicalized if +necessary. *DEFAULT-PATHNAME-DEFAULTS* bound to the newly created +project directory.") + +(defun matches-template-p (pathname template) + (and (equal (pathname-name pathname) (pathname-name template)) + (equal (pathname-type pathname) (pathname-type template)))) + +(defun template-pathname->output-name (path) + (if (or (matches-template-p path "system.asd") + (matches-template-p path "application.lisp")) + (make-pathname :name *name* :defaults path) + path)) + +(defun rewrite-templates (template-directory target-directory parameters) + "Treat every file in TEMPLATE-DIRECTORY as a template file; fill it +out using PARAMETERS into a corresponding file in +TARGET-DIRECTORY. The rewriting uses HTML-TEMPLATE. The template start +marker is the string \"\(#|\" and the template end marker is the string +\"|#)\". Template vars are not modified or escaped when written." + (let ((*template-start-marker* "(#|") + (*template-end-marker* "|#)") + (html-template:*warn-on-creation* nil) + (html-template:*string-modifier* 'identity)) + (setf template-directory (truename template-directory) + target-directory (truename target-directory)) + (flet ((rewrite-template (pathname) + (let* ((relative-namestring + (enough-namestring pathname template-directory)) + (target-pathname (template-pathname->output-name + (merge-pathnames relative-namestring + target-directory)))) + (ensure-directories-exist target-pathname) + (with-open-file (stream + target-pathname + :direction :output + :if-exists :rename-and-delete) + (fill-and-print-template pathname + parameters + :stream stream))))) + (walk-directory template-directory #'rewrite-template)))) + +(defun default-template-parameters () + "Return a plist of :NAME, :LICENSE, and :AUTHOR parameters." + (list :name *name* + :license *license* + :author *author* + :depends-on (mapcar + (lambda (sym) + (list :symbol sym :uninterned (format nil "#:~(~a~)" sym))) + *depends-on*) + :dependencies-string (format nil "(~{#:~(~a~)~^ ~})" *depends-on*) + :copyright (when *include-copyright* + (format nil "Copyright (c) ~D ~A~%" (current-year) *author*)))) + +(defvar *template-parameter-functions* (list 'default-template-parameters) + "A list of functions that return plists for use when rewriting + template files. The results of calling each function are appended + together to pass to FILL-AND-PRINT-TEMPLATE.") + +(defun template-parameters (initial-parameters) + "Return all template parameters returned by calling each element in +*TEMPLATE-PARAMETER-FUNCTIONS*, appended together as a single plist." + (apply 'append initial-parameters + (mapcar 'funcall *template-parameter-functions*))) + +(defun make-project (pathname &key + template-parameters + ((:template-directory *template-directory*) + *template-directory*) + ((:depends-on *depends-on*) *depends-on*) + ((:author *author*) *author*) + ((:license *license*) *license*) + (name (pathname-project-name pathname) name-provided-p) + ((:include-copyright *include-copyright*) *include-copyright*)) + "Create a project skeleton for NAME in PATHNAME. If DEPENDS-ON is provided, +it is used as the asdf defsystem depends-on list." + (check-type *depends-on* list) + (when (pathname-name pathname) + (warn "Coercing ~S to directory" + pathname) + (setf pathname (pathname-as-directory pathname)) + (unless name-provided-p + (setf name (pathname-project-name pathname)))) + (labels ((relative (file) + (merge-pathnames file pathname)) + (nametype (type) + (relative (make-pathname :name name :type type)))) + (ensure-directories-exist pathname) + (let ((*default-pathname-defaults* (truename pathname)) + (*name* name)) + (rewrite-templates *template-directory* *default-pathname-defaults* + (template-parameters template-parameters)) + (pushnew *default-pathname-defaults* asdf:*central-registry* + :test 'equal) + (dolist (hook *after-make-project-hooks*) + (funcall hook pathname :depends-on *depends-on* :name name + :allow-other-keys t))) + name)) diff --git a/sbcl/.quicklisp/tmp/release-install.tar b/sbcl/.quicklisp/tmp/release-install.tar index dbeff94..5df1ee0 100644 Binary files a/sbcl/.quicklisp/tmp/release-install.tar and b/sbcl/.quicklisp/tmp/release-install.tar differ diff --git a/vim/.vim/autoload/plug.vim b/vim/.vim/autoload/plug.vim index 4e05630..ac14332 100644 --- a/vim/.vim/autoload/plug.vim +++ b/vim/.vim/autoload/plug.vim @@ -99,7 +99,13 @@ let s:mac_gui = has('gui_macvim') && has('gui_running') let s:is_win = has('win32') let s:nvim = has('nvim-0.2') || (has('nvim') && exists('*jobwait') && !s:is_win) let s:vim8 = has('patch-8.0.0039') && exists('*job_start') -let s:me = resolve(expand(':p')) +if s:is_win && &shellslash + set noshellslash + let s:me = resolve(expand(':p')) + set shellslash +else + let s:me = resolve(expand(':p')) +endif let s:base_spec = { 'branch': 'master', 'frozen': 0 } let s:TYPE = { \ 'string': type(''), @@ -110,10 +116,42 @@ let s:TYPE = { let s:loaded = get(s:, 'loaded', {}) let s:triggers = get(s:, 'triggers', {}) +if s:is_win + function! s:plug_call(fn, ...) + let shellslash = &shellslash + try + set noshellslash + return call(a:fn, a:000) + finally + let &shellslash = shellslash + endtry + endfunction +else + function! s:plug_call(fn, ...) + return call(a:fn, a:000) + endfunction +endif + +function! s:plug_getcwd() + return s:plug_call('getcwd') +endfunction + +function! s:plug_fnamemodify(fname, mods) + return s:plug_call('fnamemodify', a:fname, a:mods) +endfunction + +function! s:plug_expand(fmt) + return s:plug_call('expand', a:fmt, 1) +endfunction + +function! s:plug_tempname() + return s:plug_call('tempname') +endfunction + function! plug#begin(...) if a:0 > 0 let s:plug_home_org = a:1 - let home = s:path(fnamemodify(expand(a:1), ':p')) + let home = s:path(s:plug_fnamemodify(s:plug_expand(a:1), ':p')) elseif exists('g:plug_home') let home = s:path(g:plug_home) elseif !empty(&rtp) @@ -121,7 +159,7 @@ function! plug#begin(...) else return s:err('Unable to determine plug home. Try calling plug#begin() with a path argument.') endif - if fnamemodify(home, ':t') ==# 'plugin' && fnamemodify(home, ':h') ==# s:first_rtp + if s:plug_fnamemodify(home, ':t') ==# 'plugin' && s:plug_fnamemodify(home, ':h') ==# s:first_rtp return s:err('Invalid plug home. '.home.' is a standard Vim runtime path and is not allowed.') endif @@ -139,6 +177,16 @@ function! s:define_commands() if !executable('git') return s:err('`git` executable not found. Most commands will not be available. To suppress this message, prepend `silent!` to `call plug#begin(...)`.') endif + if has('win32') + \ && &shellslash + \ && (&shell =~# 'cmd\.exe' || &shell =~# 'powershell\.exe') + return s:err('vim-plug does not support shell, ' . &shell . ', when shellslash is set.') + endif + if !has('nvim') + \ && (has('win32') || has('win32unix')) + \ && !has('multi_byte') + return s:err('Vim needs +multi_byte feature on Windows to run shell commands. Enable +iconv for best results.') + endif command! -nargs=* -bar -bang -complete=customlist,s:names PlugInstall call s:install(0, []) command! -nargs=* -bar -bang -complete=customlist,s:names PlugUpdate call s:update(0, []) command! -nargs=0 -bar -bang PlugClean call s:clean(0) @@ -203,7 +251,7 @@ endfunction function! plug#end() if !exists('g:plugs') - return s:err('Call plug#begin() first') + return s:err('plug#end() called without calling plug#begin() first') endif if exists('#PlugLOD') @@ -334,11 +382,11 @@ function! s:progress_opt(base) \ s:git_version_requirement(1, 7, 1) ? '--progress' : '' endfunction -if s:is_win - function! s:rtp(spec) - return s:path(a:spec.dir . get(a:spec, 'rtp', '')) - endfunction +function! s:rtp(spec) + return s:path(a:spec.dir . get(a:spec, 'rtp', '')) +endfunction +if s:is_win function! s:path(path) return s:trim(substitute(a:path, '/', '\', 'g')) endfunction @@ -350,11 +398,33 @@ if s:is_win function! s:is_local_plug(repo) return a:repo =~? '^[a-z]:\|^[%~]' endfunction -else - function! s:rtp(spec) - return s:dirpath(a:spec.dir . get(a:spec, 'rtp', '')) + + " Copied from fzf + function! s:wrap_cmds(cmds) + let cmds = [ + \ '@echo off', + \ 'setlocal enabledelayedexpansion'] + \ + (type(a:cmds) == type([]) ? a:cmds : [a:cmds]) + \ + ['endlocal'] + if has('iconv') + if !exists('s:codepage') + let s:codepage = libcallnr('kernel32.dll', 'GetACP', 0) + endif + return map(cmds, printf('iconv(v:val."\r", "%s", "cp%d")', &encoding, s:codepage)) + endif + return map(cmds, 'v:val."\r"') endfunction + function! s:batchfile(cmd) + let batchfile = s:plug_tempname().'.bat' + call writefile(s:wrap_cmds(a:cmd), batchfile) + let cmd = plug#shellescape(batchfile, {'shell': &shell, 'script': 0}) + if &shell =~# 'powershell\.exe' + let cmd = '& ' . cmd + endif + return [batchfile, cmd] + endfunction +else function! s:path(path) return s:trim(a:path) endfunction @@ -434,8 +504,8 @@ endfunction function! s:dobufread(names) for name in a:names - let path = s:rtp(g:plugs[name]).'/**' - for dir in ['ftdetect', 'ftplugin'] + let path = s:rtp(g:plugs[name]) + for dir in ['ftdetect', 'ftplugin', 'after/ftdetect', 'after/ftplugin'] if len(finddir(dir, path)) if exists('#BufRead') doautocmd BufRead @@ -554,7 +624,7 @@ function! plug#(repo, ...) try let repo = s:trim(a:repo) let opts = a:0 == 1 ? s:parse_options(a:1) : s:base_spec - let name = get(opts, 'as', fnamemodify(repo, ':t:s?\.git$??')) + let name = get(opts, 'as', s:plug_fnamemodify(repo, ':t:s?\.git$??')) let spec = extend(s:infer_properties(name, repo), opts) if !has_key(g:plugs, name) call add(g:plugs_order, name) @@ -574,7 +644,7 @@ function! s:parse_options(arg) elseif type == s:TYPE.dict call extend(opts, a:arg) if has_key(opts, 'dir') - let opts.dir = s:dirpath(expand(opts.dir)) + let opts.dir = s:dirpath(s:plug_expand(opts.dir)) endif else throw 'Invalid argument type (expected: string or dictionary)' @@ -585,7 +655,7 @@ endfunction function! s:infer_properties(name, repo) let repo = a:repo if s:is_local_plug(repo) - return { 'dir': s:dirpath(expand(repo)) } + return { 'dir': s:dirpath(s:plug_expand(repo)) } else if repo =~ ':' let uri = repo @@ -738,7 +808,7 @@ function! s:finish_bindings() endfunction function! s:prepare(...) - if empty(getcwd()) + if empty(s:plug_getcwd()) throw 'Invalid current working directory. Cannot proceed.' endif @@ -794,31 +864,28 @@ endfunction function! s:chsh(swap) let prev = [&shell, &shellcmdflag, &shellredir] - if s:is_win - set shell=cmd.exe shellcmdflag=/c shellredir=>%s\ 2>&1 - elseif a:swap + if !s:is_win && a:swap set shell=sh shellredir=>%s\ 2>&1 endif return prev endfunction function! s:bang(cmd, ...) + let batchfile = '' try let [sh, shellcmdflag, shrd] = s:chsh(a:0) " FIXME: Escaping is incomplete. We could use shellescape with eval, " but it won't work on Windows. let cmd = a:0 ? s:with_cd(a:cmd, a:1) : a:cmd if s:is_win - let batchfile = tempname().'.bat' - call writefile(["@echo off\r", cmd . "\r"], batchfile) - let cmd = batchfile + let [batchfile, cmd] = s:batchfile(cmd) endif let g:_plug_bang = (s:is_win && has('gui_running') ? 'silent ' : '').'!'.escape(cmd, '#!%') execute "normal! :execute g:_plug_bang\\" finally unlet g:_plug_bang let [&shell, &shellcmdflag, &shellredir] = [sh, shellcmdflag, shrd] - if s:is_win + if s:is_win && filereadable(batchfile) call delete(batchfile) endif endtry @@ -897,7 +964,7 @@ function! s:checkout(spec) let output = s:system('git rev-parse HEAD', a:spec.dir) if !v:shell_error && !s:hash_match(sha, s:lines(output)[0]) let output = s:system( - \ 'git fetch --depth 999999 && git checkout '.s:esc(sha).' --', a:spec.dir) + \ 'git fetch --depth 999999 && git checkout '.plug#shellescape(sha).' --', a:spec.dir) endif return output endfunction @@ -1015,7 +1082,7 @@ function! s:update_impl(pull, force, args) abort let s:clone_opt = get(g:, 'plug_shallow', 1) ? \ '--depth 1' . (s:git_version_requirement(1, 7, 10) ? ' --no-single-branch' : '') : '' - if has('win32unix') + if has('win32unix') || has('wsl') let s:clone_opt .= ' -c core.eol=lf -c core.autocrlf=input' endif @@ -1094,7 +1161,7 @@ function! s:update_finish() elseif has_key(spec, 'tag') let tag = spec.tag if tag =~ '\*' - let tags = s:lines(s:system('git tag --list '.s:shellesc(tag).' --sort -version:refname 2>&1', spec.dir)) + let tags = s:lines(s:system('git tag --list '.plug#shellescape(tag).' --sort -version:refname 2>&1', spec.dir)) if !v:shell_error && !empty(tags) let tag = tags[0] call s:log4(name, printf('Latest tag for %s -> %s', spec.tag, tag)) @@ -1102,12 +1169,12 @@ function! s:update_finish() endif endif call s:log4(name, 'Checking out '.tag) - let out = s:system('git checkout -q '.s:esc(tag).' -- 2>&1', spec.dir) + let out = s:system('git checkout -q '.plug#shellescape(tag).' -- 2>&1', spec.dir) else - let branch = s:esc(get(spec, 'branch', 'master')) - call s:log4(name, 'Merging origin/'.branch) - let out = s:system('git checkout -q '.branch.' -- 2>&1' - \. (has_key(s:update.new, name) ? '' : ('&& git merge --ff-only origin/'.branch.' 2>&1')), spec.dir) + let branch = get(spec, 'branch', 'master') + call s:log4(name, 'Merging origin/'.s:esc(branch)) + let out = s:system('git checkout -q '.plug#shellescape(branch).' -- 2>&1' + \. (has_key(s:update.new, name) ? '' : ('&& git merge --ff-only '.plug#shellescape('origin/'.branch).' 2>&1')), spec.dir) endif if !v:shell_error && filereadable(spec.dir.'/.gitmodules') && \ (s:update.force || has_key(s:update.new, name) || s:is_updated(spec.dir)) @@ -1151,7 +1218,7 @@ function! s:job_abort() silent! call job_stop(j.jobid) endif if j.new - call s:system('rm -rf ' . s:shellesc(g:plugs[name].dir)) + call s:rm_rf(g:plugs[name].dir) endif endfor let s:jobs = {} @@ -1204,22 +1271,17 @@ endfunction function! s:spawn(name, cmd, opts) let job = { 'name': a:name, 'running': 1, 'error': 0, 'lines': [''], - \ 'batchfile': (s:is_win && (s:nvim || s:vim8)) ? tempname().'.bat' : '', \ 'new': get(a:opts, 'new', 0) } let s:jobs[a:name] = job - let cmd = has_key(a:opts, 'dir') ? s:with_cd(a:cmd, a:opts.dir) : a:cmd - if !empty(job.batchfile) - call writefile(["@echo off\r", cmd . "\r"], job.batchfile) - let cmd = job.batchfile - endif - let argv = add(s:is_win ? ['cmd', '/c'] : ['sh', '-c'], cmd) + let cmd = has_key(a:opts, 'dir') ? s:with_cd(a:cmd, a:opts.dir, 0) : a:cmd + let argv = s:is_win ? ['cmd', '/s', '/c', '"'.cmd.'"'] : ['sh', '-c', cmd] if s:nvim call extend(job, { \ 'on_stdout': function('s:nvim_cb'), \ 'on_exit': function('s:nvim_cb'), \ }) - let jid = jobstart(argv, job) + let jid = s:plug_call('jobstart', argv, job) if jid > 0 let job.jobid = jid else @@ -1262,9 +1324,6 @@ function! s:reap(name) call s:log(bullet, a:name, empty(result) ? 'OK' : result) call s:bar() - if has_key(job, 'batchfile') && !empty(job.batchfile) - call delete(job.batchfile) - endif call remove(s:jobs, a:name) endfunction @@ -1279,9 +1338,10 @@ function! s:bar() endfunction function! s:logpos(name) - for i in range(4, line('$')) + let max = line('$') + for i in range(4, max > 4 ? max : 4) if getline(i) =~# '^[-+x*] '.a:name.':' - for j in range(i + 1, line('$')) + for j in range(i + 1, max > 5 ? max : 5) if getline(j) !~ '^ ' return [i, j - 1] endif @@ -1354,8 +1414,8 @@ while 1 " Without TCO, Vim stack is bound to explode \ printf('git clone %s %s %s %s 2>&1', \ has_tag ? '' : s:clone_opt, \ prog, - \ s:shellesc(spec.uri), - \ s:shellesc(s:trim(spec.dir))), { 'new': 1 }) + \ plug#shellescape(spec.uri, {'script': 0}), + \ plug#shellescape(s:trim(spec.dir), {'script': 0})), { 'new': 1 }) endif if !s:jobs[name].running @@ -1982,19 +2042,29 @@ function! s:update_ruby() EOF endfunction -function! s:shellesc_cmd(arg) - let escaped = substitute(a:arg, '[&|<>()@^]', '^&', 'g') - let escaped = substitute(escaped, '%', '%%', 'g') - let escaped = substitute(escaped, '"', '\\^&', 'g') - let escaped = substitute(escaped, '\(\\\+\)\(\\^\)', '\1\1\2', 'g') - return '^"'.substitute(escaped, '\(\\\+\)$', '\1\1', '').'^"' +function! s:shellesc_cmd(arg, script) + let escaped = substitute('"'.a:arg.'"', '[&|<>()@^!"]', '^&', 'g') + return substitute(escaped, '%', (a:script ? '%' : '^') . '&', 'g') endfunction -function! s:shellesc(arg) - if &shell =~# 'cmd.exe$' - return s:shellesc_cmd(a:arg) +function! s:shellesc_ps1(arg) + return "'".substitute(escape(a:arg, '\"'), "'", "''", 'g')."'" +endfunction + +function! s:shellesc_sh(arg) + return "'".substitute(a:arg, "'", "'\\\\''", 'g')."'" +endfunction + +function! plug#shellescape(arg, ...) + let opts = a:0 > 0 && type(a:1) == s:TYPE.dict ? a:1 : {} + let shell = get(opts, 'shell', s:is_win ? 'cmd.exe' : 'sh') + let script = get(opts, 'script', 1) + if shell =~# 'cmd\.exe' + return s:shellesc_cmd(a:arg, script) + elseif shell =~# 'powershell\.exe' || shell =~# 'pwsh$' + return s:shellesc_ps1(a:arg) endif - return shellescape(a:arg) + return s:shellesc_sh(a:arg) endfunction function! s:glob_dir(path) @@ -2026,23 +2096,23 @@ function! s:format_message(bullet, name, message) endif endfunction -function! s:with_cd(cmd, dir) - return printf('cd%s %s && %s', s:is_win ? ' /d' : '', s:shellesc(a:dir), a:cmd) +function! s:with_cd(cmd, dir, ...) + let script = a:0 > 0 ? a:1 : 1 + return printf('cd%s %s && %s', s:is_win ? ' /d' : '', plug#shellescape(a:dir, {'script': script}), a:cmd) endfunction function! s:system(cmd, ...) + let batchfile = '' try let [sh, shellcmdflag, shrd] = s:chsh(1) let cmd = a:0 > 0 ? s:with_cd(a:cmd, a:1) : a:cmd if s:is_win - let batchfile = tempname().'.bat' - call writefile(["@echo off\r", cmd . "\r"], batchfile) - let cmd = batchfile + let [batchfile, cmd] = s:batchfile(cmd) endif - return system(s:is_win ? '('.cmd.')' : cmd) + return system(cmd) finally let [&shell, &shellcmdflag, &shellredir] = [sh, shellcmdflag, shrd] - if s:is_win + if s:is_win && filereadable(batchfile) call delete(batchfile) endif endtry @@ -2115,7 +2185,7 @@ endfunction function! s:rm_rf(dir) if isdirectory(a:dir) - call s:system((s:is_win ? 'rmdir /S /Q ' : 'rm -rf ') . s:shellesc(a:dir)) + call s:system((s:is_win ? 'rmdir /S /Q ' : 'rm -rf ') . plug#shellescape(a:dir)) endif endfunction @@ -2147,7 +2217,7 @@ function! s:clean(force) let allowed = {} for dir in dirs - let allowed[s:dirpath(fnamemodify(dir, ':h:h'))] = 1 + let allowed[s:dirpath(s:plug_fnamemodify(dir, ':h:h'))] = 1 let allowed[dir] = 1 for child in s:glob_dir(dir) let allowed[child] = 1 @@ -2220,11 +2290,11 @@ endfunction function! s:upgrade() echo 'Downloading the latest version of vim-plug' redraw - let tmp = tempname() + let tmp = s:plug_tempname() let new = tmp . '/plug.vim' try - let out = s:system(printf('git clone --depth 1 %s %s', s:plug_src, tmp)) + let out = s:system(printf('git clone --depth 1 %s %s', plug#shellescape(s:plug_src), plug#shellescape(tmp))) if v:shell_error return s:err('Error upgrading vim-plug: '. out) endif @@ -2365,18 +2435,17 @@ function! s:preview_commit() wincmd P endif setlocal previewwindow filetype=git buftype=nofile nobuflisted modifiable + let batchfile = '' try let [sh, shellcmdflag, shrd] = s:chsh(1) - let cmd = 'cd '.s:shellesc(g:plugs[name].dir).' && git show --no-color --pretty=medium '.sha + let cmd = 'cd '.plug#shellescape(g:plugs[name].dir).' && git show --no-color --pretty=medium '.sha if s:is_win - let batchfile = tempname().'.bat' - call writefile(["@echo off\r", cmd . "\r"], batchfile) - let cmd = batchfile + let [batchfile, cmd] = s:batchfile(cmd) endif execute 'silent %!' cmd finally let [&shell, &shellcmdflag, &shellredir] = [sh, shellcmdflag, shrd] - if s:is_win + if s:is_win && filereadable(batchfile) call delete(batchfile) endif endtry @@ -2420,9 +2489,11 @@ function! s:diff() call s:append_ul(2, origin ? 'Pending updates:' : 'Last update:') for [k, v] in plugs let range = origin ? '..origin/'.v.branch : 'HEAD@{1}..' - let cmd = 'git log --graph --color=never '.join(map(['--pretty=format:%x01%h%x01%d%x01%s%x01%cr', range], 's:shellesc(v:val)')) + let cmd = 'git log --graph --color=never ' + \ . (s:git_version_requirement(2, 10, 0) ? '--no-show-signature ' : '') + \ . join(map(['--pretty=format:%x01%h%x01%d%x01%s%x01%cr', range], 'plug#shellescape(v:val)')) if has_key(v, 'rtp') - let cmd .= ' -- '.s:shellesc(v.rtp) + let cmd .= ' -- '.plug#shellescape(v.rtp) endif let diff = s:system_chomp(cmd, v.dir) if !empty(diff) @@ -2470,7 +2541,7 @@ function! s:revert() return endif - call s:system('git reset --hard HEAD@{1} && git checkout '.s:esc(g:plugs[name].branch).' --', g:plugs[name].dir) + call s:system('git reset --hard HEAD@{1} && git checkout '.plug#shellescape(g:plugs[name].branch).' --', g:plugs[name].dir) setlocal modifiable normal! "_dap setlocal nomodifiable @@ -2498,7 +2569,7 @@ function! s:snapshot(force, ...) abort endfor if a:0 > 0 - let fn = expand(a:1) + let fn = s:plug_expand(a:1) if filereadable(fn) && !(a:force || s:ask(a:1.' already exists. Overwrite?')) return endif diff --git a/vim/.vim/autoload/plug.vim.old b/vim/.vim/autoload/plug.vim.old new file mode 100644 index 0000000..4e05630 --- /dev/null +++ b/vim/.vim/autoload/plug.vim.old @@ -0,0 +1,2526 @@ +" vim-plug: Vim plugin manager +" ============================ +" +" Download plug.vim and put it in ~/.vim/autoload +" +" curl -fLo ~/.vim/autoload/plug.vim --create-dirs \ +" https://raw.githubusercontent.com/junegunn/vim-plug/master/plug.vim +" +" Edit your .vimrc +" +" call plug#begin('~/.vim/plugged') +" +" " Make sure you use single quotes +" +" " Shorthand notation; fetches https://github.com/junegunn/vim-easy-align +" Plug 'junegunn/vim-easy-align' +" +" " Any valid git URL is allowed +" Plug 'https://github.com/junegunn/vim-github-dashboard.git' +" +" " Multiple Plug commands can be written in a single line using | separators +" Plug 'SirVer/ultisnips' | Plug 'honza/vim-snippets' +" +" " On-demand loading +" Plug 'scrooloose/nerdtree', { 'on': 'NERDTreeToggle' } +" Plug 'tpope/vim-fireplace', { 'for': 'clojure' } +" +" " Using a non-master branch +" Plug 'rdnetto/YCM-Generator', { 'branch': 'stable' } +" +" " Using a tagged release; wildcard allowed (requires git 1.9.2 or above) +" Plug 'fatih/vim-go', { 'tag': '*' } +" +" " Plugin options +" Plug 'nsf/gocode', { 'tag': 'v.20150303', 'rtp': 'vim' } +" +" " Plugin outside ~/.vim/plugged with post-update hook +" Plug 'junegunn/fzf', { 'dir': '~/.fzf', 'do': './install --all' } +" +" " Unmanaged plugin (manually installed and updated) +" Plug '~/my-prototype-plugin' +" +" " Initialize plugin system +" call plug#end() +" +" Then reload .vimrc and :PlugInstall to install plugins. +" +" Plug options: +" +"| Option | Description | +"| ----------------------- | ------------------------------------------------ | +"| `branch`/`tag`/`commit` | Branch/tag/commit of the repository to use | +"| `rtp` | Subdirectory that contains Vim plugin | +"| `dir` | Custom directory for the plugin | +"| `as` | Use different name for the plugin | +"| `do` | Post-update hook (string or funcref) | +"| `on` | On-demand loading: Commands or ``-mappings | +"| `for` | On-demand loading: File types | +"| `frozen` | Do not update unless explicitly specified | +" +" More information: https://github.com/junegunn/vim-plug +" +" +" Copyright (c) 2017 Junegunn Choi +" +" MIT License +" +" Permission is hereby granted, free of charge, to any person obtaining +" a copy of this software and associated documentation files (the +" "Software"), to deal in the Software without restriction, including +" without limitation the rights to use, copy, modify, merge, publish, +" distribute, sublicense, and/or sell copies of the Software, and to +" permit persons to whom the Software is furnished to do so, subject to +" the following conditions: +" +" The above copyright notice and this permission notice shall be +" included in all copies or substantial portions of the Software. +" +" THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +" EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +" MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +" NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +" LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +" OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +" WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +if exists('g:loaded_plug') + finish +endif +let g:loaded_plug = 1 + +let s:cpo_save = &cpo +set cpo&vim + +let s:plug_src = 'https://github.com/junegunn/vim-plug.git' +let s:plug_tab = get(s:, 'plug_tab', -1) +let s:plug_buf = get(s:, 'plug_buf', -1) +let s:mac_gui = has('gui_macvim') && has('gui_running') +let s:is_win = has('win32') +let s:nvim = has('nvim-0.2') || (has('nvim') && exists('*jobwait') && !s:is_win) +let s:vim8 = has('patch-8.0.0039') && exists('*job_start') +let s:me = resolve(expand(':p')) +let s:base_spec = { 'branch': 'master', 'frozen': 0 } +let s:TYPE = { +\ 'string': type(''), +\ 'list': type([]), +\ 'dict': type({}), +\ 'funcref': type(function('call')) +\ } +let s:loaded = get(s:, 'loaded', {}) +let s:triggers = get(s:, 'triggers', {}) + +function! plug#begin(...) + if a:0 > 0 + let s:plug_home_org = a:1 + let home = s:path(fnamemodify(expand(a:1), ':p')) + elseif exists('g:plug_home') + let home = s:path(g:plug_home) + elseif !empty(&rtp) + let home = s:path(split(&rtp, ',')[0]) . '/plugged' + else + return s:err('Unable to determine plug home. Try calling plug#begin() with a path argument.') + endif + if fnamemodify(home, ':t') ==# 'plugin' && fnamemodify(home, ':h') ==# s:first_rtp + return s:err('Invalid plug home. '.home.' is a standard Vim runtime path and is not allowed.') + endif + + let g:plug_home = home + let g:plugs = {} + let g:plugs_order = [] + let s:triggers = {} + + call s:define_commands() + return 1 +endfunction + +function! s:define_commands() + command! -nargs=+ -bar Plug call plug#() + if !executable('git') + return s:err('`git` executable not found. Most commands will not be available. To suppress this message, prepend `silent!` to `call plug#begin(...)`.') + endif + command! -nargs=* -bar -bang -complete=customlist,s:names PlugInstall call s:install(0, []) + command! -nargs=* -bar -bang -complete=customlist,s:names PlugUpdate call s:update(0, []) + command! -nargs=0 -bar -bang PlugClean call s:clean(0) + command! -nargs=0 -bar PlugUpgrade if s:upgrade() | execute 'source' s:esc(s:me) | endif + command! -nargs=0 -bar PlugStatus call s:status() + command! -nargs=0 -bar PlugDiff call s:diff() + command! -nargs=? -bar -bang -complete=file PlugSnapshot call s:snapshot(0, ) +endfunction + +function! s:to_a(v) + return type(a:v) == s:TYPE.list ? a:v : [a:v] +endfunction + +function! s:to_s(v) + return type(a:v) == s:TYPE.string ? a:v : join(a:v, "\n") . "\n" +endfunction + +function! s:glob(from, pattern) + return s:lines(globpath(a:from, a:pattern)) +endfunction + +function! s:source(from, ...) + let found = 0 + for pattern in a:000 + for vim in s:glob(a:from, pattern) + execute 'source' s:esc(vim) + let found = 1 + endfor + endfor + return found +endfunction + +function! s:assoc(dict, key, val) + let a:dict[a:key] = add(get(a:dict, a:key, []), a:val) +endfunction + +function! s:ask(message, ...) + call inputsave() + echohl WarningMsg + let answer = input(a:message.(a:0 ? ' (y/N/a) ' : ' (y/N) ')) + echohl None + call inputrestore() + echo "\r" + return (a:0 && answer =~? '^a') ? 2 : (answer =~? '^y') ? 1 : 0 +endfunction + +function! s:ask_no_interrupt(...) + try + return call('s:ask', a:000) + catch + return 0 + endtry +endfunction + +function! s:lazy(plug, opt) + return has_key(a:plug, a:opt) && + \ (empty(s:to_a(a:plug[a:opt])) || + \ !isdirectory(a:plug.dir) || + \ len(s:glob(s:rtp(a:plug), 'plugin')) || + \ len(s:glob(s:rtp(a:plug), 'after/plugin'))) +endfunction + +function! plug#end() + if !exists('g:plugs') + return s:err('Call plug#begin() first') + endif + + if exists('#PlugLOD') + augroup PlugLOD + autocmd! + augroup END + augroup! PlugLOD + endif + let lod = { 'ft': {}, 'map': {}, 'cmd': {} } + + if exists('g:did_load_filetypes') + filetype off + endif + for name in g:plugs_order + if !has_key(g:plugs, name) + continue + endif + let plug = g:plugs[name] + if get(s:loaded, name, 0) || !s:lazy(plug, 'on') && !s:lazy(plug, 'for') + let s:loaded[name] = 1 + continue + endif + + if has_key(plug, 'on') + let s:triggers[name] = { 'map': [], 'cmd': [] } + for cmd in s:to_a(plug.on) + if cmd =~? '^.\+' + if empty(mapcheck(cmd)) && empty(mapcheck(cmd, 'i')) + call s:assoc(lod.map, cmd, name) + endif + call add(s:triggers[name].map, cmd) + elseif cmd =~# '^[A-Z]' + let cmd = substitute(cmd, '!*$', '', '') + if exists(':'.cmd) != 2 + call s:assoc(lod.cmd, cmd, name) + endif + call add(s:triggers[name].cmd, cmd) + else + call s:err('Invalid `on` option: '.cmd. + \ '. Should start with an uppercase letter or ``.') + endif + endfor + endif + + if has_key(plug, 'for') + let types = s:to_a(plug.for) + if !empty(types) + augroup filetypedetect + call s:source(s:rtp(plug), 'ftdetect/**/*.vim', 'after/ftdetect/**/*.vim') + augroup END + endif + for type in types + call s:assoc(lod.ft, type, name) + endfor + endif + endfor + + for [cmd, names] in items(lod.cmd) + execute printf( + \ 'command! -nargs=* -range -bang -complete=file %s call s:lod_cmd(%s, "", , , , %s)', + \ cmd, string(cmd), string(names)) + endfor + + for [map, names] in items(lod.map) + for [mode, map_prefix, key_prefix] in + \ [['i', '', ''], ['n', '', ''], ['v', '', 'gv'], ['o', '', '']] + execute printf( + \ '%snoremap %s %s:call lod_map(%s, %s, %s, "%s")', + \ mode, map, map_prefix, string(map), string(names), mode != 'i', key_prefix) + endfor + endfor + + for [ft, names] in items(lod.ft) + augroup PlugLOD + execute printf('autocmd FileType %s call lod_ft(%s, %s)', + \ ft, string(ft), string(names)) + augroup END + endfor + + call s:reorg_rtp() + filetype plugin indent on + if has('vim_starting') + if has('syntax') && !exists('g:syntax_on') + syntax enable + end + else + call s:reload_plugins() + endif +endfunction + +function! s:loaded_names() + return filter(copy(g:plugs_order), 'get(s:loaded, v:val, 0)') +endfunction + +function! s:load_plugin(spec) + call s:source(s:rtp(a:spec), 'plugin/**/*.vim', 'after/plugin/**/*.vim') +endfunction + +function! s:reload_plugins() + for name in s:loaded_names() + call s:load_plugin(g:plugs[name]) + endfor +endfunction + +function! s:trim(str) + return substitute(a:str, '[\/]\+$', '', '') +endfunction + +function! s:version_requirement(val, min) + for idx in range(0, len(a:min) - 1) + let v = get(a:val, idx, 0) + if v < a:min[idx] | return 0 + elseif v > a:min[idx] | return 1 + endif + endfor + return 1 +endfunction + +function! s:git_version_requirement(...) + if !exists('s:git_version') + let s:git_version = map(split(split(s:system('git --version'))[2], '\.'), 'str2nr(v:val)') + endif + return s:version_requirement(s:git_version, a:000) +endfunction + +function! s:progress_opt(base) + return a:base && !s:is_win && + \ s:git_version_requirement(1, 7, 1) ? '--progress' : '' +endfunction + +if s:is_win + function! s:rtp(spec) + return s:path(a:spec.dir . get(a:spec, 'rtp', '')) + endfunction + + function! s:path(path) + return s:trim(substitute(a:path, '/', '\', 'g')) + endfunction + + function! s:dirpath(path) + return s:path(a:path) . '\' + endfunction + + function! s:is_local_plug(repo) + return a:repo =~? '^[a-z]:\|^[%~]' + endfunction +else + function! s:rtp(spec) + return s:dirpath(a:spec.dir . get(a:spec, 'rtp', '')) + endfunction + + function! s:path(path) + return s:trim(a:path) + endfunction + + function! s:dirpath(path) + return substitute(a:path, '[/\\]*$', '/', '') + endfunction + + function! s:is_local_plug(repo) + return a:repo[0] =~ '[/$~]' + endfunction +endif + +function! s:err(msg) + echohl ErrorMsg + echom '[vim-plug] '.a:msg + echohl None +endfunction + +function! s:warn(cmd, msg) + echohl WarningMsg + execute a:cmd 'a:msg' + echohl None +endfunction + +function! s:esc(path) + return escape(a:path, ' ') +endfunction + +function! s:escrtp(path) + return escape(a:path, ' ,') +endfunction + +function! s:remove_rtp() + for name in s:loaded_names() + let rtp = s:rtp(g:plugs[name]) + execute 'set rtp-='.s:escrtp(rtp) + let after = globpath(rtp, 'after') + if isdirectory(after) + execute 'set rtp-='.s:escrtp(after) + endif + endfor +endfunction + +function! s:reorg_rtp() + if !empty(s:first_rtp) + execute 'set rtp-='.s:first_rtp + execute 'set rtp-='.s:last_rtp + endif + + " &rtp is modified from outside + if exists('s:prtp') && s:prtp !=# &rtp + call s:remove_rtp() + unlet! s:middle + endif + + let s:middle = get(s:, 'middle', &rtp) + let rtps = map(s:loaded_names(), 's:rtp(g:plugs[v:val])') + let afters = filter(map(copy(rtps), 'globpath(v:val, "after")'), '!empty(v:val)') + let rtp = join(map(rtps, 'escape(v:val, ",")'), ',') + \ . ','.s:middle.',' + \ . join(map(afters, 'escape(v:val, ",")'), ',') + let &rtp = substitute(substitute(rtp, ',,*', ',', 'g'), '^,\|,$', '', 'g') + let s:prtp = &rtp + + if !empty(s:first_rtp) + execute 'set rtp^='.s:first_rtp + execute 'set rtp+='.s:last_rtp + endif +endfunction + +function! s:doautocmd(...) + if exists('#'.join(a:000, '#')) + execute 'doautocmd' ((v:version > 703 || has('patch442')) ? '' : '') join(a:000) + endif +endfunction + +function! s:dobufread(names) + for name in a:names + let path = s:rtp(g:plugs[name]).'/**' + for dir in ['ftdetect', 'ftplugin'] + if len(finddir(dir, path)) + if exists('#BufRead') + doautocmd BufRead + endif + return + endif + endfor + endfor +endfunction + +function! plug#load(...) + if a:0 == 0 + return s:err('Argument missing: plugin name(s) required') + endif + if !exists('g:plugs') + return s:err('plug#begin was not called') + endif + let names = a:0 == 1 && type(a:1) == s:TYPE.list ? a:1 : a:000 + let unknowns = filter(copy(names), '!has_key(g:plugs, v:val)') + if !empty(unknowns) + let s = len(unknowns) > 1 ? 's' : '' + return s:err(printf('Unknown plugin%s: %s', s, join(unknowns, ', '))) + end + let unloaded = filter(copy(names), '!get(s:loaded, v:val, 0)') + if !empty(unloaded) + for name in unloaded + call s:lod([name], ['ftdetect', 'after/ftdetect', 'plugin', 'after/plugin']) + endfor + call s:dobufread(unloaded) + return 1 + end + return 0 +endfunction + +function! s:remove_triggers(name) + if !has_key(s:triggers, a:name) + return + endif + for cmd in s:triggers[a:name].cmd + execute 'silent! delc' cmd + endfor + for map in s:triggers[a:name].map + execute 'silent! unmap' map + execute 'silent! iunmap' map + endfor + call remove(s:triggers, a:name) +endfunction + +function! s:lod(names, types, ...) + for name in a:names + call s:remove_triggers(name) + let s:loaded[name] = 1 + endfor + call s:reorg_rtp() + + for name in a:names + let rtp = s:rtp(g:plugs[name]) + for dir in a:types + call s:source(rtp, dir.'/**/*.vim') + endfor + if a:0 + if !s:source(rtp, a:1) && !empty(s:glob(rtp, a:2)) + execute 'runtime' a:1 + endif + call s:source(rtp, a:2) + endif + call s:doautocmd('User', name) + endfor +endfunction + +function! s:lod_ft(pat, names) + let syn = 'syntax/'.a:pat.'.vim' + call s:lod(a:names, ['plugin', 'after/plugin'], syn, 'after/'.syn) + execute 'autocmd! PlugLOD FileType' a:pat + call s:doautocmd('filetypeplugin', 'FileType') + call s:doautocmd('filetypeindent', 'FileType') +endfunction + +function! s:lod_cmd(cmd, bang, l1, l2, args, names) + call s:lod(a:names, ['ftdetect', 'after/ftdetect', 'plugin', 'after/plugin']) + call s:dobufread(a:names) + execute printf('%s%s%s %s', (a:l1 == a:l2 ? '' : (a:l1.','.a:l2)), a:cmd, a:bang, a:args) +endfunction + +function! s:lod_map(map, names, with_prefix, prefix) + call s:lod(a:names, ['ftdetect', 'after/ftdetect', 'plugin', 'after/plugin']) + call s:dobufread(a:names) + let extra = '' + while 1 + let c = getchar(0) + if c == 0 + break + endif + let extra .= nr2char(c) + endwhile + + if a:with_prefix + let prefix = v:count ? v:count : '' + let prefix .= '"'.v:register.a:prefix + if mode(1) == 'no' + if v:operator == 'c' + let prefix = "\" . prefix + endif + let prefix .= v:operator + endif + call feedkeys(prefix, 'n') + endif + call feedkeys(substitute(a:map, '^', "\", '') . extra) +endfunction + +function! plug#(repo, ...) + if a:0 > 1 + return s:err('Invalid number of arguments (1..2)') + endif + + try + let repo = s:trim(a:repo) + let opts = a:0 == 1 ? s:parse_options(a:1) : s:base_spec + let name = get(opts, 'as', fnamemodify(repo, ':t:s?\.git$??')) + let spec = extend(s:infer_properties(name, repo), opts) + if !has_key(g:plugs, name) + call add(g:plugs_order, name) + endif + let g:plugs[name] = spec + let s:loaded[name] = get(s:loaded, name, 0) + catch + return s:err(v:exception) + endtry +endfunction + +function! s:parse_options(arg) + let opts = copy(s:base_spec) + let type = type(a:arg) + if type == s:TYPE.string + let opts.tag = a:arg + elseif type == s:TYPE.dict + call extend(opts, a:arg) + if has_key(opts, 'dir') + let opts.dir = s:dirpath(expand(opts.dir)) + endif + else + throw 'Invalid argument type (expected: string or dictionary)' + endif + return opts +endfunction + +function! s:infer_properties(name, repo) + let repo = a:repo + if s:is_local_plug(repo) + return { 'dir': s:dirpath(expand(repo)) } + else + if repo =~ ':' + let uri = repo + else + if repo !~ '/' + throw printf('Invalid argument: %s (implicit `vim-scripts'' expansion is deprecated)', repo) + endif + let fmt = get(g:, 'plug_url_format', 'https://git::@github.com/%s.git') + let uri = printf(fmt, repo) + endif + return { 'dir': s:dirpath(g:plug_home.'/'.a:name), 'uri': uri } + endif +endfunction + +function! s:install(force, names) + call s:update_impl(0, a:force, a:names) +endfunction + +function! s:update(force, names) + call s:update_impl(1, a:force, a:names) +endfunction + +function! plug#helptags() + if !exists('g:plugs') + return s:err('plug#begin was not called') + endif + for spec in values(g:plugs) + let docd = join([s:rtp(spec), 'doc'], '/') + if isdirectory(docd) + silent! execute 'helptags' s:esc(docd) + endif + endfor + return 1 +endfunction + +function! s:syntax() + syntax clear + syntax region plug1 start=/\%1l/ end=/\%2l/ contains=plugNumber + syntax region plug2 start=/\%2l/ end=/\%3l/ contains=plugBracket,plugX + syn match plugNumber /[0-9]\+[0-9.]*/ contained + syn match plugBracket /[[\]]/ contained + syn match plugX /x/ contained + syn match plugDash /^-/ + syn match plugPlus /^+/ + syn match plugStar /^*/ + syn match plugMessage /\(^- \)\@<=.*/ + syn match plugName /\(^- \)\@<=[^ ]*:/ + syn match plugSha /\%(: \)\@<=[0-9a-f]\{4,}$/ + syn match plugTag /(tag: [^)]\+)/ + syn match plugInstall /\(^+ \)\@<=[^:]*/ + syn match plugUpdate /\(^* \)\@<=[^:]*/ + syn match plugCommit /^ \X*[0-9a-f]\{7,9} .*/ contains=plugRelDate,plugEdge,plugTag + syn match plugEdge /^ \X\+$/ + syn match plugEdge /^ \X*/ contained nextgroup=plugSha + syn match plugSha /[0-9a-f]\{7,9}/ contained + syn match plugRelDate /([^)]*)$/ contained + syn match plugNotLoaded /(not loaded)$/ + syn match plugError /^x.*/ + syn region plugDeleted start=/^\~ .*/ end=/^\ze\S/ + syn match plugH2 /^.*:\n-\+$/ + syn keyword Function PlugInstall PlugStatus PlugUpdate PlugClean + hi def link plug1 Title + hi def link plug2 Repeat + hi def link plugH2 Type + hi def link plugX Exception + hi def link plugBracket Structure + hi def link plugNumber Number + + hi def link plugDash Special + hi def link plugPlus Constant + hi def link plugStar Boolean + + hi def link plugMessage Function + hi def link plugName Label + hi def link plugInstall Function + hi def link plugUpdate Type + + hi def link plugError Error + hi def link plugDeleted Ignore + hi def link plugRelDate Comment + hi def link plugEdge PreProc + hi def link plugSha Identifier + hi def link plugTag Constant + + hi def link plugNotLoaded Comment +endfunction + +function! s:lpad(str, len) + return a:str . repeat(' ', a:len - len(a:str)) +endfunction + +function! s:lines(msg) + return split(a:msg, "[\r\n]") +endfunction + +function! s:lastline(msg) + return get(s:lines(a:msg), -1, '') +endfunction + +function! s:new_window() + execute get(g:, 'plug_window', 'vertical topleft new') +endfunction + +function! s:plug_window_exists() + let buflist = tabpagebuflist(s:plug_tab) + return !empty(buflist) && index(buflist, s:plug_buf) >= 0 +endfunction + +function! s:switch_in() + if !s:plug_window_exists() + return 0 + endif + + if winbufnr(0) != s:plug_buf + let s:pos = [tabpagenr(), winnr(), winsaveview()] + execute 'normal!' s:plug_tab.'gt' + let winnr = bufwinnr(s:plug_buf) + execute winnr.'wincmd w' + call add(s:pos, winsaveview()) + else + let s:pos = [winsaveview()] + endif + + setlocal modifiable + return 1 +endfunction + +function! s:switch_out(...) + call winrestview(s:pos[-1]) + setlocal nomodifiable + if a:0 > 0 + execute a:1 + endif + + if len(s:pos) > 1 + execute 'normal!' s:pos[0].'gt' + execute s:pos[1] 'wincmd w' + call winrestview(s:pos[2]) + endif +endfunction + +function! s:finish_bindings() + nnoremap R :call retry() + nnoremap D :PlugDiff + nnoremap S :PlugStatus + nnoremap U :call status_update() + xnoremap U :call status_update() + nnoremap ]] :silent! call section('') + nnoremap [[ :silent! call section('b') +endfunction + +function! s:prepare(...) + if empty(getcwd()) + throw 'Invalid current working directory. Cannot proceed.' + endif + + for evar in ['$GIT_DIR', '$GIT_WORK_TREE'] + if exists(evar) + throw evar.' detected. Cannot proceed.' + endif + endfor + + call s:job_abort() + if s:switch_in() + if b:plug_preview == 1 + pc + endif + enew + else + call s:new_window() + endif + + nnoremap q :if b:plug_preview==1pcendifbd + if a:0 == 0 + call s:finish_bindings() + endif + let b:plug_preview = -1 + let s:plug_tab = tabpagenr() + let s:plug_buf = winbufnr(0) + call s:assign_name() + + for k in ['', 'L', 'o', 'X', 'd', 'dd'] + execute 'silent! unmap ' k + endfor + setlocal buftype=nofile bufhidden=wipe nobuflisted nolist noswapfile nowrap cursorline modifiable nospell + if exists('+colorcolumn') + setlocal colorcolumn= + endif + setf vim-plug + if exists('g:syntax_on') + call s:syntax() + endif +endfunction + +function! s:assign_name() + " Assign buffer name + let prefix = '[Plugins]' + let name = prefix + let idx = 2 + while bufexists(name) + let name = printf('%s (%s)', prefix, idx) + let idx = idx + 1 + endwhile + silent! execute 'f' fnameescape(name) +endfunction + +function! s:chsh(swap) + let prev = [&shell, &shellcmdflag, &shellredir] + if s:is_win + set shell=cmd.exe shellcmdflag=/c shellredir=>%s\ 2>&1 + elseif a:swap + set shell=sh shellredir=>%s\ 2>&1 + endif + return prev +endfunction + +function! s:bang(cmd, ...) + try + let [sh, shellcmdflag, shrd] = s:chsh(a:0) + " FIXME: Escaping is incomplete. We could use shellescape with eval, + " but it won't work on Windows. + let cmd = a:0 ? s:with_cd(a:cmd, a:1) : a:cmd + if s:is_win + let batchfile = tempname().'.bat' + call writefile(["@echo off\r", cmd . "\r"], batchfile) + let cmd = batchfile + endif + let g:_plug_bang = (s:is_win && has('gui_running') ? 'silent ' : '').'!'.escape(cmd, '#!%') + execute "normal! :execute g:_plug_bang\\" + finally + unlet g:_plug_bang + let [&shell, &shellcmdflag, &shellredir] = [sh, shellcmdflag, shrd] + if s:is_win + call delete(batchfile) + endif + endtry + return v:shell_error ? 'Exit status: ' . v:shell_error : '' +endfunction + +function! s:regress_bar() + let bar = substitute(getline(2)[1:-2], '.*\zs=', 'x', '') + call s:progress_bar(2, bar, len(bar)) +endfunction + +function! s:is_updated(dir) + return !empty(s:system_chomp('git log --pretty=format:"%h" "HEAD...HEAD@{1}"', a:dir)) +endfunction + +function! s:do(pull, force, todo) + for [name, spec] in items(a:todo) + if !isdirectory(spec.dir) + continue + endif + let installed = has_key(s:update.new, name) + let updated = installed ? 0 : + \ (a:pull && index(s:update.errors, name) < 0 && s:is_updated(spec.dir)) + if a:force || installed || updated + execute 'cd' s:esc(spec.dir) + call append(3, '- Post-update hook for '. name .' ... ') + let error = '' + let type = type(spec.do) + if type == s:TYPE.string + if spec.do[0] == ':' + if !get(s:loaded, name, 0) + let s:loaded[name] = 1 + call s:reorg_rtp() + endif + call s:load_plugin(spec) + try + execute spec.do[1:] + catch + let error = v:exception + endtry + if !s:plug_window_exists() + cd - + throw 'Warning: vim-plug was terminated by the post-update hook of '.name + endif + else + let error = s:bang(spec.do) + endif + elseif type == s:TYPE.funcref + try + let status = installed ? 'installed' : (updated ? 'updated' : 'unchanged') + call spec.do({ 'name': name, 'status': status, 'force': a:force }) + catch + let error = v:exception + endtry + else + let error = 'Invalid hook type' + endif + call s:switch_in() + call setline(4, empty(error) ? (getline(4) . 'OK') + \ : ('x' . getline(4)[1:] . error)) + if !empty(error) + call add(s:update.errors, name) + call s:regress_bar() + endif + cd - + endif + endfor +endfunction + +function! s:hash_match(a, b) + return stridx(a:a, a:b) == 0 || stridx(a:b, a:a) == 0 +endfunction + +function! s:checkout(spec) + let sha = a:spec.commit + let output = s:system('git rev-parse HEAD', a:spec.dir) + if !v:shell_error && !s:hash_match(sha, s:lines(output)[0]) + let output = s:system( + \ 'git fetch --depth 999999 && git checkout '.s:esc(sha).' --', a:spec.dir) + endif + return output +endfunction + +function! s:finish(pull) + let new_frozen = len(filter(keys(s:update.new), 'g:plugs[v:val].frozen')) + if new_frozen + let s = new_frozen > 1 ? 's' : '' + call append(3, printf('- Installed %d frozen plugin%s', new_frozen, s)) + endif + call append(3, '- Finishing ... ') | 4 + redraw + call plug#helptags() + call plug#end() + call setline(4, getline(4) . 'Done!') + redraw + let msgs = [] + if !empty(s:update.errors) + call add(msgs, "Press 'R' to retry.") + endif + if a:pull && len(s:update.new) < len(filter(getline(5, '$'), + \ "v:val =~ '^- ' && v:val !~# 'Already up.to.date'")) + call add(msgs, "Press 'D' to see the updated changes.") + endif + echo join(msgs, ' ') + call s:finish_bindings() +endfunction + +function! s:retry() + if empty(s:update.errors) + return + endif + echo + call s:update_impl(s:update.pull, s:update.force, + \ extend(copy(s:update.errors), [s:update.threads])) +endfunction + +function! s:is_managed(name) + return has_key(g:plugs[a:name], 'uri') +endfunction + +function! s:names(...) + return sort(filter(keys(g:plugs), 'stridx(v:val, a:1) == 0 && s:is_managed(v:val)')) +endfunction + +function! s:check_ruby() + silent! ruby require 'thread'; VIM::command("let g:plug_ruby = '#{RUBY_VERSION}'") + if !exists('g:plug_ruby') + redraw! + return s:warn('echom', 'Warning: Ruby interface is broken') + endif + let ruby_version = split(g:plug_ruby, '\.') + unlet g:plug_ruby + return s:version_requirement(ruby_version, [1, 8, 7]) +endfunction + +function! s:update_impl(pull, force, args) abort + let sync = index(a:args, '--sync') >= 0 || has('vim_starting') + let args = filter(copy(a:args), 'v:val != "--sync"') + let threads = (len(args) > 0 && args[-1] =~ '^[1-9][0-9]*$') ? + \ remove(args, -1) : get(g:, 'plug_threads', 16) + + let managed = filter(copy(g:plugs), 's:is_managed(v:key)') + let todo = empty(args) ? filter(managed, '!v:val.frozen || !isdirectory(v:val.dir)') : + \ filter(managed, 'index(args, v:key) >= 0') + + if empty(todo) + return s:warn('echo', 'No plugin to '. (a:pull ? 'update' : 'install')) + endif + + if !s:is_win && s:git_version_requirement(2, 3) + let s:git_terminal_prompt = exists('$GIT_TERMINAL_PROMPT') ? $GIT_TERMINAL_PROMPT : '' + let $GIT_TERMINAL_PROMPT = 0 + for plug in values(todo) + let plug.uri = substitute(plug.uri, + \ '^https://git::@github\.com', 'https://github.com', '') + endfor + endif + + if !isdirectory(g:plug_home) + try + call mkdir(g:plug_home, 'p') + catch + return s:err(printf('Invalid plug directory: %s. '. + \ 'Try to call plug#begin with a valid directory', g:plug_home)) + endtry + endif + + if has('nvim') && !exists('*jobwait') && threads > 1 + call s:warn('echom', '[vim-plug] Update Neovim for parallel installer') + endif + + let use_job = s:nvim || s:vim8 + let python = (has('python') || has('python3')) && !use_job + let ruby = has('ruby') && !use_job && (v:version >= 703 || v:version == 702 && has('patch374')) && !(s:is_win && has('gui_running')) && threads > 1 && s:check_ruby() + + let s:update = { + \ 'start': reltime(), + \ 'all': todo, + \ 'todo': copy(todo), + \ 'errors': [], + \ 'pull': a:pull, + \ 'force': a:force, + \ 'new': {}, + \ 'threads': (python || ruby || use_job) ? min([len(todo), threads]) : 1, + \ 'bar': '', + \ 'fin': 0 + \ } + + call s:prepare(1) + call append(0, ['', '']) + normal! 2G + silent! redraw + + let s:clone_opt = get(g:, 'plug_shallow', 1) ? + \ '--depth 1' . (s:git_version_requirement(1, 7, 10) ? ' --no-single-branch' : '') : '' + + if has('win32unix') + let s:clone_opt .= ' -c core.eol=lf -c core.autocrlf=input' + endif + + let s:submodule_opt = s:git_version_requirement(2, 8) ? ' --jobs='.threads : '' + + " Python version requirement (>= 2.7) + if python && !has('python3') && !ruby && !use_job && s:update.threads > 1 + redir => pyv + silent python import platform; print platform.python_version() + redir END + let python = s:version_requirement( + \ map(split(split(pyv)[0], '\.'), 'str2nr(v:val)'), [2, 6]) + endif + + if (python || ruby) && s:update.threads > 1 + try + let imd = &imd + if s:mac_gui + set noimd + endif + if ruby + call s:update_ruby() + else + call s:update_python() + endif + catch + let lines = getline(4, '$') + let printed = {} + silent! 4,$d _ + for line in lines + let name = s:extract_name(line, '.', '') + if empty(name) || !has_key(printed, name) + call append('$', line) + if !empty(name) + let printed[name] = 1 + if line[0] == 'x' && index(s:update.errors, name) < 0 + call add(s:update.errors, name) + end + endif + endif + endfor + finally + let &imd = imd + call s:update_finish() + endtry + else + call s:update_vim() + while use_job && sync + sleep 100m + if s:update.fin + break + endif + endwhile + endif +endfunction + +function! s:log4(name, msg) + call setline(4, printf('- %s (%s)', a:msg, a:name)) + redraw +endfunction + +function! s:update_finish() + if exists('s:git_terminal_prompt') + let $GIT_TERMINAL_PROMPT = s:git_terminal_prompt + endif + if s:switch_in() + call append(3, '- Updating ...') | 4 + for [name, spec] in items(filter(copy(s:update.all), 'index(s:update.errors, v:key) < 0 && (s:update.force || s:update.pull || has_key(s:update.new, v:key))')) + let [pos, _] = s:logpos(name) + if !pos + continue + endif + if has_key(spec, 'commit') + call s:log4(name, 'Checking out '.spec.commit) + let out = s:checkout(spec) + elseif has_key(spec, 'tag') + let tag = spec.tag + if tag =~ '\*' + let tags = s:lines(s:system('git tag --list '.s:shellesc(tag).' --sort -version:refname 2>&1', spec.dir)) + if !v:shell_error && !empty(tags) + let tag = tags[0] + call s:log4(name, printf('Latest tag for %s -> %s', spec.tag, tag)) + call append(3, '') + endif + endif + call s:log4(name, 'Checking out '.tag) + let out = s:system('git checkout -q '.s:esc(tag).' -- 2>&1', spec.dir) + else + let branch = s:esc(get(spec, 'branch', 'master')) + call s:log4(name, 'Merging origin/'.branch) + let out = s:system('git checkout -q '.branch.' -- 2>&1' + \. (has_key(s:update.new, name) ? '' : ('&& git merge --ff-only origin/'.branch.' 2>&1')), spec.dir) + endif + if !v:shell_error && filereadable(spec.dir.'/.gitmodules') && + \ (s:update.force || has_key(s:update.new, name) || s:is_updated(spec.dir)) + call s:log4(name, 'Updating submodules. This may take a while.') + let out .= s:bang('git submodule update --init --recursive'.s:submodule_opt.' 2>&1', spec.dir) + endif + let msg = s:format_message(v:shell_error ? 'x': '-', name, out) + if v:shell_error + call add(s:update.errors, name) + call s:regress_bar() + silent execute pos 'd _' + call append(4, msg) | 4 + elseif !empty(out) + call setline(pos, msg[0]) + endif + redraw + endfor + silent 4 d _ + try + call s:do(s:update.pull, s:update.force, filter(copy(s:update.all), 'index(s:update.errors, v:key) < 0 && has_key(v:val, "do")')) + catch + call s:warn('echom', v:exception) + call s:warn('echo', '') + return + endtry + call s:finish(s:update.pull) + call setline(1, 'Updated. Elapsed time: ' . split(reltimestr(reltime(s:update.start)))[0] . ' sec.') + call s:switch_out('normal! gg') + endif +endfunction + +function! s:job_abort() + if (!s:nvim && !s:vim8) || !exists('s:jobs') + return + endif + + for [name, j] in items(s:jobs) + if s:nvim + silent! call jobstop(j.jobid) + elseif s:vim8 + silent! call job_stop(j.jobid) + endif + if j.new + call s:system('rm -rf ' . s:shellesc(g:plugs[name].dir)) + endif + endfor + let s:jobs = {} +endfunction + +function! s:last_non_empty_line(lines) + let len = len(a:lines) + for idx in range(len) + let line = a:lines[len-idx-1] + if !empty(line) + return line + endif + endfor + return '' +endfunction + +function! s:job_out_cb(self, data) abort + let self = a:self + let data = remove(self.lines, -1) . a:data + let lines = map(split(data, "\n", 1), 'split(v:val, "\r", 1)[-1]') + call extend(self.lines, lines) + " To reduce the number of buffer updates + let self.tick = get(self, 'tick', -1) + 1 + if !self.running || self.tick % len(s:jobs) == 0 + let bullet = self.running ? (self.new ? '+' : '*') : (self.error ? 'x' : '-') + let result = self.error ? join(self.lines, "\n") : s:last_non_empty_line(self.lines) + call s:log(bullet, self.name, result) + endif +endfunction + +function! s:job_exit_cb(self, data) abort + let a:self.running = 0 + let a:self.error = a:data != 0 + call s:reap(a:self.name) + call s:tick() +endfunction + +function! s:job_cb(fn, job, ch, data) + if !s:plug_window_exists() " plug window closed + return s:job_abort() + endif + call call(a:fn, [a:job, a:data]) +endfunction + +function! s:nvim_cb(job_id, data, event) dict abort + return a:event == 'stdout' ? + \ s:job_cb('s:job_out_cb', self, 0, join(a:data, "\n")) : + \ s:job_cb('s:job_exit_cb', self, 0, a:data) +endfunction + +function! s:spawn(name, cmd, opts) + let job = { 'name': a:name, 'running': 1, 'error': 0, 'lines': [''], + \ 'batchfile': (s:is_win && (s:nvim || s:vim8)) ? tempname().'.bat' : '', + \ 'new': get(a:opts, 'new', 0) } + let s:jobs[a:name] = job + let cmd = has_key(a:opts, 'dir') ? s:with_cd(a:cmd, a:opts.dir) : a:cmd + if !empty(job.batchfile) + call writefile(["@echo off\r", cmd . "\r"], job.batchfile) + let cmd = job.batchfile + endif + let argv = add(s:is_win ? ['cmd', '/c'] : ['sh', '-c'], cmd) + + if s:nvim + call extend(job, { + \ 'on_stdout': function('s:nvim_cb'), + \ 'on_exit': function('s:nvim_cb'), + \ }) + let jid = jobstart(argv, job) + if jid > 0 + let job.jobid = jid + else + let job.running = 0 + let job.error = 1 + let job.lines = [jid < 0 ? argv[0].' is not executable' : + \ 'Invalid arguments (or job table is full)'] + endif + elseif s:vim8 + let jid = job_start(s:is_win ? join(argv, ' ') : argv, { + \ 'out_cb': function('s:job_cb', ['s:job_out_cb', job]), + \ 'exit_cb': function('s:job_cb', ['s:job_exit_cb', job]), + \ 'out_mode': 'raw' + \}) + if job_status(jid) == 'run' + let job.jobid = jid + else + let job.running = 0 + let job.error = 1 + let job.lines = ['Failed to start job'] + endif + else + let job.lines = s:lines(call('s:system', [cmd])) + let job.error = v:shell_error != 0 + let job.running = 0 + endif +endfunction + +function! s:reap(name) + let job = s:jobs[a:name] + if job.error + call add(s:update.errors, a:name) + elseif get(job, 'new', 0) + let s:update.new[a:name] = 1 + endif + let s:update.bar .= job.error ? 'x' : '=' + + let bullet = job.error ? 'x' : '-' + let result = job.error ? join(job.lines, "\n") : s:last_non_empty_line(job.lines) + call s:log(bullet, a:name, empty(result) ? 'OK' : result) + call s:bar() + + if has_key(job, 'batchfile') && !empty(job.batchfile) + call delete(job.batchfile) + endif + call remove(s:jobs, a:name) +endfunction + +function! s:bar() + if s:switch_in() + let total = len(s:update.all) + call setline(1, (s:update.pull ? 'Updating' : 'Installing'). + \ ' plugins ('.len(s:update.bar).'/'.total.')') + call s:progress_bar(2, s:update.bar, total) + call s:switch_out() + endif +endfunction + +function! s:logpos(name) + for i in range(4, line('$')) + if getline(i) =~# '^[-+x*] '.a:name.':' + for j in range(i + 1, line('$')) + if getline(j) !~ '^ ' + return [i, j - 1] + endif + endfor + return [i, i] + endif + endfor + return [0, 0] +endfunction + +function! s:log(bullet, name, lines) + if s:switch_in() + let [b, e] = s:logpos(a:name) + if b > 0 + silent execute printf('%d,%d d _', b, e) + if b > winheight('.') + let b = 4 + endif + else + let b = 4 + endif + " FIXME For some reason, nomodifiable is set after :d in vim8 + setlocal modifiable + call append(b - 1, s:format_message(a:bullet, a:name, a:lines)) + call s:switch_out() + endif +endfunction + +function! s:update_vim() + let s:jobs = {} + + call s:bar() + call s:tick() +endfunction + +function! s:tick() + let pull = s:update.pull + let prog = s:progress_opt(s:nvim || s:vim8) +while 1 " Without TCO, Vim stack is bound to explode + if empty(s:update.todo) + if empty(s:jobs) && !s:update.fin + call s:update_finish() + let s:update.fin = 1 + endif + return + endif + + let name = keys(s:update.todo)[0] + let spec = remove(s:update.todo, name) + let new = empty(globpath(spec.dir, '.git', 1)) + + call s:log(new ? '+' : '*', name, pull ? 'Updating ...' : 'Installing ...') + redraw + + let has_tag = has_key(spec, 'tag') + if !new + let [error, _] = s:git_validate(spec, 0) + if empty(error) + if pull + let fetch_opt = (has_tag && !empty(globpath(spec.dir, '.git/shallow'))) ? '--depth 99999999' : '' + call s:spawn(name, printf('git fetch %s %s 2>&1', fetch_opt, prog), { 'dir': spec.dir }) + else + let s:jobs[name] = { 'running': 0, 'lines': ['Already installed'], 'error': 0 } + endif + else + let s:jobs[name] = { 'running': 0, 'lines': s:lines(error), 'error': 1 } + endif + else + call s:spawn(name, + \ printf('git clone %s %s %s %s 2>&1', + \ has_tag ? '' : s:clone_opt, + \ prog, + \ s:shellesc(spec.uri), + \ s:shellesc(s:trim(spec.dir))), { 'new': 1 }) + endif + + if !s:jobs[name].running + call s:reap(name) + endif + if len(s:jobs) >= s:update.threads + break + endif +endwhile +endfunction + +function! s:update_python() +let py_exe = has('python') ? 'python' : 'python3' +execute py_exe "<< EOF" +import datetime +import functools +import os +try: + import queue +except ImportError: + import Queue as queue +import random +import re +import shutil +import signal +import subprocess +import tempfile +import threading as thr +import time +import traceback +import vim + +G_NVIM = vim.eval("has('nvim')") == '1' +G_PULL = vim.eval('s:update.pull') == '1' +G_RETRIES = int(vim.eval('get(g:, "plug_retries", 2)')) + 1 +G_TIMEOUT = int(vim.eval('get(g:, "plug_timeout", 60)')) +G_CLONE_OPT = vim.eval('s:clone_opt') +G_PROGRESS = vim.eval('s:progress_opt(1)') +G_LOG_PROB = 1.0 / int(vim.eval('s:update.threads')) +G_STOP = thr.Event() +G_IS_WIN = vim.eval('s:is_win') == '1' + +class PlugError(Exception): + def __init__(self, msg): + self.msg = msg +class CmdTimedOut(PlugError): + pass +class CmdFailed(PlugError): + pass +class InvalidURI(PlugError): + pass +class Action(object): + INSTALL, UPDATE, ERROR, DONE = ['+', '*', 'x', '-'] + +class Buffer(object): + def __init__(self, lock, num_plugs, is_pull): + self.bar = '' + self.event = 'Updating' if is_pull else 'Installing' + self.lock = lock + self.maxy = int(vim.eval('winheight(".")')) + self.num_plugs = num_plugs + + def __where(self, name): + """ Find first line with name in current buffer. Return line num. """ + found, lnum = False, 0 + matcher = re.compile('^[-+x*] {0}:'.format(name)) + for line in vim.current.buffer: + if matcher.search(line) is not None: + found = True + break + lnum += 1 + + if not found: + lnum = -1 + return lnum + + def header(self): + curbuf = vim.current.buffer + curbuf[0] = self.event + ' plugins ({0}/{1})'.format(len(self.bar), self.num_plugs) + + num_spaces = self.num_plugs - len(self.bar) + curbuf[1] = '[{0}{1}]'.format(self.bar, num_spaces * ' ') + + with self.lock: + vim.command('normal! 2G') + vim.command('redraw') + + def write(self, action, name, lines): + first, rest = lines[0], lines[1:] + msg = ['{0} {1}{2}{3}'.format(action, name, ': ' if first else '', first)] + msg.extend([' ' + line for line in rest]) + + try: + if action == Action.ERROR: + self.bar += 'x' + vim.command("call add(s:update.errors, '{0}')".format(name)) + elif action == Action.DONE: + self.bar += '=' + + curbuf = vim.current.buffer + lnum = self.__where(name) + if lnum != -1: # Found matching line num + del curbuf[lnum] + if lnum > self.maxy and action in set([Action.INSTALL, Action.UPDATE]): + lnum = 3 + else: + lnum = 3 + curbuf.append(msg, lnum) + + self.header() + except vim.error: + pass + +class Command(object): + CD = 'cd /d' if G_IS_WIN else 'cd' + + def __init__(self, cmd, cmd_dir=None, timeout=60, cb=None, clean=None): + self.cmd = cmd + if cmd_dir: + self.cmd = '{0} {1} && {2}'.format(Command.CD, cmd_dir, self.cmd) + self.timeout = timeout + self.callback = cb if cb else (lambda msg: None) + self.clean = clean if clean else (lambda: None) + self.proc = None + + @property + def alive(self): + """ Returns true only if command still running. """ + return self.proc and self.proc.poll() is None + + def execute(self, ntries=3): + """ Execute the command with ntries if CmdTimedOut. + Returns the output of the command if no Exception. + """ + attempt, finished, limit = 0, False, self.timeout + + while not finished: + try: + attempt += 1 + result = self.try_command() + finished = True + return result + except CmdTimedOut: + if attempt != ntries: + self.notify_retry() + self.timeout += limit + else: + raise + + def notify_retry(self): + """ Retry required for command, notify user. """ + for count in range(3, 0, -1): + if G_STOP.is_set(): + raise KeyboardInterrupt + msg = 'Timeout. Will retry in {0} second{1} ...'.format( + count, 's' if count != 1 else '') + self.callback([msg]) + time.sleep(1) + self.callback(['Retrying ...']) + + def try_command(self): + """ Execute a cmd & poll for callback. Returns list of output. + Raises CmdFailed -> return code for Popen isn't 0 + Raises CmdTimedOut -> command exceeded timeout without new output + """ + first_line = True + + try: + tfile = tempfile.NamedTemporaryFile(mode='w+b') + preexec_fn = not G_IS_WIN and os.setsid or None + self.proc = subprocess.Popen(self.cmd, stdout=tfile, + stderr=subprocess.STDOUT, + stdin=subprocess.PIPE, shell=True, + preexec_fn=preexec_fn) + thrd = thr.Thread(target=(lambda proc: proc.wait()), args=(self.proc,)) + thrd.start() + + thread_not_started = True + while thread_not_started: + try: + thrd.join(0.1) + thread_not_started = False + except RuntimeError: + pass + + while self.alive: + if G_STOP.is_set(): + raise KeyboardInterrupt + + if first_line or random.random() < G_LOG_PROB: + first_line = False + line = '' if G_IS_WIN else nonblock_read(tfile.name) + if line: + self.callback([line]) + + time_diff = time.time() - os.path.getmtime(tfile.name) + if time_diff > self.timeout: + raise CmdTimedOut(['Timeout!']) + + thrd.join(0.5) + + tfile.seek(0) + result = [line.decode('utf-8', 'replace').rstrip() for line in tfile] + + if self.proc.returncode != 0: + raise CmdFailed([''] + result) + + return result + except: + self.terminate() + raise + + def terminate(self): + """ Terminate process and cleanup. """ + if self.alive: + if G_IS_WIN: + os.kill(self.proc.pid, signal.SIGINT) + else: + os.killpg(self.proc.pid, signal.SIGTERM) + self.clean() + +class Plugin(object): + def __init__(self, name, args, buf_q, lock): + self.name = name + self.args = args + self.buf_q = buf_q + self.lock = lock + self.tag = args.get('tag', 0) + + def manage(self): + try: + if os.path.exists(self.args['dir']): + self.update() + else: + self.install() + with self.lock: + thread_vim_command("let s:update.new['{0}'] = 1".format(self.name)) + except PlugError as exc: + self.write(Action.ERROR, self.name, exc.msg) + except KeyboardInterrupt: + G_STOP.set() + self.write(Action.ERROR, self.name, ['Interrupted!']) + except: + # Any exception except those above print stack trace + msg = 'Trace:\n{0}'.format(traceback.format_exc().rstrip()) + self.write(Action.ERROR, self.name, msg.split('\n')) + raise + + def install(self): + target = self.args['dir'] + if target[-1] == '\\': + target = target[0:-1] + + def clean(target): + def _clean(): + try: + shutil.rmtree(target) + except OSError: + pass + return _clean + + self.write(Action.INSTALL, self.name, ['Installing ...']) + callback = functools.partial(self.write, Action.INSTALL, self.name) + cmd = 'git clone {0} {1} {2} {3} 2>&1'.format( + '' if self.tag else G_CLONE_OPT, G_PROGRESS, self.args['uri'], + esc(target)) + com = Command(cmd, None, G_TIMEOUT, callback, clean(target)) + result = com.execute(G_RETRIES) + self.write(Action.DONE, self.name, result[-1:]) + + def repo_uri(self): + cmd = 'git rev-parse --abbrev-ref HEAD 2>&1 && git config -f .git/config remote.origin.url' + command = Command(cmd, self.args['dir'], G_TIMEOUT,) + result = command.execute(G_RETRIES) + return result[-1] + + def update(self): + actual_uri = self.repo_uri() + expect_uri = self.args['uri'] + regex = re.compile(r'^(?:\w+://)?(?:[^@/]*@)?([^:/]*(?::[0-9]*)?)[:/](.*?)(?:\.git)?/?$') + ma = regex.match(actual_uri) + mb = regex.match(expect_uri) + if ma is None or mb is None or ma.groups() != mb.groups(): + msg = ['', + 'Invalid URI: {0}'.format(actual_uri), + 'Expected {0}'.format(expect_uri), + 'PlugClean required.'] + raise InvalidURI(msg) + + if G_PULL: + self.write(Action.UPDATE, self.name, ['Updating ...']) + callback = functools.partial(self.write, Action.UPDATE, self.name) + fetch_opt = '--depth 99999999' if self.tag and os.path.isfile(os.path.join(self.args['dir'], '.git/shallow')) else '' + cmd = 'git fetch {0} {1} 2>&1'.format(fetch_opt, G_PROGRESS) + com = Command(cmd, self.args['dir'], G_TIMEOUT, callback) + result = com.execute(G_RETRIES) + self.write(Action.DONE, self.name, result[-1:]) + else: + self.write(Action.DONE, self.name, ['Already installed']) + + def write(self, action, name, msg): + self.buf_q.put((action, name, msg)) + +class PlugThread(thr.Thread): + def __init__(self, tname, args): + super(PlugThread, self).__init__() + self.tname = tname + self.args = args + + def run(self): + thr.current_thread().name = self.tname + buf_q, work_q, lock = self.args + + try: + while not G_STOP.is_set(): + name, args = work_q.get_nowait() + plug = Plugin(name, args, buf_q, lock) + plug.manage() + work_q.task_done() + except queue.Empty: + pass + +class RefreshThread(thr.Thread): + def __init__(self, lock): + super(RefreshThread, self).__init__() + self.lock = lock + self.running = True + + def run(self): + while self.running: + with self.lock: + thread_vim_command('noautocmd normal! a') + time.sleep(0.33) + + def stop(self): + self.running = False + +if G_NVIM: + def thread_vim_command(cmd): + vim.session.threadsafe_call(lambda: vim.command(cmd)) +else: + def thread_vim_command(cmd): + vim.command(cmd) + +def esc(name): + return '"' + name.replace('"', '\"') + '"' + +def nonblock_read(fname): + """ Read a file with nonblock flag. Return the last line. """ + fread = os.open(fname, os.O_RDONLY | os.O_NONBLOCK) + buf = os.read(fread, 100000).decode('utf-8', 'replace') + os.close(fread) + + line = buf.rstrip('\r\n') + left = max(line.rfind('\r'), line.rfind('\n')) + if left != -1: + left += 1 + line = line[left:] + + return line + +def main(): + thr.current_thread().name = 'main' + nthreads = int(vim.eval('s:update.threads')) + plugs = vim.eval('s:update.todo') + mac_gui = vim.eval('s:mac_gui') == '1' + + lock = thr.Lock() + buf = Buffer(lock, len(plugs), G_PULL) + buf_q, work_q = queue.Queue(), queue.Queue() + for work in plugs.items(): + work_q.put(work) + + start_cnt = thr.active_count() + for num in range(nthreads): + tname = 'PlugT-{0:02}'.format(num) + thread = PlugThread(tname, (buf_q, work_q, lock)) + thread.start() + if mac_gui: + rthread = RefreshThread(lock) + rthread.start() + + while not buf_q.empty() or thr.active_count() != start_cnt: + try: + action, name, msg = buf_q.get(True, 0.25) + buf.write(action, name, ['OK'] if not msg else msg) + buf_q.task_done() + except queue.Empty: + pass + except KeyboardInterrupt: + G_STOP.set() + + if mac_gui: + rthread.stop() + rthread.join() + +main() +EOF +endfunction + +function! s:update_ruby() + ruby << EOF + module PlugStream + SEP = ["\r", "\n", nil] + def get_line + buffer = '' + loop do + char = readchar rescue return + if SEP.include? char.chr + buffer << $/ + break + else + buffer << char + end + end + buffer + end + end unless defined?(PlugStream) + + def esc arg + %["#{arg.gsub('"', '\"')}"] + end + + def killall pid + pids = [pid] + if /mswin|mingw|bccwin/ =~ RUBY_PLATFORM + pids.each { |pid| Process.kill 'INT', pid.to_i rescue nil } + else + unless `which pgrep 2> /dev/null`.empty? + children = pids + until children.empty? + children = children.map { |pid| + `pgrep -P #{pid}`.lines.map { |l| l.chomp } + }.flatten + pids += children + end + end + pids.each { |pid| Process.kill 'TERM', pid.to_i rescue nil } + end + end + + def compare_git_uri a, b + regex = %r{^(?:\w+://)?(?:[^@/]*@)?([^:/]*(?::[0-9]*)?)[:/](.*?)(?:\.git)?/?$} + regex.match(a).to_a.drop(1) == regex.match(b).to_a.drop(1) + end + + require 'thread' + require 'fileutils' + require 'timeout' + running = true + iswin = VIM::evaluate('s:is_win').to_i == 1 + pull = VIM::evaluate('s:update.pull').to_i == 1 + base = VIM::evaluate('g:plug_home') + all = VIM::evaluate('s:update.todo') + limit = VIM::evaluate('get(g:, "plug_timeout", 60)') + tries = VIM::evaluate('get(g:, "plug_retries", 2)') + 1 + nthr = VIM::evaluate('s:update.threads').to_i + maxy = VIM::evaluate('winheight(".")').to_i + vim7 = VIM::evaluate('v:version').to_i <= 703 && RUBY_PLATFORM =~ /darwin/ + cd = iswin ? 'cd /d' : 'cd' + tot = VIM::evaluate('len(s:update.todo)') || 0 + bar = '' + skip = 'Already installed' + mtx = Mutex.new + take1 = proc { mtx.synchronize { running && all.shift } } + logh = proc { + cnt = bar.length + $curbuf[1] = "#{pull ? 'Updating' : 'Installing'} plugins (#{cnt}/#{tot})" + $curbuf[2] = '[' + bar.ljust(tot) + ']' + VIM::command('normal! 2G') + VIM::command('redraw') + } + where = proc { |name| (1..($curbuf.length)).find { |l| $curbuf[l] =~ /^[-+x*] #{name}:/ } } + log = proc { |name, result, type| + mtx.synchronize do + ing = ![true, false].include?(type) + bar += type ? '=' : 'x' unless ing + b = case type + when :install then '+' when :update then '*' + when true, nil then '-' else + VIM::command("call add(s:update.errors, '#{name}')") + 'x' + end + result = + if type || type.nil? + ["#{b} #{name}: #{result.lines.to_a.last || 'OK'}"] + elsif result =~ /^Interrupted|^Timeout/ + ["#{b} #{name}: #{result}"] + else + ["#{b} #{name}"] + result.lines.map { |l| " " << l } + end + if lnum = where.call(name) + $curbuf.delete lnum + lnum = 4 if ing && lnum > maxy + end + result.each_with_index do |line, offset| + $curbuf.append((lnum || 4) - 1 + offset, line.gsub(/\e\[./, '').chomp) + end + logh.call + end + } + bt = proc { |cmd, name, type, cleanup| + tried = timeout = 0 + begin + tried += 1 + timeout += limit + fd = nil + data = '' + if iswin + Timeout::timeout(timeout) do + tmp = VIM::evaluate('tempname()') + system("(#{cmd}) > #{tmp}") + data = File.read(tmp).chomp + File.unlink tmp rescue nil + end + else + fd = IO.popen(cmd).extend(PlugStream) + first_line = true + log_prob = 1.0 / nthr + while line = Timeout::timeout(timeout) { fd.get_line } + data << line + log.call name, line.chomp, type if name && (first_line || rand < log_prob) + first_line = false + end + fd.close + end + [$? == 0, data.chomp] + rescue Timeout::Error, Interrupt => e + if fd && !fd.closed? + killall fd.pid + fd.close + end + cleanup.call if cleanup + if e.is_a?(Timeout::Error) && tried < tries + 3.downto(1) do |countdown| + s = countdown > 1 ? 's' : '' + log.call name, "Timeout. Will retry in #{countdown} second#{s} ...", type + sleep 1 + end + log.call name, 'Retrying ...', type + retry + end + [false, e.is_a?(Interrupt) ? "Interrupted!" : "Timeout!"] + end + } + main = Thread.current + threads = [] + watcher = Thread.new { + if vim7 + while VIM::evaluate('getchar(1)') + sleep 0.1 + end + else + require 'io/console' # >= Ruby 1.9 + nil until IO.console.getch == 3.chr + end + mtx.synchronize do + running = false + threads.each { |t| t.raise Interrupt } unless vim7 + end + threads.each { |t| t.join rescue nil } + main.kill + } + refresh = Thread.new { + while true + mtx.synchronize do + break unless running + VIM::command('noautocmd normal! a') + end + sleep 0.2 + end + } if VIM::evaluate('s:mac_gui') == 1 + + clone_opt = VIM::evaluate('s:clone_opt') + progress = VIM::evaluate('s:progress_opt(1)') + nthr.times do + mtx.synchronize do + threads << Thread.new { + while pair = take1.call + name = pair.first + dir, uri, tag = pair.last.values_at *%w[dir uri tag] + exists = File.directory? dir + ok, result = + if exists + chdir = "#{cd} #{iswin ? dir : esc(dir)}" + ret, data = bt.call "#{chdir} && git rev-parse --abbrev-ref HEAD 2>&1 && git config -f .git/config remote.origin.url", nil, nil, nil + current_uri = data.lines.to_a.last + if !ret + if data =~ /^Interrupted|^Timeout/ + [false, data] + else + [false, [data.chomp, "PlugClean required."].join($/)] + end + elsif !compare_git_uri(current_uri, uri) + [false, ["Invalid URI: #{current_uri}", + "Expected: #{uri}", + "PlugClean required."].join($/)] + else + if pull + log.call name, 'Updating ...', :update + fetch_opt = (tag && File.exist?(File.join(dir, '.git/shallow'))) ? '--depth 99999999' : '' + bt.call "#{chdir} && git fetch #{fetch_opt} #{progress} 2>&1", name, :update, nil + else + [true, skip] + end + end + else + d = esc dir.sub(%r{[\\/]+$}, '') + log.call name, 'Installing ...', :install + bt.call "git clone #{clone_opt unless tag} #{progress} #{uri} #{d} 2>&1", name, :install, proc { + FileUtils.rm_rf dir + } + end + mtx.synchronize { VIM::command("let s:update.new['#{name}'] = 1") } if !exists && ok + log.call name, result, ok + end + } if running + end + end + threads.each { |t| t.join rescue nil } + logh.call + refresh.kill if refresh + watcher.kill +EOF +endfunction + +function! s:shellesc_cmd(arg) + let escaped = substitute(a:arg, '[&|<>()@^]', '^&', 'g') + let escaped = substitute(escaped, '%', '%%', 'g') + let escaped = substitute(escaped, '"', '\\^&', 'g') + let escaped = substitute(escaped, '\(\\\+\)\(\\^\)', '\1\1\2', 'g') + return '^"'.substitute(escaped, '\(\\\+\)$', '\1\1', '').'^"' +endfunction + +function! s:shellesc(arg) + if &shell =~# 'cmd.exe$' + return s:shellesc_cmd(a:arg) + endif + return shellescape(a:arg) +endfunction + +function! s:glob_dir(path) + return map(filter(s:glob(a:path, '**'), 'isdirectory(v:val)'), 's:dirpath(v:val)') +endfunction + +function! s:progress_bar(line, bar, total) + call setline(a:line, '[' . s:lpad(a:bar, a:total) . ']') +endfunction + +function! s:compare_git_uri(a, b) + " See `git help clone' + " https:// [user@] github.com[:port] / junegunn/vim-plug [.git] + " [git@] github.com[:port] : junegunn/vim-plug [.git] + " file:// / junegunn/vim-plug [/] + " / junegunn/vim-plug [/] + let pat = '^\%(\w\+://\)\='.'\%([^@/]*@\)\='.'\([^:/]*\%(:[0-9]*\)\=\)'.'[:/]'.'\(.\{-}\)'.'\%(\.git\)\=/\?$' + let ma = matchlist(a:a, pat) + let mb = matchlist(a:b, pat) + return ma[1:2] ==# mb[1:2] +endfunction + +function! s:format_message(bullet, name, message) + if a:bullet != 'x' + return [printf('%s %s: %s', a:bullet, a:name, s:lastline(a:message))] + else + let lines = map(s:lines(a:message), '" ".v:val') + return extend([printf('x %s:', a:name)], lines) + endif +endfunction + +function! s:with_cd(cmd, dir) + return printf('cd%s %s && %s', s:is_win ? ' /d' : '', s:shellesc(a:dir), a:cmd) +endfunction + +function! s:system(cmd, ...) + try + let [sh, shellcmdflag, shrd] = s:chsh(1) + let cmd = a:0 > 0 ? s:with_cd(a:cmd, a:1) : a:cmd + if s:is_win + let batchfile = tempname().'.bat' + call writefile(["@echo off\r", cmd . "\r"], batchfile) + let cmd = batchfile + endif + return system(s:is_win ? '('.cmd.')' : cmd) + finally + let [&shell, &shellcmdflag, &shellredir] = [sh, shellcmdflag, shrd] + if s:is_win + call delete(batchfile) + endif + endtry +endfunction + +function! s:system_chomp(...) + let ret = call('s:system', a:000) + return v:shell_error ? '' : substitute(ret, '\n$', '', '') +endfunction + +function! s:git_validate(spec, check_branch) + let err = '' + if isdirectory(a:spec.dir) + let result = s:lines(s:system('git rev-parse --abbrev-ref HEAD 2>&1 && git config -f .git/config remote.origin.url', a:spec.dir)) + let remote = result[-1] + if v:shell_error + let err = join([remote, 'PlugClean required.'], "\n") + elseif !s:compare_git_uri(remote, a:spec.uri) + let err = join(['Invalid URI: '.remote, + \ 'Expected: '.a:spec.uri, + \ 'PlugClean required.'], "\n") + elseif a:check_branch && has_key(a:spec, 'commit') + let result = s:lines(s:system('git rev-parse HEAD 2>&1', a:spec.dir)) + let sha = result[-1] + if v:shell_error + let err = join(add(result, 'PlugClean required.'), "\n") + elseif !s:hash_match(sha, a:spec.commit) + let err = join([printf('Invalid HEAD (expected: %s, actual: %s)', + \ a:spec.commit[:6], sha[:6]), + \ 'PlugUpdate required.'], "\n") + endif + elseif a:check_branch + let branch = result[0] + " Check tag + if has_key(a:spec, 'tag') + let tag = s:system_chomp('git describe --exact-match --tags HEAD 2>&1', a:spec.dir) + if a:spec.tag !=# tag && a:spec.tag !~ '\*' + let err = printf('Invalid tag: %s (expected: %s). Try PlugUpdate.', + \ (empty(tag) ? 'N/A' : tag), a:spec.tag) + endif + " Check branch + elseif a:spec.branch !=# branch + let err = printf('Invalid branch: %s (expected: %s). Try PlugUpdate.', + \ branch, a:spec.branch) + endif + if empty(err) + let [ahead, behind] = split(s:lastline(s:system(printf( + \ 'git rev-list --count --left-right HEAD...origin/%s', + \ a:spec.branch), a:spec.dir)), '\t') + if !v:shell_error && ahead + if behind + " Only mention PlugClean if diverged, otherwise it's likely to be + " pushable (and probably not that messed up). + let err = printf( + \ "Diverged from origin/%s (%d commit(s) ahead and %d commit(s) behind!\n" + \ .'Backup local changes and run PlugClean and PlugUpdate to reinstall it.', a:spec.branch, ahead, behind) + else + let err = printf("Ahead of origin/%s by %d commit(s).\n" + \ .'Cannot update until local changes are pushed.', + \ a:spec.branch, ahead) + endif + endif + endif + endif + else + let err = 'Not found' + endif + return [err, err =~# 'PlugClean'] +endfunction + +function! s:rm_rf(dir) + if isdirectory(a:dir) + call s:system((s:is_win ? 'rmdir /S /Q ' : 'rm -rf ') . s:shellesc(a:dir)) + endif +endfunction + +function! s:clean(force) + call s:prepare() + call append(0, 'Searching for invalid plugins in '.g:plug_home) + call append(1, '') + + " List of valid directories + let dirs = [] + let errs = {} + let [cnt, total] = [0, len(g:plugs)] + for [name, spec] in items(g:plugs) + if !s:is_managed(name) + call add(dirs, spec.dir) + else + let [err, clean] = s:git_validate(spec, 1) + if clean + let errs[spec.dir] = s:lines(err)[0] + else + call add(dirs, spec.dir) + endif + endif + let cnt += 1 + call s:progress_bar(2, repeat('=', cnt), total) + normal! 2G + redraw + endfor + + let allowed = {} + for dir in dirs + let allowed[s:dirpath(fnamemodify(dir, ':h:h'))] = 1 + let allowed[dir] = 1 + for child in s:glob_dir(dir) + let allowed[child] = 1 + endfor + endfor + + let todo = [] + let found = sort(s:glob_dir(g:plug_home)) + while !empty(found) + let f = remove(found, 0) + if !has_key(allowed, f) && isdirectory(f) + call add(todo, f) + call append(line('$'), '- ' . f) + if has_key(errs, f) + call append(line('$'), ' ' . errs[f]) + endif + let found = filter(found, 'stridx(v:val, f) != 0') + end + endwhile + + 4 + redraw + if empty(todo) + call append(line('$'), 'Already clean.') + else + let s:clean_count = 0 + call append(3, ['Directories to delete:', '']) + redraw! + if a:force || s:ask_no_interrupt('Delete all directories?') + call s:delete([6, line('$')], 1) + else + call setline(4, 'Cancelled.') + nnoremap d :set opfunc=delete_opg@ + nmap dd d_ + xnoremap d :call delete_op(visualmode(), 1) + echo 'Delete the lines (d{motion}) to delete the corresponding directories' + endif + endif + 4 + setlocal nomodifiable +endfunction + +function! s:delete_op(type, ...) + call s:delete(a:0 ? [line("'<"), line("'>")] : [line("'["), line("']")], 0) +endfunction + +function! s:delete(range, force) + let [l1, l2] = a:range + let force = a:force + while l1 <= l2 + let line = getline(l1) + if line =~ '^- ' && isdirectory(line[2:]) + execute l1 + redraw! + let answer = force ? 1 : s:ask('Delete '.line[2:].'?', 1) + let force = force || answer > 1 + if answer + call s:rm_rf(line[2:]) + setlocal modifiable + call setline(l1, '~'.line[1:]) + let s:clean_count += 1 + call setline(4, printf('Removed %d directories.', s:clean_count)) + setlocal nomodifiable + endif + endif + let l1 += 1 + endwhile +endfunction + +function! s:upgrade() + echo 'Downloading the latest version of vim-plug' + redraw + let tmp = tempname() + let new = tmp . '/plug.vim' + + try + let out = s:system(printf('git clone --depth 1 %s %s', s:plug_src, tmp)) + if v:shell_error + return s:err('Error upgrading vim-plug: '. out) + endif + + if readfile(s:me) ==# readfile(new) + echo 'vim-plug is already up-to-date' + return 0 + else + call rename(s:me, s:me . '.old') + call rename(new, s:me) + unlet g:loaded_plug + echo 'vim-plug has been upgraded' + return 1 + endif + finally + silent! call s:rm_rf(tmp) + endtry +endfunction + +function! s:upgrade_specs() + for spec in values(g:plugs) + let spec.frozen = get(spec, 'frozen', 0) + endfor +endfunction + +function! s:status() + call s:prepare() + call append(0, 'Checking plugins') + call append(1, '') + + let ecnt = 0 + let unloaded = 0 + let [cnt, total] = [0, len(g:plugs)] + for [name, spec] in items(g:plugs) + let is_dir = isdirectory(spec.dir) + if has_key(spec, 'uri') + if is_dir + let [err, _] = s:git_validate(spec, 1) + let [valid, msg] = [empty(err), empty(err) ? 'OK' : err] + else + let [valid, msg] = [0, 'Not found. Try PlugInstall.'] + endif + else + if is_dir + let [valid, msg] = [1, 'OK'] + else + let [valid, msg] = [0, 'Not found.'] + endif + endif + let cnt += 1 + let ecnt += !valid + " `s:loaded` entry can be missing if PlugUpgraded + if is_dir && get(s:loaded, name, -1) == 0 + let unloaded = 1 + let msg .= ' (not loaded)' + endif + call s:progress_bar(2, repeat('=', cnt), total) + call append(3, s:format_message(valid ? '-' : 'x', name, msg)) + normal! 2G + redraw + endfor + call setline(1, 'Finished. '.ecnt.' error(s).') + normal! gg + setlocal nomodifiable + if unloaded + echo "Press 'L' on each line to load plugin, or 'U' to update" + nnoremap L :call status_load(line('.')) + xnoremap L :call status_load(line('.')) + end +endfunction + +function! s:extract_name(str, prefix, suffix) + return matchstr(a:str, '^'.a:prefix.' \zs[^:]\+\ze:.*'.a:suffix.'$') +endfunction + +function! s:status_load(lnum) + let line = getline(a:lnum) + let name = s:extract_name(line, '-', '(not loaded)') + if !empty(name) + call plug#load(name) + setlocal modifiable + call setline(a:lnum, substitute(line, ' (not loaded)$', '', '')) + setlocal nomodifiable + endif +endfunction + +function! s:status_update() range + let lines = getline(a:firstline, a:lastline) + let names = filter(map(lines, 's:extract_name(v:val, "[x-]", "")'), '!empty(v:val)') + if !empty(names) + echo + execute 'PlugUpdate' join(names) + endif +endfunction + +function! s:is_preview_window_open() + silent! wincmd P + if &previewwindow + wincmd p + return 1 + endif +endfunction + +function! s:find_name(lnum) + for lnum in reverse(range(1, a:lnum)) + let line = getline(lnum) + if empty(line) + return '' + endif + let name = s:extract_name(line, '-', '') + if !empty(name) + return name + endif + endfor + return '' +endfunction + +function! s:preview_commit() + if b:plug_preview < 0 + let b:plug_preview = !s:is_preview_window_open() + endif + + let sha = matchstr(getline('.'), '^ \X*\zs[0-9a-f]\{7,9}') + if empty(sha) + return + endif + + let name = s:find_name(line('.')) + if empty(name) || !has_key(g:plugs, name) || !isdirectory(g:plugs[name].dir) + return + endif + + if exists('g:plug_pwindow') && !s:is_preview_window_open() + execute g:plug_pwindow + execute 'e' sha + else + execute 'pedit' sha + wincmd P + endif + setlocal previewwindow filetype=git buftype=nofile nobuflisted modifiable + try + let [sh, shellcmdflag, shrd] = s:chsh(1) + let cmd = 'cd '.s:shellesc(g:plugs[name].dir).' && git show --no-color --pretty=medium '.sha + if s:is_win + let batchfile = tempname().'.bat' + call writefile(["@echo off\r", cmd . "\r"], batchfile) + let cmd = batchfile + endif + execute 'silent %!' cmd + finally + let [&shell, &shellcmdflag, &shellredir] = [sh, shellcmdflag, shrd] + if s:is_win + call delete(batchfile) + endif + endtry + setlocal nomodifiable + nnoremap q :q + wincmd p +endfunction + +function! s:section(flags) + call search('\(^[x-] \)\@<=[^:]\+:', a:flags) +endfunction + +function! s:format_git_log(line) + let indent = ' ' + let tokens = split(a:line, nr2char(1)) + if len(tokens) != 5 + return indent.substitute(a:line, '\s*$', '', '') + endif + let [graph, sha, refs, subject, date] = tokens + let tag = matchstr(refs, 'tag: [^,)]\+') + let tag = empty(tag) ? ' ' : ' ('.tag.') ' + return printf('%s%s%s%s%s (%s)', indent, graph, sha, tag, subject, date) +endfunction + +function! s:append_ul(lnum, text) + call append(a:lnum, ['', a:text, repeat('-', len(a:text))]) +endfunction + +function! s:diff() + call s:prepare() + call append(0, ['Collecting changes ...', '']) + let cnts = [0, 0] + let bar = '' + let total = filter(copy(g:plugs), 's:is_managed(v:key) && isdirectory(v:val.dir)') + call s:progress_bar(2, bar, len(total)) + for origin in [1, 0] + let plugs = reverse(sort(items(filter(copy(total), (origin ? '' : '!').'(has_key(v:val, "commit") || has_key(v:val, "tag"))')))) + if empty(plugs) + continue + endif + call s:append_ul(2, origin ? 'Pending updates:' : 'Last update:') + for [k, v] in plugs + let range = origin ? '..origin/'.v.branch : 'HEAD@{1}..' + let cmd = 'git log --graph --color=never '.join(map(['--pretty=format:%x01%h%x01%d%x01%s%x01%cr', range], 's:shellesc(v:val)')) + if has_key(v, 'rtp') + let cmd .= ' -- '.s:shellesc(v.rtp) + endif + let diff = s:system_chomp(cmd, v.dir) + if !empty(diff) + let ref = has_key(v, 'tag') ? (' (tag: '.v.tag.')') : has_key(v, 'commit') ? (' '.v.commit) : '' + call append(5, extend(['', '- '.k.':'.ref], map(s:lines(diff), 's:format_git_log(v:val)'))) + let cnts[origin] += 1 + endif + let bar .= '=' + call s:progress_bar(2, bar, len(total)) + normal! 2G + redraw + endfor + if !cnts[origin] + call append(5, ['', 'N/A']) + endif + endfor + call setline(1, printf('%d plugin(s) updated.', cnts[0]) + \ . (cnts[1] ? printf(' %d plugin(s) have pending updates.', cnts[1]) : '')) + + if cnts[0] || cnts[1] + nnoremap (plug-preview) :silent! call preview_commit() + if empty(maparg("\", 'n')) + nmap (plug-preview) + endif + if empty(maparg('o', 'n')) + nmap o (plug-preview) + endif + endif + if cnts[0] + nnoremap X :call revert() + echo "Press 'X' on each block to revert the update" + endif + normal! gg + setlocal nomodifiable +endfunction + +function! s:revert() + if search('^Pending updates', 'bnW') + return + endif + + let name = s:find_name(line('.')) + if empty(name) || !has_key(g:plugs, name) || + \ input(printf('Revert the update of %s? (y/N) ', name)) !~? '^y' + return + endif + + call s:system('git reset --hard HEAD@{1} && git checkout '.s:esc(g:plugs[name].branch).' --', g:plugs[name].dir) + setlocal modifiable + normal! "_dap + setlocal nomodifiable + echo 'Reverted' +endfunction + +function! s:snapshot(force, ...) abort + call s:prepare() + setf vim + call append(0, ['" Generated by vim-plug', + \ '" '.strftime("%c"), + \ '" :source this file in vim to restore the snapshot', + \ '" or execute: vim -S snapshot.vim', + \ '', '', 'PlugUpdate!']) + 1 + let anchor = line('$') - 3 + let names = sort(keys(filter(copy(g:plugs), + \'has_key(v:val, "uri") && !has_key(v:val, "commit") && isdirectory(v:val.dir)'))) + for name in reverse(names) + let sha = s:system_chomp('git rev-parse --short HEAD', g:plugs[name].dir) + if !empty(sha) + call append(anchor, printf("silent! let g:plugs['%s'].commit = '%s'", name, sha)) + redraw + endif + endfor + + if a:0 > 0 + let fn = expand(a:1) + if filereadable(fn) && !(a:force || s:ask(a:1.' already exists. Overwrite?')) + return + endif + call writefile(getline(1, '$'), fn) + echo 'Saved as '.a:1 + silent execute 'e' s:esc(fn) + setf vim + endif +endfunction + +function! s:split_rtp() + return split(&rtp, '\\\@