thirdparty/zencoding-mode.el
changeset 55 d4adcd3d5ef9
parent 54 e1b82f67f96e
child 56 7446c9ffe828
equal deleted inserted replaced
54:e1b82f67f96e 55:d4adcd3d5ef9
     1 ;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup
       
     2 
       
     3 ;; Copyright (C) 2009, Chris Done
       
     4 
       
     5 ;; Version: 0.5.1
       
     6 ;; Author: Chris Done <[email protected]>
       
     7 ;; URL: https://github.com/rooney/zencoding
       
     8 ;; Last-Updated: 2011-12-31 Sat
       
     9 ;; Keywords: convenience
       
    10 
       
    11 ;; This file is free software; you can redistribute it and/or modify
       
    12 ;; it under the terms of the GNU General Public License as published by
       
    13 ;; the Free Software Foundation; either version 3, or (at your option)
       
    14 ;; any later version.
       
    15 ;;
       
    16 ;; This file is distributed in the hope that it will be useful,
       
    17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
       
    19 ;; GNU General Public License for more details.
       
    20 ;;
       
    21 ;; You should have received a copy of the GNU General Public License
       
    22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
       
    23 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
       
    24 ;; Boston, MA 02110-1301, USA.
       
    25 
       
    26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
    27 ;;
       
    28 ;;; Commentary:
       
    29 ;;
       
    30 ;; Unfold CSS-selector-like expressions to markup. Intended to be used
       
    31 ;; with sgml-like languages; xml, html, xhtml, xsl, etc.
       
    32 ;;
       
    33 ;; See `zencoding-mode' for more information.
       
    34 ;;
       
    35 ;; Copy zencoding-mode.el to your load-path and add to your .emacs:
       
    36 ;;
       
    37 ;;    (require 'zencoding-mode)
       
    38 ;;
       
    39 ;; Example setup:
       
    40 ;;
       
    41 ;;    (add-to-list 'load-path "~/Emacs/zencoding/")
       
    42 ;;    (require 'zencoding-mode)
       
    43 ;;    (add-hook 'sgml-mode-hook 'zencoding-mode) ;; Auto-start on any markup modes
       
    44 ;;
       
    45 ;; Enable the minor mode with M-x zencoding-mode.
       
    46 ;;
       
    47 ;; See ``Test cases'' section for a complete set of expression types.
       
    48 ;;
       
    49 ;; If you are hacking on this project, eval (zencoding-test-cases) to
       
    50 ;; ensure that your changes have not broken anything. Feel free to add
       
    51 ;; new test cases if you add new features.
       
    52 ;;
       
    53 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
    54 ;;
       
    55 ;;; History:
       
    56 ;;
       
    57 ;; Modified by Lennart Borgman.
       
    58 ;;
       
    59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
    60 ;;
       
    61 ;;; Code:
       
    62 
       
    63 (defconst zencoding-mode:version "0.5.1")
       
    64 
       
    65 ;; Include the trie data structure for caching
       
    66 ;(require 'zencoding-trie)
       
    67 
       
    68 (require 'cl)
       
    69 
       
    70 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
    71 ;; Generic parsing macros and utilities
       
    72 
       
    73 (defmacro zencoding-aif (test-form then-form &rest else-forms)
       
    74   "Anaphoric if. Temporary variable `it' is the result of test-form."
       
    75   `(let ((it ,test-form))
       
    76      (if it ,then-form ,@(or else-forms '(it)))))
       
    77 
       
    78 (defmacro zencoding-pif (test-form then-form &rest else-forms)
       
    79   "Parser anaphoric if. Temporary variable `it' is the result of test-form."
       
    80   `(let ((it ,test-form))
       
    81      (if (not (eq 'error (car it))) ,then-form ,@(or else-forms '(it)))))
       
    82 
       
    83 (defmacro zencoding-parse (regex nums label &rest body)
       
    84   "Parse according to a regex and update the `input' variable."
       
    85   `(zencoding-aif (zencoding-regex ,regex input ',(number-sequence 0 nums))
       
    86                   (let ((input (elt it ,nums)))
       
    87                     ,@body)
       
    88                   `,`(error ,(concat "expected " ,label))))
       
    89 
       
    90 (defmacro zencoding-run (parser then-form &rest else-forms)
       
    91   "Run a parser and update the input properly, extract the parsed
       
    92    expression."
       
    93   `(zencoding-pif (,parser input)
       
    94                   (let ((input (cdr it))
       
    95                         (expr (car it)))
       
    96                     ,then-form)
       
    97                   ,@(or else-forms '(it))))
       
    98 
       
    99 (defmacro zencoding-por (parser1 parser2 then-form &rest else-forms)
       
   100   "OR two parsers. Try one parser, if it fails try the next."
       
   101   `(zencoding-pif (,parser1 input)
       
   102                   (let ((input (cdr it))
       
   103                         (expr (car it)))
       
   104                     ,then-form)
       
   105                   (zencoding-pif (,parser2 input)
       
   106                                  (let ((input (cdr it))
       
   107                                        (expr (car it)))
       
   108                                    ,then-form)
       
   109                                  ,@else-forms)))
       
   110 
       
   111 (defun zencoding-regex (regexp string refs)
       
   112   "Return a list of (`ref') matches for a `regex' on a `string' or nil."
       
   113   (if (string-match (concat "^" regexp "\\([^\n]*\\)$") string)
       
   114       (mapcar (lambda (ref) (match-string ref string))
       
   115               (if (sequencep refs) refs (list refs)))
       
   116     nil))
       
   117 
       
   118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   119 ;; Zen coding parsers
       
   120 
       
   121 (defun zencoding-expr (input)
       
   122   "Parse a zen coding expression with optional filters."
       
   123   (zencoding-pif (zencoding-parse "\\(.*?\\)|" 2 "expr|filter" it)
       
   124                  (let ((input (elt it 1))
       
   125                        (filters (elt it 2)))
       
   126                    (zencoding-pif (zencoding-extract-filters filters)
       
   127                                   (zencoding-filter input it)
       
   128                                   it))
       
   129                  (zencoding-filter input (zencoding-default-filter))))
       
   130 
       
   131 (defun zencoding-subexpr (input)
       
   132   "Parse a zen coding expression with no filter. This pretty much defines precedence."
       
   133   (zencoding-run zencoding-siblings
       
   134                  it
       
   135                  (zencoding-run zencoding-parent-child
       
   136                                 it
       
   137                                 (zencoding-run zencoding-multiplier
       
   138                                                it
       
   139                                                (zencoding-run zencoding-pexpr
       
   140                                                               it
       
   141                                                               (zencoding-run zencoding-tag
       
   142                                                                              it
       
   143                                                                              '(error "no match, expecting ( or a-zA-Z0-9")))))))
       
   144 
       
   145 (defun zencoding-extract-filters (input)
       
   146   "Extract filters from expression."
       
   147   (zencoding-pif (zencoding-parse "\\([^\\|]+?\\)|" 2 "" it)
       
   148                  (let ((filter-name (elt it 1))
       
   149                        (more-filters (elt it 2)))
       
   150                    (zencoding-pif (zencoding-extract-filters more-filters)
       
   151                                   (cons filter-name it)
       
   152                                   it))
       
   153                  (zencoding-parse "\\([^\\|]+\\)" 1 "filter name" `(,(elt it 1)))))
       
   154 
       
   155 (defun zencoding-filter (input filters)
       
   156   "Construct AST with specified filters."
       
   157   (zencoding-pif (zencoding-subexpr input)
       
   158                  (let ((result (car it))
       
   159                        (rest (cdr it)))
       
   160                    `((filter ,filters ,result) . ,rest))
       
   161                  it))
       
   162 
       
   163 (defun zencoding-default-filter ()
       
   164   "Default filter(s) to be used if none is specified."
       
   165   (let* ((file-ext (car (zencoding-regex ".*\\(\\..*\\)" (or (buffer-file-name) "") 1)))
       
   166          (defaults '(".html" ("html")
       
   167                      ".htm"  ("html")
       
   168                      ".haml" ("haml")
       
   169                      ".clj"  ("hic")))
       
   170          (default-else      '("html"))
       
   171          (selected-default (member file-ext defaults)))
       
   172     (if selected-default
       
   173         (cadr selected-default)
       
   174       default-else)))
       
   175 
       
   176 (defun zencoding-multiplier (input)
       
   177   (zencoding-por zencoding-pexpr zencoding-tag
       
   178                  (let ((multiplier expr))
       
   179                    (zencoding-parse "\\*\\([0-9]+\\)" 2 "*n where n is a number"
       
   180                                     (let ((multiplicand (read (elt it 1))))
       
   181                                       `((list ,(make-list multiplicand multiplier)) . ,input))))
       
   182                  '(error "expected *n multiplier")))
       
   183 
       
   184 (defun zencoding-tag (input)
       
   185   "Parse a tag."
       
   186   (zencoding-run zencoding-tagname
       
   187                  (let ((tagname (cadr expr))
       
   188                        (has-body? (cddr expr)))
       
   189                    (zencoding-pif (zencoding-run zencoding-identifier
       
   190                                                  (zencoding-tag-classes
       
   191                                                   `(tag (,tagname ,has-body? ,(cddr expr))) input)
       
   192                                                  (zencoding-tag-classes
       
   193                                                   `(tag (,tagname ,has-body? nil)) input))
       
   194                                   (let ((expr (car it))
       
   195                                         (input (cdr it)))
       
   196                                     (zencoding-tag-props expr input))))
       
   197                  (zencoding-default-tag input)))
       
   198 
       
   199 (defun zencoding-default-tag (input)
       
   200   "Parse a #id or .class"
       
   201   (zencoding-parse "\\([#|\\.]\\)" 1 "tagname"
       
   202                    (zencoding-tag (concat "div" (elt it 0)))))
       
   203 
       
   204 (defun zencoding-tag-props (tag input)
       
   205   (let ((tag-data (cadr tag)))
       
   206     (zencoding-run zencoding-props
       
   207                    (let ((props (cdr expr)))
       
   208                      `((tag ,(append tag-data (list props))) . ,input))
       
   209                    `((tag ,(append tag-data '(nil))) . ,input))))
       
   210 
       
   211 (defun zencoding-props (input)
       
   212   "Parse many props."
       
   213     (zencoding-run zencoding-prop
       
   214                    (zencoding-pif (zencoding-props input)
       
   215                                   `((props . ,(cons expr (cdar it))) . ,(cdr it))
       
   216                                   `((props . ,(list expr)) . ,input))))
       
   217 
       
   218 (defun zencoding-prop (input)
       
   219   (zencoding-parse
       
   220    " " 1 "space"
       
   221    (zencoding-run
       
   222     zencoding-name
       
   223     (let ((name (cdr expr)))
       
   224       (zencoding-pif (zencoding-prop-value name input)
       
   225                      it
       
   226                      `((,(read name) "") . ,input))))))
       
   227 
       
   228 (defun zencoding-prop-value (name input)
       
   229   (zencoding-pif (zencoding-parse "=\"\\(.*?\\)\"" 2
       
   230                                   "=\"property value\""
       
   231                                   (let ((value (elt it 1))
       
   232                                         (input (elt it 2)))
       
   233                                     `((,(read name) ,value) . ,input)))
       
   234                  it
       
   235                  (zencoding-parse "=\\([^\\,\\+\\>\\ )]*\\)" 2
       
   236                                   "=property value"
       
   237                                   (let ((value (elt it 1))
       
   238                                         (input (elt it 2)))
       
   239                                     `((,(read name) ,value) . ,input)))))
       
   240 
       
   241 (defun zencoding-tag-classes (tag input)
       
   242   (let ((tag-data (cadr tag)))
       
   243     (zencoding-run zencoding-classes
       
   244                    (let ((classes (mapcar (lambda (cls) (cdadr cls))
       
   245                                           (cdr expr))))
       
   246                      `((tag ,(append tag-data (list classes))) . ,input))
       
   247                    `((tag ,(append tag-data '(nil))) . ,input))))
       
   248 
       
   249 (defun zencoding-tagname (input)
       
   250   "Parse a tagname a-zA-Z0-9 tagname (e.g. html/head/xsl:if/br)."
       
   251   (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9:-]*\/?\\)" 2 "tagname, a-zA-Z0-9"
       
   252                    (let* ((tag-spec (elt it 1))
       
   253                           (empty-tag (zencoding-regex "\\([^\/]*\\)\/" tag-spec 1))
       
   254                           (tag (if empty-tag
       
   255                                    (car empty-tag)
       
   256                                  tag-spec)))
       
   257                      `((tagname . (,tag . ,(not empty-tag))) . ,input))))
       
   258 
       
   259 (defun zencoding-pexpr (input)
       
   260   "A zen coding expression with parentheses around it."
       
   261   (zencoding-parse "(" 1 "("
       
   262                    (zencoding-run zencoding-subexpr
       
   263                                   (zencoding-aif (zencoding-regex ")" input '(0 1))
       
   264                                                  `(,expr . ,(elt it 1))
       
   265                                                  '(error "expecting `)'")))))
       
   266 
       
   267 (defun zencoding-parent-child (input)
       
   268   "Parse an tag>e expression, where `n' is an tag and `e' is any
       
   269    expression."
       
   270   (zencoding-run zencoding-multiplier
       
   271                  (let* ((items (cadr expr))
       
   272                         (rest (zencoding-child-sans expr input)))
       
   273                    (if (not (eq (car rest) 'error))
       
   274                        (let ((child (car rest))
       
   275                              (input (cdr rest)))
       
   276                          (cons (cons 'list
       
   277                                      (cons (mapcar (lambda (parent)
       
   278                                                      `(parent-child ,parent ,child))
       
   279                                                    items)
       
   280                                            nil))
       
   281                                input))
       
   282                      '(error "expected child")))
       
   283                  (zencoding-run zencoding-tag
       
   284                                 (zencoding-child expr input)
       
   285                                 '(error "expected parent"))))
       
   286 
       
   287 (defun zencoding-child-sans (parent input)
       
   288   (zencoding-parse ">" 1 ">"
       
   289                    (zencoding-run zencoding-subexpr
       
   290                                   it
       
   291                                   '(error "expected child"))))
       
   292 
       
   293 (defun zencoding-child (parent input)
       
   294   (zencoding-parse ">" 1 ">"
       
   295                    (zencoding-run zencoding-subexpr
       
   296                                   (let ((child expr))
       
   297                                     `((parent-child ,parent ,child) . ,input))
       
   298                                   '(error "expected child"))))
       
   299 
       
   300 (defun zencoding-sibling (input)
       
   301   (zencoding-por zencoding-pexpr zencoding-multiplier
       
   302                  it
       
   303                  (zencoding-run zencoding-tag
       
   304                                 it
       
   305                                 '(error "expected sibling"))))
       
   306 
       
   307 (defun zencoding-siblings (input)
       
   308   "Parse an e+e expression, where e is an tag or a pexpr."
       
   309   (zencoding-run zencoding-sibling
       
   310                  (let ((parent expr))
       
   311                    (zencoding-parse "\\+" 1 "+"
       
   312                                     (zencoding-run zencoding-subexpr
       
   313                                                    (let ((child expr))
       
   314                                                      `((sibling ,parent ,child) . ,input))
       
   315                                                    (zencoding-expand parent input))))
       
   316                  '(error "expected first sibling")))
       
   317 
       
   318 (defvar zencoding-expandable-tags
       
   319   '("dl"    ">(dt+dd)"
       
   320     "ol"    ">li"
       
   321     "ul"    ">li"
       
   322     "table" ">tr>td"))
       
   323 
       
   324 (defun zencoding-expand (parent input)
       
   325   "Parse an e+ expression, where e is an expandable tag"
       
   326   (let* ((parent-tag (car (elt parent 1)))
       
   327          (expandable (member parent-tag zencoding-expandable-tags)))
       
   328     (if expandable
       
   329         (let ((expansion (zencoding-child parent (concat (cadr expandable)))))
       
   330           (zencoding-pif (zencoding-parse "+\\(.*\\)" 1 "+expr"
       
   331                                           (zencoding-subexpr (elt it 1)))
       
   332                          `((sibling ,(car expansion) ,(car it)))
       
   333                          expansion))
       
   334       '(error "expected second sibling"))))
       
   335 
       
   336 (defun zencoding-name (input)
       
   337   "Parse a class or identifier name, e.g. news, footer, mainimage"
       
   338   (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9-_:]*\\)" 2 "class or identifer name"
       
   339                    `((name . ,(elt it 1)) . ,input)))
       
   340 
       
   341 (defun zencoding-class (input)
       
   342   "Parse a classname expression, e.g. .foo"
       
   343   (zencoding-parse "\\." 1 "."
       
   344                    (zencoding-run zencoding-name
       
   345                                   `((class ,expr) . ,input)
       
   346                                   '(error "expected class name"))))
       
   347 (defun zencoding-identifier (input)
       
   348   "Parse an identifier expression, e.g. #foo"
       
   349   (zencoding-parse "#" 1 "#"
       
   350                    (zencoding-run zencoding-name
       
   351                                   `((identifier . ,expr) . ,input))))
       
   352 
       
   353 (defun zencoding-classes (input)
       
   354   "Parse many classes."
       
   355   (zencoding-run zencoding-class
       
   356                  (zencoding-pif (zencoding-classes input)
       
   357                                 `((classes . ,(cons expr (cdar it))) . ,(cdr it))
       
   358                                 `((classes . ,(list expr)) . ,input))
       
   359                  '(error "expected class")))
       
   360 
       
   361 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   362 ;; Zen coding transformer from AST to string
       
   363 
       
   364 (defvar zencoding-inline-tags
       
   365   '("a"
       
   366     "abbr"
       
   367     "acronym"
       
   368     "cite"
       
   369     "code"
       
   370     "dd"
       
   371     "dfn"
       
   372     "dt"
       
   373     "em"
       
   374     "h1" "h2" "h3" "h4" "h5" "h6"
       
   375     "kbd"
       
   376     "li"
       
   377     "q"
       
   378     "span"
       
   379     "strong"
       
   380     "var"))
       
   381 
       
   382 (defvar zencoding-block-tags
       
   383   '("p"))
       
   384 
       
   385 (defvar zencoding-self-closing-tags
       
   386   '("br"
       
   387     "img"
       
   388     "input"))
       
   389 
       
   390 (defvar zencoding-leaf-function nil
       
   391   "Function to execute when expanding a leaf node in the
       
   392   Zencoding AST.")
       
   393 
       
   394 (defvar zencoding-filters
       
   395   '("html" (zencoding-primary-filter zencoding-make-html-tag)
       
   396     "c"    (zencoding-primary-filter zencoding-make-commented-html-tag)
       
   397     "haml" (zencoding-primary-filter zencoding-make-haml-tag)
       
   398     "hic"  (zencoding-primary-filter zencoding-make-hiccup-tag)
       
   399     "e"    (zencoding-escape-xml)))
       
   400 
       
   401 (defun zencoding-primary-filter (input proc)
       
   402   "Process filter that needs to be executed first, ie. not given output from other filter."
       
   403   (if (listp input)
       
   404       (let ((tag-maker (cadr proc)))
       
   405         (zencoding-transform-ast input tag-maker))
       
   406     nil))
       
   407 
       
   408 (defun zencoding-process-filter (filters input)
       
   409   "Process filters, chain one filter output as the input of the next filter."
       
   410   (let ((filter-data (member (car filters) zencoding-filters))
       
   411         (more-filters (cdr filters)))
       
   412     (if filter-data
       
   413         (let* ((proc   (cadr filter-data))
       
   414                (fun    (car proc))
       
   415                (filter-output (funcall fun input proc)))
       
   416           (if more-filters
       
   417               (zencoding-process-filter more-filters filter-output)
       
   418             filter-output))
       
   419       nil)))
       
   420 
       
   421 (defun zencoding-make-tag (tag-maker tag-info &optional content)
       
   422   "Extract tag info and pass them to tag-maker."
       
   423   (let* ((name      (pop tag-info))
       
   424          (has-body? (pop tag-info))
       
   425          (id        (pop tag-info))
       
   426          (classes   (pop tag-info))
       
   427          (props     (pop tag-info))
       
   428          (self-closing? (not (or content
       
   429                                  (and has-body?
       
   430                                       (not (member name zencoding-self-closing-tags)))))))
       
   431     (funcall tag-maker name id classes props self-closing?
       
   432              (if content content
       
   433                (if zencoding-leaf-function (funcall zencoding-leaf-function))))))
       
   434 
       
   435 (defun zencoding-make-html-tag (tag-name tag-id tag-classes tag-props self-closing? content)
       
   436   "Create HTML markup string"
       
   437   (let* ((id      (zencoding-concat-or-empty " id=\"" tag-id "\""))
       
   438          (classes (zencoding-mapconcat-or-empty " class=\"" tag-classes " " "\""))
       
   439          (props   (zencoding-mapconcat-or-empty " " tag-props " " nil
       
   440                                                 (lambda (prop)
       
   441                                                   (concat (symbol-name (car prop)) "=\"" (cadr prop) "\""))))
       
   442          (content-multiline? (and content (string-match "\n" content)))
       
   443          (block-tag? (or (member tag-name zencoding-block-tags)
       
   444                          (and (> (length tag-name) 1)
       
   445                               (not (member tag-name zencoding-inline-tags)))))
       
   446          (lf (if (or content-multiline? block-tag?)
       
   447                  "\n")))
       
   448     (concat "<" tag-name id classes props (if self-closing?
       
   449                                               "/>"
       
   450                                             (concat ">" (if content
       
   451                                                             (if (or content-multiline? block-tag?)
       
   452                                                                 (zencoding-indent content)
       
   453                                                               content))
       
   454                                                     lf
       
   455                                                     "</" tag-name ">")))))
       
   456 
       
   457 (defun zencoding-make-commented-html-tag (tag-name tag-id tag-classes tag-props self-closing? content)
       
   458   "Create HTML markup string with extra comments for elements with #id or .classes"
       
   459   (let ((body (zencoding-make-html-tag tag-name tag-id tag-classes tag-props self-closing? content)))
       
   460     (if (or tag-id tag-classes)
       
   461         (let ((id      (zencoding-concat-or-empty "#" tag-id))
       
   462               (classes (zencoding-mapconcat-or-empty "." tag-classes ".")))
       
   463           (concat "<!-- " id classes " -->\n"
       
   464                   body
       
   465                   "\n<!-- /" id classes " -->"))
       
   466       body)))
       
   467 
       
   468 (defun zencoding-make-haml-tag (tag-name tag-id tag-classes tag-props self-closing? content)
       
   469   "Create HAML string"
       
   470   (let ((name    (if (and (equal tag-name "div")
       
   471                           (or tag-id tag-classes))
       
   472                      ""
       
   473                    (concat "%" tag-name)))
       
   474         (id      (zencoding-concat-or-empty "#" tag-id))
       
   475         (classes (zencoding-mapconcat-or-empty "." tag-classes "."))
       
   476         (props   (zencoding-mapconcat-or-empty "{" tag-props ", " "}"
       
   477                                                (lambda (prop)
       
   478                                                  (concat ":" (symbol-name (car prop)) " => \"" (cadr prop) "\"")))))
       
   479     (concat name id classes props (if content
       
   480                                       (zencoding-indent content)))))
       
   481 
       
   482 (defun zencoding-make-hiccup-tag (tag-name tag-id tag-classes tag-props self-closing? content)
       
   483   "Create Hiccup string"
       
   484   (let* ((id      (zencoding-concat-or-empty "#" tag-id))
       
   485          (classes (zencoding-mapconcat-or-empty "." tag-classes "."))
       
   486          (props   (zencoding-mapconcat-or-empty " {" tag-props ", " "}"
       
   487                                                 (lambda (prop)
       
   488                                                   (concat ":" (symbol-name (car prop)) " \"" (cadr prop) "\""))))
       
   489          (content-multiline? (and content (string-match "\n" content)))
       
   490          (block-tag? (or (member tag-name zencoding-block-tags)
       
   491                          (and (> (length tag-name) 1)
       
   492                               (not (member tag-name zencoding-inline-tags))))))
       
   493     (concat "[:" tag-name id classes props
       
   494             (if content
       
   495                 (if (or content-multiline? block-tag?)
       
   496                     (zencoding-indent content)
       
   497                   (concat " " content)))
       
   498             "]")))
       
   499 
       
   500 (defun zencoding-concat-or-empty (prefix body &optional suffix)
       
   501   "Return prefixed suffixed text or empty string."
       
   502   (if body
       
   503       (concat prefix body suffix)
       
   504     ""))
       
   505 
       
   506 (defun zencoding-mapconcat-or-empty (prefix list-body delimiter &optional suffix map-fun)
       
   507   "Return prefixed suffixed mapconcated text or empty string."
       
   508   (if list-body
       
   509       (let* ((mapper (if map-fun map-fun 'identity))
       
   510              (body (mapconcat mapper list-body delimiter)))
       
   511         (concat prefix body suffix))
       
   512     ""))
       
   513 
       
   514 (defun zencoding-escape-xml (input proc)
       
   515   "Escapes XML-unsafe characters: <, > and &."
       
   516   (replace-regexp-in-string
       
   517    "<" "&lt;"
       
   518    (replace-regexp-in-string
       
   519     ">" "&gt;"
       
   520     (replace-regexp-in-string
       
   521      "&" "&amp;"
       
   522      (if (stringp input)
       
   523          input
       
   524        (zencoding-process-filter (zencoding-default-filter) input))))))
       
   525 
       
   526 (defun zencoding-transform (ast-with-filters)
       
   527   "Transform AST (containing filter data) into string."
       
   528   (let ((filters (cadr ast-with-filters))
       
   529         (ast (caddr ast-with-filters)))
       
   530     (zencoding-process-filter filters ast)))
       
   531 
       
   532 (defun zencoding-transform-ast (ast tag-maker)
       
   533   "Transform AST (without filter data) into string."
       
   534   (let ((type (car ast)))
       
   535     (cond
       
   536      ((eq type 'list)
       
   537       (mapconcat (lexical-let ((make-tag-fun tag-maker))
       
   538                    #'(lambda (sub-ast)
       
   539                        (zencoding-transform-ast sub-ast make-tag-fun)))
       
   540                  (cadr ast)
       
   541                  "\n"))
       
   542      ((eq type 'tag)
       
   543       (zencoding-make-tag tag-maker (cadr ast)))
       
   544      ((eq type 'parent-child)
       
   545       (let ((parent (cadadr ast))
       
   546             (children (zencoding-transform-ast (caddr ast) tag-maker)))
       
   547         (zencoding-make-tag tag-maker parent children)))
       
   548      ((eq type 'sibling)
       
   549       (let ((sib1 (zencoding-transform-ast (cadr ast) tag-maker))
       
   550             (sib2 (zencoding-transform-ast (caddr ast) tag-maker)))
       
   551         (concat sib1 "\n" sib2))))))
       
   552 
       
   553 (defun zencoding-indent (text)
       
   554   "Indent the text"
       
   555   (if text
       
   556       (replace-regexp-in-string "\n" "\n    " (concat "\n" text))
       
   557     nil))
       
   558 
       
   559 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   560 ;; Test-cases
       
   561 
       
   562 (defun zencoding-test-cases ()
       
   563   (let ((tests '(;; Tags
       
   564                  ("a"                      "<a></a>")
       
   565                  ("a.x"                    "<a class=\"x\"></a>")
       
   566                  ("a#q.x"                  "<a id=\"q\" class=\"x\"></a>")
       
   567                  ("a#q.x.y.z"              "<a id=\"q\" class=\"x y z\"></a>")
       
   568                  ("#q"                     "<div id=\"q\">"
       
   569                                            "</div>")
       
   570                  (".x"                     "<div class=\"x\">"
       
   571                                            "</div>")
       
   572                  ("#q.x"                   "<div id=\"q\" class=\"x\">"
       
   573                                            "</div>")
       
   574                  ("#q.x.y.z"               "<div id=\"q\" class=\"x y z\">"
       
   575                                            "</div>")
       
   576                  ;; Empty tags
       
   577                  ("a/"                     "<a/>")
       
   578                  ("a/.x"                   "<a class=\"x\"/>")
       
   579                  ("a/#q.x"                 "<a id=\"q\" class=\"x\"/>")
       
   580                  ("a/#q.x.y.z"             "<a id=\"q\" class=\"x y z\"/>")
       
   581                  ;; Self-closing tags
       
   582                  ("input type=text"        "<input type=\"text\"/>")
       
   583                  ("img"                    "<img/>")
       
   584                  ("img>metadata/*2"        "<img>"
       
   585                                            "    <metadata/>"
       
   586                                            "    <metadata/>"
       
   587                                            "</img>")
       
   588                  ;; Siblings
       
   589                  ("a+b"                    "<a></a>"
       
   590                                            "<b></b>")
       
   591                  ("a+b+c"                  "<a></a>"
       
   592                                            "<b></b>"
       
   593                                            "<c></c>")
       
   594                  ("a.x+b"                  "<a class=\"x\"></a>"
       
   595                                            "<b></b>")
       
   596                  ("a#q.x+b"                "<a id=\"q\" class=\"x\"></a>"
       
   597                                            "<b></b>")
       
   598                  ("a#q.x.y.z+b"            "<a id=\"q\" class=\"x y z\"></a>"
       
   599                                            "<b></b>")
       
   600                  ("a#q.x.y.z+b#p.l.m.n"    "<a id=\"q\" class=\"x y z\"></a>"
       
   601                                            "<b id=\"p\" class=\"l m n\"></b>")
       
   602                  ;; Tag expansion
       
   603                  ("table+"                 "<table>"
       
   604                                            "    <tr>"
       
   605                                            "        <td>"
       
   606                                            "        </td>"
       
   607                                            "    </tr>"
       
   608                                            "</table>")
       
   609                  ("dl+"                    "<dl>"
       
   610                                            "    <dt></dt>"
       
   611                                            "    <dd></dd>"
       
   612                                            "</dl>")
       
   613                  ("ul+"                    "<ul>"
       
   614                                            "    <li></li>"
       
   615                                            "</ul>")
       
   616                  ("ul++ol+"                "<ul>"
       
   617                                            "    <li></li>"
       
   618                                            "</ul>"
       
   619                                            "<ol>"
       
   620                                            "    <li></li>"
       
   621                                            "</ol>")
       
   622                  ("ul#q.x.y m=l+"          "<ul id=\"q\" class=\"x y\" m=\"l\">"
       
   623                                            "    <li></li>"
       
   624                                            "</ul>")
       
   625                  ;; Parent > child
       
   626                  ("a>b"                    "<a><b></b></a>")
       
   627                  ("a>b>c"                  "<a><b><c></c></b></a>")
       
   628                  ("a.x>b"                  "<a class=\"x\"><b></b></a>")
       
   629                  ("a#q.x>b"                "<a id=\"q\" class=\"x\"><b></b></a>")
       
   630                  ("a#q.x.y.z>b"            "<a id=\"q\" class=\"x y z\"><b></b></a>")
       
   631                  ("a#q.x.y.z>b#p.l.m.n"    "<a id=\"q\" class=\"x y z\"><b id=\"p\" class=\"l m n\"></b></a>")
       
   632                  ("#q>.x"                  "<div id=\"q\">"
       
   633                                            "    <div class=\"x\">"
       
   634                                            "    </div>"
       
   635                                            "</div>")
       
   636                  ("a>b+c"                  "<a>"
       
   637                                            "    <b></b>"
       
   638                                            "    <c></c>"
       
   639                                            "</a>")
       
   640                  ("a>b+c>d"                "<a>"
       
   641                                            "    <b></b>"
       
   642                                            "    <c><d></d></c>"
       
   643                                            "</a>")
       
   644                  ;; Multiplication
       
   645                  ("a*1"                    "<a></a>")
       
   646                  ("a*2"                    "<a></a>"
       
   647                                            "<a></a>")
       
   648                  ("a/*2"                   "<a/>"
       
   649                                            "<a/>")
       
   650                  ("a*2+b*2"                "<a></a>"
       
   651                                            "<a></a>"
       
   652                                            "<b></b>"
       
   653                                            "<b></b>")
       
   654                  ("a*2>b*2"                "<a>"
       
   655                                            "    <b></b>"
       
   656                                            "    <b></b>"
       
   657                                            "</a>"
       
   658                                            "<a>"
       
   659                                            "    <b></b>"
       
   660                                            "    <b></b>"
       
   661                                            "</a>")
       
   662                  ("a>b*2"                  "<a>"
       
   663                                            "    <b></b>"
       
   664                                            "    <b></b>"
       
   665                                            "</a>")
       
   666                  ("a#q.x>b#q.x*2"          "<a id=\"q\" class=\"x\">"
       
   667                                            "    <b id=\"q\" class=\"x\"></b>"
       
   668                                            "    <b id=\"q\" class=\"x\"></b>"
       
   669                                            "</a>")
       
   670                  ("a#q.x>b/#q.x*2"         "<a id=\"q\" class=\"x\">"
       
   671                                            "    <b id=\"q\" class=\"x\"/>"
       
   672                                            "    <b id=\"q\" class=\"x\"/>"
       
   673                                            "</a>")
       
   674                  ;; Properties
       
   675                  ("a x"                    "<a x=\"\"></a>")
       
   676                  ("a x="                   "<a x=\"\"></a>")
       
   677                  ("a x=\"\""               "<a x=\"\"></a>")
       
   678                  ("a x=y"                  "<a x=\"y\"></a>")
       
   679                  ("a x=\"y\""              "<a x=\"y\"></a>")
       
   680                  ("a x=\"()\""             "<a x=\"()\"></a>")
       
   681                  ("a x m"                  "<a x=\"\" m=\"\"></a>")
       
   682                  ("a x= m=\"\""            "<a x=\"\" m=\"\"></a>")
       
   683                  ("a x=y m=l"              "<a x=\"y\" m=\"l\"></a>")
       
   684                  ("a/ x=y m=l"             "<a x=\"y\" m=\"l\"/>")
       
   685                  ("a#foo x=y m=l"          "<a id=\"foo\" x=\"y\" m=\"l\"></a>")
       
   686                  ("a.foo x=y m=l"          "<a class=\"foo\" x=\"y\" m=\"l\"></a>")
       
   687                  ("a#foo.bar.mu x=y m=l"   "<a id=\"foo\" class=\"bar mu\" x=\"y\" m=\"l\"></a>")
       
   688                  ("a/#foo.bar.mu x=y m=l"  "<a id=\"foo\" class=\"bar mu\" x=\"y\" m=\"l\"/>")
       
   689                  ("a x=y+b"                "<a x=\"y\"></a>"
       
   690                                            "<b></b>")
       
   691                  ("a x=y+b x=y"            "<a x=\"y\"></a>"
       
   692                                            "<b x=\"y\"></b>")
       
   693                  ("a x=y>b"                "<a x=\"y\"><b></b></a>")
       
   694                  ("a x=y>b x=y"            "<a x=\"y\"><b x=\"y\"></b></a>")
       
   695                  ("a x=y>b x=y+c x=y"      "<a x=\"y\">"
       
   696                                            "    <b x=\"y\"></b>"
       
   697                                            "    <c x=\"y\"></c>"
       
   698                                            "</a>")
       
   699                  ;; Parentheses
       
   700                  ("(a)"                    "<a></a>")
       
   701                  ("(a)+(b)"                "<a></a>"
       
   702                                            "<b></b>")
       
   703                  ("a>(b)"                  "<a><b></b></a>")
       
   704                  ("(a>b)>c"                "<a><b></b></a>")
       
   705                  ("(a>b)+c"                "<a><b></b></a>"
       
   706                                            "<c></c>")
       
   707                  ("z+(a>b)+c+k"            "<z></z>"
       
   708                                            "<a><b></b></a>"
       
   709                                            "<c></c>"
       
   710                                            "<k></k>")
       
   711                  ("(a)*2"                  "<a></a>"
       
   712                                            "<a></a>")
       
   713                  ("((a)*2)"                "<a></a>"
       
   714                                            "<a></a>")
       
   715                  ("((a))*2"                "<a></a>"
       
   716                                            "<a></a>")
       
   717                  ("(a>b)*2"                "<a><b></b></a>"
       
   718                                            "<a><b></b></a>")
       
   719                  ("(a+b)*2"                "<a></a>"
       
   720                                            "<b></b>"
       
   721                                            "<a></a>"
       
   722                                            "<b></b>")
       
   723                  ;; Filter: comment
       
   724                  ("a.b|c"                  "<!-- .b -->"
       
   725                                            "<a class=\"b\"></a>"
       
   726                                            "<!-- /.b -->")
       
   727                  ("#a>.b|c"                "<!-- #a -->"
       
   728                                            "<div id=\"a\">"
       
   729                                            "    <!-- .b -->"
       
   730                                            "    <div class=\"b\">"
       
   731                                            "    </div>"
       
   732                                            "    <!-- /.b -->"
       
   733                                            "</div>"
       
   734                                            "<!-- /#a -->")
       
   735                  ;; Filter: HAML
       
   736                  ("a|haml"                 "%a")
       
   737                  ("a#q.x.y.z|haml"         "%a#q.x.y.z")
       
   738                  ("a#q.x x=y m=l|haml"     "%a#q.x{:x => \"y\", :m => \"l\"}")
       
   739                  ("div|haml"               "%div")
       
   740                  ("div.footer|haml"        ".footer")
       
   741                  (".footer|haml"           ".footer")
       
   742                  ("p>a href=#+br|haml"     "%p"
       
   743                                            "    %a{:href => \"#\"}"
       
   744                                            "    %br")
       
   745                  ;; Filter: Hiccup
       
   746                  ("a|hic"                  "[:a]")
       
   747                  ("a#q.x.y.z|hic"          "[:a#q.x.y.z]")
       
   748                  ("a#q.x x=y m=l|hic"      "[:a#q.x {:x \"y\", :m \"l\"}]")
       
   749                  (".footer|hic"            "[:div.footer]")
       
   750                  ("p>a href=#+br|hic"      "[:p"
       
   751                                            "    [:a {:href \"#\"}]"
       
   752                                            "    [:br]]")
       
   753                  ("#q>(a*2>b)+p>b|hic"     "[:div#q"
       
   754                                            "    [:a [:b]]"
       
   755                                            "    [:a [:b]]"
       
   756                                            "    [:p"
       
   757                                            "        [:b]]]")
       
   758                  ;; Filter: escape
       
   759                  ("script src=&quot;|e"    "&lt;script src=\"&amp;quot;\"&gt;"
       
   760                                            "&lt;/script&gt;")
       
   761                  )))
       
   762     (mapc (lambda (input)
       
   763             (let ((expected (mapconcat 'identity (cdr input) "\n"))
       
   764                   (actual (zencoding-transform (car (zencoding-expr (car input))))))
       
   765               (if (not (equal expected actual))
       
   766                   (error (concat "Assertion " (car input) " failed:"
       
   767                                  expected
       
   768                                  " == "
       
   769                                  actual)))))
       
   770             tests)
       
   771     (concat (number-to-string (length tests)) " tests performed. All OK.")))
       
   772 
       
   773 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   774 ;; Zencoding minor mode
       
   775 
       
   776 (defgroup zencoding nil
       
   777   "Customization group for zencoding-mode."
       
   778   :group 'convenience)
       
   779 
       
   780 (defun zencoding-expr-on-line ()
       
   781   "Extract a zencoding expression and the corresponding bounds
       
   782    for the current line."
       
   783   (let* ((start (line-beginning-position))
       
   784          (end (line-end-position))
       
   785          (line (buffer-substring-no-properties start end))
       
   786          (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2)))
       
   787     (if (first expr)
       
   788         (list (first expr) start end))))
       
   789 
       
   790 (defcustom zencoding-indentation 4
       
   791   "Number of spaces used for indentation."
       
   792   :type '(number :tag "Spaces")
       
   793   :group 'zencoding)
       
   794 
       
   795 (defun zencoding-prettify (markup indent)
       
   796   (let ((first-col (format (format "%%%ds" indent) ""))
       
   797         (tab       (format (format "%%%ds" zencoding-indentation) "")))
       
   798     (concat first-col
       
   799             (replace-regexp-in-string "\n" (concat "\n" first-col)
       
   800                                       (replace-regexp-in-string "    " tab markup)))))
       
   801 
       
   802 ;;;###autoload
       
   803 (defun zencoding-expand-line (arg)
       
   804   "Replace the current line's zencode expression with the corresponding expansion.
       
   805 If prefix ARG is given or region is visible call `zencoding-preview' to start an
       
   806 interactive preview.
       
   807 
       
   808 Otherwise expand line directly.
       
   809 
       
   810 For more information see `zencoding-mode'."
       
   811   (interactive "P")
       
   812   (let* ((here (point))
       
   813          (preview (if zencoding-preview-default (not arg) arg))
       
   814          (beg (if preview
       
   815                   (progn
       
   816                     (beginning-of-line)
       
   817                     (skip-chars-forward " \t")
       
   818                     (point))
       
   819                 (when mark-active (region-beginning))))
       
   820          (end (if preview
       
   821                   (progn
       
   822                     (end-of-line)
       
   823                     (skip-chars-backward " \t")
       
   824                     (point))
       
   825                 (when mark-active (region-end)))))
       
   826     (if beg
       
   827         (progn
       
   828           (goto-char here)
       
   829           (zencoding-preview beg end))
       
   830       (let ((expr (zencoding-expr-on-line)))
       
   831         (if expr
       
   832             (let* ((markup (zencoding-transform (car (zencoding-expr (first expr)))))
       
   833                    (pretty (zencoding-prettify markup (current-indentation))))
       
   834               (save-excursion
       
   835                 (delete-region (second expr) (third expr))
       
   836                 (zencoding-insert-and-flash pretty))))))))
       
   837 
       
   838 (defvar zencoding-mode-keymap nil
       
   839   "Keymap for zencode minor mode.")
       
   840 
       
   841 (if zencoding-mode-keymap
       
   842     nil
       
   843   (progn
       
   844     (setq zencoding-mode-keymap (make-sparse-keymap))
       
   845     (define-key zencoding-mode-keymap (kbd "C-j") 'zencoding-expand-line)
       
   846     (define-key zencoding-mode-keymap (kbd "<C-return>") 'zencoding-expand-line)))
       
   847 
       
   848 ;;;###autoload
       
   849 (define-minor-mode zencoding-mode
       
   850   "Minor mode for writing HTML and CSS markup.
       
   851 With zen coding for HTML and CSS you can write a line like
       
   852 
       
   853   ul#name>li.item*2
       
   854 
       
   855 and have it expanded to
       
   856 
       
   857   <ul id=\"name\">
       
   858     <li class=\"item\"></li>
       
   859     <li class=\"item\"></li>
       
   860   </ul>
       
   861 
       
   862 This minor mode defines keys for quick access:
       
   863 
       
   864 \\{zencoding-mode-keymap}
       
   865 
       
   866 Home page URL `http://www.emacswiki.org/emacs/ZenCoding'.
       
   867 
       
   868 See also `zencoding-expand-line'."
       
   869   :lighter " Zen"
       
   870   :keymap zencoding-mode-keymap)
       
   871 
       
   872 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   873 ;; Zencoding yasnippet integration
       
   874 
       
   875 (defun zencoding-transform-yas (ast)
       
   876   (let* ((leaf-count 0)
       
   877          (zencoding-leaf-function
       
   878           (lambda ()
       
   879             (format "$%d" (incf leaf-count)))))
       
   880     (zencoding-transform ast)))
       
   881 
       
   882 ;;;###autoload
       
   883 (defun zencoding-expand-yas ()
       
   884   (interactive)
       
   885   (let ((expr (zencoding-expr-on-line)))
       
   886     (if expr
       
   887         (let* ((markup (zencoding-transform-yas (car (zencoding-expr (first expr)))))
       
   888                (filled (replace-regexp-in-string "><" ">\n<" markup)))
       
   889           (delete-region (second expr) (third expr))
       
   890           (insert filled)
       
   891           (indent-region (second expr) (point))
       
   892           (yas/expand-snippet
       
   893            (buffer-substring (second expr) (point))
       
   894            (second expr) (point))))))
       
   895 
       
   896 
       
   897 
       
   898 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   899 ;;; Real-time preview
       
   900 ;;
       
   901 
       
   902 ;;;;;;;;;;
       
   903 ;; Lennart's version
       
   904 
       
   905 (defvar zencoding-preview-input nil)
       
   906 (make-local-variable 'zencoding-preview-input)
       
   907 (defvar zencoding-preview-output nil)
       
   908 (make-local-variable 'zencoding-preview-output)
       
   909 (defvar zencoding-old-show-paren nil)
       
   910 (make-local-variable 'zencoding-old-show-paren)
       
   911 
       
   912 (defface zencoding-preview-input
       
   913   '((default :box t :inherit secondary-selection))
       
   914   "Face for preview input field."
       
   915   :group 'zencoding)
       
   916 
       
   917 (defface zencoding-preview-output
       
   918   '((default :inherit highlight))
       
   919   "Face for preview output field."
       
   920   :group 'zencoding)
       
   921 
       
   922 (defvar zencoding-preview-keymap
       
   923   (let ((map (make-sparse-keymap)))
       
   924     (define-key map (kbd "RET") 'zencoding-preview-accept)
       
   925     (define-key map (kbd "<return>") 'zencoding-preview-accept)
       
   926     (define-key map [(control ?g)] 'zencoding-preview-abort)
       
   927     map))
       
   928 
       
   929 (defun zencoding-preview-accept ()
       
   930   (interactive)
       
   931   (let ((ovli zencoding-preview-input))
       
   932     (if (not (and (overlayp ovli)
       
   933                   (bufferp (overlay-buffer ovli))))
       
   934         (message "Preview is not active")
       
   935       (let* ((indent (current-indentation))
       
   936              (markup (zencoding-preview-transformed indent)))
       
   937         (when markup
       
   938           (delete-region (line-beginning-position) (overlay-end ovli))
       
   939           (zencoding-insert-and-flash markup)))))
       
   940   (zencoding-preview-abort))
       
   941 
       
   942 (defvar zencoding-flash-ovl nil)
       
   943 (make-variable-buffer-local 'zencoding-flash-ovl)
       
   944 
       
   945 (defun zencoding-remove-flash-ovl (buf)
       
   946   (with-current-buffer buf
       
   947     (when (overlayp zencoding-flash-ovl)
       
   948       (delete-overlay zencoding-flash-ovl))
       
   949     (setq zencoding-flash-ovl nil)))
       
   950 
       
   951 (defcustom zencoding-preview-default t
       
   952   "If non-nil then preview is the default action.
       
   953 This determines how `zencoding-expand-line' works by default."
       
   954   :type 'boolean
       
   955   :group 'zencoding)
       
   956 
       
   957 (defcustom zencoding-insert-flash-time 0.5
       
   958   "Time to flash insertion.
       
   959 Set this to a negative number if you do not want flashing the
       
   960 expansion after insertion."
       
   961   :type '(number :tag "Seconds")
       
   962   :group 'zencoding)
       
   963 
       
   964 (defun zencoding-insert-and-flash (markup)
       
   965   (zencoding-remove-flash-ovl (current-buffer))
       
   966   (let ((here (point)))
       
   967     (insert markup)
       
   968     (setq zencoding-flash-ovl (make-overlay here (point)))
       
   969     (overlay-put zencoding-flash-ovl 'face 'zencoding-preview-output)
       
   970     (when (< 0 zencoding-insert-flash-time)
       
   971       (run-with-idle-timer zencoding-insert-flash-time
       
   972                            nil 'zencoding-remove-flash-ovl (current-buffer)))))
       
   973 
       
   974 ;;;###autoload
       
   975 (defun zencoding-preview (beg end)
       
   976   "Expand zencode between BEG and END interactively.
       
   977 This will show a preview of the expanded zen code and you can
       
   978 accept it or skip it."
       
   979   (interactive (if mark-active
       
   980                    (list (region-beginning) (region-end))
       
   981                  (list nil nil)))
       
   982   (zencoding-preview-abort)
       
   983   (if (not beg)
       
   984       (message "Region not active")
       
   985     (setq zencoding-old-show-paren show-paren-mode)
       
   986     (show-paren-mode -1)
       
   987     (let ((here (point)))
       
   988       (goto-char beg)
       
   989       (forward-line 1)
       
   990       (unless (= 0 (current-column))
       
   991         (insert "\n"))
       
   992       (let* ((opos (point))
       
   993              (ovli (make-overlay beg end nil nil t))
       
   994              (ovlo (make-overlay opos opos))
       
   995              (info (propertize " Zen preview. Choose with RET. Cancel by stepping out. \n"
       
   996                                'face 'tooltip)))
       
   997         (overlay-put ovli 'face 'zencoding-preview-input)
       
   998         (overlay-put ovli 'keymap zencoding-preview-keymap)
       
   999         (overlay-put ovlo 'face 'zencoding-preview-output)
       
  1000         (overlay-put ovlo 'before-string info)
       
  1001         (setq zencoding-preview-input  ovli)
       
  1002         (setq zencoding-preview-output ovlo)
       
  1003         (add-hook 'before-change-functions 'zencoding-preview-before-change t t)
       
  1004         (goto-char here)
       
  1005         (add-hook 'post-command-hook 'zencoding-preview-post-command t t)))))
       
  1006 
       
  1007 (defvar zencoding-preview-pending-abort nil)
       
  1008 (make-variable-buffer-local 'zencoding-preview-pending-abort)
       
  1009 
       
  1010 (defun zencoding-preview-before-change (beg end)
       
  1011   (when
       
  1012       (or (> beg (overlay-end zencoding-preview-input))
       
  1013           (< beg (overlay-start zencoding-preview-input))
       
  1014           (> end (overlay-end zencoding-preview-input))
       
  1015           (< end (overlay-start zencoding-preview-input)))
       
  1016     (setq zencoding-preview-pending-abort t)))
       
  1017 
       
  1018 (defun zencoding-preview-abort ()
       
  1019   "Abort zen code preview."
       
  1020   (interactive)
       
  1021   (setq zencoding-preview-pending-abort nil)
       
  1022   (remove-hook 'before-change-functions 'zencoding-preview-before-change t)
       
  1023   (when (overlayp zencoding-preview-input)
       
  1024     (delete-overlay zencoding-preview-input))
       
  1025   (setq zencoding-preview-input nil)
       
  1026   (when (overlayp zencoding-preview-output)
       
  1027     (delete-overlay zencoding-preview-output))
       
  1028   (setq zencoding-preview-output nil)
       
  1029   (remove-hook 'post-command-hook 'zencoding-preview-post-command t)
       
  1030   (when zencoding-old-show-paren (show-paren-mode 1)))
       
  1031 
       
  1032 (defun zencoding-preview-post-command ()
       
  1033   (condition-case err
       
  1034       (zencoding-preview-post-command-1)
       
  1035     (error (message "zencoding-preview-post: %s" err))))
       
  1036 
       
  1037 (defun zencoding-preview-post-command-1 ()
       
  1038   (if (and (not zencoding-preview-pending-abort)
       
  1039            (<= (point) (overlay-end zencoding-preview-input))
       
  1040            (>= (point) (overlay-start zencoding-preview-input)))
       
  1041       (zencoding-update-preview (current-indentation))
       
  1042     (zencoding-preview-abort)))
       
  1043 
       
  1044 (defun zencoding-preview-transformed (indent)
       
  1045   (let* ((string (buffer-substring-no-properties
       
  1046 		  (overlay-start zencoding-preview-input)
       
  1047 		  (overlay-end zencoding-preview-input)))
       
  1048 	 (ast    (car (zencoding-expr string))))
       
  1049     (when (not (eq ast 'error))
       
  1050       (let ((output (zencoding-transform ast)))
       
  1051         (when output
       
  1052           (zencoding-prettify output indent))))))
       
  1053 
       
  1054 (defun zencoding-update-preview (indent)
       
  1055   (let* ((pretty (zencoding-preview-transformed indent))
       
  1056          (show (when pretty
       
  1057                  (propertize pretty 'face 'highlight))))
       
  1058     (when show
       
  1059       (overlay-put zencoding-preview-output 'after-string
       
  1060                    (concat show "\n")))))
       
  1061 
       
  1062 (provide 'zencoding-mode)
       
  1063 
       
  1064 ;;; zencoding-mode.el ends here