├── .gitignore
├── scripts.js
├── styles.css
├── test.el
├── README.creole
├── COPYING
├── creole-tests.el
└── creole.el


/.gitignore:
--------------------------------------------------------------------------------
1 | *~
2 | *.elc
3 | /#*#
4 | /#*.*#
5 | .#*
6 | .#*.*


--------------------------------------------------------------------------------
/scripts.js:
--------------------------------------------------------------------------------
1 | /* Just here to make creole.el's tests pass */
2 | 


--------------------------------------------------------------------------------
/styles.css:
--------------------------------------------------------------------------------
1 | <!-- Needed to make the tests for creole pass -->
2 | 


--------------------------------------------------------------------------------
/test.el:
--------------------------------------------------------------------------------
1 | ;; A piece of elisp to htmlize
2 | 
3 | (defun nic-test-10 (arg1 &key arg2)
4 |   (let ((x 200))
5 |     (format "%S" arg2)))
6 | 
7 | ;; End
8 | 


--------------------------------------------------------------------------------
/README.creole:
--------------------------------------------------------------------------------
  1 | = WikiCreole Parser =
  2 | 
  3 | This is a [[http://www.wikicreole.org/|WikiCreole]] parser in
  4 | [[http://www.emacswiki.org/emacs/EmacsLisp|EmacsLisp]].
  5 | 
  6 | == Rationale ==
  7 | 
  8 | We have [[http://www.emacswiki.org/emacs/EmacsMuse|Emacs Muse]] and we
  9 | have [[http://www.emacswiki.org/emacs/OrgMode|OrgMode]] as wiki/blog
 10 | makers but neither is close to the Creole syntax which is actually the
 11 | syntax used on the [[http://EmacsWiki.org|EmacsWiki]].
 12 | 
 13 | WikiCreole is closest to the OddMuse syntax used there. It also
 14 | happens to be my favorite Wiki syntax.
 15 | 
 16 | The combination of this and
 17 | [[http://emacswiki.org/wiki/Elnode|Elnode]] should make a complete
 18 | EmacsLisp EmacsWiki a possibility. Also a blog engine and all sorts of
 19 | other simple content based things.
 20 | 
 21 | I even like the idea of using WikiCreole as a kind of base language
 22 | for every HTML template I write, rather than HTML.
 23 | 
 24 | == Compliance ==
 25 | 
 26 | This is early stages so it's not fully compliant with WikiCreole
 27 | yet. Here is the [[http://www.wikicreole.org/attach/Creole1.0TestCases/creole1.0test.txt|WikiCreole test document]] 
 28 | and we don't handle some big things and all of what I'd call the exceptions:
 29 | 
 30 | * not ending headings with an appropriate {{{=}}}
 31 | * having whitespace before list items
 32 | * no escapes
 33 | * org-mode tables only
 34 | 
 35 | == Tests ==
 36 | 
 37 | We do have a somewhat comprehensive {{{ERT}}} suite for the code we do
 38 | have.
 39 | 
 40 | == Extensions ==
 41 | 
 42 | We support a couple of extra extensions over Creole right now.
 43 | 
 44 | 
 45 | === Syntax Coloring ===
 46 | 
 47 | We automatically fontify PRE sections with extra markup:
 48 | 
 49 | {{{
 50 | ##! emacs-lisp
 51 | (defun creole-block-parse (text)
 52 |   "Parses TEXT as a creole block.
 53 | 
 54 | A creole block is a paragraph or list item that can include
 55 | links, italic, bold, line break or inline preformatted markup.
 56 | 
 57 | Returns a copy of TEXT with the WikiCreole replaced with
 58 | appropriate HTML."
 59 |   (replace-regexp-in-string
 60 |    "\\*\\*\\(\\(.\\|\n\\)*\\)\\*\\*"
 61 |    "<strong>\\1</strong>"
 62 |    (replace-regexp-in-string
 63 |     "//\\(\\(.\\|\n\\)*\\)//"
 64 |     "<em>\\1</em>"
 65 |     (replace-regexp-in-string
 66 |      "{{{\\(\\(.\\|\n\\)*\\)}}}"
 67 |      "<code>\\1</code>"
 68 |      (replace-regexp-in-string
 69 |       "\\\\"
 70 |       "<br/>"
 71 |       (creole-link-parse text))))))
 72 | }}}
 73 | 
 74 | === Org-Mode tables ===
 75 | 
 76 | Instead of Creole tables, we actually use org-mode tables. Org-mode
 77 | tables are very similar:
 78 | 
 79 | |       Date | Amount | Description         |
 80 | |------------+--------+---------------------|
 81 | | 2011-11-15 | 100.15 | Expensive lunch out |
 82 | | 2011-11-18 |   7.30 | Dry cleaning        |
 83 | | 2011-11-21 |  22.50 | Takeaway curry      |
 84 | |------------+--------+---------------------|
 85 | |            | 129.95 |                     |
 86 | #+TBLFM: @5$2=vsum(@I..@II)
 87 | 
 88 | When a table is exported to HTML it is recalculated, so you can use
 89 | formulas quite happily. Formula lines are not exported to HTML.
 90 | 
 91 | === Lisp callouts ===
 92 | 
 93 | You can call to EmacsLisp like this:
 94 | 
 95 | {{{
 96 | <<(
 97 |  (mapconcat
 98 |    (lambda (s)
 99 |      (format "* %s" s))
100 |    '("rationale" "compliance" "tests")
101 |    "\n")
102 | )>>
103 | }}}
104 | 
105 | And this is what that would output:
106 | 
107 | <<(
108 |  (mapconcat
109 |    (lambda (s)
110 |      (format "* %s" s))
111 |    '("rationale" "compliance" "tests")
112 |    "\n")
113 | )>>
114 | 
115 | It's my intention to build a few Lisp functions specifically for use
116 | inside the Lisp extension element. The first of these is:
117 | 
118 | ==== creole-directory-list directory-name &optional make-links ====
119 | 
120 | WikiCreole format a table of files in //directory-name//.
121 | 
122 | //make-links// causes the files to be WikiCreole links.
123 | 
124 | === HTML ===
125 | 
126 | You can embed HTML directly into this Creole implementation, using a
127 | plugin, like this:
128 | 
129 | <<html
130 | <P>This is HTML which is just embedded <EM>directly</EM> into 
131 | the output.<BR/>
132 | You obviously have to be really <u>careful</u> you don't 
133 | break the output.</P>
134 | html>>
135 | 
136 | === OddMuse Links ===
137 | 
138 | If you set the variable: {{{creole-oddmuse-on}}} to {{{t}}} you can
139 | use OddMuse links, which look like this:
140 | 
141 | {{{
142 | [http://target text about target]
143 | }}}
144 | 
145 | === CamelCaps Links ===
146 | 
147 | If you let bind {{{creole-link-resolver-fn }}} to a function that
148 | resolves links then {{{creole}}} will use that resolver to also
149 | convert CamelCaps to links:
150 | 
151 | {{{
152 | MyLink
153 | }}}
154 | 
155 | will be passed to the resolver, the result of the resolver will be
156 | used to generate the link so that, if the resolver returns:
157 | {{{http://myserver/MyLink}}} the link will be:
158 | 
159 | {{{
160 | <a href="http://myserver/MyLink">MyLink</a>
161 | }}}
162 | 
163 | This is intended to support real Wiki engines, like the EmacsWiki
164 | engine.
165 | 
166 | === Extended embed ===
167 | 
168 | You can use the image syntax to embed things other than images. Use an
169 | embed handler function, which are called like:
170 | 
171 | {{{
172 | (function match-data-object scheme path)
173 | }}}
174 | 
175 | where the {{{match-data-object}}} has the following sub-matches:
176 | 
177 | 1 the url part
178 | 2 the query part with the leading \"?\"
179 | 3 the query part without the \"?\"
180 | 4 the description part with the leading \"|\"
181 | 5 the description part without the leading \"|\"
182 | 
183 | Two examples embed handlers are:
184 | 
185 | {{{creole-youtube-handler}}} and {{{creole-include-handler}}}. The
186 | former provides embed HTML code and the latter will include a whole
187 | other creole file as HTML.
188 | 
189 | == API ==
190 | 
191 | The code is designed to be reused in differing circumstances, it is split into:
192 | 
193 | * a tokenizer {{{creole-tokenizer}}} which produces a list of tokens representing the input document
194 | ** Inline markup inside a paragraph is NOT converted.
195 | * a //parser// {{{creole-structure}}} which takes a tokenizer list and returns a parsed representation
196 | ** note it's only creole lists that need this //parsing// step
197 | ** {{{creole-html}}} adds the parsed structure to the creole source buffer as a local variable
198 | * an HTML exporter {{{creole-html}}} which outputs HTML from a WikiCreole source buffer
199 | ** it always outputs to the same buffer right now, obviously changes coming here
200 | ** it also has an interactive output option
201 | ** it can also take a structure transformation function, see below
202 | * a user tool {{{creole-wiki}}} which can take lots of customization options
203 | 
204 | === Structure Transformation ===
205 | 
206 | The {{{creole-structure}}} function produces a list based syntax tree
207 | of a creole document. The resulting structure can be transformed into
208 | something else.
209 | 
210 | The {{{creole-html}}} function supports a parameter
211 | {{{:structure-transform-fn}}} which can be a function, or a list of
212 | functions, which are passed the structure and can return a transformed
213 | version. The transformed version is then rendered to HTML.
214 | 
215 | This is intended to be used for implementing things like tables of
216 | contents (these are required by EmacsWiki).
217 | 
218 | == About EmacsWiki ==
219 | 
220 | [[http://github.com/aidalgol/elwiki|Here]] is a Wiki engine that is
221 | designed, eventually, to do the job that OddMuse does for the
222 | EmacsWiki. It will use this creole implementation
223 | via [[http://elnode.org|Elnode]] to implement the Wiki.
224 | 
225 | I hope this will produce a more hackable wiki for the Emacs
226 | community. We're a very hacky community, we like to change things, so
227 | having our wiki implemented in Elisp seems like a good step forward.
228 | 
229 | == Using Creole for other doc ==
230 | 
231 | I like writing creole so much that I really don't want to get into
232 | writing texinfo again. Especially for writing manuals for all the
233 | Elisp I do. I wonder if creole could be converted to texinfo? In many
234 | ways texinfo is much richer, so we'd have to find ways of capturing
235 | certain semantics. For example, texinfo has the {{{@function}}} and
236 | {{{@example}}} tags whereas creole just has one syntax for which is
237 | used for code or pre-formatted sections depending on whether it's used
238 | inline or not.
239 | 
240 | I wonder if we couldn't achieve the correct conversion by doing
241 | something smart though. Creole could lookup single word code/pre
242 | markup to see if it's a declared function or variable (via some
243 | program specific lookup function, easy for EmacsLisp, maybe harder for
244 | Java).
245 | 
246 | To achieve this we could just have more hooks in the conversion.
247 | 
248 | == To do ==
249 | 
250 | There are things that people could help with on creole. Here's a list
251 | of my next priorities:
252 | 
253 | * make the block parsing routines more abstract
254 | ** {{{creole-block-parse}}}
255 | ** {{{creole-image-parse}}}
256 | ** {{{creole-link-parse}}}
257 | ** all are fixed to HTML output, they need to be abstracted to allow other transformations
258 | 


--------------------------------------------------------------------------------
/COPYING:
--------------------------------------------------------------------------------
  1 |                     GNU GENERAL PUBLIC LICENSE
  2 |                        Version 3, 29 June 2007
  3 | 
  4 |  Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
  5 |  Everyone is permitted to copy and distribute verbatim copies
  6 |  of this license document, but changing it is not allowed.
  7 | 
  8 |                             Preamble
  9 | 
 10 |   The GNU General Public License is a free, copyleft license for
 11 | software and other kinds of works.
 12 | 
 13 |   The licenses for most software and other practical works are designed
 14 | to take away your freedom to share and change the works.  By contrast,
 15 | the GNU General Public License is intended to guarantee your freedom to
 16 | share and change all versions of a program--to make sure it remains free
 17 | software for all its users.  We, the Free Software Foundation, use the
 18 | GNU General Public License for most of our software; it applies also to
 19 | any other work released this way by its authors.  You can apply it to
 20 | your programs, too.
 21 | 
 22 |   When we speak of free software, we are referring to freedom, not
 23 | price.  Our General Public Licenses are designed to make sure that you
 24 | have the freedom to distribute copies of free software (and charge for
 25 | them if you wish), that you receive source code or can get it if you
 26 | want it, that you can change the software or use pieces of it in new
 27 | free programs, and that you know you can do these things.
 28 | 
 29 |   To protect your rights, we need to prevent others from denying you
 30 | these rights or asking you to surrender the rights.  Therefore, you have
 31 | certain responsibilities if you distribute copies of the software, or if
 32 | you modify it: responsibilities to respect the freedom of others.
 33 | 
 34 |   For example, if you distribute copies of such a program, whether
 35 | gratis or for a fee, you must pass on to the recipients the same
 36 | freedoms that you received.  You must make sure that they, too, receive
 37 | or can get the source code.  And you must show them these terms so they
 38 | know their rights.
 39 | 
 40 |   Developers that use the GNU GPL protect your rights with two steps:
 41 | (1) assert copyright on the software, and (2) offer you this License
 42 | giving you legal permission to copy, distribute and/or modify it.
 43 | 
 44 |   For the developers' and authors' protection, the GPL clearly explains
 45 | that there is no warranty for this free software.  For both users' and
 46 | authors' sake, the GPL requires that modified versions be marked as
 47 | changed, so that their problems will not be attributed erroneously to
 48 | authors of previous versions.
 49 | 
 50 |   Some devices are designed to deny users access to install or run
 51 | modified versions of the software inside them, although the manufacturer
 52 | can do so.  This is fundamentally incompatible with the aim of
 53 | protecting users' freedom to change the software.  The systematic
 54 | pattern of such abuse occurs in the area of products for individuals to
 55 | use, which is precisely where it is most unacceptable.  Therefore, we
 56 | have designed this version of the GPL to prohibit the practice for those
 57 | products.  If such problems arise substantially in other domains, we
 58 | stand ready to extend this provision to those domains in future versions
 59 | of the GPL, as needed to protect the freedom of users.
 60 | 
 61 |   Finally, every program is threatened constantly by software patents.
 62 | States should not allow patents to restrict development and use of
 63 | software on general-purpose computers, but in those that do, we wish to
 64 | avoid the special danger that patents applied to a free program could
 65 | make it effectively proprietary.  To prevent this, the GPL assures that
 66 | patents cannot be used to render the program non-free.
 67 | 
 68 |   The precise terms and conditions for copying, distribution and
 69 | modification follow.
 70 | 
 71 |                        TERMS AND CONDITIONS
 72 | 
 73 |   0. Definitions.
 74 | 
 75 |   "This License" refers to version 3 of the GNU General Public License.
 76 | 
 77 |   "Copyright" also means copyright-like laws that apply to other kinds of
 78 | works, such as semiconductor masks.
 79 | 
 80 |   "The Program" refers to any copyrightable work licensed under this
 81 | License.  Each licensee is addressed as "you".  "Licensees" and
 82 | "recipients" may be individuals or organizations.
 83 | 
 84 |   To "modify" a work means to copy from or adapt all or part of the work
 85 | in a fashion requiring copyright permission, other than the making of an
 86 | exact copy.  The resulting work is called a "modified version" of the
 87 | earlier work or a work "based on" the earlier work.
 88 | 
 89 |   A "covered work" means either the unmodified Program or a work based
 90 | on the Program.
 91 | 
 92 |   To "propagate" a work means to do anything with it that, without
 93 | permission, would make you directly or secondarily liable for
 94 | infringement under applicable copyright law, except executing it on a
 95 | computer or modifying a private copy.  Propagation includes copying,
 96 | distribution (with or without modification), making available to the
 97 | public, and in some countries other activities as well.
 98 | 
 99 |   To "convey" a work means any kind of propagation that enables other
100 | parties to make or receive copies.  Mere interaction with a user through
101 | a computer network, with no transfer of a copy, is not conveying.
102 | 
103 |   An interactive user interface displays "Appropriate Legal Notices"
104 | to the extent that it includes a convenient and prominently visible
105 | feature that (1) displays an appropriate copyright notice, and (2)
106 | tells the user that there is no warranty for the work (except to the
107 | extent that warranties are provided), that licensees may convey the
108 | work under this License, and how to view a copy of this License.  If
109 | the interface presents a list of user commands or options, such as a
110 | menu, a prominent item in the list meets this criterion.
111 | 
112 |   1. Source Code.
113 | 
114 |   The "source code" for a work means the preferred form of the work
115 | for making modifications to it.  "Object code" means any non-source
116 | form of a work.
117 | 
118 |   A "Standard Interface" means an interface that either is an official
119 | standard defined by a recognized standards body, or, in the case of
120 | interfaces specified for a particular programming language, one that
121 | is widely used among developers working in that language.
122 | 
123 |   The "System Libraries" of an executable work include anything, other
124 | than the work as a whole, that (a) is included in the normal form of
125 | packaging a Major Component, but which is not part of that Major
126 | Component, and (b) serves only to enable use of the work with that
127 | Major Component, or to implement a Standard Interface for which an
128 | implementation is available to the public in source code form.  A
129 | "Major Component", in this context, means a major essential component
130 | (kernel, window system, and so on) of the specific operating system
131 | (if any) on which the executable work runs, or a compiler used to
132 | produce the work, or an object code interpreter used to run it.
133 | 
134 |   The "Corresponding Source" for a work in object code form means all
135 | the source code needed to generate, install, and (for an executable
136 | work) run the object code and to modify the work, including scripts to
137 | control those activities.  However, it does not include the work's
138 | System Libraries, or general-purpose tools or generally available free
139 | programs which are used unmodified in performing those activities but
140 | which are not part of the work.  For example, Corresponding Source
141 | includes interface definition files associated with source files for
142 | the work, and the source code for shared libraries and dynamically
143 | linked subprograms that the work is specifically designed to require,
144 | such as by intimate data communication or control flow between those
145 | subprograms and other parts of the work.
146 | 
147 |   The Corresponding Source need not include anything that users
148 | can regenerate automatically from other parts of the Corresponding
149 | Source.
150 | 
151 |   The Corresponding Source for a work in source code form is that
152 | same work.
153 | 
154 |   2. Basic Permissions.
155 | 
156 |   All rights granted under this License are granted for the term of
157 | copyright on the Program, and are irrevocable provided the stated
158 | conditions are met.  This License explicitly affirms your unlimited
159 | permission to run the unmodified Program.  The output from running a
160 | covered work is covered by this License only if the output, given its
161 | content, constitutes a covered work.  This License acknowledges your
162 | rights of fair use or other equivalent, as provided by copyright law.
163 | 
164 |   You may make, run and propagate covered works that you do not
165 | convey, without conditions so long as your license otherwise remains
166 | in force.  You may convey covered works to others for the sole purpose
167 | of having them make modifications exclusively for you, or provide you
168 | with facilities for running those works, provided that you comply with
169 | the terms of this License in conveying all material for which you do
170 | not control copyright.  Those thus making or running the covered works
171 | for you must do so exclusively on your behalf, under your direction
172 | and control, on terms that prohibit them from making any copies of
173 | your copyrighted material outside their relationship with you.
174 | 
175 |   Conveying under any other circumstances is permitted solely under
176 | the conditions stated below.  Sublicensing is not allowed; section 10
177 | makes it unnecessary.
178 | 
179 |   3. Protecting Users' Legal Rights From Anti-Circumvention Law.
180 | 
181 |   No covered work shall be deemed part of an effective technological
182 | measure under any applicable law fulfilling obligations under article
183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or
184 | similar laws prohibiting or restricting circumvention of such
185 | measures.
186 | 
187 |   When you convey a covered work, you waive any legal power to forbid
188 | circumvention of technological measures to the extent such circumvention
189 | is effected by exercising rights under this License with respect to
190 | the covered work, and you disclaim any intention to limit operation or
191 | modification of the work as a means of enforcing, against the work's
192 | users, your or third parties' legal rights to forbid circumvention of
193 | technological measures.
194 | 
195 |   4. Conveying Verbatim Copies.
196 | 
197 |   You may convey verbatim copies of the Program's source code as you
198 | receive it, in any medium, provided that you conspicuously and
199 | appropriately publish on each copy an appropriate copyright notice;
200 | keep intact all notices stating that this License and any
201 | non-permissive terms added in accord with section 7 apply to the code;
202 | keep intact all notices of the absence of any warranty; and give all
203 | recipients a copy of this License along with the Program.
204 | 
205 |   You may charge any price or no price for each copy that you convey,
206 | and you may offer support or warranty protection for a fee.
207 | 
208 |   5. Conveying Modified Source Versions.
209 | 
210 |   You may convey a work based on the Program, or the modifications to
211 | produce it from the Program, in the form of source code under the
212 | terms of section 4, provided that you also meet all of these conditions:
213 | 
214 |     a) The work must carry prominent notices stating that you modified
215 |     it, and giving a relevant date.
216 | 
217 |     b) The work must carry prominent notices stating that it is
218 |     released under this License and any conditions added under section
219 |     7.  This requirement modifies the requirement in section 4 to
220 |     "keep intact all notices".
221 | 
222 |     c) You must license the entire work, as a whole, under this
223 |     License to anyone who comes into possession of a copy.  This
224 |     License will therefore apply, along with any applicable section 7
225 |     additional terms, to the whole of the work, and all its parts,
226 |     regardless of how they are packaged.  This License gives no
227 |     permission to license the work in any other way, but it does not
228 |     invalidate such permission if you have separately received it.
229 | 
230 |     d) If the work has interactive user interfaces, each must display
231 |     Appropriate Legal Notices; however, if the Program has interactive
232 |     interfaces that do not display Appropriate Legal Notices, your
233 |     work need not make them do so.
234 | 
235 |   A compilation of a covered work with other separate and independent
236 | works, which are not by their nature extensions of the covered work,
237 | and which are not combined with it such as to form a larger program,
238 | in or on a volume of a storage or distribution medium, is called an
239 | "aggregate" if the compilation and its resulting copyright are not
240 | used to limit the access or legal rights of the compilation's users
241 | beyond what the individual works permit.  Inclusion of a covered work
242 | in an aggregate does not cause this License to apply to the other
243 | parts of the aggregate.
244 | 
245 |   6. Conveying Non-Source Forms.
246 | 
247 |   You may convey a covered work in object code form under the terms
248 | of sections 4 and 5, provided that you also convey the
249 | machine-readable Corresponding Source under the terms of this License,
250 | in one of these ways:
251 | 
252 |     a) Convey the object code in, or embodied in, a physical product
253 |     (including a physical distribution medium), accompanied by the
254 |     Corresponding Source fixed on a durable physical medium
255 |     customarily used for software interchange.
256 | 
257 |     b) Convey the object code in, or embodied in, a physical product
258 |     (including a physical distribution medium), accompanied by a
259 |     written offer, valid for at least three years and valid for as
260 |     long as you offer spare parts or customer support for that product
261 |     model, to give anyone who possesses the object code either (1) a
262 |     copy of the Corresponding Source for all the software in the
263 |     product that is covered by this License, on a durable physical
264 |     medium customarily used for software interchange, for a price no
265 |     more than your reasonable cost of physically performing this
266 |     conveying of source, or (2) access to copy the
267 |     Corresponding Source from a network server at no charge.
268 | 
269 |     c) Convey individual copies of the object code with a copy of the
270 |     written offer to provide the Corresponding Source.  This
271 |     alternative is allowed only occasionally and noncommercially, and
272 |     only if you received the object code with such an offer, in accord
273 |     with subsection 6b.
274 | 
275 |     d) Convey the object code by offering access from a designated
276 |     place (gratis or for a charge), and offer equivalent access to the
277 |     Corresponding Source in the same way through the same place at no
278 |     further charge.  You need not require recipients to copy the
279 |     Corresponding Source along with the object code.  If the place to
280 |     copy the object code is a network server, the Corresponding Source
281 |     may be on a different server (operated by you or a third party)
282 |     that supports equivalent copying facilities, provided you maintain
283 |     clear directions next to the object code saying where to find the
284 |     Corresponding Source.  Regardless of what server hosts the
285 |     Corresponding Source, you remain obligated to ensure that it is
286 |     available for as long as needed to satisfy these requirements.
287 | 
288 |     e) Convey the object code using peer-to-peer transmission, provided
289 |     you inform other peers where the object code and Corresponding
290 |     Source of the work are being offered to the general public at no
291 |     charge under subsection 6d.
292 | 
293 |   A separable portion of the object code, whose source code is excluded
294 | from the Corresponding Source as a System Library, need not be
295 | included in conveying the object code work.
296 | 
297 |   A "User Product" is either (1) a "consumer product", which means any
298 | tangible personal property which is normally used for personal, family,
299 | or household purposes, or (2) anything designed or sold for incorporation
300 | into a dwelling.  In determining whether a product is a consumer product,
301 | doubtful cases shall be resolved in favor of coverage.  For a particular
302 | product received by a particular user, "normally used" refers to a
303 | typical or common use of that class of product, regardless of the status
304 | of the particular user or of the way in which the particular user
305 | actually uses, or expects or is expected to use, the product.  A product
306 | is a consumer product regardless of whether the product has substantial
307 | commercial, industrial or non-consumer uses, unless such uses represent
308 | the only significant mode of use of the product.
309 | 
310 |   "Installation Information" for a User Product means any methods,
311 | procedures, authorization keys, or other information required to install
312 | and execute modified versions of a covered work in that User Product from
313 | a modified version of its Corresponding Source.  The information must
314 | suffice to ensure that the continued functioning of the modified object
315 | code is in no case prevented or interfered with solely because
316 | modification has been made.
317 | 
318 |   If you convey an object code work under this section in, or with, or
319 | specifically for use in, a User Product, and the conveying occurs as
320 | part of a transaction in which the right of possession and use of the
321 | User Product is transferred to the recipient in perpetuity or for a
322 | fixed term (regardless of how the transaction is characterized), the
323 | Corresponding Source conveyed under this section must be accompanied
324 | by the Installation Information.  But this requirement does not apply
325 | if neither you nor any third party retains the ability to install
326 | modified object code on the User Product (for example, the work has
327 | been installed in ROM).
328 | 
329 |   The requirement to provide Installation Information does not include a
330 | requirement to continue to provide support service, warranty, or updates
331 | for a work that has been modified or installed by the recipient, or for
332 | the User Product in which it has been modified or installed.  Access to a
333 | network may be denied when the modification itself materially and
334 | adversely affects the operation of the network or violates the rules and
335 | protocols for communication across the network.
336 | 
337 |   Corresponding Source conveyed, and Installation Information provided,
338 | in accord with this section must be in a format that is publicly
339 | documented (and with an implementation available to the public in
340 | source code form), and must require no special password or key for
341 | unpacking, reading or copying.
342 | 
343 |   7. Additional Terms.
344 | 
345 |   "Additional permissions" are terms that supplement the terms of this
346 | License by making exceptions from one or more of its conditions.
347 | Additional permissions that are applicable to the entire Program shall
348 | be treated as though they were included in this License, to the extent
349 | that they are valid under applicable law.  If additional permissions
350 | apply only to part of the Program, that part may be used separately
351 | under those permissions, but the entire Program remains governed by
352 | this License without regard to the additional permissions.
353 | 
354 |   When you convey a copy of a covered work, you may at your option
355 | remove any additional permissions from that copy, or from any part of
356 | it.  (Additional permissions may be written to require their own
357 | removal in certain cases when you modify the work.)  You may place
358 | additional permissions on material, added by you to a covered work,
359 | for which you have or can give appropriate copyright permission.
360 | 
361 |   Notwithstanding any other provision of this License, for material you
362 | add to a covered work, you may (if authorized by the copyright holders of
363 | that material) supplement the terms of this License with terms:
364 | 
365 |     a) Disclaiming warranty or limiting liability differently from the
366 |     terms of sections 15 and 16 of this License; or
367 | 
368 |     b) Requiring preservation of specified reasonable legal notices or
369 |     author attributions in that material or in the Appropriate Legal
370 |     Notices displayed by works containing it; or
371 | 
372 |     c) Prohibiting misrepresentation of the origin of that material, or
373 |     requiring that modified versions of such material be marked in
374 |     reasonable ways as different from the original version; or
375 | 
376 |     d) Limiting the use for publicity purposes of names of licensors or
377 |     authors of the material; or
378 | 
379 |     e) Declining to grant rights under trademark law for use of some
380 |     trade names, trademarks, or service marks; or
381 | 
382 |     f) Requiring indemnification of licensors and authors of that
383 |     material by anyone who conveys the material (or modified versions of
384 |     it) with contractual assumptions of liability to the recipient, for
385 |     any liability that these contractual assumptions directly impose on
386 |     those licensors and authors.
387 | 
388 |   All other non-permissive additional terms are considered "further
389 | restrictions" within the meaning of section 10.  If the Program as you
390 | received it, or any part of it, contains a notice stating that it is
391 | governed by this License along with a term that is a further
392 | restriction, you may remove that term.  If a license document contains
393 | a further restriction but permits relicensing or conveying under this
394 | License, you may add to a covered work material governed by the terms
395 | of that license document, provided that the further restriction does
396 | not survive such relicensing or conveying.
397 | 
398 |   If you add terms to a covered work in accord with this section, you
399 | must place, in the relevant source files, a statement of the
400 | additional terms that apply to those files, or a notice indicating
401 | where to find the applicable terms.
402 | 
403 |   Additional terms, permissive or non-permissive, may be stated in the
404 | form of a separately written license, or stated as exceptions;
405 | the above requirements apply either way.
406 | 
407 |   8. Termination.
408 | 
409 |   You may not propagate or modify a covered work except as expressly
410 | provided under this License.  Any attempt otherwise to propagate or
411 | modify it is void, and will automatically terminate your rights under
412 | this License (including any patent licenses granted under the third
413 | paragraph of section 11).
414 | 
415 |   However, if you cease all violation of this License, then your
416 | license from a particular copyright holder is reinstated (a)
417 | provisionally, unless and until the copyright holder explicitly and
418 | finally terminates your license, and (b) permanently, if the copyright
419 | holder fails to notify you of the violation by some reasonable means
420 | prior to 60 days after the cessation.
421 | 
422 |   Moreover, your license from a particular copyright holder is
423 | reinstated permanently if the copyright holder notifies you of the
424 | violation by some reasonable means, this is the first time you have
425 | received notice of violation of this License (for any work) from that
426 | copyright holder, and you cure the violation prior to 30 days after
427 | your receipt of the notice.
428 | 
429 |   Termination of your rights under this section does not terminate the
430 | licenses of parties who have received copies or rights from you under
431 | this License.  If your rights have been terminated and not permanently
432 | reinstated, you do not qualify to receive new licenses for the same
433 | material under section 10.
434 | 
435 |   9. Acceptance Not Required for Having Copies.
436 | 
437 |   You are not required to accept this License in order to receive or
438 | run a copy of the Program.  Ancillary propagation of a covered work
439 | occurring solely as a consequence of using peer-to-peer transmission
440 | to receive a copy likewise does not require acceptance.  However,
441 | nothing other than this License grants you permission to propagate or
442 | modify any covered work.  These actions infringe copyright if you do
443 | not accept this License.  Therefore, by modifying or propagating a
444 | covered work, you indicate your acceptance of this License to do so.
445 | 
446 |   10. Automatic Licensing of Downstream Recipients.
447 | 
448 |   Each time you convey a covered work, the recipient automatically
449 | receives a license from the original licensors, to run, modify and
450 | propagate that work, subject to this License.  You are not responsible
451 | for enforcing compliance by third parties with this License.
452 | 
453 |   An "entity transaction" is a transaction transferring control of an
454 | organization, or substantially all assets of one, or subdividing an
455 | organization, or merging organizations.  If propagation of a covered
456 | work results from an entity transaction, each party to that
457 | transaction who receives a copy of the work also receives whatever
458 | licenses to the work the party's predecessor in interest had or could
459 | give under the previous paragraph, plus a right to possession of the
460 | Corresponding Source of the work from the predecessor in interest, if
461 | the predecessor has it or can get it with reasonable efforts.
462 | 
463 |   You may not impose any further restrictions on the exercise of the
464 | rights granted or affirmed under this License.  For example, you may
465 | not impose a license fee, royalty, or other charge for exercise of
466 | rights granted under this License, and you may not initiate litigation
467 | (including a cross-claim or counterclaim in a lawsuit) alleging that
468 | any patent claim is infringed by making, using, selling, offering for
469 | sale, or importing the Program or any portion of it.
470 | 
471 |   11. Patents.
472 | 
473 |   A "contributor" is a copyright holder who authorizes use under this
474 | License of the Program or a work on which the Program is based.  The
475 | work thus licensed is called the contributor's "contributor version".
476 | 
477 |   A contributor's "essential patent claims" are all patent claims
478 | owned or controlled by the contributor, whether already acquired or
479 | hereafter acquired, that would be infringed by some manner, permitted
480 | by this License, of making, using, or selling its contributor version,
481 | but do not include claims that would be infringed only as a
482 | consequence of further modification of the contributor version.  For
483 | purposes of this definition, "control" includes the right to grant
484 | patent sublicenses in a manner consistent with the requirements of
485 | this License.
486 | 
487 |   Each contributor grants you a non-exclusive, worldwide, royalty-free
488 | patent license under the contributor's essential patent claims, to
489 | make, use, sell, offer for sale, import and otherwise run, modify and
490 | propagate the contents of its contributor version.
491 | 
492 |   In the following three paragraphs, a "patent license" is any express
493 | agreement or commitment, however denominated, not to enforce a patent
494 | (such as an express permission to practice a patent or covenant not to
495 | sue for patent infringement).  To "grant" such a patent license to a
496 | party means to make such an agreement or commitment not to enforce a
497 | patent against the party.
498 | 
499 |   If you convey a covered work, knowingly relying on a patent license,
500 | and the Corresponding Source of the work is not available for anyone
501 | to copy, free of charge and under the terms of this License, through a
502 | publicly available network server or other readily accessible means,
503 | then you must either (1) cause the Corresponding Source to be so
504 | available, or (2) arrange to deprive yourself of the benefit of the
505 | patent license for this particular work, or (3) arrange, in a manner
506 | consistent with the requirements of this License, to extend the patent
507 | license to downstream recipients.  "Knowingly relying" means you have
508 | actual knowledge that, but for the patent license, your conveying the
509 | covered work in a country, or your recipient's use of the covered work
510 | in a country, would infringe one or more identifiable patents in that
511 | country that you have reason to believe are valid.
512 | 
513 |   If, pursuant to or in connection with a single transaction or
514 | arrangement, you convey, or propagate by procuring conveyance of, a
515 | covered work, and grant a patent license to some of the parties
516 | receiving the covered work authorizing them to use, propagate, modify
517 | or convey a specific copy of the covered work, then the patent license
518 | you grant is automatically extended to all recipients of the covered
519 | work and works based on it.
520 | 
521 |   A patent license is "discriminatory" if it does not include within
522 | the scope of its coverage, prohibits the exercise of, or is
523 | conditioned on the non-exercise of one or more of the rights that are
524 | specifically granted under this License.  You may not convey a covered
525 | work if you are a party to an arrangement with a third party that is
526 | in the business of distributing software, under which you make payment
527 | to the third party based on the extent of your activity of conveying
528 | the work, and under which the third party grants, to any of the
529 | parties who would receive the covered work from you, a discriminatory
530 | patent license (a) in connection with copies of the covered work
531 | conveyed by you (or copies made from those copies), or (b) primarily
532 | for and in connection with specific products or compilations that
533 | contain the covered work, unless you entered into that arrangement,
534 | or that patent license was granted, prior to 28 March 2007.
535 | 
536 |   Nothing in this License shall be construed as excluding or limiting
537 | any implied license or other defenses to infringement that may
538 | otherwise be available to you under applicable patent law.
539 | 
540 |   12. No Surrender of Others' Freedom.
541 | 
542 |   If conditions are imposed on you (whether by court order, agreement or
543 | otherwise) that contradict the conditions of this License, they do not
544 | excuse you from the conditions of this License.  If you cannot convey a
545 | covered work so as to satisfy simultaneously your obligations under this
546 | License and any other pertinent obligations, then as a consequence you may
547 | not convey it at all.  For example, if you agree to terms that obligate you
548 | to collect a royalty for further conveying from those to whom you convey
549 | the Program, the only way you could satisfy both those terms and this
550 | License would be to refrain entirely from conveying the Program.
551 | 
552 |   13. Use with the GNU Affero General Public License.
553 | 
554 |   Notwithstanding any other provision of this License, you have
555 | permission to link or combine any covered work with a work licensed
556 | under version 3 of the GNU Affero General Public License into a single
557 | combined work, and to convey the resulting work.  The terms of this
558 | License will continue to apply to the part which is the covered work,
559 | but the special requirements of the GNU Affero General Public License,
560 | section 13, concerning interaction through a network will apply to the
561 | combination as such.
562 | 
563 |   14. Revised Versions of this License.
564 | 
565 |   The Free Software Foundation may publish revised and/or new versions of
566 | the GNU General Public License from time to time.  Such new versions will
567 | be similar in spirit to the present version, but may differ in detail to
568 | address new problems or concerns.
569 | 
570 |   Each version is given a distinguishing version number.  If the
571 | Program specifies that a certain numbered version of the GNU General
572 | Public License "or any later version" applies to it, you have the
573 | option of following the terms and conditions either of that numbered
574 | version or of any later version published by the Free Software
575 | Foundation.  If the Program does not specify a version number of the
576 | GNU General Public License, you may choose any version ever published
577 | by the Free Software Foundation.
578 | 
579 |   If the Program specifies that a proxy can decide which future
580 | versions of the GNU General Public License can be used, that proxy's
581 | public statement of acceptance of a version permanently authorizes you
582 | to choose that version for the Program.
583 | 
584 |   Later license versions may give you additional or different
585 | permissions.  However, no additional obligations are imposed on any
586 | author or copyright holder as a result of your choosing to follow a
587 | later version.
588 | 
589 |   15. Disclaimer of Warranty.
590 | 
591 |   THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
592 | APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
596 | PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
597 | IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
599 | 
600 |   16. Limitation of Liability.
601 | 
602 |   IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
610 | SUCH DAMAGES.
611 | 
612 |   17. Interpretation of Sections 15 and 16.
613 | 
614 |   If the disclaimer of warranty and limitation of liability provided
615 | above cannot be given local legal effect according to their terms,
616 | reviewing courts shall apply local law that most closely approximates
617 | an absolute waiver of all civil liability in connection with the
618 | Program, unless a warranty or assumption of liability accompanies a
619 | copy of the Program in return for a fee.
620 | 
621 |                      END OF TERMS AND CONDITIONS
622 | 
623 |             How to Apply These Terms to Your New Programs
624 | 
625 |   If you develop a new program, and you want it to be of the greatest
626 | possible use to the public, the best way to achieve this is to make it
627 | free software which everyone can redistribute and change under these terms.
628 | 
629 |   To do so, attach the following notices to the program.  It is safest
630 | to attach them to the start of each source file to most effectively
631 | state the exclusion of warranty; and each file should have at least
632 | the "copyright" line and a pointer to where the full notice is found.
633 | 
634 |     <one line to give the program's name and a brief idea of what it does.>
635 |     Copyright (C) <year>  <name of author>
636 | 
637 |     This program is free software: you can redistribute it and/or modify
638 |     it under the terms of the GNU General Public License as published by
639 |     the Free Software Foundation, either version 3 of the License, or
640 |     (at your option) any later version.
641 | 
642 |     This program is distributed in the hope that it will be useful,
643 |     but WITHOUT ANY WARRANTY; without even the implied warranty of
644 |     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
645 |     GNU General Public License for more details.
646 | 
647 |     You should have received a copy of the GNU General Public License
648 |     along with this program.  If not, see <http://www.gnu.org/licenses/>.
649 | 
650 | Also add information on how to contact you by electronic and paper mail.
651 | 
652 |   If the program does terminal interaction, make it output a short
653 | notice like this when it starts in an interactive mode:
654 | 
655 |     <program>  Copyright (C) <year>  <name of author>
656 |     This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
657 |     This is free software, and you are welcome to redistribute it
658 |     under certain conditions; type `show c' for details.
659 | 
660 | The hypothetical commands `show w' and `show c' should show the appropriate
661 | parts of the General Public License.  Of course, your program's commands
662 | might be different; for a GUI interface, you would use an "about box".
663 | 
664 |   You should also get your employer (if you work as a programmer) or school,
665 | if any, to sign a "copyright disclaimer" for the program, if necessary.
666 | For more information on this, and how to apply and follow the GNU GPL, see
667 | <http://www.gnu.org/licenses/>.
668 | 
669 |   The GNU General Public License does not permit incorporating your program
670 | into proprietary programs.  If your program is a subroutine library, you
671 | may consider it more useful to permit linking proprietary applications with
672 | the library.  If this is what you want to do, use the GNU Lesser General
673 | Public License instead of this License.  But first, please read
674 | <http://www.gnu.org/philosophy/why-not-lgpl.html>.
675 | 


--------------------------------------------------------------------------------
/creole-tests.el:
--------------------------------------------------------------------------------
   1 | ;; test creole stuff
   2 | 
   3 | (require 'creole)
   4 | (require 'ert)
   5 | (require 'noflet)
   6 | 
   7 | (ert-deftest creole/link-resolve ()
   8 |   "Test simple resolution."
   9 |   (should
  10 |    (equal
  11 |     "test.creole"
  12 |     (noflet ((directory-files (dir &optional full match nosort)
  13 |                (list "test.creole")))
  14 |       (creole/link-resolve "test"))))
  15 |   (should
  16 |    (equal
  17 |     "test"
  18 |     (noflet ((directory-files (dir &optional full match nosort)
  19 |                (list)))
  20 |       (creole/link-resolve "test")))))
  21 | 
  22 | (ert-deftest creole-link-parse ()
  23 |   (should (equal "<a href='http://thing'>thing</a>"
  24 |                  (creole-link-parse "[[http://thing|thing]]")))
  25 |   (should (equal "<a href='thing'>fing!</a>"
  26 |                  (creole-link-parse "[[thing|fing!]]")))
  27 |   (should (equal "<a href='thing'>thing</a>"
  28 |                  (creole-link-parse "[[thing]]")))
  29 |   (should (equal "<a href='thing'>thing
  30 | broken over lines</a>"
  31 |                  (creole-link-parse "[[thing|thing
  32 | broken over lines]]"))))
  33 | 
  34 | (ert-deftest creole-link-parse-camel ()
  35 |   (let (creole-link-resolver-fn)
  36 |     (should (equal (creole-link-parse "ThisThing")
  37 |                    "ThisThing")))
  38 |   (let ((creole-link-resolver-fn 'creole/link-resolve)
  39 |         (link-thing "ThisThing.creole"))
  40 |     (noflet ((directory-files (dir &optional full match nosort)
  41 |                (list link-thing)))
  42 |       (should (equal (creole-link-parse "ThisThing")
  43 |                      "<a href='ThisThing.creole'>ThisThing</a>"))
  44 |       ;; make sure we do NOT escape if creole-oddmuse-on is nil
  45 |       (should
  46 |        (equal
  47 |           (creole-link-parse "!OtherLongerThing")
  48 |           "<a href='ThisThing.creole'>!OtherLongerThing</a>"))
  49 |       (let ((link-thing "OtherLongerThing.creole"))
  50 |         (should
  51 |          (equal
  52 |           (creole-link-parse "OtherLongerThing")
  53 |           "<a href='OtherLongerThing.creole'>OtherLongerThing</a>"))
  54 |         ;; Without oddmuse we don't match []
  55 |         (should
  56 |          (equal
  57 |           (creole-link-parse "[OtherLongerThing]")
  58 |           "[OtherLongerThing]"))
  59 |         (let ((creole-oddmuse-on t))
  60 |           (should
  61 |            (equal
  62 |             (creole-link-parse "[OtherLongerThing]")
  63 |             "<a href='OtherLongerThing.creole'>OtherLongerThing</a>"))
  64 |           (should
  65 |            (equal
  66 |             (creole-link-parse "!UnescapedThing")
  67 |             "UnescapedThing")))))))
  68 | 
  69 | (ert-deftest creole-link-parse-resolver ()
  70 |   (let ((creole-link-resolver-fn 'creole/link-resolve))
  71 |     (noflet ((directory-files (dir &optional full match nosort)
  72 |                (list "thing.creole")))
  73 |       (should
  74 |        (equal "<a href='thing.creole'>thing</a>"
  75 |               (creole-link-parse "[[thing]]"))))
  76 |     (noflet ((directory-files (dir &optional full match nosort)
  77 |              (list "ThisThing.creole")))
  78 |       (should
  79 |        (equal "<a href='ThisThing.creole'>ThisThing</a>"
  80 |               (creole-link-parse "ThisThing"))))
  81 |     (noflet ((directory-files (dir &optional full match nosort)
  82 |              (list "ThisThing.creole")))
  83 |       (should
  84 |        (equal "<a href='http://blah/blah'>blah</a>"
  85 |               (creole-link-parse "[[http://blah/blah|blah]]"))))
  86 |     (noflet ((directory-files (dir &optional full match nosort)
  87 |              (list "ThisThing.creole")))
  88 |       (should
  89 |        (equal "<a href='ThisThing.creole'>blah</a>"
  90 |               (creole-link-parse "[[ThisThing|blah]]"))))))
  91 | 
  92 | 
  93 | (ert-deftest creole-link-parse-oddmuse ()
  94 |   (let ((creole-oddmuse-on t))
  95 |     (should (equal "<a href='http://thing'>thing</a>"
  96 |                    (creole-link-parse "[[http://thing|thing]]")))
  97 |     (should (equal "<a href='http://thing'>thing</a>"
  98 |                    (creole-link-parse "[http://thing|thing]")))
  99 |     (should (equal "<a href='http://thing'>blah</a>"
 100 |                    (creole-link-parse "[http://thing blah]")))
 101 |     (should (equal "<a href='thing'>fing!</a>"
 102 |                    (creole-link-parse "[[thing|fing!]]")))
 103 |     (should (equal "<a href='thing'>thing</a>"
 104 |                    (creole-link-parse "[[thing]]")))
 105 |     (should (equal "<a href='thing'>thing
 106 | broken over lines</a>"
 107 |                    (creole-link-parse "[[thing|thing
 108 | broken over lines]]")))))
 109 | 
 110 | (ert-deftest creole-image-resolve ()
 111 |   "Test that the `creole-image-parse' gives the right match data."
 112 |   (let (match-strings)
 113 |     (noflet ((creole-image-resolve (m)
 114 |                (setq match-strings
 115 |                      (loop for i from 0 to 5 collect (match-string i m)))
 116 |                "<img src=\"dummy\"></img>"))
 117 |       (creole-image-parse "{{something?width=100|some text to finish}}")
 118 |       (should (equal (elt match-strings 1) "something"))
 119 |       (should (equal (elt match-strings 3) "width=100"))
 120 |       (should (equal (elt match-strings 5) "some text to finish"))
 121 |       ;; Test without the query
 122 |       (creole-image-parse "{{something|some text to finish}}")
 123 |       (should (equal (elt match-strings 1) "something"))
 124 |       (should (equal (elt match-strings 3) nil))
 125 |       (should (equal (elt match-strings 5) "some text to finish"))
 126 |       ;; Test without the description
 127 |       (creole-image-parse "{{something}}")
 128 |       (should (equal (elt match-strings 1) "something"))
 129 |       (should (equal (elt match-strings 3) nil))
 130 |       (should (equal (elt match-strings 5) nil)))))
 131 | 
 132 | (ert-deftest creole-image-parse ()
 133 |   (should (equal "<img src=\"image.jpg\" alt=\"whatever I tell you\" title=\"whatever I tell you\" width=\"20\" height=\"1000\" ></img>"
 134 |                  (creole-image-parse "{{image.jpg?size=20x1000|whatever I tell you}}")))
 135 |   (should (equal "<img src=\"image.jpg\" alt=\"image.jpg\" ></img>"
 136 |                  (creole-image-parse "{{image.jpg}}")))
 137 |   (should (equal "<img src=\"image.jpg\" alt=\"alternate text\" title=\"alternate text\" ></img>"
 138 |                  (creole-image-parse "{{image.jpg|alternate text}}")))
 139 |   (should (equal "<img src=\"image.jpg\" alt=\"image.jpg\" width=\"20\" ></img>"
 140 |                  (creole-image-parse "{{image.jpg?size=20}}")))
 141 |   (should (equal "<img src=\"image.jpg\" alt=\"alternate text\" title=\"alternate text\" width=\"20\" ></img>"
 142 |                  (creole-image-parse "{{image.jpg?size=20|alternate text}}")))
 143 |   (should (equal "<img src=\"image.jpg\" alt=\"image.jpg\" width=\"20\" height=\"10\" ></img>"
 144 |                  (creole-image-parse "{{image.jpg?size=20x10}}")))
 145 |   ;; Resolver testing
 146 |   (let ((creole-link-resolver-fn
 147 |          (lambda (name)
 148 |            (concat name ".jpg"))))
 149 |     (noflet ((directory-files (dir &optional full match nosort)
 150 |              (list "thing.jpg")))
 151 |       (should
 152 |        (equal (creole-image-parse "{{thing}}")
 153 |               "<img src=\"thing.jpg\" alt=\"thing\" ></img>"))))
 154 |   ;; Embed handler testing
 155 |   (let ((creole-embed-handlers
 156 |          (list (cons "test"
 157 |                      (lambda (m scheme path)
 158 |                        (format
 159 |                         "<object src=\"%s\"></object>"
 160 |                         path))))))
 161 |     (should
 162 |      (equal "<object src=\"blah\"></object>"
 163 |             (creole-image-parse "{{test:blah|whatever I tell you}}")))))
 164 | 
 165 | (ert-deftest creole-youtube-embed ()
 166 |   "Test we can use `creole-youtube-handler'."
 167 |   (let ((creole-embed-handlers '(("youtube" . creole-youtube-handler))))
 168 |     (should
 169 |      (equal
 170 |       (creole-image-parse "{{youtube:WcUwCsAhWMk|a nice video on emacs-lisp}}")
 171 |       "<span class=\"youtube\"><iframe src=\"//www.youtube.com/embed/WcUwCsAhWMk\"
 172 | width=\"420\" height=\"315\"
 173 | frameborder=\"0\" allowfullscreen></iframe>
 174 | <em>a nice video on emacs-lisp</em>
 175 | </span>"
 176 | ))))
 177 | 
 178 | (ert-deftest creole-block-parse ()
 179 |   "Test the block parsing routines."
 180 |   (should (equal "<strong>this is bold</strong>"
 181 |                  (creole-block-parse "**this is bold**")))
 182 |   (should (equal "<em>this is italic</em>"
 183 |                  (creole-block-parse "//this is italic//")))
 184 |   (should (equal "<code>this is code</code>"
 185 |                  (creole-block-parse "{{{this is code}}}")))
 186 |   (should (equal "this has a<br/>line break"
 187 |                  (creole-block-parse "this has a\\line break")))
 188 |   (should (equal "<em><strong>this is italic bold</strong></em>"
 189 |                  (creole-block-parse "//**this is italic bold**//")))
 190 |   (should (equal "<strong><em>this is bold italic</em></strong>"
 191 |                  (creole-block-parse "**//this is bold italic//**")))
 192 |   (should
 193 |    (equal
 194 |     (creole-block-parse "**this is bold** this is not **but this is**")
 195 |     "<strong>this is bold</strong> this is not <strong>but this is</strong>"))
 196 |   (should
 197 |    (equal
 198 |     (creole-block-parse "{{{this is code}}} and this is //italic//")
 199 |     "<code>this is code</code> and this is <em>italic</em>"))
 200 |   (should
 201 |    (equal
 202 |     (creole-block-parse
 203 |      "this is //italic// and more //italics//")
 204 |     "this is <em>italic</em> and more <em>italics</em>"))
 205 |   (should
 206 |    (equal
 207 |     (creole-block-parse
 208 |      "//test// http://server thing is //italic//")
 209 |     "<em>test</em> http://server thing is <em>italic</em>"))
 210 |   (should
 211 |    (equal
 212 |     (creole-block-parse
 213 |      "http://server //test// http://server thing is //italic//")
 214 |     "http://server <em>test</em> http://server thing is <em>italic</em>"))
 215 |   (should (equal "<a href='http://thing'>thing</a>"
 216 |                  (creole-block-parse "[[http://thing|thing]]")))
 217 |   (should (equal "<a href='thing'><strong>fing!</strong></a>"
 218 |                  (creole-block-parse "[[thing|**fing!**]]")))
 219 |   (should (equal "<a href='thing'><code>some code</code></a>"
 220 |                  (creole-block-parse "[[thing|{{{some code}}}]]")))
 221 |   (should (equal "<a href='thing'>thing</a>"
 222 |                  (creole-block-parse "[[thing]]")))
 223 |   (should (equal "<a href='http://thing'>http://thing</a>"
 224 |                  (creole-block-parse "[[http://thing]]")))
 225 |   (should (equal "<a href='http://thing'>http://thing</a>"
 226 |                  (creole-block-parse "[[http://thing]]")))
 227 |   (should (equal "<a href='thing'>thing
 228 | broken over lines</a>"
 229 |                  (creole-block-parse "[[thing|thing
 230 | broken over lines]]"))))
 231 | 
 232 | (ert-deftest creole-tokenize-with-table ()
 233 |   "Test a simple WikiCreole document with a table."
 234 |   (with-temp-buffer
 235 |     (insert "= Heading! =\n")
 236 |     (insert "\n")
 237 |     (insert "== Heading2! ==\n")
 238 |     (insert "| col1 | col2 |
 239 | |   15 |   20 |
 240 | |   7  |      |
 241 | #+TBLFM: @3$1=@2$1 + 20
 242 | ")
 243 |     (insert "This is a paragraph
 244 | that runs over several lines
 245 | * and a list item stops it
 246 | ")
 247 |     (insert "This is a paragraph {{{with code}}} and [[links]]
 248 | and **bold** and //italics//.")
 249 |     (should
 250 |      (equal
 251 |       (creole-tokenize (current-buffer))
 252 |       '((heading1 . "Heading!")
 253 |         (heading2 . "Heading2!")
 254 |         (table . (("col1" "col2") ("15" "20") ("35" "")))
 255 |         (para . "This is a paragraph\nthat runs over several lines")
 256 |         (ul1 . "and a list item stops it")
 257 |         (para . "This is a paragraph {{{with code}}} and [[links]]
 258 | and **bold** and //italics//.")))))
 259 |   (with-temp-buffer
 260 |     (insert "= Heading! =\n")
 261 |     (insert "\n")
 262 |     (insert "== Heading2! ==\n")
 263 |     (insert "| col1 | col2 |
 264 | |   15 |   20 |
 265 | |   7  |      |
 266 | #+TBLFM: @3$1=@2$1 + 20
 267 | ")
 268 |     (should
 269 |      (equal
 270 |       (creole-tokenize (current-buffer))
 271 |       '((heading1 . "Heading!")
 272 |         (heading2 . "Heading2!")
 273 |         (table . (("col1" "col2") ("15" "20") ("35" ""))))))))
 274 | 
 275 | (ert-deftest creole-tokenize-newline-doc-end ()
 276 |   "Specific test for dealing with carriage return as the end."
 277 |   (with-temp-buffer
 278 |     (insert "= Heading! =\n")
 279 |     (insert "This is a paragraph {{{with code}}} and [[links]]\n")
 280 |     (should
 281 |      (equal
 282 |       (creole-tokenize (current-buffer))
 283 |       '((heading1 . "Heading!")
 284 |         (para . "This is a paragraph {{{with code}}} and [[links]]"))))))
 285 | 
 286 | (ert-deftest creole-tokenize-lisp ()
 287 |   "Test the new embedded lisp stuff"
 288 |   (flet ((my-plugin () ; arg list
 289 |            "== Plugin Heading! ==
 290 | This is a paragraph {{{with code}}} and [[links]]"))
 291 |     (with-temp-buffer
 292 |       (insert "= Heading! =\n")
 293 |       (insert "\n<<(\n(my-plugin)\n)>>\n")
 294 |       (should
 295 |        (equal
 296 |         (creole-tokenize (current-buffer))
 297 |         '((heading1 . "Heading!")
 298 |           (heading2 . "Plugin Heading!")
 299 |           (para . "This is a paragraph {{{with code}}} and [[links]]")))))))
 300 | 
 301 | (ert-deftest creole-tokenize-plugin-html ()
 302 |   "Test the embedded HTML stuff"
 303 |   (with-temp-buffer
 304 |     (insert "= Heading! =\n")
 305 |     (insert "\n<<html\n<P>A test of HTML code</P>\nhtml>>\n")
 306 |     (insert "\n{{{\nsome code\n}}}\n")
 307 |     (should
 308 |      (equal
 309 |       (creole-tokenize (current-buffer))
 310 |       '((heading1 . "Heading!")
 311 |         (plugin-html . "<P>A test of HTML code</P>")
 312 |         (preformatted . "some code"))))))
 313 | 
 314 | (ert-deftest creole-tokenize ()
 315 |   (with-temp-buffer
 316 |     (creole/test-doc (current-buffer))
 317 |     (should
 318 |      (equal
 319 |       (creole-tokenize (current-buffer))
 320 |       '((heading1 . "Heading!")
 321 |         (heading2 . "Heading2!")
 322 |         (ol1 . "an ordered list item")
 323 |         (ol2 . "a 2nd ordered list item")
 324 |         (heading2 . "Heading3 is a multi word heading")
 325 |         (preformatted . "== this is preformatted ==\n{{\nIt looks great\n}}")
 326 |         (ul1 . "list item")
 327 |         (ul2 . "2nd list item")
 328 |         (ul3 . "3rd list item")
 329 |         (ul2 . "another 2nd list item")
 330 |         (ul3 . "another 3rd list item")
 331 |         (hr . "")
 332 |         (para . "This is a paragraph\nthat runs over several lines")
 333 |         (ul1 . "and a list item stops it")
 334 |         (para . "This is a paragraph {{{with code}}} and [[links]]
 335 | and **bold** and //italics//."))))))
 336 | 
 337 | (ert-deftest creole/list-item ()
 338 |   "Test the little creole list item function."
 339 |   (should (equal '(ul . 1) (creole/list-item 'ul1)))
 340 |   (should (equal '(ul . 10) (creole/list-item 'ul10)))
 341 |   (should (equal '(ul . 7) (creole/list-item 'ul7)))
 342 |   (should (equal '(ol . 7) (creole/list-item 'ol7)))
 343 |   (should (equal nil (creole/list-item 'h1))))
 344 | 
 345 | (ert-deftest creole-structure ()
 346 |   "Testing tokenize lists to parsed representations.
 347 | 
 348 | The test here takes a list that would come from `creole-tokenize'
 349 | and checks it against what should come out of `creole-structure'.
 350 | In other words, a parsed creole document representation."
 351 |   (should
 352 |    (equal
 353 |     (creole-structure
 354 |      '((h1 . "this is a heading!")
 355 |        (ul1 . "this is a first item")
 356 |        (ul1 . "this is a 2nd first level item")
 357 |        (ul2 . "this is a first 2nd level item")
 358 |        (ul2 . "this is a 2nd 2nd level item")
 359 |        (ul3 . "this is a first 3rd level item")
 360 |        (ul1 . "this is a return to the first level item")
 361 |        (ul1 . "this is a 2nd first level item")
 362 |        (ul2 . "this is a first 2nd level item")
 363 |        (ul2 . "this is a 2nd 2nd level item")
 364 |        (ul1 . "this is another return to first level item")))
 365 |     '((h1 . "this is a heading!")
 366 |       (ul
 367 |        "this is a first item"
 368 |        "this is a 2nd first level item"
 369 |        (ul
 370 |         "this is a first 2nd level item"
 371 |         "this is a 2nd 2nd level item"
 372 |         (ul
 373 |          "this is a first 3rd level item"))
 374 |        "this is a return to the first level item"
 375 |        "this is a 2nd first level item"
 376 |        (ul
 377 |         "this is a first 2nd level item"
 378 |         "this is a 2nd 2nd level item")
 379 |        "this is another return to first level item")))))
 380 | 
 381 | (ert-deftest creole-structure-end-to-end ()
 382 |   "Test the parser directly with the result of the tokenizer.
 383 | 
 384 | `creole-tokenize' is called on a buffer and checked against what
 385 | should come out."
 386 |   (with-temp-buffer
 387 |     (insert "= this is a heading! =\n")
 388 |     (insert "* this is a first item\n")
 389 |     (insert "* this is a 2nd first level item\n")
 390 |     (insert "** this is a first 2nd level item\n")
 391 |     (insert "** this is a 2nd 2nd level item\n")
 392 |     (insert "*** this is a first 3rd level item\n")
 393 |     (insert "* this is a return to the first level item\n")
 394 |     (insert "* this is a 2nd first level item\n")
 395 |     (insert "** this is a first 2nd level item\n")
 396 |     (insert "** this is a 2nd 2nd level item\n")
 397 |     (insert "* this is another return to first level item\n")
 398 |     (insert "This is a paragraph
 399 | that runs over several lines
 400 | * and a list item stops it
 401 | ")
 402 |     (insert "This is a paragraph {{{with code}}} and [[links]]\n")
 403 |     (should
 404 |      (equal
 405 |       (creole-structure (creole-tokenize (current-buffer)))
 406 |       '((heading1 . "this is a heading!")
 407 |         (ul
 408 |          "this is a first item"
 409 |          "this is a 2nd first level item"
 410 |          (ul
 411 |           "this is a first 2nd level item"
 412 |           "this is a 2nd 2nd level item"
 413 |           (ul
 414 |            "this is a first 3rd level item"))
 415 |          "this is a return to the first level item"
 416 |          "this is a 2nd first level item"
 417 |          (ul
 418 |           "this is a first 2nd level item"
 419 |           "this is a 2nd 2nd level item")
 420 |          "this is another return to first level item")
 421 |         (para . "This is a paragraph
 422 | that runs over several lines")
 423 |         (ul "and a list item stops it")
 424 |         (para . "This is a paragraph {{{with code}}} and [[links]]"))))))
 425 | 
 426 | (ert-deftest creole-structure-end-to-end-with-table ()
 427 |   "Test the parser directly with the result of the tokenizer.
 428 | 
 429 | `creole-tokenize' is called on a buffer and checked against what
 430 | should come out."
 431 |   (with-temp-buffer
 432 |     (insert "= this is a heading! =\n")
 433 |     (insert "| col1 | col2 |
 434 | |   15 |   20 |
 435 | |   7  |      |
 436 | #+TBLFM: @3$1=@2$1 + 20
 437 | ")
 438 |     (insert "* this is a first item\n")
 439 |     (insert "* this is a 2nd first level item\n")
 440 |     (insert "** this is a first 2nd level item\n")
 441 |     (insert "** this is a 2nd 2nd level item\n")
 442 |     (insert "*** this is a first 3rd level item\n")
 443 |     (insert "* this is a return to the first level item\n")
 444 |     (insert "* this is a 2nd first level item\n")
 445 |     (insert "** this is a first 2nd level item\n")
 446 |     (insert "** this is a 2nd 2nd level item\n")
 447 |     (insert "* this is another return to first level item\n")
 448 |     (insert "This is a paragraph
 449 | that runs over several lines
 450 | * and a list item stops it
 451 | ")
 452 |     (insert "This is a paragraph {{{with code}}} and [[links]]\n")
 453 |     (should
 454 |      (equal
 455 |       (creole-structure (creole-tokenize (current-buffer)))
 456 |       '((heading1 . "this is a heading!")
 457 |         (table . (("col1" "col2") ("15" "20") ("35" "")))
 458 |         (ul
 459 |          "this is a first item"
 460 |          "this is a 2nd first level item"
 461 |          (ul
 462 |           "this is a first 2nd level item"
 463 |           "this is a 2nd 2nd level item"
 464 |           (ul
 465 |            "this is a first 3rd level item"))
 466 |          "this is a return to the first level item"
 467 |          "this is a 2nd first level item"
 468 |          (ul
 469 |           "this is a first 2nd level item"
 470 |           "this is a 2nd 2nd level item")
 471 |          "this is another return to first level item")
 472 |         (para . "This is a paragraph
 473 | that runs over several lines")
 474 |         (ul "and a list item stops it")
 475 |         (para . "This is a paragraph {{{with code}}} and [[links]]"))))))
 476 | 
 477 | (ert-deftest creole/html-list ()
 478 |   "Test the list export, which is a little complex."
 479 |   (with-temp-buffer
 480 |     (creole/html-list
 481 |      'ul
 482 |      '("this is a list //with an italicized part//"
 483 |        (ul "with a deeper list")
 484 |        "and another item on the end with **bold**"))
 485 |     (should
 486 |      (equal
 487 |       (buffer-substring-no-properties
 488 |        (point-min)(point-max))
 489 |       "<ul>
 490 | <li>this is a list <em>with an italicized part</em><ul>
 491 | <li>with a deeper list</li>
 492 | </ul>
 493 | </li>
 494 | <li>and another item on the end with <strong>bold</strong></li>
 495 | </ul>
 496 | "))))
 497 | 
 498 | (ert-deftest creole/html-table ()
 499 |   "Test org tables.
 500 | 
 501 | org-tables are not quite WikiCreole tables.  Creole table headers
 502 | are like this:
 503 | 
 504 |  |= header|= header|
 505 |  |cell    |cell    |
 506 | 
 507 | whereas we do org table headers like this:
 508 | 
 509 |  |header| header|
 510 |  ----------------
 511 |  |cell  |cell   |
 512 | 
 513 | Getting `orgtbl-to-generic' to do the WikiCreole style seems quite
 514 | difficult."
 515 |   (let ((tbl '(("col1" "col2")
 516 |                hline
 517 |                ("15" "20")
 518 |                ("35" "**end**"))))
 519 |     (should
 520 |      (equal
 521 |       (creole/html-table tbl)
 522 |       "<table>
 523 | <thead><tr>
 524 | <th>col1</th>
 525 | <th>col2</th>
 526 | </tr></thead>
 527 | <tr>
 528 | <td>15</td>
 529 | <td>20</td>
 530 | </tr>
 531 | <tr>
 532 | <td>35</td>
 533 | <td><strong>end</strong></td>
 534 | </tr>
 535 | </table>
 536 | "))))
 537 | 
 538 | (ert-deftest creole/heading-test>id ()
 539 |   "Test that we convert heading text to HTML IDs."
 540 |   (should (equal
 541 |            "this-is-it-then"
 542 |            (creole/heading-text->id "this is it then")))
 543 |   (should (equal
 544 |            "This-is-it-then"
 545 |            (creole/heading-text->id "This is it then"))))
 546 | 
 547 | (ert-deftest creole/heading->html ()
 548 |   "Test the heading production."
 549 |   (should
 550 |    (equal
 551 |     (let (creole-oddmuse-on creole-do-anchor-headings)
 552 |       (creole/heading->html
 553 |        '(heading1 "this is a test")))
 554 |     "<h1>this is a test</h1>\n"))
 555 |   ;; Now test with automatic anchor links
 556 |   (let ((creole-oddmuse-on t))
 557 |     (should
 558 |      (equal
 559 |       (creole/heading->html
 560 |        '(heading1 "this is a test"))
 561 |       "<a id='this-is-a-test'></a>\n<h1>this is a test</h1>\n")))
 562 |   (let ((creole-oddmuse-on nil)
 563 |         (creole-do-anchor-headings t))
 564 |     (should
 565 |      (equal
 566 |       (creole/heading->html
 567 |        '(heading1 "this is a test"))
 568 |       "<a id='this-is-a-test'></a>\n<h1>this is a test</h1>\n"))))
 569 | 
 570 | (ert-deftest creole-html-with-links ()
 571 |   (with-temp-buffer
 572 |     (insert "= Heading! =\n")
 573 |     (insert "This is a paragraph.\n\n")
 574 |     (insert "This is a paragraph {{{with code}}} and [[links]]
 575 | and **bold** and //italics//.\n\n")
 576 |     (insert "This is a paragraph with [[http://absolute/links]]
 577 | and **bold** and //italics//.\n\n")
 578 |     (insert "This is a paragraph with [[http://absolute/links]]\n")
 579 |     (let* ((html (creole-html (current-buffer)))
 580 |            (htmlstr (with-current-buffer html
 581 |                       (buffer-substring (point-min)(point-max)))))
 582 |       (should
 583 |        (equal
 584 |         htmlstr
 585 |         "<a id='Heading!'></a>
 586 | <h1>Heading!</h1>
 587 | <p>This is a paragraph.</p>
 588 | <p>This is a paragraph <code>with code</code> and <a href='links'>links</a>
 589 | and <strong>bold</strong> and <em>italics</em>.</p>
 590 | <p>This is a paragraph with <a href='http://absolute/links'>http://absolute/links</a>
 591 | and <strong>bold</strong> and <em>italics</em>.</p>
 592 | <p>This is a paragraph with <a href='http://absolute/links'>http://absolute/links</a></p>
 593 | ")))))
 594 | 
 595 | (ert-deftest creole-htmlize-string-null ()
 596 |   "Test that a string with no markup does NOT get fontified."
 597 |   (should
 598 |    (equal
 599 |     (creole-htmlize-string "<<(
 600 |  (mapconcat
 601 |    (lambda (s)
 602 |      (format \"== %s ==\" s))
 603 |    '(\"rationale\" \"compliance\" \"tests\")
 604 |    \"\n\")
 605 | )>>")
 606 |     "<pre>
 607 | <<(
 608 |  (mapconcat
 609 |    (lambda (s)
 610 |      (format \"== %s ==\" s))
 611 |    '(\"rationale\" \"compliance\" \"tests\")
 612 |    \"\n\")
 613 | )>>
 614 | </pre>")))
 615 | 
 616 | (ert-deftest creole-htmlize-string ()
 617 |   "Test that we can capture 'htmlfontify' into strings."
 618 |   (let ((css-decl-list ; this is a list of the CSS declarations there should be
 619 |          '(default
 620 |             font-lock-keyword-face
 621 |             font-lock-variable-name-face
 622 |             font-lock-function-name-face
 623 |             font-lock-type-face))
 624 |         ;; The actual program text we'll fontify
 625 |         (fontified (creole-htmlize-string "##! c
 626 | int main(char **argv, int argc)
 627 | {
 628 |   return 1;
 629 | }
 630 | ")))
 631 |     ;; Now the assertions
 632 |     (should
 633 |      (equal
 634 |       (substring-no-properties fontified 0 (length fontified))
 635 |       "
 636 | <pre>
 637 | <span class=\"type\">in</span><span class=\"type\">t</span> <span class=\"function-name\">main</span>(<span class=\"type\">char</span> **<span class=\"variable-name\">argv</span>, <span class=\"type\">int</span> <span class=\"variable-name\">argc</span>)
 638 | {
 639 |   <span class=\"keyword\">return</span> 1;
 640 | }
 641 | 
 642 | </pre>
 643 | "))
 644 |     (should
 645 |      (equal
 646 |       (loop for style-decl in (get-text-property 0 :css-list fontified)
 647 |             collect (car style-decl))
 648 |       css-decl-list))))
 649 | 
 650 | (ert-deftest creole-plugin-html-to-html ()
 651 |   "Test raw HTML exports correctly."
 652 |   (with-temp-buffer
 653 |     (insert "= Heading =
 654 | 
 655 | <<html
 656 | <P>This is a paragraph of text</P>
 657 | html>>
 658 | ")
 659 |     (let ((html (creole-html (current-buffer))))
 660 |       (with-current-buffer html
 661 |         (goto-char (point-min))
 662 |         (should (looking-at "<a id='Heading'></a>
 663 | <h1>Heading</h1>
 664 | <P>This is a paragraph of text</P>"))))))
 665 | 
 666 | (ert-deftest creole-list-to-html ()
 667 |   "Test lists (which are a little complicated) export correctly."
 668 |   (with-temp-buffer
 669 |     (insert "* list item
 670 | ** 2nd list item")
 671 |     (let ((html (creole-html (current-buffer))))
 672 |       (with-current-buffer html
 673 |         (goto-char (point-min))
 674 |         (should (looking-at "<ul>
 675 | <li>list item<ul>
 676 | <li>2nd list item</li>
 677 | </ul>
 678 | </li>
 679 | </ul>
 680 | "))))))
 681 | 
 682 | (ert-deftest creole-table-to-html ()
 683 |   "Test tables (which are a little complicated) export correctly."
 684 |   (with-temp-buffer
 685 |     (insert "| col1 | col2 |
 686 | |------|------|
 687 | |   15 |   20 |
 688 | |   7  |**end**|
 689 | #+TBLFM: @3$1=@2$1 + 20
 690 | ")
 691 |     (let ((html (creole-html (current-buffer))))
 692 |       (with-current-buffer html
 693 |         (goto-char (point-min))
 694 |         (should (looking-at "<table>
 695 | <thead><tr>
 696 | <th>col1</th>
 697 | <th>col2</th>
 698 | </tr></thead>
 699 | <tr>
 700 | <td>15</td>
 701 | <td>20</td>
 702 | </tr>
 703 | <tr>
 704 | <td>35</td>
 705 | <td><strong>end</strong></td>
 706 | </tr>
 707 | </table>
 708 | "))))))
 709 | 
 710 | (ert-deftest creole/structure-pipeline ()
 711 |   "Test the pipelining."
 712 |   (should ;; test with empty pipeline
 713 |    (equal
 714 |     '((heading1 "hello")
 715 |       (ul "a tokenizer"
 716 |        (ul "Inline markup inside a paragraph is NOT converted.")
 717 |        "a //parser//"))
 718 |     (creole/structure-pipeline
 719 |      (list)
 720 |      '((heading1 "hello")
 721 |        (ul "a tokenizer"
 722 |         (ul "Inline markup inside a paragraph is NOT converted.")
 723 |         "a //parser//")))))
 724 |   (should ;; test with a single stage in the pipeline
 725 |    (equal
 726 |     '((heading1 "hello")
 727 |       (ul "a tokenizer"
 728 |        (ul "Inline markup inside a paragraph is NOT converted.")
 729 |        "a //parser//")
 730 |       (para "end of the document"))
 731 |     (creole/structure-pipeline
 732 |      (list (lambda (structure)
 733 |              (append
 734 |               structure
 735 |               (list (list 'para "end of the document")))))
 736 |      '((heading1 "hello")
 737 |        (ul "a tokenizer"
 738 |         (ul "Inline markup inside a paragraph is NOT converted.")
 739 |         "a //parser//"))))))
 740 | 
 741 | (ert-deftest creole-html ()
 742 |   "Test the HTML export end to end."
 743 |   (with-temp-buffer
 744 |     (creole/test-doc (current-buffer))
 745 |     (let ((html (creole-html (current-buffer))))
 746 |       (should 
 747 |        (equal
 748 |         (with-current-buffer html (buffer-string))
 749 |         "<a id='Heading!'></a>
 750 | <h1>Heading!</h1>
 751 | <a id='Heading2!'></a>
 752 | <h2>Heading2!</h2>
 753 | <ol>
 754 | <li>an ordered list item<ol>
 755 | <li>a 2nd ordered list item</li>
 756 | </ol>
 757 | </li>
 758 | </ol>
 759 | <a id='Heading3-is-a-multi-word-heading'></a>
 760 | <h2>Heading3 is a multi word heading</h2>
 761 | <pre>
 762 | == this is preformatted ==
 763 | {{
 764 | It looks great
 765 | }}
 766 | </pre>
 767 | <ul>
 768 | <li>list item<ul>
 769 | <li>2nd list item<ul>
 770 | <li>3rd list item</li>
 771 | </ul>
 772 | </li>
 773 | <li>another 2nd list item<ul>
 774 | <li>another 3rd list item</li>
 775 | </ul>
 776 | </li>
 777 | </ul>
 778 | </li>
 779 | </ul>
 780 | <hr/>
 781 | <p>This is a paragraph
 782 | that runs over several lines</p>
 783 | <ul>
 784 | <li>and a list item stops it</li>
 785 | </ul>
 786 | <p>This is a paragraph <code>with code</code> and <a href='links'>links</a>
 787 | and <strong>bold</strong> and <em>italics</em>.</p>
 788 | ")))))
 789 | 
 790 | 
 791 | (ert-deftest creole/expand-item-value-mocked-file ()
 792 |   "Test that we can mock the file loading."
 793 |   (with-temp-buffer
 794 |     (insert "= A very small creole file =\n")
 795 |     (let ((file-buffer (current-buffer)))
 796 |       ;; Mock both these functions to cause the buffer 'file-buffer'
 797 |       ;; to be returned from creole/get-file
 798 |       (noflet ((creole/file-under-root-p
 799 |                    (file-name root)
 800 |                  nil)
 801 |                (creole/get-file
 802 |                    (filename)
 803 |                  file-buffer))
 804 |         (should (equal
 805 |                  (cons :string "= A very small creole file =\n")
 806 |                  (creole/expand-item-value
 807 |                   "~/elwikicreole/README.creole"
 808 |                   "~/elwikicreole/")))))))
 809 | 
 810 | (ert-deftest creole/expand-item-value-plain-string ()
 811 |   ;; Should just be the value of the string
 812 |   (should (equal
 813 |            (cons :string "just a string")
 814 |            (creole/expand-item-value
 815 |             "just a string"
 816 |             "~/elwikicreole/"))))
 817 | 
 818 | (ert-deftest creole/expand-item-value-safe-file ()
 819 |   "Test that a file under the docroot is returned as just a file."
 820 |   (noflet ((creole/file-under-root-p
 821 |                (file-name root)
 822 |              ;; TODO - implementation
 823 |              "/README.creole"))
 824 |     (should (equal
 825 |              (cons :link "/README.creole")
 826 |              (creole/expand-item-value
 827 |               "~/elwikicreole/README.creole"
 828 |               "~/elwikicreole/")))))
 829 | 
 830 | (ert-deftest creole/expand-item-value-null-file ()
 831 |   ;; Should be an empty :link
 832 |   (noflet ((creole/file-under-root-p (file-name root)
 833 |              ;; TODO - implementation
 834 |              nil))
 835 |     (should (equal
 836 |              (cons :link "/__not__there__.creole")
 837 |              (creole/expand-item-value
 838 |               "/__not__there__.creole"
 839 |               "~/elwikicreole/")))))
 840 | 
 841 | (ert-deftest creole/expand-item-value-unsafe-file ()
 842 |   ;; Supply a filename but get back the expanded string
 843 |   ;; because the filename is not under the docroot
 844 |   (let ((TEST-FILE-NAME "/home/nferrier/wiki/small.creole")
 845 |         (TMPBUF
 846 |          (get-buffer-create
 847 |           (generate-new-buffer-name
 848 |            " *creole-expand-item-value-unsafe-file*"))))
 849 |     (with-current-buffer TMPBUF
 850 |       (insert "= A very small Creole document =\n"))
 851 |     (noflet
 852 |         ((creole/file-under-root-p
 853 |              (file-name root)
 854 |            nil)
 855 |          (file-truename
 856 |              (file-name)
 857 |            TEST-FILE-NAME)
 858 |          (file-exists-p
 859 |              (file-name)
 860 |            (equal file-name TEST-FILE-NAME))
 861 |          (find-file-noselect
 862 |              (file-name)
 863 |            TMPBUF))
 864 |       (should
 865 |        (equal
 866 |         (cons :string "= A very small Creole document =\n")
 867 |         (creole/expand-item-value
 868 |          "~/elwikiengine/wiki/small.creole"
 869 |          "~/elwikicreole/"))))
 870 |     (kill-buffer TMPBUF)))
 871 | 
 872 | (ert-deftest creole-htmlize-css-lists ()
 873 |   "Test that we can capture 'htmlfontify' css lists."
 874 |   (let* ((css-decl-list ; this is a list of the CSS declarations there should be
 875 |           '(default
 876 |             font-lock-keyword-face
 877 |             font-lock-variable-name-face
 878 |             font-lock-function-name-face
 879 |             font-lock-type-face))
 880 |          ;; The actual program text we'll fontify
 881 |          (fontified (creole-htmlize-string "##! c
 882 | int main(char **argv, int argc)
 883 | {
 884 |   return 1;
 885 | }
 886 | "))
 887 |          (style-decl
 888 |           (creole-css-list-to-style-decl
 889 |            (get-text-property 0 :css-list fontified))))
 890 |     (should (string-match-p "^span.keyword" style-decl))
 891 |     (should (string-match-p "^span.default" style-decl))
 892 |     (should (string-match-p "^span.variable-name" style-decl))
 893 |     (should (string-match-p "^span.function-name" style-decl))
 894 |     (should (string-match-p "^span.type" style-decl))))
 895 | 
 896 | 
 897 | (ert-deftest creole-moustache ()
 898 |   "Test the moustache templating."
 899 |   (should
 900 |    (equal
 901 |     "<<this is a test>>"
 902 |     (creole-moustache
 903 |      "<<{{text}}>>"
 904 |      '((text . "this is a test")))))
 905 |   (should
 906 |    (equal
 907 |     "<<this is a test>>[[{{with-a-spare-var}}]]"
 908 |     (creole-moustache
 909 |      "<<{{text}}>>[[{{with-a-spare-var}}]]"
 910 |      '((text . "this is a test")))))
 911 |   (should
 912 |    (equal
 913 |     "<<this is a test>>[[another test]]"
 914 |     (creole-moustache
 915 |      "<<{{text}}>>[[{{working-var}}]]"
 916 |      '((text . "this is a test")
 917 |        (working-var . "another test"))))))
 918 | 
 919 | 
 920 | (ert-deftest creole-wiki-file ()
 921 |   "Test that a mocked file can be loaded as a Wiki file."
 922 |   (with-temp-buffer
 923 |     (insert "= A Creole Wiki file =
 924 | 
 925 | This is a nice simple Creole Wiki file.
 926 | ")
 927 |     (let ((creole-file-buffer (current-buffer)))
 928 |       (noflet ((creole/get-file
 929 |                    (filename)
 930 |                  creole-file-buffer))
 931 |         (with-temp-buffer
 932 |           (creole-wiki
 933 |            "~/anyfilename"
 934 |            :destination (current-buffer)
 935 |            :htmlfontify-style nil)
 936 |           (should
 937 |            (equal
 938 |             (buffer-substring-no-properties (point-min) (point-max))
 939 |             "<html>
 940 | <body>
 941 | <a id='A-Creole-Wiki-file'></a>
 942 | <h1>A Creole Wiki file</h1>
 943 | <p>This is a nice simple Creole Wiki file.</p>
 944 | </body>
 945 | </html>
 946 | ")))))))
 947 | 
 948 | (defmacro creole/wiki-test (creoletext htmltext &rest extras)
 949 |   "A helper macro for testing full HTML conversion.
 950 | 
 951 | CREOLETEXT is the creoletext to test.
 952 | 
 953 | HTMLTEXT is what it should produce.
 954 | 
 955 | EXTRAS are any extra controls to be added to the 'creole-to-html'
 956 | call.
 957 | 
 958 | HTMLFONTIFY-STYLE is turned off for all these tests because it's
 959 | too difficult to test strings of 'htmlfontify' styles.  They are
 960 | too dependent on the particular environment (fonts etc...)."
 961 |   (declare (indent defun))
 962 |   `(with-temp-buffer
 963 |      (let ((html-buffer (current-buffer)))
 964 |        (with-temp-buffer
 965 |          ;; Setup the buffer
 966 |          (insert ,creoletext)
 967 |          ;; Now convert
 968 |          (creole-wiki
 969 |           (current-buffer)
 970 |           :destination html-buffer
 971 |           ;; Turn off style header
 972 |           :htmlfontify-style nil
 973 |           ;; Include any further parameters
 974 |           ,@extras)
 975 |          ;; Now test the resulting HTML
 976 |          (should
 977 |           (equal
 978 |            (with-current-buffer html-buffer
 979 |              (buffer-substring-no-properties (point-min)(point-max)))
 980 |            ,htmltext))))))
 981 | 
 982 | 
 983 | 
 984 | (ert-deftest creole-wiki-fontify ()
 985 |   ;; Font lock testing
 986 |   (let (creole-do-anchor-headings)
 987 |     (creole/wiki-test
 988 |         "= A Creole Document =
 989 | 
 990 | {{{
 991 | ##! c
 992 | int main(char **argv, int argc)
 993 | {
 994 |   return 1;
 995 | }
 996 | }}}
 997 | 
 998 | A preformatted area with styling.
 999 | " "<html>
1000 | <body>
1001 | <h1>A Creole Document</h1>
1002 | 
1003 | <pre>
1004 | <span class=\"type\">in</span><span class=\"type\">t</span> <span class=\"function-name\">main</span>(<span class=\"type\">char</span> **<span class=\"variable-name\">argv</span>, <span class=\"type\">int</span> <span class=\"variable-name\">argc</span>)
1005 | {
1006 |   <span class=\"keyword\">return</span> 1;
1007 | }
1008 | </pre>
1009 | <p>A preformatted area with styling.</p>
1010 | </body>
1011 | </html>
1012 | " :htmlfontify t)))
1013 | 
1014 | 
1015 | (ert-deftest creole-wiki-base ()
1016 |   "Test the comprehensive HTML production."
1017 |   (creole/wiki-test
1018 |     "= A Creole Document =
1019 | 
1020 | This is a Creole document with some stuff in it.
1021 | "
1022 |     "<html>
1023 | <body>
1024 | <a id='A-Creole-Document'></a>
1025 | <h1>A Creole Document</h1>
1026 | <p>This is a Creole document with some stuff in it.</p>
1027 | </body>
1028 | </html>
1029 | "))
1030 | 
1031 | (ert-deftest creole-wiki-headers-footers ()
1032 |   "Test that specified headers and footers come out correctly."
1033 |   (creole/wiki-test
1034 |     "= A Creole Document =
1035 | 
1036 | This is a Creole document with some stuff in it.
1037 | "
1038 |     "<html>
1039 | <body>
1040 | <div id='header'>the header</div>
1041 | <a id='A-Creole-Document'></a>
1042 | <h1>A Creole Document</h1>
1043 | <p>This is a Creole document with some stuff in it.</p>
1044 | <div id='footer'>the footer</div>
1045 | </body>
1046 | </html>
1047 | "
1048 |     :body-header "<div id='header'>the header</div>\n"
1049 |     :body-footer "<div id='footer'>the footer</div>\n"))
1050 | 
1051 | (ert-deftest creole-wiki-css-link ()
1052 |   "Test that a CSS under the docroot is linked not embedded."
1053 |   (noflet ((creole/file-under-root-p (file-name root)
1054 |              "/styles.css"))
1055 |     (let (creole-do-anchor-headings)
1056 |       (creole/wiki-test
1057 |           "= A Creole Document =
1058 | 
1059 | This is a Creole document with some stuff in it.
1060 | "
1061 |           "<html>
1062 | <head>
1063 | <title>A Creole Document</title>
1064 | <link rel='stylesheet' href='/styles.css' type='text/css'/>
1065 | </head>
1066 | <body>
1067 | <h1>A Creole Document</h1>
1068 | <p>This is a Creole document with some stuff in it.</p>
1069 | </body>
1070 | </html>
1071 | "
1072 |         :docroot "~/elwikicreole/"
1073 |         :css '("~/elwikicreole/styles.css")))))
1074 | 
1075 | (ert-deftest creole-wiki-css-embed ()
1076 |   "Test that strings are embedded for CSS when necessary."
1077 |   (noflet ((creole/file-under-root-p (file-name root)
1078 |              "/styles.css"))
1079 |     (let (creole-do-anchor-headings)
1080 |       ;; Test a string specified as the CSS is embedded
1081 |       (creole/wiki-test
1082 |           "= A Creole Document =
1083 | 
1084 | This is a Creole document with some stuff in it.
1085 | "
1086 |           "<html>
1087 | <head>
1088 | <title>A Creole Document</title>
1089 | <style>
1090 | p {
1091 | font-size: 8pt;
1092 | }
1093 | </style>
1094 | </head>
1095 | <body>
1096 | <h1>A Creole Document</h1>
1097 | <p>This is a Creole document with some stuff in it.</p>
1098 | </body>
1099 | </html>
1100 | "
1101 |         ;; Here's the docroot
1102 |         :docroot "~/elwikicreole/"
1103 |         ;; Here's a string specifying some CSS, clearly not a file
1104 |         :css '("p {
1105 | font-size: 8pt;
1106 | }"))))
1107 | 
1108 |   ;; This version tests the full mocking causing embedding
1109 |   (with-temp-buffer
1110 |     (insert "P { background: blue; }")
1111 |     (let (creole-do-anchor-headings
1112 |           (css-file-buffer (current-buffer)))
1113 |       ;; Mock the 2 functions so that the file is not considered under
1114 |       ;; the docroot and so that it's contents if the CSS fragment
1115 |       ;; above
1116 |       (noflet ((creole/file-under-root-p (file-name root)
1117 |                  nil)
1118 |                (creole/get-file (filename)
1119 |                  css-file-buffer))
1120 |         (creole/wiki-test
1121 |           "= A Creole Document =
1122 | 
1123 | This is a Creole document with some stuff in it.
1124 | "
1125 |     "<html>
1126 | <head>
1127 | <title>A Creole Document</title>
1128 | <style>
1129 | P { background: blue; }
1130 | </style>
1131 | </head>
1132 | <body>
1133 | <h1>A Creole Document</h1>
1134 | <p>This is a Creole document with some stuff in it.</p>
1135 | </body>
1136 | </html>
1137 | "
1138 |     ;; Here's the docroot...
1139 |     :docroot "~/elwikicreole/"
1140 |     ;; ... here's a file clearly not under the docroot, so it should
1141 |     ;; be embedded.
1142 |     :css '("~/someplace/styles.css"))))))
1143 | 
1144 | (ert-deftest creole-wiki-js ()
1145 |   (noflet ((creole/file-under-root-p (file-name root)
1146 |              "/scripts.js"))
1147 |     (let (creole-do-anchor-headings)
1148 |       (creole/wiki-test
1149 |           "= A Creole Document =
1150 | 
1151 | This is a Creole document with some stuff in it.
1152 | "
1153 |           "<html>
1154 | <head>
1155 | <title>A Creole Document</title>
1156 | <script src='/scripts.js' language='Javascript'></script>
1157 | </head>
1158 | <body>
1159 | <h1>A Creole Document</h1>
1160 | <p>This is a Creole document with some stuff in it.</p>
1161 | </body>
1162 | </html>
1163 | "
1164 |         :docroot "~/elwikicreole/"
1165 |         :javascript '("~/elwikicreole/scripts.js"))
1166 |       (creole/wiki-test
1167 |           "= A Creole Document =
1168 | 
1169 | This is a Creole document with some stuff in it.
1170 | "
1171 |           "<html>
1172 | <head>
1173 | <title>A Creole Document</title>
1174 | <script>
1175 | //<!--
1176 | $(document).ready(function () {
1177 | doSomething();
1178 | });
1179 | 
1180 | //-->
1181 | </script>
1182 | </head>
1183 | <body>
1184 | <h1>A Creole Document</h1>
1185 | <p>This is a Creole document with some stuff in it.</p>
1186 | </body>
1187 | </html>
1188 | "
1189 |         :docroot "~/elwikicreole/"
1190 |         :javascript '("$(document).ready(function () {
1191 | doSomething();
1192 | });
1193 | ")))))
1194 | 
1195 | (ert-deftest creole-directory-list ()
1196 |   (noflet ((directory-files (directory-name)
1197 |            '("." ".." "file1.html" "file2.html"))
1198 |            (file-attributes (file-name)
1199 |              (let ((t1 (encode-time 0 32 9 1 12 2011))
1200 |                    (t2 (encode-time 0 22 9 1 12 2011)))
1201 |                (cond
1202 |                  ((string-match-p ".*/file1.html" file-name)
1203 |                   `(nil 1 "uid" "grp"
1204 |                         ,t1 ,t1 ,t1
1205 |                         200 "-rwxrwxrwx-" t
1206 |                         1333331114234 0))
1207 |                  ((string-match-p ".*/file2.html" file-name)
1208 |                   `(nil 1 "uid" "grp"
1209 |                         ,t2 ,t2 ,t2
1210 |                         157 "-rwxrwxrwx-" t
1211 |                         1333331114234 0))))))
1212 |     (should
1213 |      (equal
1214 |       (creole-directory-list "~/mydirectory")
1215 |       "|file1.html|2011-12-01 09:32|200|
1216 | |file2.html|2011-12-01 09:22|157|
1217 | "))
1218 |     (should
1219 |      (equal
1220 |       (creole-directory-list "~/mydirectory" t)
1221 |       "|[[file1.html]]|2011-12-01 09:32|200|
1222 | |[[file2.html]]|2011-12-01 09:22|157|
1223 | "))))
1224 | 
1225 | ;; creole-tests.el ends here
1226 | 


--------------------------------------------------------------------------------
/creole.el:
--------------------------------------------------------------------------------
   1 | ;;; creole.el --- A parser for the Creole Wiki language
   2 | 
   3 | ;;; Copyright (C) 2011, 2012 by Nic Ferrier
   4 | 
   5 | ;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
   6 | ;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
   7 | ;; Created: 27th October 2011
   8 | ;; Version: 1.0.6
   9 | ;; Package-requires: ((noflet "0.0.3")(kv "0.0.17"))
  10 | ;; Keywords: lisp, creole, wiki
  11 | 
  12 | ;; This file is NOT part of GNU Emacs.
  13 | 
  14 | ;; This program is free software; you can redistribute it and/or modify
  15 | ;; it under the terms of the GNU General Public License as published by
  16 | ;; the Free Software Foundation, either version 3 of the License, or
  17 | ;; (at your option) any later version.
  18 | 
  19 | ;; This program is distributed in the hope that it will be useful,
  20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 | ;; GNU General Public License for more details.
  23 | 
  24 | ;; You should have received a copy of the GNU General Public License
  25 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  26 | 
  27 | ;;; Commentary:
  28 | 
  29 | ;; This is a WikiCreole wiki parser. WikiCreole is something like the
  30 | ;; Wiki language used by OddMuse, which is the EmacsWiki wiki
  31 | ;; language.
  32 | 
  33 | ;; This parser now includes extra support to help deal with OddMuse
  34 | ;; files.
  35 | 
  36 | ;; This code was originally written to mark the death of John McCarthy
  37 | ;; - http://news.ycombinator.com/item?id=3151988
  38 | 
  39 | ;; WikiCreole is an emerging standard documented at:
  40 | ;; http://www.wikicreole.org/wiki/Creole1.0
  41 | 
  42 | ;;; Code:
  43 | 
  44 | (require 'htmlfontify)
  45 | (require 'org-table)
  46 | (require 'calc)
  47 | (require 'rx)
  48 | (require 'noflet)
  49 | (require 'cl)
  50 | (require 'kv)
  51 | 
  52 | (defmacro when1 (expr &rest body)
  53 |   "Evaluate BODY when EXPR but return EXPR."
  54 |   (declare (debug (form &rest form))
  55 |            (indent 1))
  56 |   (let ((expr-val (make-symbol "expr-val")))
  57 |     `(let ((,expr-val ,expr))
  58 |        (when ,expr-val
  59 |          ,@body)
  60 |        ,expr-val)))
  61 | 
  62 | (defgroup creole nil
  63 |   "A WikiCreole parser and associated tools."
  64 |   :group 'hypertext)
  65 | 
  66 | (defvar creole-oddmuse-on nil
  67 |   "Whether creole should include OddMuse compatability.
  68 | 
  69 | OddMuse is the Wiki language used by the EmacsWiki.  It is very
  70 | nearly WikiCreole but not quite.  Hence this flag which turns on
  71 | various small tweaks in behaviour.")
  72 | 
  73 | (defvar creole-link-resolver-fn nil
  74 |   "The function which will resolve links.
  75 | 
  76 | Resolving a link is necessary for links without context such as:
  77 | 
  78 |   [thing]
  79 | 
  80 | or a link formed by CamelCaps.
  81 | 
  82 | By default there is no link resolver and these links are not
  83 | resolved.")
  84 | 
  85 | (defun creole/link-resolve (name)
  86 |   "A simple creole link resolver.
  87 | 
  88 | Resolve the link by looking in the current directory for a
  89 | .creole file that matches the name.
  90 | 
  91 | A note for Wiki implementors: This is not a good implementation
  92 | for a web app since it exposes the extensions and does not
  93 | prepend a URL.  If you use a resolver to prepend the url then you
  94 | may as well resolve the extension in the webapp."
  95 |   (let ((candidates
  96 |          (directory-files
  97 |           default-directory
  98 |           nil (concat name ".creole"))))
  99 |     (if (and (listp candidates)
 100 |              (car-safe candidates))
 101 |         (car candidates)
 102 |         name)))
 103 | 
 104 | (defun creole/link-replacer (m)
 105 |   "Replace regexp replacer for `creole-link'."
 106 |   (apply
 107 |    'format
 108 |    "<a href='%s'>%s</a>"
 109 |    (cond
 110 |      ;; We have both a url and a link
 111 |      ((match-string 4 m)
 112 |       (let ((link (match-string 1 m))
 113 |             (text (match-string 5 m)))
 114 |         (list
 115 |          (if (and (not (string-match-p (rx (or "ftp" "http" "mailto") ":") link))
 116 |                   (functionp creole-link-resolver-fn))
 117 |              (funcall creole-link-resolver-fn link) link) text)))
 118 |      ;; We only have a url
 119 |      ((match-string 1 m)
 120 |       (let ((link (match-string 1 m)))
 121 |         (list
 122 |          (if (and (not (string-match-p (rx (or "ftp" "http" "mailto") ":") link))
 123 |                   (functionp creole-link-resolver-fn))
 124 |              (funcall creole-link-resolver-fn link) link)
 125 |          link))))))
 126 | 
 127 | (defun creole-link-parse (text)
 128 |   "Parse TEXT for creole links.
 129 | 
 130 | If `creole-oddmuse-on' is t then OddMuse links (that do not start
 131 | with '!') will be parsed as well. OddMuse links are single
 132 | bracket links, like:
 133 | 
 134 |  [ThisIsOddMuse]
 135 | 
 136 | If `creole-link-resolver-fn' is non-nil and a function then all
 137 | single element links are passed through it.  This variable also
 138 | turns on CamelCase linking."
 139 |   (if (and creole-oddmuse-on (string-match-p (rx bol "!") text))
 140 |       (replace-regexp-in-string (rx bol "!") "" text t)
 141 |       ;; Else it's not an escaped link
 142 |       (let* ((resolvable-link
 143 |               (if (functionp creole-link-resolver-fn)
 144 |                   (let* ((case-fold-search nil)) ; do CamelCaps links
 145 |                     (replace-regexp-in-string
 146 |                      (rx
 147 |                       (or buffer-start bol bos)
 148 |                       (group
 149 |                        (? (not (any "[")))
 150 |                        (group
 151 |                         (>= 2 (and (any upper)
 152 |                                    (one-or-more (any lower)))))))
 153 |                      (lambda (m)
 154 |                        (let ((link (match-string 1 m)))
 155 |                          (format
 156 |                           "<a href='%s'>%s</a>"
 157 |                           (funcall creole-link-resolver-fn link)
 158 |                           link)))
 159 |                      text t))
 160 |                   ;; Else just use the text
 161 |                   text))
 162 |              (real-creole
 163 |               (replace-regexp-in-string
 164 |                (rx "[["
 165 |                    (group
 166 |                     (* (group (or "ftp" "http" "mailto") ":"))
 167 |                     (+ (not (any "]|"))))
 168 |                    (*
 169 |                   (group
 170 |                    "|" (group (group (+ (not (any "]")))))))
 171 |                    "]]")
 172 |                'creole/link-replacer
 173 |                resolvable-link))
 174 |              (oddmuse
 175 |               (when creole-oddmuse-on
 176 |                 (replace-regexp-in-string
 177 |                  (rx "["
 178 |                      (group
 179 |                       (* (group (and (+ (in alpha))) ":"))
 180 |                       (+ (not (any "]| "))))
 181 |                      (* (group
 182 |                          (any "| ")
 183 |                          (group (group (+ (not (any ?\])))))))
 184 |                      "]")
 185 |                  'creole/link-replacer
 186 |                  real-creole)))
 187 |              (bracket-resolved (if oddmuse oddmuse real-creole)))
 188 |         bracket-resolved)))
 189 | 
 190 | (defvar creole-image-class nil
 191 |   "A default class to be applied to wiki linked images.")
 192 | 
 193 | (defun creole/image->html (m)
 194 |   "Convert image urls to HTML."
 195 |   (let (title)
 196 |     (apply
 197 |      'format
 198 |      (append
 199 |       '("<img %ssrc=\"%s\" alt=\"%s\" %s%s></img>")
 200 |       (list
 201 |        ;; Whether we have a class to apply or not
 202 |        (if creole-image-class (format "class=\"%s\" " creole-image-class) "")
 203 |        ;; URL of the image
 204 |        (if (functionp creole-link-resolver-fn)
 205 |            (funcall creole-link-resolver-fn (match-string 1 m))
 206 |            ;; Else
 207 |            (match-string 1 m))
 208 |        ;; if we don't have an alternate, use the URL
 209 |        (if (match-string 4 m)
 210 |            (setq title (match-string 5 m))
 211 |            (match-string 1 m))
 212 |        ;; title
 213 |        (if title (format "title=\"%s\" " title) "")
 214 |        ;; Match only the size part for now
 215 |        (if (match-string 2 m)
 216 |            (let ((options (match-string 3 m)))
 217 |              (save-match-data
 218 |                ;; 'size=' is optional and is the only parameter right now
 219 |                (string-match
 220 |                 (rx (group (+ digit))
 221 |                     (? (group (and ?x (group (+ digit))))))
 222 |                 options)
 223 |                (when (match-string 1 options)
 224 |                  (concat
 225 |                   (format
 226 |                    "width=\"%s\" " (match-string 1 options))
 227 |                   (when (match-string 2 options)
 228 |                     (format "height=\"%s\" " (match-string 3 options)))))))
 229 |            ""))))))
 230 | 
 231 | (defun creole-include-handler (match-data scheme path)
 232 |   "Embed handler to handle \"include:file\" embeds.
 233 | 
 234 | Add this to `creole-embed-hanndlers' (for example, for scheme
 235 | \"include\") to support creole includes, for example:
 236 | 
 237 |   = A document =
 238 |   {{include:somecreolefile}}
 239 | 
 240 | allows \"somecreolefile\" to be HTML rendered and embedded in the
 241 | output of the main document.
 242 | 
 243 | If `creole-link-resolver' is defined then link resolution is
 244 | performed on PATH before loading.
 245 | 
 246 | `creole-html' is used to render the HTML for the included file."
 247 |   (let* ((file-path (if (functionp creole-link-resolver-fn)
 248 |                         (funcall creole-link-resolver-fn path)
 249 |                         ;; Else just the path
 250 |                         path)))
 251 |     (with-temp-buffer
 252 |       (insert-file-contents-literally file-path)
 253 |       (let ((creole-buffer (current-buffer)))
 254 |         (with-temp-buffer
 255 |           (creole-html creole-buffer (current-buffer) :erase-existing t)
 256 |           (buffer-string))))))
 257 | 
 258 | (defvar creole-youtube-handler-width 420
 259 |   "The width that will be used for youtube videos.
 260 | 
 261 | Note that not all widths are possible.")
 262 | 
 263 | (defvar creole-youtube-handler-height 315
 264 |   "The height that will be used for youtube videos.
 265 | 
 266 | Note that not all heights are possible.")
 267 | 
 268 | (defun creole-youtube-handler (m scheme path)
 269 |   "Handle \"youtube\" scheme, turning it into an HTML embed.
 270 | 
 271 | This creole:
 272 | 
 273 |   {{youtube:WcUwCsAhWMk|a nice video on emacs-lisp}}
 274 | 
 275 | will produce this HTML:
 276 | 
 277 |  <span class=\"youtube\">
 278 |    <iframe src=\"//www.youtube.com/embed/WcUwCsAhWMk\"
 279 |          width=\"420\" height=\"315\"
 280 |          frameborder=\"0\" allowfullscreen></iframe>
 281 |    <em>a nice video on emacs-lisp</em>
 282 |  </span>
 283 | 
 284 | The link resolver is not consulted to resolve the link."
 285 |   ;; Just the youtube iframe thing
 286 |   (format "<span class=\"youtube\"><iframe src=\"//www.youtube.com/embed/%s\"
 287 | width=\"%s\" height=\"%s\"
 288 | frameborder=\"0\" allowfullscreen></iframe>
 289 | %s
 290 | </span>" path creole-youtube-handler-width creole-youtube-handler-height
 291 | (if (match-string 4 m)
 292 |     (format "<em>%s</em>" (match-string 5 m))
 293 |     "")))
 294 | 
 295 | (defvar creole-summary-resolver nil
 296 |   "Optional resolver function for article links from summaries.
 297 | 
 298 | If set to a function of one argument, this is used by
 299 | `creole-summary-handler' to resolve the path to the summary
 300 | article into an article path.")
 301 | 
 302 | (defun creole-summary-handler (m scheme path)
 303 |   "Embed handler to handle \"summary:file\" embeds.
 304 | 
 305 | Using this will let you pull in the first para of an article."
 306 |   ;; This is not a very good summary handler
 307 |   ;;
 308 |   ;; what is SHOULD do is to take the elements up to and including the
 309 |   ;; first para and then throw everything else away.
 310 |   (let* ((file-path (if (functionp creole-link-resolver-fn)
 311 |                         (funcall creole-link-resolver-fn path)
 312 |                         ;; Else just the path
 313 |                         path)))
 314 |     (with-temp-buffer
 315 |       (insert-file-contents-literally file-path)
 316 |       (let* ((creole-buffer (current-buffer))
 317 |              ;; We could cache the creole-structure?
 318 |              (struct
 319 |               (creole-structure (creole-tokenize creole-buffer)))
 320 |              ;; cdar expects a para...need to change that
 321 |              (summary (cdar struct))
 322 |              (decorated (format "%s [[%s|... read more]]"
 323 |                                 summary
 324 |                                 path)))
 325 |         (with-temp-buffer
 326 |           (insert
 327 |            (let ((creole-link-resolver-fn
 328 |                   (lambda (path)
 329 |                     (if (functionp creole-summary-resolver)
 330 |                         (funcall creole-summary-resolver path)
 331 |                         path))))
 332 |              (creole-block-parse decorated)))
 333 |           (buffer-string))))))
 334 | 
 335 | 
 336 | (defvar creole-embed-handlers nil
 337 |   "An a-list of scheme . handler-function pairs for handling embeds.
 338 | 
 339 | The image syntax can be used to handle generic embedding, turning
 340 | a URL into some generic output code.  Each url scheme that can be
 341 | used to do that must be registered here.
 342 | 
 343 | For example: youtube:TR7DPvEi7Jg could be returned as the embed
 344 | HTML for that specific youtube video.
 345 | 
 346 | Handlers should expect three arguments: the match data (as passed
 347 | to `creole-image-resolve') and then the scheme and the path (the
 348 | non-scheme part of the url).")
 349 | 
 350 | (defun creole-image-resolve (m)
 351 |   "Resolve M, a match object, into HTML.
 352 | 
 353 | M comes from `creole-image-parse' and has the following groups:
 354 | 
 355 |  1 the url part
 356 |  2 the query part with the leading \"?\"
 357 |  3 the query part without the \"?\"
 358 |  4 the description part with the leading \"|\"
 359 |  5 the description part without the leading \"|\"
 360 | 
 361 | The resolution uses `creole-embed-handlers' to attach handling
 362 | logic to urls via url schemes.
 363 | 
 364 | If no handler is found the embed is presumed to be an image and
 365 | passed to `creole/image->html'."
 366 |   (let ((md (match-data)))
 367 |     ;; Match the url part for a scheme
 368 |     (noflet ((matches (regex to-match)
 369 |                (save-match-data
 370 |                  (when (string-match regex to-match)
 371 |                    (loop for i from 0 to (- (/ (length (match-data)) 2) 1)
 372 |                       collect (match-string i to-match))))))
 373 |       (let ((url (match-string 1 m)))
 374 |         (destructuring-bind (&optional url scheme path)
 375 |             (matches
 376 |              (rx (group (+ (any "A-Za-z"))) ":"
 377 |                  (group (+ anything)))
 378 |              url)
 379 |           ;; I do this because save-match-data doesn't seem to work.
 380 |           (set-match-data md)
 381 |           ;; Find whether we have a specific handler for scheme and then
 382 |           ;; pass it path
 383 |           (let ((handler-fn (kva scheme creole-embed-handlers)))
 384 |             (if (functionp handler-fn)
 385 |                 (save-match-data
 386 |                   (funcall handler-fn m scheme path))
 387 |                 ;; Else just call the image handler
 388 |                 (creole/image->html m))))))))
 389 | 
 390 | (defun creole-image-parse (text)
 391 |   "Parse TEXT for creole images.
 392 | 
 393 | Images should have this format:
 394 | 
 395 | {{image.jpg?size=50x100|description}}
 396 | 
 397 | where the size and description is optional, and the second
 398 | dimension in size can be omitted.
 399 | 
 400 | The 'size=' is optional, and I keep there because this way you
 401 | could add more parameters to the image if you needed them. By
 402 | now, a size is supposed, and the values are assumed to be either
 403 | a Width, or a WidthxHeight specification.
 404 | 
 405 | If defined then `creole-link-resolver-fn' is used for links."
 406 |   (replace-regexp-in-string
 407 |    (rx "{{"
 408 |        (group (+ (not (any "?|}"))))
 409 |        (* (group "?" (group (+ (not (any "?|}"))))))
 410 |        (? (group "|" (group (+ (not (any "}"))))))
 411 |        "}}")
 412 |    'creole-image-resolve
 413 |    text))
 414 | 
 415 | (defun creole-block-parse (text)
 416 |   "Parses TEXT as a creole block.
 417 | 
 418 | A creole block is a paragraph or list item that can include
 419 | links, italic, bold, line break or inline preformatted markup.
 420 | 
 421 | Returns a copy of TEXT with the WikiCreole replaced with
 422 | appropriate HTML."
 423 |   (let ((transformed
 424 |          (replace-regexp-in-string
 425 |           (rx "**"
 426 |               (group (*? anything))
 427 |               "**")
 428 |           "<strong>\\1</strong>"
 429 |           (replace-regexp-in-string
 430 |            (rx (group (not (any ":")))
 431 |                "//"
 432 |                (group (*? anything) (not (any ":")))
 433 |                "//")
 434 |            "\\1<em>\\2</em>"
 435 |            (replace-regexp-in-string
 436 |             (rx bol
 437 |                 "//"
 438 |                 (group (*? anything) (not (any ":")))
 439 |                 "//")
 440 |             "<em>\\1</em>"
 441 |             (replace-regexp-in-string
 442 |              (rx "{{{"
 443 |                  (group (*? anything))
 444 |                  "}}}")
 445 |              "<code>\\1</code>"
 446 |              (replace-regexp-in-string
 447 |               (rx ?\\)
 448 |               "<br/>"
 449 |               text)))))))
 450 |     (if creole-oddmuse-on
 451 |         (creole-image-parse
 452 |          (creole-link-parse
 453 |           (replace-regexp-in-string
 454 |            (rx "'''"
 455 |                (group (*? not-newline))
 456 |                "'''")
 457 |            "<em>\\1</em>"
 458 |            (replace-regexp-in-string
 459 |             (rx "##"
 460 |                 (group (*? not-newline))
 461 |                 "##")
 462 |             "<code>\\1</code>"
 463 |             transformed))))
 464 |         ;; Else
 465 |         (creole-image-parse (creole-link-parse transformed)))))
 466 | 
 467 | (defvar creole-recalculate-org-tables t
 468 |   "Indicates that Org tables should be recalculated inplace.
 469 | 
 470 | Table calculation is performed calling
 471 | `org-table-recalculate'. The default value is to recalculate the
 472 | tables. However, this leaves the original buffer modified. If you
 473 | don't want the original buffer modified, or you don't have
 474 | formulas in your tables (so recalculation is not necessary), you
 475 | can change this value to nil.")
 476 | 
 477 | (defun creole/org-table-row-parser (row-text)
 478 |   "Split an org-table row into a list of cells."
 479 |   (noflet ((last-pos (text) ;; find the last |
 480 |              (string-match "|[ \n]*$" text)))
 481 |     (let* ((pairs (list (cons "//" "//")
 482 |                         (cons "{{" "}}")
 483 |                         (cons "[[" "]]")))
 484 |            (cellstart 1)
 485 |            (pt cellstart)
 486 |            lst)
 487 |       (catch :escape
 488 |         (while t
 489 |           (if (< pt (last-pos row-text))
 490 |               (let* ((cell (substring row-text pt))
 491 |                      (delim-pos (string-match
 492 |                                  (rx (group
 493 |                                       (or "//" "{{" "[[" "|")))
 494 |                                  cell))
 495 |                      (delim (match-string 1 cell)))
 496 |                 (if (equal delim "|")
 497 |                     (progn
 498 |                       (push
 499 |                        (substring row-text cellstart
 500 |                                   (+ pt delim-pos))
 501 |                        lst)
 502 |                       (setq pt (setq cellstart (+ pt delim-pos 1))))
 503 |                     ;; else it's got some formatting so skip it whatever it is
 504 |                     (let* ((start (+ delim-pos (length delim)))
 505 |                            (delim-end (kva delim pairs))
 506 |                            (end (string-match
 507 |                                  (rx-to-string `(and ,delim-end) t)
 508 |                                  (substring cell start))))
 509 |                       ;; and add it to l to find end point
 510 |                       ;; and then search again
 511 |                       (setq pt (+ pt (+ start end (length delim-end)))))))
 512 |               ;; Else
 513 |               (unless (equal cellstart pt)
 514 |                 (push (substring row-text cellstart pt) lst))
 515 |               (throw :escape (reverse lst))))))))
 516 | 
 517 | (defun creole/org-table-to-lisp (&optional txt)
 518 |   "Convert the table at point to a Lisp structure.
 519 | 
 520 | Replaces `org-table-to-lisp' with something that handles cells
 521 | for creole better since a cell with a link in it would fail
 522 | otherwise because creole uses the | as a link separator."
 523 |   (unless txt
 524 |     (unless (org-at-table-p)
 525 |       (user-error "No table at point")))
 526 |   (let* ((txt (or txt
 527 | 		  (buffer-substring-no-properties
 528 |                    (org-table-begin)
 529 |                    (org-table-end))))
 530 | 	 (lines (org-split-string txt "[ \t]*\n[ \t]*")))
 531 |     (mapcar
 532 |      (lambda (x)
 533 |        (if (string-match org-table-hline-regexp x)
 534 | 	   'hline
 535 |            (creole/org-table-row-parser x)))
 536 |      lines)))
 537 | 
 538 | (defun creole-tokenize (docbuf)
 539 |   "Parse DOCBUF which is full of creole wiki text.
 540 | 
 541 | See http://www.wikicreole.org/wiki/Creole1.0 for more information
 542 | on WikiCreole.
 543 | 
 544 | Returns a list of parsed elements."
 545 |   (with-current-buffer docbuf
 546 |     (save-excursion
 547 |       (goto-char (point-min))
 548 |       (let ((res '()))
 549 |         (while (not (eobp))
 550 |           (cond
 551 |            (;; Heading
 552 |             (looking-at (rx bol (group (+ "=")) (in blank)))
 553 |              (let ((level (length (match-string 1))))
 554 |                ;; Actually, the end = is optional... not sure if, when
 555 |                ;; there is an end = it has to be the same number as the
 556 |                ;; first one
 557 |                (if (not
 558 |                     (re-search-forward
 559 |                      (rx bol
 560 |                          (group (+ "="))
 561 |                          (+ blank)
 562 |                          (group (* any))
 563 |                          (+ blank)
 564 |                          (group (+ "="))
 565 |                          eol)
 566 |                      nil 't))
 567 |                    (error "Creole: badly formatted heading"))
 568 |                (when (equal (length (match-string 3))
 569 |                             level)
 570 |                  (setq res (append res
 571 |                                    (list
 572 |                                     (cons
 573 |                                      (intern (format "heading%s" level))
 574 |                                      ;; The string that is the heading
 575 |                                      ;; - any internal rules we should
 576 |                                      ;; deal with here
 577 |                                      (match-string 2)))))
 578 |                  (forward-line))))
 579 |             (;; OddMuse portraits
 580 |              (and creole-oddmuse-on (looking-at
 581 |                                      (rx bol "portrait:" (group (* any)))))
 582 |              (setq res (append res (list (cons 'portrait (match-string 1)))))
 583 |              (forward-line))
 584 |             (;; Table
 585 |              (looking-at "^|")
 586 |              ;; Recalculate tables?
 587 |              (when creole-recalculate-org-tables
 588 |                ;; Requires that we're back in the table
 589 |                (org-table-recalculate t))
 590 |              (let* ((tbl (creole/org-table-to-lisp))
 591 |                     (pt (org-table-end)))
 592 |                (setq res (append
 593 |                           res
 594 |                           (list
 595 |                            (cons 'table tbl))))
 596 |                (goto-char pt)
 597 |                ;; Skip forward over any org-tbl comments
 598 |                (unless (re-search-forward "^[^#]" nil t)
 599 |                  (goto-char (point-max)))
 600 |                (beginning-of-line)))
 601 |             (;; Unordered list item
 602 |              (looking-at
 603 |               (rx bol
 604 |                   (group (+ "*"))
 605 |                   (in blank)
 606 |                   (group (* any))))
 607 |              (let ((level (length (match-string 1))))
 608 |                (setq res (append res
 609 |                                  (list
 610 |                                   (cons
 611 |                                    (intern (format "ul%s" level))
 612 |                                    ;; The string that is the heading
 613 |                                    ;; - any internal rules we should
 614 |                                    ;; deal with here
 615 |                                    (match-string 2)))))
 616 |                (forward-line)))
 617 |             (;; Ordered list item
 618 |              (looking-at (rx bol
 619 |                              (group (+ "#"))
 620 |                              (in blank)
 621 |                              (group (* any))))
 622 |              (let ((level (length (match-string 1))))
 623 |                (setq res (append res
 624 |                                  (list
 625 |                                   (cons
 626 |                                    (intern (format "ol%s" level))
 627 |                                    ;; The string that is the heading
 628 |                                    ;; - any internal rules we should
 629 |                                    ;; deal with here
 630 |                                    (match-string 2)))))
 631 |                (forward-line)))
 632 |             (;; Horizontal rule
 633 |              (looking-at (rx bol
 634 |                              (* (in blank))
 635 |                              "----"
 636 |                              (* (in blank))
 637 |                              eol))
 638 |              (setq res (append res (list (cons 'hr ""))))
 639 |              (forward-line))
 640 |             (;; Pre-formatted block
 641 |              (looking-at (rx bol "\n{{{" eol))
 642 |              (if (not
 643 |                   (re-search-forward
 644 |                    (rx bol
 645 |                        "\n{{{\n"
 646 |                        (group (*? anything))
 647 |                        "\n}}}" (* space)
 648 |                        eol)
 649 |                    nil t))
 650 |                  (error "Creole: bad preformatted block"))
 651 |              (setq res (append res
 652 |                                (list
 653 |                                 (cons 'preformatted (match-string 1)))))
 654 |              (forward-line))
 655 |             ;; Oddmuse allows space defined pre-blocks
 656 |             ((and creole-oddmuse-on (looking-at "^\n +[^-]"))
 657 |              (let* ((start (point))
 658 |                     (end (progn (next-line)
 659 |                                 (re-search-forward "^$" nil t)))
 660 |                     (str (buffer-substring start end)))
 661 |                (setq res (append res (list (cons 'preformatted str))))
 662 |                (goto-char end)))
 663 |             (;; Lisp-plugin
 664 |              (or (looking-at (rx bol "\n" "<<(" eol))
 665 |                  (and (looking-at "^<<(")
 666 |                       (when1 (save-excursion
 667 |                                (previous-line)
 668 |                                (looking-at (rx bol "\n" "<<(")))
 669 |                         (previous-line))))
 670 |              (if (not
 671 |                   (re-search-forward
 672 |                    (rx bol
 673 |                        "\n"
 674 |                        "<<("
 675 |                        "\n"
 676 |                        (group (*? anything))
 677 |                        "\n"
 678 |                        ")>>"
 679 |                        (* space)
 680 |                        eol)
 681 |                    nil t))
 682 |                  (error "Creole: bad Lisp plugin block"))
 683 |              (let* ((plugin-lisp (match-string 1))
 684 |                     (value (eval (car (read-from-string plugin-lisp))))
 685 |                     (plugin-fragment (with-temp-buffer
 686 |                                        (insert value)
 687 |                                        (creole-tokenize (current-buffer)))))
 688 |                (setq res (append res plugin-fragment)))
 689 |              (forward-line))
 690 |             (;; HTML-plugin
 691 |              (or (looking-at "^\n<<html\n")
 692 |                  (and
 693 |                   (looking-at "<<html\n")
 694 |                   (when1
 695 |                       (save-excursion
 696 |                         (previous-line)
 697 |                         (looking-at "\n<<html\n"))
 698 |                     (previous-line))))
 699 |              (if (not
 700 |                   (re-search-forward
 701 |                    (rx bol
 702 |                        "\n"
 703 |                        "<<html"
 704 |                        "\n"
 705 |                        (group-n 1 (*? anything))
 706 |                        "\n"
 707 |                        "html>>"
 708 |                        eol) nil t))
 709 |                  (error "Creole: bad HTML plugin block"))
 710 |              (setq res (append res
 711 |                                (list
 712 |                                 (cons 'plugin-html (match-string 1)))))
 713 |              (forward-line))
 714 |             (;; Paragraph line
 715 |              (and (looking-at (rx bol (not (any "=*"))))
 716 |                   (not (looking-at (rx bol "<<html")))
 717 |                   (not (looking-at (rx bol eol))))
 718 |              (let* ((start (point))
 719 |                     (end
 720 |                      (save-match-data
 721 |                        (let* ((matched-end
 722 |                                ;; Find the end - the end is actually BEFORE this
 723 |                                (re-search-forward
 724 |                                 (rx (or (group bol eol)
 725 |                                         (group bol (in "=*"))
 726 |                                         (group eol "\nhtml>>\n")))
 727 |                                 nil 't))
 728 |                               (matched (if matched-end (match-string 0))))
 729 |                          (cond
 730 |                            ((equal matched "") (- matched-end 1))
 731 |                            ((equal matched "*") (- matched-end 2))
 732 |                            ((equal matched "=") (- matched-end 2))
 733 |                            ((equal matched "\n<<html") (- matched-end 8))
 734 |                            (t
 735 |                             (point-max)))))))
 736 |                (setq res
 737 |                      (append
 738 |                       res
 739 |                       (list
 740 |                        (cons 'para (buffer-substring start end)))))
 741 |                (goto-char end)))
 742 |             ('t
 743 |              (forward-line))))
 744 |         res))))
 745 | 
 746 | (defun creole/test-doc (buffer)
 747 |   "Insert a test document of creole text into BUFFER."
 748 |   (with-current-buffer buffer
 749 |     (insert "= Heading! =\n")
 750 |     (insert "\n")
 751 |     (insert "== Heading2! ==\n")
 752 |     (insert "# an ordered list item\n## a 2nd ordered list item\n")
 753 |     (insert "== Heading3 is a multi word heading ==\n")
 754 |     (insert "\n{{{\n== this is preformatted ==\n{{\nIt looks great\n}}\n}}}\n")
 755 |     (insert "* list item\n** 2nd list item\n*** 3rd list item\n")
 756 |     (insert "** another 2nd list item\n*** another 3rd list item\n")
 757 |     (insert " ----\n")
 758 |     (insert "This is a paragraph
 759 | that runs over several lines
 760 | * and a list item stops it
 761 | ")
 762 |     (insert "This is a paragraph {{{with code}}} and [[links]]
 763 | and **bold** and //italics//.")))
 764 | 
 765 | (defun creole/list-item (list-symbol)
 766 |   "Return the type and the level of the LIST-SYMBOL.
 767 | 
 768 | For example:
 769 | 
 770 |  (creole/list-item 'ol1)
 771 |   => (ordered . 1)
 772 | 
 773 |  (creole/list-item 'ul10)
 774 |   => (unordered . 10)"
 775 |   (save-match-data
 776 |     (let ((s (symbol-name list-symbol)))
 777 |       (when (string-match (rx (group (in "uo") "l")
 778 |                               (group (+ digit)))
 779 |                           s)
 780 |         (cons
 781 |          (intern (match-string 1 s))
 782 |          (string-to-number (match-string 2 s)))))))
 783 | 
 784 | (defun creole-structure (lst)
 785 |   "Make a parsed structure from a list.
 786 | 
 787 | This is a parser, of sorts, in that it turns a list of tokens
 788 | into more of a tree structure.  In WikiCreole though, the only
 789 | thing that really needs a tree representation is ordered and
 790 | unordered lists, so all this function does is add structure to a
 791 | stream of list tokens.  All other tokens are passed through
 792 | directly.
 793 | 
 794 | This is not marked private because it does form part of what
 795 | might be called the parsing API of this creole library."
 796 |   (let* ((docptr lst)
 797 |          (state '()) ; used as a stack
 798 |          (result '()))
 799 |     (while docptr
 800 |       (let* ((token (car docptr))
 801 |              (lst-item (creole/list-item (car token))))
 802 |         (case (if lst-item 'listitem (car token))
 803 |           (listitem
 804 |            (let* ((last (if (car state) (cdar state)))
 805 |                   (last-level (if (car state) (caar state)))
 806 |                   (new (list (car lst-item) (cdr token))))
 807 |              (cond
 808 |               ;; Current level is higher than the last, embed a new list
 809 |               ((and last
 810 |                     (> (cdr lst-item) last-level))
 811 |                (setcdr last (append (cdr last) (list new)))
 812 |                ;; Update the stack
 813 |                (push (cons (cdr lst-item) new) state))
 814 |               ;; Current level is same as the last, extend the last list
 815 |               ((and last
 816 |                     (= (cdr lst-item) last-level))
 817 |                (setq new (list (cdr token)))
 818 |                (setcdr last (append (cdr last) new))
 819 |                ;; Reset the top of the stack
 820 |                (pop state)
 821 |                (push (cons (cdr lst-item) new) state))
 822 |               ;; Current level is same as the last, extend the last list
 823 |               ((and last
 824 |                     (< (cdr lst-item) last-level))
 825 |                (loop for i from 1 to (- last-level (cdr lst-item))
 826 |                      do (pop state))
 827 |                (let* ((last (if (car state) (cdar state)))
 828 |                       (last-level (if (car state) (caar state))))
 829 |                  (setq new (list (cdr token)))
 830 |                  (setcdr last (append (cdr last) new))))
 831 |               ;; The default action when we're dealing with lists
 832 |               (t
 833 |                (setq result (append result (list new)))
 834 |                ;; Update the stack
 835 |                (push (cons (cdr lst-item) new) state)))))
 836 |           ;; Not a list item - just push it onto the result, always
 837 |           ;; empty the list state
 838 |           (t
 839 |            (setq state '())
 840 |            (setq result (append result (list token))))))
 841 |       (setq docptr (cdr docptr)))
 842 |     result))
 843 | 
 844 | ;; Exporting functions
 845 | 
 846 | (defun creole/html-list (type lst)
 847 |   "Export the specified LST in HTML.
 848 | 
 849 | The exported HTML is written into the current buffer.
 850 | 
 851 | This is NOT intended to be used by anything but
 852 | `creole-export-html'."
 853 |   (let ((first t))
 854 |     (insert "<" (symbol-name type) ">\n")
 855 |     (loop for item in lst
 856 |           do
 857 |           (cond
 858 |            ((listp item)
 859 |             (creole/html-list (car item) (cdr item))
 860 |             (setq first nil))
 861 |            (t
 862 |             (when (not first)
 863 |               (insert "</li>\n"))
 864 |             (setq first nil)
 865 |             (insert "<li>")
 866 |             (insert (creole-block-parse item)))))
 867 |     (insert "</li>\n")
 868 |     (insert "</" (symbol-name type) ">\n")))
 869 | 
 870 | (defun creole/html-table (table-list)
 871 |   "Convert the org-table structure TABLE-LIST to HTML.
 872 | 
 873 | We use `orgtbl-to-generic' to do this."
 874 |   (let ((value
 875 |          (orgtbl-to-generic
 876 |           table-list
 877 |           (list
 878 |            :tstart "<table>"
 879 |            :tend "</table>\n"
 880 |            :hlstart "<thead><tr>\n"
 881 |            :hlend "</tr></thead>"
 882 |            :hllstart "<thead><tr>\n"
 883 |            :hllend "</tr></thead>"
 884 |            :lstart "<tr>\n"
 885 |            :lend "</tr>"
 886 |            :hline nil
 887 |            :hfmt (lambda (field)
 888 |                   ;; Where we do block formatting
 889 |                   (format
 890 |                    "<th>%s</th>\n"
 891 |                    (creole-block-parse field)))
 892 |            :fmt (lambda (field)
 893 |                   ;; Where we do block formatting
 894 |                   (format
 895 |                    "<td>%s</td>\n"
 896 |                    (creole-block-parse field)))
 897 |            ))))
 898 |     value))
 899 | 
 900 | (defun creole-htmlize/mode-func (text)
 901 |   "Work out the mode function for TEXT.
 902 | 
 903 | A list is returned.  The first element is whether the first line
 904 | of the text should be stripped or not (if forcing marker text is
 905 | used that should be the case).  The `cdr' of the cons is the
 906 | Emacs mode function to use to color the text.  This either uses
 907 | some heuristics or a specific instruction at the start of the
 908 | text:
 909 | 
 910 |  ##! C
 911 |  int main(char** argv, int argc)
 912 |  {
 913 |    return 0;
 914 |  }
 915 | 
 916 | Shows how to indicate some C.
 917 | 
 918 | The heuristics are very simple right now.  They will probably
 919 | change to something heavily based on existing mode choosing
 920 | logic."
 921 |   (save-match-data
 922 |     (cond
 923 |       ((string-match
 924 |         (rx bol "##! " (group (* any)) "\n")
 925 |         text)
 926 |        (list
 927 |         t
 928 |         (intern
 929 |          (concat
 930 |           (or (match-string 1 text)
 931 |               (downcase mode-name))
 932 |           "-mode"))))
 933 |       ((string-match-p (rx bol (or (group ";;" (* ";") " " (* any)) "(")) text)
 934 |        ;; It's lisp
 935 |        (list nil (if (string-match-p (rx bol (* any) " -*- " (* any)) text)
 936 |                      'emacs-lisp-mode
 937 |                    'lisp-mode)))
 938 |       ((string-match-p (rx bol "#!/bin/" (+ lower) "sh" eol) text)
 939 |        (list nil 'shell-script-mode))
 940 |       ((string-match-p (rx bol "-module(") text)
 941 |        (list nil 'erlang-mode))
 942 |       (t (list nil text)))))
 943 | 
 944 | (defun creole-htmlize-string (text)
 945 |   "Make TEXT syntax coloured HTML using Emacs font-lock.
 946 | 
 947 | The syntax coloring to use is decided by `creole-htmlize/mode-func'.
 948 | 
 949 | A string containing the HTML syntax coloured with
 950 | `font-lock-fontify-buffer' and `htmlfontify' is returned.
 951 | 
 952 | If called interactively the current region is used as the string
 953 | and the result buffer is left open and switched to.
 954 | 
 955 | A property `:css-list' attached to the returned string contains
 956 | the list of CSS declarations generated by `htmlfontify'.  The
 957 | list can be turned into CSS by `creole-css-list-to-style-decl'.
 958 | 
 959 | Unfortunately, when run in batch mode Emacs doesn't attach colors
 960 | to faces and so we don't get coloured styles.  It should be
 961 | possible to use the `cadr' of the style to add colors."
 962 |   (interactive
 963 |    (list
 964 |     (if (mark)
 965 |         (buffer-substring
 966 |          (region-beginning)
 967 |          (region-end))
 968 |       (buffer-substring
 969 |        (point-min)
 970 |        (point-max)))))
 971 |   (destructuring-bind (strip-line mode-func) (creole-htmlize/mode-func text)
 972 |     (save-match-data
 973 |       (if (not (functionp mode-func))
 974 |           (concat "<pre>\n" text "\n</pre>")
 975 |           (with-temp-buffer
 976 |             ;; Get font-lock?
 977 |             (insert text "\n")
 978 |             (when strip-line
 979 |               ;; Kill the mode variable line
 980 |               (goto-char (point-min))
 981 |               (kill-line))
 982 |             ;; Now switch that mode into the new mode
 983 |             (funcall mode-func)
 984 |             (whitespace-mode -1)
 985 |             (font-lock-fontify-buffer)
 986 |             ;; Do some dynamic binding magic to alter htmlfontify
 987 |             ;; behaviour - no header, no footer and the styles list is
 988 |             ;; captured rather than written out.
 989 |             (let (css-list)
 990 |               (noflet ((hfy-sprintf-stylesheet
 991 |                         (css file)
 992 |                         (setq css-list css)
 993 |                         ""))
 994 |                 (let ((hfy-display-class '((type x-toolkit)))
 995 |                       (hfy-page-footer (lambda (&optional file-name) "" "")))
 996 |                   (let (result
 997 |                         (htmlbuf
 998 |                          (noflet
 999 |                              ((message (format-str &rest args) t)) ; htmlfontify has annoying messages in it.
1000 |                              (htmlfontify-buffer))))
1001 |                     (with-current-buffer htmlbuf
1002 |                       ;; FIXME we should add another property
1003 |                       ;; detailing which mode we're dealing with-
1004 |                       ;;
1005 |                       ;; We MAY want to disambiguate styles, like
1006 |                       ;; "keyword" into "pre.emacs-lisp span.keyword"
1007 |                       (put-text-property
1008 |                        (point-min) (point-max)
1009 |                        :css-list css-list)
1010 |                       (setq
1011 |                        result
1012 |                        (buffer-substring
1013 |                         (point-min)
1014 |                         (point-max))))
1015 |                     (if (called-interactively-p 'interactive)
1016 |                         (switch-to-buffer htmlbuf)
1017 |                         (with-current-buffer htmlbuf
1018 |                           (set-buffer-modified-p nil))
1019 |                         (kill-buffer htmlbuf))
1020 |                     result)))))))))
1021 | 
1022 | (defun creole-content-list (structure)
1023 |   "Add a table of contents list to the STRUCTURE.
1024 | 
1025 | The list is only added if the STRUCTURE has at least 2 headings."
1026 |   (let* ((heads '(heading1 heading2 heading3 heading4))
1027 |          (headings
1028 |           (loop for el in structure
1029 |              if (memq (car el) heads)
1030 |              collect el))
1031 |          (heading-texts
1032 |           (loop for el in headings
1033 |              collect (list
1034 |                       (car el)
1035 |                       (format
1036 |                        "<a href='#%s'>%s</a>"
1037 |                        (creole/heading-text->id (cdr el))
1038 |                        (cdr el))))))
1039 |     (if (< (length headings) 2)
1040 |         structure
1041 |         ;; Else add the index before the 2nd index
1042 |         (let* ((toc `(ul ,@(loop for (head . data)
1043 |                               in (cdr heading-texts)
1044 |                               collect (car data)))))
1045 |           (loop for el in structure
1046 |              if (equal el (elt headings 0))
1047 |              append `((heading2 . "Table of content") ,toc)
1048 |              collect el)))))
1049 | 
1050 | (defvar creole-structured '()
1051 |   "A buffer local containing the parsed creole for the buffer.")
1052 | 
1053 | (defun creole/structure-pipeline (pipeline structure)
1054 |   "Calls each function in PIPELINE transforming STRUCTURE."
1055 |   (assert (listp pipeline) "creole/structure-pipeline needs a list")
1056 |   (loop
1057 |      with result = structure
1058 |      for stage in pipeline
1059 |        do (setq result (funcall stage result))
1060 |        finally return result))
1061 | 
1062 | (defun creole/heading-text->id (heading-text)
1063 |   "Make HEADING-TEXT into an HTML ID."
1064 |   (replace-regexp-in-string " " "-" heading-text))
1065 | 
1066 | (defvar creole-do-anchor-headings t
1067 |   "Whether to give each heading it's own anchor.
1068 | 
1069 | This behaviour is also controlled by `creole-oddmuse-on'.")
1070 | 
1071 | (defun creole/heading->html (heading-cons)
1072 |   "Convert a heading to HTML.
1073 | 
1074 | If `creole-oddmuse-on' or `creole-do-anchor-headings' is `t' then
1075 | an anchor is added automatically."
1076 |   (let* ((h-str (symbol-name (car heading-cons)))
1077 |          (level (save-match-data
1078 |                   (string-match
1079 |                    (rx "heading" (group (+ digit)))
1080 |                    h-str)
1081 |                   (match-string 1 h-str)))
1082 |          (h-text (if (listp (cdr heading-cons))
1083 |                      (cadr heading-cons)
1084 |                      (cdr heading-cons))))
1085 |     (format
1086 |      "%s<h%s>%s</h%s>\n"
1087 |      (if (or creole-oddmuse-on
1088 |              creole-do-anchor-headings)
1089 |          (format
1090 |           "<a id='%s'></a>\n"
1091 |           (creole/heading-text->id h-text)) "") ; else
1092 |      level h-text level)))
1093 | 
1094 | (defun* creole-html (docbuf
1095 |                      &optional html-buffer
1096 |                      &key result-mode
1097 |                      (erase-existing t)
1098 |                      (do-font-lock t)
1099 |                      switch-to
1100 |                      structure-transform-fn)
1101 |   "Export DOCBUF as HTML to HTML-BUFFER.
1102 | 
1103 | If HTML-BUFFER does not exist then a buffer is created based on
1104 | the name of DOCBUF. If DOCBUF doesn't have a name then the
1105 | destination buffer is called:
1106 | 
1107 |  *creolehtml.html
1108 | 
1109 | If RESULT-MODE is specified then the HTML-BUFFER is placed in
1110 | that mode.
1111 | 
1112 | If ERASE-EXISTING is not nil then any existing content in the
1113 | HTML-BUFFER is erased before rendering.  By default this is true.
1114 | 
1115 | If DO-FONT-LOCK is not nil then any pre-formatted areas tested
1116 | for fontification with `creole-htmlize/mode-func'.  It is `t' by
1117 | default.
1118 | 
1119 | If SWITCH-TO is not nil then the HTML-BUFFER is switched to when
1120 | the export is done.
1121 | 
1122 | When called interactively RESULT-MODE is set to 'html-mode',
1123 | ERASE-EXISTING is set to true and SWITCH-TO is set to true.
1124 | 
1125 | STRUCTURE-TRANSFORM-FN may be a function or a list of functions
1126 | to transform the parsed structure of the creole source.  A
1127 | transformation function must result in a legal creole
1128 | structure.  If a list is used the result of the first function in
1129 | the list is passed to the next until the list is exhausted.
1130 | 
1131 | The buffer local variable `creole-structured' is set on the
1132 | HTML-BUFFER with the parsed creole in it.  See `creole-structure'
1133 | for the details of that data structure.
1134 | 
1135 | Returns the HTML-BUFFER."
1136 |   (interactive
1137 |    (list
1138 |     (read-buffer "Creole buffer: " (current-buffer))
1139 |     nil
1140 |     :result-mode 'html-mode
1141 |     :switch-to 't))
1142 |   (let ((result-buffer ; make up the result buffer
1143 |          (or html-buffer
1144 |              (get-buffer-create
1145 |               (replace-regexp-in-string
1146 |                (rx (group (* "*"))
1147 |                    (group (* any))
1148 |                    (group (* "*")))
1149 |                "*creolehtml\\2.html"
1150 |                (buffer-name
1151 |                 (if (bufferp docbuf)
1152 |                     docbuf
1153 |                   (get-buffer docbuf))))))))
1154 |     (make-local-variable 'creole-structured)
1155 |     (let ((creole
1156 |            (creole/structure-pipeline
1157 |             (if (functionp structure-transform-fn)
1158 |                 (list structure-transform-fn)
1159 |                 structure-transform-fn)
1160 |             (creole-structure
1161 |              (creole-tokenize docbuf)))))  ; Get the parsed creole doc
1162 |       (with-current-buffer result-buffer
1163 |         (if erase-existing (erase-buffer)) ; Erase if we were asked to
1164 |         (loop for element in creole
1165 |               do
1166 |               (let ((syntax (car element)))
1167 |                 (case syntax
1168 |                   ;; The list elements can follow on from each other
1169 |                   ;; and require special handling
1170 |                   ((ul ol)
1171 |                    ;; FIXME lists don't do block level replacement yet!
1172 |                    (creole/html-list syntax (cdr element)))
1173 |                   ;; Headings
1174 |                   ((heading1 heading2 heading3 heading4 heading5)
1175 |                    (insert (creole/heading->html element)))
1176 |                   (portrait ; this is oddmuse/emacswiki stuff
1177 |                    (insert (format
1178 |                             "<img class='portrait' src='%s'><img>"
1179 |                             (cdr element))))
1180 |                   ;; Tables
1181 |                   (table
1182 |                    (insert (creole/html-table (cdr element))))
1183 |                   ;; We support htmfontify for PRE blocks
1184 |                   (preformatted
1185 |                    (let ((styled (and do-font-lock
1186 |                                       (creole-htmlize-string (cdr element)))))
1187 |                      (if (not styled)
1188 |                          (insert
1189 |                           (format
1190 |                            "<pre>\n%s\n</pre>\n"
1191 |                            (cdr element)))
1192 |                        (insert styled))))
1193 |                   ;; Just embed any HTML
1194 |                   (plugin-html
1195 |                    (insert (cdr element)))
1196 |                   (hr
1197 |                    (insert "<hr/>\n"))
1198 |                   (para
1199 |                    (insert (format
1200 |                             "<p>%s</p>\n"
1201 |                             (creole-block-parse (cdr element))))))))
1202 |         (if result-mode (call-interactively result-mode))
1203 |         (setq creole-structured creole))
1204 |       (if switch-to (switch-to-buffer result-buffer))
1205 |       result-buffer)))
1206 | 
1207 | 
1208 | (defun creole/file-under-root-p (file-name root)
1209 |   "Is FILE-NAME under the directory ROOT?
1210 | 
1211 | Return nil if there is no match or the part of the file-name
1212 | which was not under the docroot."
1213 |   (and root
1214 |        (file-directory-p root)
1215 |        (let* ((true-name
1216 |                (file-truename
1217 |                 (expand-file-name file-name)))
1218 |               (root-dir
1219 |                (directory-file-name
1220 |                 (expand-file-name root))))
1221 |          (let ((docroot-match-index
1222 |                 (compare-strings
1223 |                  root-dir 0 (length root-dir)
1224 |                  true-name 0 (length true-name))))
1225 |            ;; If the compare-value is less than 0 we matched
1226 |            ;; and we have extra characters in the
1227 |            ;; true-name...  we *should* have extra
1228 |            ;; characters because otherwise we'd be referring
1229 |            ;; to the docroot.
1230 |            (when (< docroot-match-index 0)
1231 |              (substring
1232 |               true-name
1233 |               ;; -2 here because of index 0 *and* needing the
1234 |               ;; -leading slash
1235 |               (- (abs docroot-match-index) 1)
1236 |               (length true-name)))))))
1237 | 
1238 | (defun creole/get-file (filename)
1239 |   "An exception based FILENAME lookup.
1240 | 
1241 | Either loads the FILENAME in a buffer (but does not select it) or
1242 | errors 'file-error.
1243 | 
1244 | The FILENAME is expanded and `file-truename'd first."
1245 |   (let ((file-path
1246 |          (ignore-errors
1247 |            (file-truename (expand-file-name filename)))))
1248 |     (if (not (file-exists-p file-path))
1249 |         (signal 'file-error (format "No such file %s" file-path))
1250 |       (find-file-noselect file-path))))
1251 | 
1252 | (defun creole/expand-item-value (item &optional docroot)
1253 |   "Expand ITEM to be a value.
1254 | 
1255 | If ITEM begins with a file-name identifying character then try
1256 | and resolve the ITEM as a file-name, optionally under the
1257 | DOCROOT.
1258 | 
1259 | Return a cons cell with the `car' identifying the type, one of:
1260 | 
1261 |  :link     to indicate a linkable file-name
1262 |  :string   to indicate the raw data
1263 | 
1264 | and the `cdr' being the expanded string."
1265 |   (save-match-data
1266 |     (if (string-match
1267 |          (rx bol (or "./" "/" "~") (* any))
1268 |          item)
1269 |         ;; file-name templating has been requested
1270 |         ;; Check if we have a docroot that works
1271 |         (let* ((path-info (creole/file-under-root-p item docroot)))
1272 |           (if path-info
1273 |               ;; The file is linkable so return the template with the
1274 |               ;; docroot-ed true-name
1275 |               (cons :link path-info)
1276 |             ;; No workable docroot so return either the text of the
1277 |             ;; file (if it exists) or just the filename
1278 |             (condition-case err
1279 |                 (with-current-buffer (creole/get-file item)
1280 |                   (cons :string
1281 |                         (buffer-substring
1282 |                          (point-min)
1283 |                          (point-max))))
1284 |               ;; FIXME - I'd like this to be file-error - why doesn't
1285 |               ;; that work???
1286 |               (error (cons :link item)))))
1287 |       ;; The item was not a file-name so just return it
1288 |       (cons :string item))))
1289 | 
1290 | (defun creole/wrap-buffer-text (start end &optional buffer)
1291 |   "Simply wrap the text of BUFFER (or the current buffer).
1292 | 
1293 | START is placed at the start of the BUFFER and END is placed at
1294 | the end of the BUFFER."
1295 |   (let ((buf (or buffer (current-buffer))))
1296 |     (with-current-buffer buf
1297 |       (save-excursion
1298 |         (goto-char (point-min))
1299 |         (insert start)
1300 |         (goto-char (point-max))
1301 |         (insert end)))))
1302 | 
1303 | (defun creole/insert-template (key
1304 |                                 position
1305 |                                 docroot
1306 |                                 link-template
1307 |                                 embed-template
1308 |                                 &optional docroot-alias)
1309 |   "Insert either the LINK-TEMPLATE or the EMBED-TEMPLATE.
1310 | 
1311 | KEY specifies a value that is expanded with
1312 | `creole/expand-item-value', possibly with DOCROOT.
1313 | 
1314 | Whether we're a :link or a :string will cause either the
1315 | LINK-TEMPLATE or the EMBED-TEMPLATE to be inserted at the marker
1316 | POSITION.
1317 | 
1318 | If DOCROOT-ALIAS is specified and the :link template is used then
1319 | the filename is concatenated with that."
1320 |   (save-excursion
1321 |     (when key
1322 |       (goto-char position)
1323 |       (let ((value (creole/expand-item-value key docroot)))
1324 |         (case (car value)
1325 |           (:link
1326 |            (insert
1327 |             (format
1328 |              link-template
1329 |              (if docroot-alias
1330 |                  (concat docroot-alias (cdr value))
1331 |                  (cdr value)))))
1332 |           (:string
1333 |            (insert
1334 |             (format embed-template (cdr value)))))))))
1335 | 
1336 | (defcustom creole-css-color-type "#000000"
1337 |   "A custom color to be used for CSS style rendering."
1338 |   :group 'creole
1339 |   :type '(string))
1340 | 
1341 | (defcustom creole-css-color-default "#000000"
1342 |   "A custom color to be used for CSS style rendering."
1343 |   :group 'creole
1344 |   :type '(string))
1345 | 
1346 | (defcustom creole-css-color-whitespace-empty "#b22222"
1347 |   "A custom color to be used for CSS style rendering."
1348 |   :group 'creole
1349 |   :type '(string))
1350 | 
1351 | (defcustom creole-css-color-regexp-grouping-construct "#000000"
1352 |   "A custom color to be used for CSS style rendering."
1353 |   :group 'creole
1354 |   :type '(string))
1355 | 
1356 | (defcustom creole-css-color-builtin "#483d8b"
1357 |   "A custom color to be used for CSS style rendering."
1358 |   :group 'creole
1359 |   :type '(string))
1360 | 
1361 | (defcustom creole-css-color-function-name "#0000ff"
1362 |   "A custom color to be used for CSS style rendering."
1363 |   :group 'creole
1364 |   :type '(string))
1365 | 
1366 | (defcustom creole-css-color-doc "#8b2252"
1367 |   "A custom color to be used for CSS style rendering."
1368 |   :group 'creole
1369 |   :type '(string))
1370 | 
1371 | (defcustom creole-css-color-string "#8b2252"
1372 |   "A custom color to be used for CSS style rendering."
1373 |   :group 'creole
1374 |   :type '(string))
1375 | 
1376 | (defcustom creole-css-color-variable-name "#a0522d"
1377 |   "A custom color to be used for CSS style rendering."
1378 |   :group 'creole
1379 |   :type '(string))
1380 | 
1381 | (defcustom creole-css-color-constant "#008b8b"
1382 |   "A custom color to be used for CSS style rendering."
1383 |   :group 'creole
1384 |   :type '(string))
1385 | 
1386 | (defcustom creole-css-color-keyword "#a020f0"
1387 |   "A custom color to be used for CSS style rendering."
1388 |   :group 'creole
1389 |   :type '(string))
1390 | 
1391 | (defcustom creole-css-color-comment "#b22222"
1392 |   "A custom color to be used for CSS style rendering."
1393 |   :group 'creole
1394 |   :type '(string))
1395 | 
1396 | (defcustom creole-css-color-whitespace-space "#d3d3d3"
1397 |   "A custom color to be used for CSS style rendering."
1398 |   :group 'creole
1399 |   :type '(string))
1400 | 
1401 | (defcustom creole-css-color-comment-delimiter "#b22222"
1402 |   "A custom color to be used for CSS style rendering."
1403 |   :group 'creole
1404 |   :type '(string))
1405 | 
1406 | (defcustom creole-css-background-default "#ffffff"
1407 |   "A custom color to be used for CSS style rendering."
1408 |   :group 'creole
1409 |   :type '(string))
1410 | 
1411 | (defcustom creole-css-background-whitespace-empty "#ffff00"
1412 |   "A custom color to be used for CSS style rendering."
1413 |   :group 'creole
1414 |   :type '(string))
1415 | 
1416 | (defcustom creole-css-background-regexp-grouping-construct "#ffffff"
1417 |   "A custom color to be used for CSS style rendering."
1418 |   :group 'creole
1419 |   :type '(string))
1420 | 
1421 | (defcustom creole-css-background-regexp-grouping-backslash "#ffffff"
1422 |   "A custom color to be used for CSS style rendering."
1423 |   :group 'creole
1424 |   :type '(string))
1425 | 
1426 | (defcustom creole-css-background-builtin "#ffffff"
1427 |   "A custom color to be used for CSS style rendering."
1428 |   :group 'creole
1429 |   :type '(string))
1430 | 
1431 | (defcustom creole-css-background-function-name "#ffffff"
1432 |   "A custom color to be used for CSS style rendering."
1433 |   :group 'creole
1434 |   :type '(string))
1435 | 
1436 | (defcustom creole-css-background-doc "#ffffff"
1437 |   "A custom color to be used for CSS style rendering."
1438 |   :group 'creole
1439 |   :type '(string))
1440 | 
1441 | (defcustom creole-css-background-string "#ffffff"
1442 |   "A custom color to be used for CSS style rendering."
1443 |   :group 'creole
1444 |   :type '(string))
1445 | 
1446 | (defcustom creole-css-background-variable-name "#ffffff"
1447 |   "A custom color to be used for CSS style rendering."
1448 |   :group 'creole
1449 |   :type '(string))
1450 | 
1451 | (defcustom creole-css-background-constant "#ffffff"
1452 |   "A custom color to be used for CSS style rendering."
1453 |   :group 'creole
1454 |   :type '(string))
1455 | 
1456 | (defcustom creole-css-background-keyword "#ffffff"
1457 |   "A custom color to be used for CSS style rendering."
1458 |   :group 'creole
1459 |   :type '(string))
1460 | 
1461 | (defcustom creole-css-background-comment "#ffffff"
1462 |   "A custom color to be used for CSS style rendering."
1463 |   :group 'creole
1464 |   :type '(string))
1465 | 
1466 | (defcustom creole-css-background-whitespace-space "#ffffe0"
1467 |   "A custom color to be used for CSS style rendering."
1468 |   :group 'creole
1469 |   :type '(string))
1470 | 
1471 | (defcustom creole-css-background-comment-delimiter "#ffffff"
1472 |   "A custom color to be used for CSS style rendering."
1473 |   :group 'creole
1474 |   :type '(string))
1475 | 
1476 | (defun creole-css-list-to-style-decl (css-list)
1477 |   "Make the CSS-LIST into an HTML STYLE decl.
1478 | 
1479 | A CSS-LIST should look something like this:
1480 | 
1481 |  ((default \"default\" . \"{ ... CSS declarations ... }\")
1482 |   (font-lock-string-face \"string\" . \"{ ... CSS declarations ... }\")
1483 |   (font-lock-type-face \"type\" . \"{ ... CSS declarations ... }\")
1484 |   (font-lock-function-name-face \"function-name\" . \"{ ... CSS declarations ... }\")
1485 |   (font-lock-keyword-face \"keyword\" . \"{ ... CSS declarations ... }\")
1486 |   (font-lock-comment-face \"comment\" . \"{ ... CSS declarations ... }\")
1487 |   (whitespace-space \"whitespace-space\" . \"{ ... CSS declarations ... }\")
1488 |   (font-lock-comment-delimiter-face \"comment-delimiter\" . \"{ ... CSS declarations ... }\"))
1489 | 
1490 | Each element of the list contains the descriptive part of a CSS
1491 | class declaration.
1492 | 
1493 | This is from `hfy-sprintf-stylesheet' which is part of
1494 | `htmlfontify'."
1495 |   (mapconcat
1496 |    (lambda (style)
1497 |      (format
1498 |       "span.%s   %s\nspan.%s a %s\n%s\n"
1499 |       (cadr style) (cddr style)
1500 |       (cadr style) (hfy-link-style (cddr style))
1501 |       ;; Add in our own colors - just add nothing
1502 |       ;; if we don't have customization for it
1503 |       (condition-case err
1504 |           (let ((css-value
1505 |                  (symbol-value
1506 |                   (intern
1507 |                    (concat
1508 |                     "creole-css-color-"
1509 |                     (cadr style))))))
1510 |             (if css-value
1511 |                 (format
1512 |                  "span.%s { color: %s; }\n"
1513 |                  (cadr style)
1514 |                  css-value)))
1515 |         (void-variable ""))))
1516 |    css-list
1517 |    "\n"))
1518 | 
1519 | (defun creole-moustache (template variables)
1520 |   "Moustache replace in TEMPLATE with VARIABLES.
1521 | 
1522 | Eg:
1523 | 
1524 |   (creole-moustache
1525 |     \"<textarea>{{text}}</textarea>\"
1526 |     '((text . \"this is my text\")))
1527 | 
1528 |   =>  \"<textarea>this is my text</textarea>\""
1529 |   (replace-regexp-in-string
1530 |    (rx "{{"
1531 |        (group (+ (in alphanumeric "_-")))
1532 |        "}}")
1533 |    (lambda (m)
1534 |      (let* ((expansion (match-string 1 m))
1535 |             (var (intern expansion))
1536 |             (pair (assoc var variables)))
1537 |        (if pair
1538 |            (cdr pair)
1539 |          (concat "{{" expansion "}}"))))
1540 |    template
1541 |    nil
1542 |    t))
1543 | 
1544 | (defun creole-list-text-properties (buffer property predicate)
1545 |   "List all the values for PROPERTY in BUFFER.
1546 | 
1547 | PREDICATE is used to merge the properties."
1548 |   (with-current-buffer buffer
1549 |     (save-excursion
1550 |       (goto-char (point-min))
1551 |       (let* ((lst (list))
1552 |              (p (next-single-property-change
1553 |                  (point-min)
1554 |                  :css-list
1555 |                  (current-buffer)
1556 |                  (point-max))))
1557 |         (while (not (equal p (point-max)))
1558 |           (let ((prop (get-text-property p property)))
1559 |             (when prop
1560 |               (setq lst
1561 |                     (merge
1562 |                      'list
1563 |                      lst prop
1564 |                      predicate))))
1565 |             (goto-char (+ 1 p))
1566 |             (setq p (next-single-property-change
1567 |                      (point)
1568 |                      property
1569 |                      (current-buffer)
1570 |                      (point-max))))
1571 |           lst))))
1572 | 
1573 | ;;;###autoload
1574 | (defun* creole-wiki (source
1575 |                      &key
1576 |                      destination
1577 |                      structure-transform-fn
1578 |                      (htmlfontify t)
1579 |                      (htmlfontify-style t)
1580 |                      body-header
1581 |                      body-footer
1582 |                      variables
1583 |                      docroot
1584 |                      docroot-alias
1585 |                      css
1586 |                      javascript
1587 |                      meta
1588 |                      other-link
1589 |                      doctype)
1590 |   "Export WikiCreole SOURCE into HTML.
1591 | 
1592 | Returns the buffer where the HTML was exported. This could be a
1593 | user supplied buffer (see DESTINATION) or a buffer created based
1594 | on the filename of the source (or just automatically created).
1595 | 
1596 | SOURCE can be a buffer or plain text or something we might
1597 | recognize as a file.  A file-name is detected by a leading
1598 | '~' (meaning expand from the user root) or '/' (meaning rooted)
1599 | or './' (meaning expand from the root of the source creole file).
1600 | 
1601 | If SOURCE is a filename it is loaded with `creole/get-file'.
1602 | 
1603 | 
1604 | Keyword arguments are supported to change the way the HTML is
1605 | produced.
1606 | 
1607 | DESTINATION can be a buffer or a buffer name to write the HTML
1608 | into or it can be 't' to indicate the default output stream.  In
1609 | the latter case an automatic buffer is still created and the HTML
1610 | is sent to the default output stream when the export is done.
1611 | 
1612 | The DESTINATION buffer is always returned.
1613 | 
1614 | STRUCTURE-TRANSFORM-FN is a structure transformation function or
1615 | list of functions, see `creole-html' for details.
1616 | 
1617 | HTMLFONTIFY - use 'htmlfontify' to fontify any code blocks; this
1618 | is true by default.
1619 | 
1620 | Code blocks are marked up like pre-formatted areas but must begin
1621 | with a line stating the Emacs mode to fontify the text as; for
1622 | example:
1623 | 
1624 |  {{{
1625 |  ##! emacs-lisp
1626 |  (let ((x 1)) x)
1627 |  }}}
1628 | 
1629 | would cause Emacs Lisp to be fontified.
1630 | 
1631 | HTMLFONTIFY-STYLE - add an HTML-STYLE block for 'htmlfontify'
1632 | code blocks. If this is nil an HTML-STYLE block is NOT added.
1633 | 
1634 | BODY-HEADER - a string or a file-name with HTML code to be
1635 | inserted in the BODY of the HTML document before the Creole
1636 | markup export.  A file-name is detected in the same way as for
1637 | SOURCE.
1638 | 
1639 | BODY-FOOTER - a string or a file-name with HTML code to be
1640 | inserted in the BODY of the HTML document after the Creole markup
1641 | export.  A file-name is detected in the same way as for SOURCE.
1642 | 
1643 | The BODY-HEADER and the BODY-FOOTER are treated as moustache
1644 | templates and expanded before being inserted.  See
1645 | 'creole-moustache' for a description.  Variables passed to
1646 | 'creole-moustache' with the template are:
1647 | 
1648 |   text - the creole source text of the page
1649 | 
1650 | or any variable in VARIABLES, which is an alist of
1651 | symbols -> values.
1652 | 
1653 | DOCROOT - base any files to be served.  Any file-name reference
1654 | for CSS or JavaScript, if residing under this docroot, will be
1655 | linked to the document rather than embedded.
1656 | 
1657 | DOCROOT-ALIAS - is the docroot path to use in any links as an
1658 | alias for the docroot.
1659 | 
1660 | CSS - a list of cascading style sheets, each entry can either be
1661 | a file-name (a file-name is detected in the same way as
1662 | for SOURCE) or a string with W3C-CSS statements in it.
1663 | 
1664 | If a DOCROOT is specified then any cascading style sheets
1665 | file-name is LINKed into the resulting document, if not then the
1666 | statements are embedded directly.
1667 | 
1668 | JAVASCRIPT - a list of JavaScript, as for CSS, each entry can
1669 | be either a string of the JavaScript to be directly embedded or a
1670 | file-name reference (as in SOURCE).  As for :CSS if
1671 | a :DOCROOT is specified then the scripts will be loaded as links
1672 | but otherwise will be embedded.
1673 | 
1674 | META - a list of strings specifying resulting HTML-META elements.
1675 | For example:
1676 | 
1677 |  :meta '(\"name='description'
1678 |           content='Free Web tutorials on HTML, CSS, XML'\")
1679 | 
1680 | :OTHER-LINK - a list of string specifying resulting HTML-LINK
1681 | elements, for example:
1682 | 
1683 |  :other-link '(\"rel='alternate' href='/my-feed.rss'\")
1684 | 
1685 | :DOCTYPE may be nil, in which case nothing is added or it may be
1686 | a string in which case it is inserted directly before the <html>
1687 | element, or it may be one of the symbols 'xhtml or 'html5 in
1688 | which case the right doctype is added.
1689 | 
1690 | All, any or none of these keys may be specified.
1691 | "
1692 |   (interactive "fCreole file: ")
1693 |   (let* (file-opened ;; a flag to indicate whether we opened a file or not
1694 |          (source-buffer
1695 |           ;; Detect what sort of source we have
1696 |           (cond
1697 |            ((bufferp source)
1698 |             source)
1699 |            ((string-match (rx bol (or "/" "~") (* any)) source)
1700 |             (creole/get-file source))
1701 |            (t
1702 |             (with-current-buffer (generate-new-buffer "* creole-source *")
1703 |               (insert source)
1704 |               (current-buffer)))))
1705 |          (html-buffer
1706 |           (cond
1707 |            ((bufferp destination)
1708 |             destination)
1709 |            ((stringp destination)
1710 |             (get-buffer-create destination))
1711 |            (t
1712 |             (get-buffer-create "*creole-html*")))))
1713 | 
1714 |     ;; Export the creole to the result buffer
1715 |     (creole-html source-buffer html-buffer
1716 |                  :do-font-lock htmlfontify
1717 |                  :structure-transform-fn structure-transform-fn)
1718 | 
1719 |     ;; Now a bunch of other transformations on the result buffer
1720 |     (with-current-buffer html-buffer
1721 |       (let* ((creole-text
1722 |               (with-current-buffer source-buffer
1723 |                 (buffer-substring (point-min)(point-max))))
1724 |              ;; We should let users specify more variables in the
1725 |              ;; call to creole-wiki?
1726 |              (vars (append `((text . ,creole-text)) variables)))
1727 | 
1728 |         ;; Insert the BODY header and footer
1729 |         (when body-header
1730 |           (let ((hdr (creole/expand-item-value body-header)))
1731 |             (when (eq (car hdr) :string)
1732 |               (goto-char (point-min))
1733 |               (insert
1734 |                (creole-moustache
1735 |                 (cdr hdr)
1736 |                 vars)))))
1737 | 
1738 |         (when body-footer
1739 |           (let ((ftr (creole/expand-item-value body-footer)))
1740 |             (when (eq (car ftr) :string)
1741 |                (goto-char (point-max))
1742 |                (insert
1743 |                 (creole-moustache
1744 |                  (cdr ftr)
1745 |                  vars)))))
1746 | 
1747 |         ;; Now wrap everything we have so far with the BODY tag
1748 |         (creole/wrap-buffer-text "<body>\n" "</body>\n")
1749 | 
1750 |         ;; Now stuff that should go in a header
1751 |         (when (or css javascript meta other-link
1752 |                   (and htmlfontify
1753 |                        htmlfontify-style
1754 |                        (next-single-property-change
1755 |                         (point-min)
1756 |                         :css-list
1757 |                         (current-buffer)
1758 |                         (point-max))))
1759 |           (let (head-marker)
1760 |             (goto-char (point-min))
1761 |             (insert "<head>\n")
1762 |             (let ((creole-doc-title (assoc 'heading1 creole-structured)))
1763 |               (when creole-doc-title
1764 |                 (insert (format "<title>%s</title>\n" (cdr creole-doc-title)))))
1765 |             (setq head-marker (point-marker))
1766 |             (insert "</head>\n")
1767 |             ;; First the CSS
1768 |             (loop for ss in css
1769 |                do (creole/insert-template
1770 |                    ss
1771 |                    head-marker
1772 |                    docroot
1773 |                    "<link rel='stylesheet' href='%s' type='text/css'/>\n"
1774 |                    "<style>\n%s\n</style>\n"
1775 |                    docroot-alias))
1776 |             ;; Now the JS
1777 |             (loop for js in javascript
1778 |                do (creole/insert-template
1779 |                    js
1780 |                    head-marker
1781 |                    docroot
1782 |                    "<script src='%s' language='Javascript'></script>\n"
1783 |                    "<script>
1784 | //<!--
1785 | %s
1786 | //-->
1787 | </script>
1788 | "
1789 |                    docroot-alias))
1790 |             ;; Now meta
1791 |             (creole/insert-template
1792 |              meta
1793 |              head-marker
1794 |              docroot
1795 |              "<meta %s/>\n"
1796 |              "<meta %s/>\n")
1797 |             (creole/insert-template
1798 |              other-link
1799 |              head-marker
1800 |              docroot
1801 |              "<link %s/>\n"
1802 |              "<link %s/>\n")
1803 | 
1804 |             ;; Find any styles that are embedded
1805 |             (if (and htmlfontify htmlfontify-style)
1806 |                 (let ((css (remove-duplicates
1807 |                             (creole-list-text-properties
1808 |                              (current-buffer)
1809 |                              :css-list
1810 |                              (lambda (a b) (string< (cadr a) (cadr b))))
1811 |                             :test (lambda (a b) (string= (cadr a) (cadr b))))))
1812 |                     (save-excursion
1813 |                       (goto-char head-marker)
1814 |                       (insert
1815 |                        "<style>\n"
1816 |                        (creole-css-list-to-style-decl css)
1817 |                        "\n</style>\n"))))))
1818 | 
1819 |         ;; Wrap the whole thing in the DOCTYPE and the HTML tag
1820 |         (creole/wrap-buffer-text
1821 |          (cond
1822 |            ((eq doctype 'html5) "<!DOCTYPE html>\n<html>")
1823 |            ((eq doctype 'xhtml) "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
1824 | \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
1825 | <html xmlns=\"http://www.w3.org/1999/xhtml\">\n")
1826 |            ((stringp doctype) (concat doctype "<html>\n"))
1827 |            ((eq doctype nil) "<html>\n"))
1828 |          "</html>\n")))
1829 | 
1830 |     ;; Should we output the whole thing to the default output stream?
1831 |     (when (eq destination t)
1832 |       (with-current-buffer html-buffer
1833 |         (princ (buffer-substring (point-min)(point-max)))))
1834 | 
1835 |     (when (called-interactively-p 'any)
1836 |       (switch-to-buffer html-buffer))
1837 | 
1838 |     (when file-opened
1839 |       (kill-buffer source-buffer))
1840 | 
1841 |     ;; Return the destination buffer
1842 |     html-buffer))
1843 | 
1844 | 
1845 | ;; Useful functions
1846 | 
1847 | (defun creole-directory-list (directory-name &optional make-links)
1848 |   "WikiCreole format a table of files in DIRECTORY-NAME.
1849 | 
1850 | MAKE-LINKS causes the files to be WikiCreole links."
1851 |   (loop for filename in (directory-files directory-name)
1852 |         if (not (or (equal filename ".")
1853 |                     (equal filename "..")))
1854 |         concat
1855 |         (let* ((fq (expand-file-name filename directory-name))
1856 |                (fa (file-attributes fq))
1857 |                (timestr
1858 |                 (apply 'format
1859 |                        "%04d-%02d-%02d %02d:%02d"
1860 |                        (let ((dt (decode-time (elt fa 5))))
1861 |                          (list (elt dt 5)
1862 |                                (elt dt 4)
1863 |                                (elt dt 3)
1864 |                                (elt dt 2)
1865 |                                (elt dt 1))))))
1866 |           (format
1867 |            "|%s|%s|%s|\n"
1868 |            (if make-links
1869 |                (format "[[%s]]" filename)
1870 |              filename)
1871 |            timestr
1872 |            (elt fa 7)))))
1873 | 
1874 | (provide 'creole)
1875 | 
1876 | ;;; creole.el ends here
1877 | 


--------------------------------------------------------------------------------