ian/dotfiles
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Vim window logic, slimv

Browse source
This commit is contained in:
Ian Keane 2020-02-24 20:27:04 -05:00
parent babcc9e44b
commit 515847d07e
791 changed files with 51552 additions and 86 deletions
Download patch file Download diff file Expand all files Collapse all files

14
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/LICENSE.txt Normal file
View file

@ -0,0 +1,14 @@
CL-EMB has fixes by current maintainer, Michael Raskin <38a938c2@rambler.ru>
This fixes are Copyright (c) 2009 by Moscow Center of Continious
Mathematical Education.
CL-EMB is written and Copyright (c) 2004, 2005, 2006 by Stefan Scholl.
Parts of the source are taken from LSP, written by
John Wiseman and copyright 2001, 2002 I/NET Inc.
See lsp-LICENSE.txt
CL-EMB is licensed under the terms of the Lisp Lesser GNU
Public License (http://opensource.franz.com/preamble.html), known as
the LLGPL. The LLGPL consists of a preamble (see above URL) and the
LGPL. Where these conflict, the preamble takes precedence.
CL-EMB is referenced in the preamble as the "LIBRARY."

339
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/README.md Normal file
View file

@ -0,0 +1,339 @@
# cl-emb: Embedded Common Lisp
A mixture of features from eRuby and HTML::Template. You could name it "Yet
Another LSP" (LispServer Pages) but it's a bit more than that and not limited to
a certain server or text format.
This is a mirror of http://mtn-host.prjek.net/projects/cl-emb
The primary development repository is in Monotone, this repository will receive
just the automated snapshots.
# License
[LLGPL](http://opensource.franz.com/preamble.html)
# Installing
```lisp
(ql:quickload :cl-emb)
```
CL-EMB can also be installed manually with [ASDF-INSTALL](http://weitz.de/asdf-install/).
# Usage
## [generic function] `EXECUTE-EMB name &key env generator-maker => string`
`NAME` can be a registered (with `REGISTER-EMB`) emb code or a pathname (type
`PATHNAME`) of a file containing the code. Returns a string. Keyword parameter
ENV to pass objects to the code. `ENV` must be a plist. `ENV` can be accessed
within your emb code. The `GENERATOR-MAKER` is a function which gets called
with a key and value from the given `ENV` and should return a generator function
like described
[here](http://www.cs.northwestern.edu/academics/courses/325/readings/graham/generators.html).
## [generic function] `REGISTER-EMB name code => emb-function`
Internally registeres given `CODE` with `NAME` to be called with
`EXECUTE-EMB`. `CODE` can be a string or a pathname (type `PATHNAME`) of a file
containing the code.
## [function] `PPRINT-EMB-FUNCTION name`
`DEBUG` function. Pretty prints function form, if `*DEBUG*` was `T` when the
function was registered.
## [function] `CLEAR-EMB name`
Remove named emb code.
## [function] `CLEAR-EMB-ALL`
Remove all registered emb code.
## [function] `CLEAR-EMB-ALL-FILES`
Remove all registered file emb code (registered/executed by a pathname).
## [special variable] `*EMB-START-MARKER*` (default `"<%"`)
Start of scriptlet or expression. Remember that a following `#\=` indicates an
expression.
## [special variable] `*EMB-END-MARKER*` (default `"%>"`)
End of scriptlet or expression.
## [special variable] `*ESCAPE-TYPE*`
Default value for escaping `@var` output is `:RAW` Can be changed to `:XML`,
`:HTML`, `:URI`, `:URL`, `:URL-ENCODE`, `:LATEX`.
## [special variable] `*FUNCTION-PACKAGE*`
Package the emb function body gets interned to.
Default: `(find-package :cl-emb-intern)`.
## [special variable] `*DEBUG*`
Debugging mode if `T`. Default: `NIL`.
## [special variable] `*LOCKING-FUNCTION*`
Function to call to lock access to an internal hash table. Must accept a
function designator which must be called with the lock hold.
**IMPORTANT:** The locking function must return the value of the function it
calls!
Example:
```lisp
(defvar *emb-lock* (kmrcl::make-lock "emb-lock")
"Lock for CL-EMB.")
(defun emb-lock-function (func)
"Lock function for CL-EMB."
(kmrcl::with-lock-held (*emb-lock*)
(funcall func)))
(setf emb:*locking-function* 'emb-lock-function)
```
Files get cached and reread when they change.
The emb code consists of normal text (HTML, XML, or any other text format) and
special tags you know from eRuby or JSP (JavaServer Pages) which can hold Common
Lisp or CL-EMB's template tags, perhaps comparable to JSP's taglib.
- `<% ... %>` is a scriptlet tag, and wraps Common Lisp code.
- `<%= ... %>` is an expression tag. Its content gets evaluated and fed as a
parameter to `(FORMAT T "~A" ...)`.
- `<%# ... #%>` is a comment. Everything within will be removed/ignored. Can't
be nested!
## Examples
```lisp
CL-USER> (asdf:oos 'asdf:load-op :cl-emb)
CL-USER> (cl-emb:register-emb "test1"
"10 stars: <% (dotimes (i 10) %>*<% ) %>")
#<CL-EMB::EMB-FUNCTION {9B74259}>
CL-USER> (cl-emb:execute-emb "test1")
"10 stars: **********"
CL-USER> (cl-emb:register-emb "test2" "2 + 2 = <%= (+ 2 2) %>")
#<CL-EMB::EMB-FUNCTION {9BCACE1}>
CL-USER> (cl-emb:execute-emb "test2")
"2 + 2 = 4"
CL-USER> (let ((emb:*emb-start-marker* "<?emb")
(emb:*emb-end-marker* "?>"))
(emb:register-emb "marker-test"
"42 + 42 = <?emb= (+ 42 42) ?>"))
#<CL-EMB::EMB-FUNCTION {97BEFD9}>
CL-USER> (emb:execute-emb "marker-test")
"42 + 42 = 84"
```
# Template Tags
You can use special template tags instead of Common Lisp code between `<%` and
`%>`. This will be translated to Common Lisp and serves as a simple shortcut for
you.
And more important: It's easier to use for non-programmers. A designer can work
on HTML code and insert these simple template tags.
Template tags start with `@`.
Currently supported: `@if`, `@else`, `@endif`, `@ifnotempty`, `@unless`,
`@endunless`, `@var`, `@repeat`, `@endrepeat`, `@loop`, `@endloop`, `@include`,
`@includevar`, `@call`, `@with`, `@endwith`, `@set`, `@genloop`, `@endgenloop`,
`@insert`.
`@if` and `@unless` check if the given parameter is set in the supplied
environment (parameter ENV of `EXECUTE-EMB`). The environment is a plist with
keyword + value pairs. Must be terminated with `@endif` or `@endunless`.
`@ifnotempty` works like `@if` but considers the empty string false.
`@ifequal` accepts two parameters interpreted as variable names. It works like
`@if` but checks whether the values of two variables are equal. Variable names
are intepreted as in `@var`.
Note that `@ifnotempty` and `@ifequal` are supposed to be used together with
`@else` and `@endif`.
`@var` emits the corresponding value from the environment. Uses the escape type
defined in `*ESCAPE-TYPE*` (Default `:raw`, no escaping) or with -escape
modifier. E.g. `<% @var foo -escape xml %>` or without modifier `<% @var foo
%>` Supported escaping: `raw`, `xml` (aka `html`), `uri` (aka `url` or
`url-encode`), `latex`.
`@insert` inserts a given (text) file. Parameter from the environment. E.g. `<%
@insert textfile %>`.
`@repeat` repeats everything between it and `@endrepeat` the given
times. Parameter can be a number or a name. The name will be used to lookup the
corresponding value from the environment.
`@loop` loops over a named list in the environment. Environment gets set to
current plist inside this list. Must be terminated with `@endloop`.
`@include` includes a given file. Relative to current template. `@includevar`
does the same, but the parameter is treated like a variable name containing the
path to the file. Variable name is treated like in `@var`.
`@call` calls a given emb-function, which was registered with `REGISTER-EMB`.
`@with` is similar to `@loop` as it sets the current environment to the named
plist. `@loop` needs a list of plists and `@with` just a plist associated to the
given name. Block ends in `@endwith`.
`@set` is used to set special variables like `*ESCAPE-TYPE*` from within a emb
code. This way a default for a file can be specified in the file itself. The
variables are changed for the current and called/included code. Changes to the
variables in called/included code don't effect the caller/ includer. E.g. `<%
@set escape=uri %>`. Currently supported: `escape` (`raw`, `xml`, `html`, `url`,
`uri`, `url-encode`, `latex`).
`@genloop` starts a special kind of loop: a generator loop. It must be
terminated by `@endgenloop` and operates on a generator returned by the given
`GENERATOR-MAKER` (see `EXECUTE-EMB`). The `GENERATOR-MAKER` gets called with
two parameters: the key (which is the argument to `@genloop`) and the
corresponding value in the plist. Each time in the loop the generator is called
first with the parameter `:TEST` to see if there's data left. The generator
must return a plist on `:NEXT`, which will be the current `ENV` (like `@with` or
within a normal `@loop`).
The parameters which access the environment can just be the name of a keyword
symbol in the plist. `foo` -> :FOO in `(:FOO "bar")` Or you can provide a path
within a nested plist structure by dividing the parts of the path with a
slash. `foo/bar` -> Value of `:BAR` inside the plist at `:FOO`. `(:FOO (:BAR
"yeah"))` -> `"yeah"` Starting the parameter with a slash lets it traverse the
nested plists from the top. That way you can access top values inside loops.
Writing `<% @var foo/bar/quux %>` can be translated to `(GETF (GETF (GETF ENV
:FOO) :BAR) :QUUX)`.
## Examples
```lisp
CL-USER> (cl-emb:register-emb "test1"
"Foo: <% @if foo %>Yes!<% @else %>No!<% @endif %>")
#<CL-EMB::EMB-FUNCTION {9C0F2D1}>
CL-USER> (cl-emb:execute-emb "test1" :env '(:foo t))
"Foo: Yes!"
CL-USER> (cl-emb:execute-emb "test1")
"Foo: No!"
CL-USER> (cl-emb:execute-emb "test1" :env '(:foo nil))
"Foo: No!"
CL-USER> (cl-emb:register-emb "test2"
"What is set? -> <% @call test1 %>")
#<CL-EMB::EMB-FUNCTION {9C526E9}>
CL-USER> (cl-emb:execute-emb "test2" :env '(:foo t))
"What is set? -> Foo: Yes!"
CL-USER> (cl-emb:register-emb "test3"
"10 stars: <% @repeat 10 %>*<% @endrepeat %>")
#<CL-EMB::EMB-FUNCTION {9C9F1D1}>
CL-USER> (cl-emb:execute-emb "test3")
"10 stars: **********"
CL-USER> (cl-emb:register-emb "test4"
"<% @loop numbers %>[<% @var de %>,<% @var en %>]<% @endloop %>")
#<CL-EMB::EMB-FUNCTION {9174DF1}>
CL-USER> (cl-emb:execute-emb "test4"
:env '(:numbers ((:de "EINS" :en "ONE")
(:de "ZWEI" :en "TWO"))))
"[EINS,ONE][ZWEI,TWO]"
CL-USER> (emb:register-emb "test5"
"<a href=\"http://somewhere.test/test.cgi?<% @var foo -escape uri %>\"><% @var foo %></a>")
#<CL-EMB::EMB-FUNCTION {9FBF5F1}>
CL-USER> (let ((emb:*escape-type* :html))
(emb:execute-emb "test5" :env '(:foo "10 > 7")))
"<a href=\"http://somewhere.test/test.cgi?10+%3E+7\">10 &gt; 7</a>"
CL-USER> (emb:register-emb "test6" "1. <% @with one %>BAZ: <% @var baz %><% @endwith%>
2. <% @with two %>BAZ: <% @var baz %><% @endwith%>")
#<CL-EMB::EMB-FUNCTION {9916EB1}>
CL-USER> (emb:execute-emb "test6" :env '(:one (:baz "first")
:two (:baz "second")))
"1. BAZ: first
2. BAZ: second"
CL-USER> (emb:register-emb "test7" " - <% @var foo -escape uri %> - ")
#<CL-EMB::EMB-FUNCTION {96F1239}>
CL-USER> (emb:pprint-emb-function "test7")
(LAMBDA (&OPTIONAL CL-EMB-INTERN::ENV)
(WITH-OUTPUT-TO-STRING (*STANDARD-OUTPUT*)
(PROGN
(WRITE-STRING " - ")
(FORMAT T "~A" (CL-EMB::ECHO (GETF CL-EMB-INTERN::ENV :FOO) :ESCAPE :URI))
(WRITE-STRING " - "))))
; No value
CL-USER> (emb:register-emb "test8" "<% @set escape=xml %>--<% @var hey %>--")
#<CL-EMB::EMB-FUNCTION {962B839}>
CL-USER> (emb:register-emb "test9" "--<% @var hey %>--<% @call test8 %>--<% @var hey %>--")
#<CL-EMB::EMB-FUNCTION {96931A9}>
CL-USER> (emb:execute-emb "test9" :env '(:hey "5>2"))
"--5>2----5&gt;2----5>2--"
CL-USER> (emb:register-emb "test10" "Square root from 1 to <% @var numbers %>: <% @genloop numbers %>sqrt(<% @var number %>) = <% @var sqrt %> <% @endgenloop %>")
#<CL-EMB::EMB-FUNCTION {581EC765}>
CL-USER> (defun make-sqrt-1-to-n-gen (key n)
(declare (ignore key))
(let ((i 1))
#'(lambda (cmd)
(ecase cmd
(:test (> i n))
(:get `(:number ,i :sqrt ,(sqrt i)))
(:next (prog1 `(:number ,i :sqrt ,(sqrt i))
(unless (> i n)
(incf i))))))))
MAKE-SQRT-1-TO-N-GEN
CL-USER> (emb:execute-emb "test10" :env '(:numbers 10) :generator-maker 'make-sqrt-1-to-n-gen)
"Square root from 1 to 10: sqrt(1) = 1.0 sqrt(2) = 1.4142135 sqrt(3) = 1.7320508 sqrt(4) = 2.0 sqrt(5) = 2.236068 sqrt(6) = 2.4494898 sqrt(7) = 2.6457512 sqrt(8) = 2.828427 sqrt(9) = 3.0 sqrt(10) = 3.1622777 "
CL-USER> (emb:register-emb "test11" "<% @loop bands %>Band: <% @var band %> (Genre: <% @var /genre %>)<br><% @endloop %>")
#<CL-EMB::EMB-FUNCTION {58ADB12D}>
CL-USER> (emb:execute-emb "test11" :env '(:genre "Rock" :bands ((:band "Queen") (:band "The Rolling Stones") (:band "ZZ Top"))))
"Band: Queen (Genre: Rock)<br>Band: The Rolling Stones (Genre: Rock)<br>Band: ZZ Top (Genre: Rock)<br>"
CL-USER> (emb:register-emb "test12" "<% @repeat /foo/bar/count %>*<% @endrepeat %>")
#<CL-EMB::EMB-FUNCTION {58B7583D}>
CL-USER> (emb:execute-emb "test12" :env '(:foo (:bar (:count 42))))
"******************************************"
CL-USER> (emb:register-emb "test13" "The file:<pre><% @insert textfile %></pre>")
#<CL-EMB::EMB-FUNCTION {5894326D}>
CL-USER> (emb:execute-emb "test13" :env '(:textfile "/etc/gentoo-release"))
"The file:<pre>Gentoo Base System version 1.6.14
</pre>"
```
# Credits
Uses code from John Wiseman. See http://lemonodor.com/archives/000128.html and
lsp-LICENSE.txt Thanks to Edi Weitz for letting me use his code for
`ESCAPE-FOR-XML`.
Thanks to Eitarow Fukamachi for the whitespace-trimming patch.
Thanks to Christoph Finkensiep for making `getf*` a generic function.
# Author
Stefan Scholl <stesch@no-spoon.de>
# Current Maintainer
Michael Raskin <38a938c2@rambler.ru>

14
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/TODO Normal file
View file

@ -0,0 +1,14 @@
- Documentation
- More examples
- Tests
- Writing own escape functions?
- Better error handling
- Examples for generator loop in the examples.html
- Export GETF-EMB

26
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/cl-emb.asd Normal file
View file

@ -0,0 +1,26 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; This software is Copyright (c) Stefan Scholl, 2004.
;;; Stefan Scholl grants you the rights to distribute
;;; and use this software as governed by the terms
;;; of the Lisp Lesser GNU Public License
;;; (http://opensource.franz.com/preamble.html),
;;; known as the LLGPL.
(in-package #:cl-user)
(defpackage #:cl-emb.system
(:use #:cl
#:asdf))
(in-package #:cl-emb.system)
(defsystem #:cl-emb
:version "0.4.3"
:author "Stefan Scholl <stesch@no-spoon.de>"
:licence "Lesser Lisp General Public License"
:description "A templating system for Common Lisp"
:depends-on (#:cl-ppcre)
:components ((:file "packages")
(:file "emb" :depends-on ("packages"))))

523
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/emb.lisp Normal file
View file

@ -0,0 +1,523 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; This file contains some fixes by Michael Raskin
;;; They are Copyright (c) Moscow Center of Continious Mathematical
;;; Education, 2009
;;; This software is Copyright (c) Stefan Scholl, 2004.
;;; Stefan Scholl grants you the rights to distribute
;;; and use this software as governed by the terms
;;; of the Lisp Lesser GNU Public License
;;; (http://opensource.franz.com/preamble.html),
;;; known as the LLGPL.
;;; Parts of the source are taken from LSP, written by
;;; John Wiseman and copyright 2001, 2002 I/NET Inc.
;;; (http://www.inetmi.com/)
;;; See lsp-LICENSE.txt
(in-package :cl-emb)
(defpackage :cl-emb-intern (:use :cl))
(defvar *function-package* (find-package :cl-emb-intern)
"Package the emb function body gets interned to.")
(defvar *debug* nil
"Debugging for CL-EMB.")
(defvar *locking-function* nil
"Function to call to lock access to an internal hash table. Must accept
a function designator which must be called with the lock hold.")
(defmacro with-lock (&body body)
"Locking all accesses to *functions*"
`(cond (*locking-function*
(funcall *locking-function* #'(lambda () ,@body)))
(t ,@body)))
(defgeneric execute-emb (name &key env generator-maker)
(:documentation "Execute named emb code. Returns a string. Keyword parameter ENV
to pass objects to the code. ENV must be a plist."))
(defmethod execute-emb ((name t) &key env generator-maker)
(funcall (get-emb-function name) :env env :generator-maker generator-maker :name name))
(defmethod execute-emb ((name pathname) &key env generator-maker)
(let ((fun (or (get-emb-function name)
(emb-function-function (register-emb name name)))))
(funcall fun :env env :generator-maker generator-maker :name name)))
(defvar *functions* (make-hash-table :test #'equal)
"Table mapping names to emb-function instances.")
(defclass emb-function ()
((path :initarg :path
:accessor emb-function-path)
(time :initarg :time
:accessor emb-function-time)
(function :initarg :function
:accessor emb-function-function)
(form :initarg :form
:initform nil
:accessor emb-function-form)))
(defun make-emb-function (path time function &optional form)
"Constructor for class EMB-FUNCTION."
(make-instance 'emb-function
:path path
:time time
:function function
:form form))
(defun pprint-emb-function (name)
"DEBUG function. Pretty prints function form, if *DEBUG* was t
when the function was registered."
(with-lock
(pprint (emb-function-form (gethash name *functions*)))))
(defun clear-emb-all ()
"Remove all registered emb code."
(with-lock
(clrhash *functions*)))
(defun clear-emb (name)
"Remove named emb code."
(with-lock
(remhash name *functions*)))
(defun clear-emb-all-files ()
"Remove all registered file emb code (registered/executed by a pathname)."
(with-lock
(maphash (lambda (key value) (declare (ignore value))
(when (typep key 'pathname) (remhash key *functions*)))
*functions*)))
(defun get-emb-function (name)
"Returns the named function implementing a registered emb code.
Rebuilds it when text template was a file which has been modified."
(with-lock
(let* ((emb-function (gethash name *functions*))
(path (when emb-function (emb-function-path emb-function))))
(cond ((and (not (typep name 'pathname)) (null emb-function))
(error "Function ~S not found." name))
((null emb-function)
(return-from get-emb-function))
((and path
(> (file-write-date path) (emb-function-time emb-function)))
;; Update when file is newer
(multiple-value-bind (function form)
(construct-emb-function (contents-of-file path))
(setf (emb-function-time emb-function) (file-write-date path)
(emb-function-function emb-function) function
(emb-function-form emb-function) form))))
(emb-function-function emb-function))))
(defgeneric register-emb (name code)
(:documentation "Register given CODE as NAME."))
(defmethod register-emb (name (code pathname))
(multiple-value-bind (function form)
(construct-emb-function (contents-of-file code))
(with-lock
(setf (gethash name *functions*)
(make-emb-function code
(file-write-date code)
function
form)))))
(defmethod register-emb (name (code string))
(multiple-value-bind (function form)
(construct-emb-function code)
(with-lock
(setf (gethash name *functions*)
(make-emb-function nil
(get-universal-time)
function
form)))))
(defvar *emb-start-marker* "<%"
"Start of scriptlet or expression. Remember that a following #\=
indicates an expression.")
(defvar *emb-end-marker* "%>"
"End of scriptlet or expression.")
(defparameter *set-special-list*
'(("escape" . "cl-emb:*escape-type*")
("case-sensitivity" . "cl-emb:*case-sensitivity*")))
(defparameter *set-parameter-list*
'(("xml" . ":xml")
("html" . ":html")
("url" . ":url")
("uri" . ":uri")
("url-encode" . ":url-encode")
("raw" . ":raw")
("latex" . ":latex")
("t" . "t")
("nil" . "nil")))
;; TODO: Refactor! Looks a bit clumsy.
(defun set-specials (match &rest registers)
"Parse parameter(s) of @set and set special variables
like e. g. *ESCAPE-TYPE*."
;; <% @set escape=xml schnuffel=poe %>
(declare (ignore match))
(let ((setf-pairs
(let ((setf-list nil))
(dolist (pair (cl-ppcre:split "\\s+" (first registers))
(when (first setf-list)
(format nil "~{ ~A~}" (reverse setf-list))))
(destructuring-bind (left right)
(cl-ppcre:split "=" pair)
(let ((place (rest (assoc left *set-special-list* :test #'equalp)))
(value (rest (assoc right *set-parameter-list* :test #'equalp))))
(when (and place value)
(push (concatenate 'string place " " value) setf-list))))))))
(if setf-pairs
(format nil "(setf ~A)" setf-pairs)
"")))
(defparameter *template-tag-expand*
`(("\\s+@if\\s+(\\S+)\\s*" . " (cond ((cl-emb::autofuncall (cl-emb::getf-emb \"\\1\")) ")
("\\s+@ifnotempty\\s+(\\S+)\\s*" . " (cond ((let* ((value (cl-emb::autofuncall (cl-emb::getf-emb \"\\1\")))) (or (numberp value) (> (length value) 0))) ")
("\\s+@ifequal\\s+(\\S+)\\s+(\\S+)\\s*" . " (cond ((equal (format nil \"~a\" (cl-emb::autofuncall (cl-emb::getf-emb \"\\1\"))) (format nil \"~a\" (cl-emb::autofuncall (cl-emb::getf-emb \"\\2\")))) ")
("\\s+@else\\s*" . " ) (t ")
("\\s+@endif\\s*" . " )) ")
("\\s+@unless\\s+(\\S+)\\s*" . " (cond ((not (cl-emb::autofuncall (cl-emb::getf-emb \"\\1\"))) ")
("\\s+@endunless\\s*" . " )) ")
("=?\\s+@var\\s+(\\S+)\\s+-(\\S+)\\s+(\\S+)\\s*"
. "= (cl-emb::echo (cl-emb::getf-emb \"\\1\") :\\2 :\\3) ")
("=?\\s+@var\\s+(\\S+)\\s*" . "= (cl-emb::echo (cl-emb::getf-emb \"\\1\")) ")
("\\s+@repeat\\s+(\\d+)\\s*" . " (dotimes (i \\1) ")
("\\s+@repeat\\s+(\\S+)\\s*" . " (dotimes (i (or (cl-emb::autofuncall (cl-emb::getf-emb \"\\1\")) 0)) ")
("\\s+@endrepeat\\s*" . " ) ")
("\\s+@loop\\s+(\\S+)\\s*" . " (dolist (env (cl-emb::autofuncall (cl-emb::getf-emb \"\\1\"))) ")
("\\s+@endloop\\s*" . " ) ")
("\\s+@genloop\\s+(\\S+)\\s*" . " (let ((env)
(%gen (funcall generator-maker :\\1
(cl-emb::getf-emb \"\\1\"))))
(loop
(when (funcall %gen :test) (return))
(setq env (funcall %gen :next))
(progn ")
("\\s+@endgenloop\\s*" . " ))) ")
("\\s+@with\\s+(\\S+)\\s*" . " (let ((env (cl-emb::autofuncall (cl-emb::getf-emb \"\\1\")))) ")
("\\s+@endwith\\s*" . " ) ")
("\\s+@include\\s+(\\S+)\\s*" . "= (let ((cl-emb:*escape-type* cl-emb:*escape-type*))
(cl-emb:execute-emb (merge-pathnames \"\\1\" template-path-default) :env env :generator-maker generator-maker)) ")
("\\s+@includevar\\s+(\\S+)\\s*" . "= (let* ((cl-emb:*escape-type* cl-emb:*escape-type*)
(parameter (cl-emb::autofuncall (cl-emb::getf-emb \"\\1\"))))
(unless parameter (error \"use of @includevar on undefined parameter ~s\" \"\\1\"))
(cl-emb:execute-emb (merge-pathnames parameter template-path-default) :env env :generator-maker generator-maker)) ")
("\\s+@call\\s+(\\S+)\\s*" . "= (let ((cl-emb:*escape-type* cl-emb:*escape-type*))
(cl-emb:execute-emb \"\\1\" :env env :generator-maker generator-maker)) ")
("\\s+@insert\\s+(\\S+)\\s*" . "= (cl-emb::contents-of-file (merge-pathnames (cl-emb::autofuncall (cl-emb::getf-emb \"\\1\")) template-path-default)) ")
("\\s+@set\\s+(.*?)\\s*" . ,(function set-specials))
("#.*" . "")
)
"List of conses. FIRST is regex, REST replacement (STRING or FUNCTION).
Functions get called with two parameters: match and list of registers.")
;; Code from Edi Weitz's TBNL <http://weitz.de/tbnl/>
(defun escape-for-xml (string)
(with-output-to-string (out)
(with-input-from-string (in string)
(loop for char = (read-char in nil nil)
while char
do (case char
((#\<) (write-string "&lt;" out))
((#\>) (write-string "&gt;" out))
((#\") (write-string "&quot;" out))
((#\') (write-string "&#39;" out))
((#\&) (write-string "&amp;" out))
(otherwise (write-char char out)))))))
(defun escape-by-table (string replacements)
(with-output-to-string (out)
(with-input-from-string (in string)
(loop for char = (read-char in nil nil)
while char
do (let ((new (find char replacements
:test 'equal
:key 'car)))
(if new
(write-string (cdr new) out)
(write-char char out))
)))))
(defvar *latex-replacements*)
(setf *latex-replacements*
(mapcar
(lambda (x) `(,(character (car x)) . ,(cdr x)))
`(
("#" . "\\#")
("$" . "\\$")
("%" . "\\%")
("&" . "\\&")
("_" . "\\_")
("{" . "\\{")
("}" . "\\}")
("<" . "{$<$}")
(">" . "{$>$}")
("\\" . "{$\\backslash{}$}")
("|" . "{$\\vert{}$}")
("~" . "{\\,$\\tilde{}$\\,}")
("^" . "{\\,$\\hat{}$\\,}")
(,(string #\Return) . "~\\\\")
(,(string #\NewLine) . "~\\\\")
("\"" . "{'{}'}")
(,(string (code-char 173)) . "\\-") ; Soft hyphen
(,(string (code-char 160)) . "~") ; No-break space
(,(string (code-char 8209)) . "-") ; Non-breaking hyphen
(,(string (code-char 8211)) . "--") ; En-dash
(,(string (code-char 8212)) . "---") ; Em-dash
(,(string (code-char 8470)) . "{\\textnumero}") ; Number sign
)))
(defun escape-for-latex (string)
(escape-by-table string
*latex-replacements*))
;; Inspired by Edi Weitz' ESCAPE-FOR-HTML
(defun url-encode (string)
"URL-encode a string."
(with-output-to-string (out)
(with-input-from-string (in string)
(loop for char = (read-char in nil nil)
while char
if (find char "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-.")
do (write-char char out)
else if (char= char #\Space)
do (write-char #\+ out)
else
do (format out "%~2,'0x" (char-code char))))))
(defvar *case-sensitivity* nil
"Whether use case-sensitive mode (the default) or case-insensitive mode. If this is set NIL, the case of keys in ENV will be ignored.")
(defun string-to-keyword (string)
"Interns a given STRING uppercased in the keyword package."
(nth-value 0 (intern
(if *case-sensitivity*
string
(string-upcase string)) :keyword)))
(defgeneric getf* (thing key &optional default)
(:documentation "Returns a value by a key"))
(defmethod getf* ((plist list) key &optional default)
"Uses getf to get a value from a plist"
(if *case-sensitivity*
(getf plist key default)
(loop for (k v) on plist by #'cddr
when (string-equal k key)
do (return v)
finally (return default))))
(defmethod getf* ((table hash-table) key &optional default)
"Uses gethash to get a value from a hash-table"
(gethash key table default))
(defmethod getf* ((object standard-object) key &optional default)
"Uses slot-value to get a value from a standard object, where the slot name is derived from key"
(let ((slot-name (intern (princ-to-string key)
(symbol-package (class-name (class-of object))))))
(if (and (slot-exists-p object slot-name)
(slot-boundp object slot-name))
(slot-value object slot-name)
default)))
(defmacro getf-emb (key)
"Search either plist TOPENV or ENV according to the search path in KEY. KEY
is a string."
(let ((plist (if (char= (char key 0) #\/)
(find-symbol "TOPENV" emb:*function-package*)
(find-symbol "ENV" emb:*function-package*)))
(path-parts (cl-ppcre:split "/" key :sharedp t)))
(labels ((dig-plist (plist keys)
(if (null keys)
plist
(dig-plist
(if (zerop (length (first keys)))
plist
`(getf* ,plist ,(string-to-keyword (first keys))))
(rest keys)))))
(dig-plist plist path-parts))))
(defvar *escape-type* :raw
"Default value for escaping @var output.")
(defun autofuncall (v)
(if (functionp v)
(autofuncall (funcall v))
v))
(defun echo (string &key (escape *escape-type*))
"Emit given STRING. Escape if wanted (global or via ESCAPE keyword).
STRING can be NIL."
(let ((str (cond
((stringp string) string)
((null string) "")
((functionp string)
(format nil "~a" (or (autofuncall string) "")))
(t (format nil "~a" string))
)))
(case escape
((:html :xml)
(escape-for-xml str))
((:latex)
(escape-for-latex str))
((:url :uri :url-encode)
(url-encode str))
(otherwise ; incl. :raw
str))))
(defun insert-file (filename)
"Get given file FILENAME."
(contents-of-file filename))
(let ((scanner-hash (make-hash-table :test #'equal)))
(defun scanner-for-expand-template-tag (tag)
"Returns a CL-PPCRE scanner which matches a template tag expanded by EXPAND-TEMPLATE-TAGS.
Scanners are memoized in SCANNER-HASH once they are created."
(or (gethash tag scanner-hash)
(setf (gethash tag scanner-hash)
(ppcre:create-scanner tag))))
(defun clear-expand-template-tag-hash ()
"Removes all scanners for template tags from cache."
(clrhash scanner-hash)))
(defun expand-template-tags (string)
"Expand template-tags (@if, @else, ...) to Common Lisp.
Replacement and regex in *TEMPLATE-TAG-EXPAND*"
(labels ((expand-tags (string &optional (expands *template-tag-expand*))
(let ((regex (scanner-for-expand-template-tag
(concatenate 'string "(?is)"
"^" (first (first expands)) "$")))
(replacement (rest (first expands))))
(if (null (rest expands))
(ppcre:regex-replace-all regex string replacement :simple-calls t)
(expand-tags
(ppcre:regex-replace-all regex string replacement :simple-calls t)
(rest expands))))))
(ppcre:regex-replace-all (format nil "(?is)(~A\\-?)(.+?)(\\-?~A)"
(ppcre:quote-meta-chars *emb-start-marker*)
(ppcre:quote-meta-chars *emb-end-marker*))
string
(lambda (match start-tag string end-tag)
(declare (ignore match))
(if (ppcre:scan "(?is)^#.+#$" string)
""
(concatenate 'string
start-tag
(expand-tags string)
end-tag)))
:simple-calls t)))
(defvar *emb-stream-redirection* "with-output-to-string (*standard-output*)")
(defun construct-emb-function (code)
"Builds and compiles the emb-function out of template code."
(let ((form
`,(let ((*package* *function-package*))
(read-from-string
(format nil "(lambda (&key env generator-maker name)(declare (ignorable env generator-maker))
(let ((topenv env)
(template-path-default (if (typep name 'pathname) name *default-pathname-defaults*)))
(declare (ignorable topenv template-path-default))
(~a
(progn ~A))))"
*emb-stream-redirection*
(construct-emb-body-string
(expand-template-tags code)))))))
(values (compile nil form)
(when *debug* form))))
(defun contents-of-file (pathname)
"Returns a string with the entire contents of the specified file."
(with-open-file (in pathname :direction :input)
;; See http://www.emmett.ca/~sabet/licensets/slurp.html
(let* ((file-length (file-length in))
(seq (make-string file-length))
(pos (read-sequence seq in)))
(if (< pos file-length)
(subseq seq 0 pos)
seq))))
(defun string-right-trim-spaces-until-newline (string)
(remove #\Newline (string-right-trim '(#\Space #\Tab) string)
:from-end t
:count 1))
;; (i) Converts text outside <% ... %> tags into calls
;; to WRITE-STRING, (ii) Text inside <% ... %>
;; ("scriptlets") is straight lisp code, (iii) Text inside <%= ... %>
;; ("expressions") becomes the argument to (FORMAT t "~A" ...)
;; The markers <% and %> can be overridden by setting
;; *emb-start-marker* and *emb-end-marker*
(defun construct-emb-body-string (code &optional (start 0))
"Takes a string containing an emb code and returns a string
containing the lisp code that implements that emb code."
(multiple-value-bind (start-tag start-code tag-type trim-start-whitespaces)
(next-code code start)
(if (not start-tag)
(format nil "(write-string ~S)" (subseq code start))
(let* ((end-code (search *emb-end-marker* code :start2 start-code))
(trim-end-whitespaces (char= (char code (1- end-code)) #\-)))
(if (not end-code)
(error "EOF reached in EMB inside open '~A' tag." *emb-start-marker*)
(format nil "(write-string ~S) ~A ~A"
(if trim-start-whitespaces
(string-right-trim-spaces-until-newline (subseq code start start-tag))
(subseq code start start-tag))
(format nil (tag-template tag-type)
(subseq code start-code (if trim-end-whitespaces
(1- end-code)
end-code)))
(construct-emb-body-string
code
(if trim-end-whitespaces
(let ((next-pos (cl-ppcre:scan "(?:\\S|\\n)" code :start (+ end-code (length *emb-end-marker*)))))
(cond
((null next-pos) (length code))
((char= (elt code next-pos) #\Newline)
(1+ next-pos))
(t next-pos)))
(+ end-code (length *emb-end-marker*))))))))))
;; Finds the next scriptlet or expression tag in EMB source. Returns
;; nil if none are found, otherwise returns 3 values:
;; 1. The position of the first character of the start tag.
;; 2. The position of the contents of the tag.
;; 3. The type of tag (:scriptlet or :expression).
;; 4. Whether trim whitespaces before the start tag.
(defun next-code (string start)
(let ((start-tag (search *emb-start-marker* string :start2 start)))
(if (not start-tag)
nil
(let ((start-code (+ start-tag (length *emb-start-marker*))))
(case (and (> (length string) start-code)
(char string start-code))
(#\= (values start-tag (1+ start-code) :expression nil))
(#\- (values start-tag (1+ start-code) :scriptlet t))
(otherwise (values start-tag start-code :scriptlet nil)))))))
;; Given a tag type (:scriptlet or :expression), returns a format
;; string to be used to generate source code from the contents of the
;; tag.
(defun tag-template (tag-type)
(ecase tag-type
((:scriptlet) "~A")
((:expression) "(format t \"~~A\" ~A)")))

18
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/examples.css Normal file
View file

@ -0,0 +1,18 @@
body { font-family: sans-serif;
background-color: #fff;
color: #000; }
pre { margin-top: 0;
margin-bottom: 0; }
table { width: 100%; }
th, td { text-align: left;
vertical-align: top; }
th { background-color: #eee; }
caption { font-weight: bold; }
table, ol { margin-bottom: 2em; }

232
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/examples.html Normal file
View file

@ -0,0 +1,232 @@
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<link href="examples.css" rel="stylesheet" type="text/css" />
<title>CL-EMB: Examples</title>
</head>
<body>
<h1>Some examples of <a href="http://common-lisp.net/project/cl-emb/">CL-EMB</a> usage</h1>
<ol>
<li><a href="#combine-cl-who">Combining CL-EMB with CL-WHO</a></li>
<li><a href="#simple-loop">A simple loop</a></li>
<li><a href="#build-dropdown">Build a dropdown</a></li>
<li><a href="#mark-fields">Mark invalid form fields</a></li>
<li><a href="#using-generic-templates">Using generic templates</a></li>
</ol>
<table border="1" cellpadding="2" id="combine-cl-who">
<caption>Combining CL-EMB with CL-WHO</caption>
<tr>
<th>
Description
</th>
<td>
You can mix several methods of HTML generating together. Think of <a href="http://www.cliki.net/Lisp%20Markup%20Languages">Lisp Markup Languages</a> like <a href="http://weitz.de/cl-who/">CL-WHO</a>. <small>(Example code from the <a href="http://weitz.de/cl-who/">CL-WHO</a> documentation.)</small>
</td>
</tr>
<tr>
<th>
ENV
</th>
<td>
<code>NIL</code>
</td>
</tr>
<tr>
<th>
Dependencies
</th>
<td>
<a href="http://weitz.de/cl-who/">CL-WHO</a>
</td>
</tr>
<tr>
<td colspan="2">
<pre>&lt;h1&gt;Music links&lt;/h1&gt;
&lt;%
(cl-who:with-html-output (*standard-output*)
(loop for (link . title) in
'((&quot;http://zappa.com/&quot; . &quot;Frank Zappa&quot;)
(&quot;http://marcusmiller.com/&quot; . &quot;Marcus Miller&quot;)
(&quot;http://www.milesdavis.com/&quot; . &quot;Miles Davis&quot;))
do (cl-who:htm (:a :href link
(:b (cl-who:str title)))
:br)))
%&gt;</pre>
</td>
</tr>
</table>
<table border="1" cellpadding="2" id="simple-loop">
<caption>A simple loop</caption>
<tr>
<th>
Description
</th>
<td>
The "Music links" example with template tags and a loop. This example isn't meant to prove anything! Use the method which fits your problem!<br/>
The output of the title gets escaped by CL-EMB ("-escape html"). Depending on the situation you'd rather escape the output yourself and don't want to use any complicated modifiers in the template code itself.
</td>
</tr>
<tr>
<th>
ENV
</th>
<td>
<pre>'(:music-list
((:link "http://zappa.com/" :title "Frank Zappa")
(:link "http://marcusmiller.com/" :title "Marcus Miller")
(:link "http://www.milesdavis.com/" :title "Miles Davis")))</pre>
</td>
</tr>
<tr>
<th>
Dependencies
</th>
<td>
-
</td>
</tr>
<tr>
<td colspan="2">
<pre>&lt;h1&gt;Music links&lt;/h1&gt;
&lt;% @loop music-list %&gt;
&lt;a href=&quot;&lt;% @var link %&gt;&quot;&gt;&lt;b&gt;&lt;% @var title -escape html%&gt;&lt;/b&gt;&lt;/a&gt;&lt;br /&gt;
&lt;% @endloop %&gt;</pre>
</td>
</tr>
</table>
<table border="1" cellpadding="2" id="build-dropdown">
<caption>Build a dropdown</caption>
<tr>
<th>
Description
</th>
<td>
You can mix template style with embedded Common Lisp style. This example shows how to access the plist ENV. Within the loop (<code >@loop</code>) ENV gets bound to every plist in the list.<br/>
<a href="http://weitz.de/tbnl/">TBNL</a> is used to access a submitted parameter "product" and compare it to the current value attribute of the option element.<br/>
Remember the escaping! Set <code>cl-emb:*escape-type*</code> to <code>:html</code> and all output of <code>@var</code> will be escaped correctly.
</td>
</tr>
<tr>
<th>
ENV
</th>
<td>
<pre>'(:products
((:value "foo1" :text "Super Foo")
(:value "fooxl" :text "Super Foo XL")
(:value "bar2000" :text "Ultra Bar 2000")
(:value "hl2" :text "Half-Life 2")
(:value "dn4e4" :text "Vaporware")))</pre>
</td>
</tr>
<tr>
<th>
Dependencies
</th>
<td>
<a href="http://weitz.de/tbnl/">TBNL</a>
</td>
</tr>
<tr>
<td colspan="2">
<pre>&lt;select name=&quot;product&quot;&gt;
&lt;% @loop products %&gt;
&lt;option value=&quot;&lt;% @var value %&gt;&quot;&lt;%
(when (equal (getf env :value) (tbnl:parameter &quot;product&quot;))
%&gt; selected=&quot;selected&quot;&lt;% ) %&gt;&gt;&lt;% @var text %&gt;&lt;/option&gt;
&lt;% @endloop %&gt;
&lt;/select&gt;</pre>
</td>
</tr>
</table>
<table border="1" cellpadding="2" id="mark-fields">
<caption>Mark invalid form fields</caption>
<tr>
<th>
Description
</th>
<td>
Validate a form and mark the errors in the <em>ENV</em> plist.<br />
Again: Remember the escaping!
</td>
</tr>
<tr>
<th>
ENV
</th>
<td>
<pre>'(:email "stesch@home" :email-error t)</pre>
</td>
</tr>
<tr>
<th>
Dependencies
</th>
<td>
-
</td>
</tr>
<tr>
<td colspan="2">
<pre>&lt;% @if email-error %&gt;
&lt;span class=&quot;error&quot;&gt;Please provide valid e-mail address&lt;/span&gt;&lt;br /&gt;
&lt;% @endif %&gt;
&lt;input type=&quot;text&quot; name=&quot;email&quot; value=&quot;&lt;% @var email %&gt;&quot;/&gt;</pre>
</td>
</tr>
</table>
<table border="1" cellpadding="2" id="using-generic-templates">
<caption>Using generic templates</caption>
<tr>
<th>
Description
</th>
<td>
You want to use generic templates which can be called with a defined set of parameters? Then <code>@with</code> and <code>@endwith</code> is what you are looking for. It sets the current <em>ENV</em> to the one accessed by a given name. See the example below, which calls a template for textinput fields.
</td>
</tr>
<tr>
<th>
ENV
</th>
<td>
<pre>'(:name (:name "name"
:length 40)
:e-mail (:name "email"
:value "no@no"
:error t
:length 120))</pre>
</td>
</tr>
<tr>
<th>
Dependencies
</th>
<td>
-
</td>
</tr>
<tr>
<td colspan="2">
<pre>Please enter your name:&lt;br /&gt;
&lt;% @with name %&gt;
&lt;% @include &quot;includes/textinput.tmpl&quot; %&gt;
&lt;% @endwith %&gt;
&lt;br /&gt;
Please enter your e-mail address:&lt;br /&gt;
&lt;small&gt;(Use the TLD &lt;em&gt;.invalid&lt;/em&gt;
if you don't want to receive mail&lt;/small&gt;
&lt;% @with e-mail %&gt;
&lt;% @include &quot;includes/textinput.tmpl&quot; %&gt;
&lt;% @endwith %&gt;</pre>
</td>
</tr>
</table>
</body>
</html>

27
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/lsp-LICENSE.txt Normal file
View file

@ -0,0 +1,27 @@
CL-EMB uses parts of LSP, written by John Wiseman.
See the copyright notice and license for LSP:
---8<---8<---8<---8<---8<---8<---8<---8<---8<---8<---8<---8<---8<---8<---
Copyright (c) 2001, 2002 I/NET Inc.
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.

31
sbcl/.quicklisp/dists/quicklisp/software/cl-emb-20190521-git/packages.lisp Normal file
View file

@ -0,0 +1,31 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; This software is Copyright (c) Stefan Scholl, 2004.
;;; Stefan Scholl grants you the rights to distribute
;;; and use this software as governed by the terms
;;; of the Lisp Lesser GNU Public License
;;; (http://opensource.franz.com/preamble.html),
;;; known as the LLGPL.
(in-package #:cl-user)
(defpackage #:cl-emb
(:nicknames #:emb)
(:use #:cl)
(:export #:execute-emb
#:register-emb
#:pprint-emb-function
#:clear-emb
#:clear-emb-all
#:clear-emb-all-files
#:clear-expand-template-tag-hash
#:*debug*
#:*emb-start-marker*
#:*emb-end-marker*
#:*escape-type*
#:*case-sensitivity*
#:*locking-function*
#:*function-package*
#:getf*
#:construct-emb-function ))