Vim window logic, slimv
This commit is contained in:
Ian Keane
parent
babcc9e44b
commit
515847d07e
791 changed files with 51552 additions and 86 deletions
|
|
@ -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) "<!-- /TMPL_LOOP -->")
|
||||
((:repeat) "<!-- /TMPL_REPEAT -->")
|
||||
((:if :if-else) "<!-- /TMPL_IF -->")
|
||||
((:unless :unless-else) "<!-- /TMPL_UNLESS -->"))))
|
||||
;; 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)))
|
||||
Loading…
Add table
Add a link
Reference in a new issue