thirdparty/zencoding-mode.el
changeset 51 c4e0668a2c87
parent 35 4a9c440b6764
equal deleted inserted replaced
50:6590d340a568 51:c4e0668a2c87
     1 ;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup
     1 ;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup
     2 ;;
     2 
     3 ;; Copyright (C) 2009, Chris Done
     3 ;; Copyright (C) 2009, Chris Done
     4 ;;
     4 
       
     5 ;; Version: 0.5.1
     5 ;; Author: Chris Done <[email protected]>
     6 ;; Author: Chris Done <[email protected]>
     6 (defconst zencoding-mode:version "0.5")
     7 ;; URL: https://github.com/rooney/zencoding
     7 ;; Last-Updated: 2009-11-20 Fri
     8 ;; Last-Updated: 2011-12-31 Sat
     8 ;; Keywords: convenience
     9 ;; Keywords: convenience
     9 ;;
    10 
    10 ;; This file is free software; you can redistribute it and/or modify
    11 ;; This file is free software; you can redistribute it and/or modify
    11 ;; it under the terms of the GNU General Public License as published by
    12 ;; it under the terms of the GNU General Public License as published by
    12 ;; the Free Software Foundation; either version 3, or (at your option)
    13 ;; the Free Software Foundation; either version 3, or (at your option)
    13 ;; any later version.
    14 ;; any later version.
    14 ;;
    15 ;;
    19 ;;
    20 ;;
    20 ;; You should have received a copy of the GNU General Public License
    21 ;; You should have received a copy of the GNU General Public License
    21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
    22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
    22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
    23 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
    23 ;; Boston, MA 02110-1301, USA.
    24 ;; Boston, MA 02110-1301, USA.
    24 ;;
    25 
    25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    26 ;;
    27 ;;
    27 ;;; Commentary:
    28 ;;; Commentary:
    28 ;;
    29 ;;
    29 ;; Unfold CSS-selector-like expressions to markup. Intended to be used
    30 ;; Unfold CSS-selector-like expressions to markup. Intended to be used
    56 ;; Modified by Lennart Borgman.
    57 ;; Modified by Lennart Borgman.
    57 ;;
    58 ;;
    58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    59 ;;
    60 ;;
    60 ;;; Code:
    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)
    61 
    69 
    62 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    70 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    63 ;; Generic parsing macros and utilities
    71 ;; Generic parsing macros and utilities
    64 
    72 
    65 (defmacro zencoding-aif (test-form then-form &rest else-forms)
    73 (defmacro zencoding-aif (test-form then-form &rest else-forms)
   109 
   117 
   110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   111 ;; Zen coding parsers
   119 ;; Zen coding parsers
   112 
   120 
   113 (defun zencoding-expr (input)
   121 (defun zencoding-expr (input)
   114   "Parse a zen coding expression. This pretty much defines precedence."
   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."
   115   (zencoding-run zencoding-siblings
   133   (zencoding-run zencoding-siblings
   116                  it
   134                  it
   117                  (zencoding-run zencoding-parent-child
   135                  (zencoding-run zencoding-parent-child
   118                                 it
   136                                 it
   119                                 (zencoding-run zencoding-multiplier
   137                                 (zencoding-run zencoding-multiplier
   122                                                               it
   140                                                               it
   123                                                               (zencoding-run zencoding-tag
   141                                                               (zencoding-run zencoding-tag
   124                                                                              it
   142                                                                              it
   125                                                                              '(error "no match, expecting ( or a-zA-Z0-9")))))))
   143                                                                              '(error "no match, expecting ( or a-zA-Z0-9")))))))
   126 
   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 
   127 (defun zencoding-multiplier (input)
   176 (defun zencoding-multiplier (input)
   128   (zencoding-por zencoding-pexpr zencoding-tag
   177   (zencoding-por zencoding-pexpr zencoding-tag
   129                  (let ((multiplier expr))
   178                  (let ((multiplier expr))
   130                    (zencoding-parse "\\*\\([0-9]+\\)" 2 "*n where n is a number"
   179                    (zencoding-parse "\\*\\([0-9]+\\)" 2 "*n where n is a number"
   131                                     (let ((multiplicand (read (elt it 1))))
   180                                     (let ((multiplicand (read (elt it 1))))
   133                  '(error "expected *n multiplier")))
   182                  '(error "expected *n multiplier")))
   134 
   183 
   135 (defun zencoding-tag (input)
   184 (defun zencoding-tag (input)
   136   "Parse a tag."
   185   "Parse a tag."
   137   (zencoding-run zencoding-tagname
   186   (zencoding-run zencoding-tagname
   138                  (let ((result it)
   187                  (let ((tagname (cadr expr))
   139                        (tagname (cdr expr)))
   188                        (has-body? (cddr expr)))
   140                    (zencoding-pif (zencoding-run zencoding-identifier
   189                    (zencoding-pif (zencoding-run zencoding-identifier
   141                                                  (zencoding-tag-classes
   190                                                  (zencoding-tag-classes
   142                                                   `(tag ,tagname ((id ,(cddr expr)))) input)
   191                                                   `(tag (,tagname ,has-body? ,(cddr expr))) input)
   143                                                  (zencoding-tag-classes `(tag ,tagname ()) input))
   192                                                  (zencoding-tag-classes
   144                                   (let ((expr-and-input it) (expr (car it)) (input (cdr it)))
   193                                                   `(tag (,tagname ,has-body? nil)) input))
   145                                     (zencoding-pif (zencoding-tag-props expr input)
   194                                   (let ((expr (car it))
   146                                                    it
   195                                         (input (cdr it)))
   147                                                    expr-and-input))))
   196                                     (zencoding-tag-props expr input))))
   148                  '(error "expected tagname")))
   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)))))
   149 
   203 
   150 (defun zencoding-tag-props (tag input)
   204 (defun zencoding-tag-props (tag input)
   151   (zencoding-run zencoding-props
   205   (let ((tag-data (cadr tag)))
   152                  (let ((tagname (cadr tag))
   206     (zencoding-run zencoding-props
   153                        (existing-props (caddr tag))
   207                    (let ((props (cdr expr)))
   154                        (props (cdr expr)))
   208                      `((tag ,(append tag-data (list props))) . ,input))
   155                    `((tag ,tagname
   209                    `((tag ,(append tag-data '(nil))) . ,input))))
   156                           ,(append existing-props props))
       
   157                      . ,input))))
       
   158 
   210 
   159 (defun zencoding-props (input)
   211 (defun zencoding-props (input)
   160   "Parse many props."
   212   "Parse many props."
   161     (zencoding-run zencoding-prop
   213     (zencoding-run zencoding-prop
   162                    (zencoding-pif (zencoding-props input)
   214                    (zencoding-pif (zencoding-props input)
   167   (zencoding-parse
   219   (zencoding-parse
   168    " " 1 "space"
   220    " " 1 "space"
   169    (zencoding-run
   221    (zencoding-run
   170     zencoding-name
   222     zencoding-name
   171     (let ((name (cdr expr)))
   223     (let ((name (cdr expr)))
   172       (zencoding-parse "=\\([^\\,\\+\\>\\ )]*\\)" 2
   224       (zencoding-pif (zencoding-prop-value name input)
   173                        "=property value"
   225                      it
   174                        (let ((value (elt it 1))
   226                      `((,(read name) "") . ,input))))))
   175                              (input (elt it 2)))
   227 
   176                          `((,(read name) ,value) . ,input)))))))
   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)))))
   177 
   240 
   178 (defun zencoding-tag-classes (tag input)
   241 (defun zencoding-tag-classes (tag input)
   179   (zencoding-run zencoding-classes
   242   (let ((tag-data (cadr tag)))
   180                  (let ((tagname (cadr tag))
   243     (zencoding-run zencoding-classes
   181                        (props (caddr tag))
   244                    (let ((classes (mapcar (lambda (cls) (cdadr cls))
   182                        (classes `(class ,(mapconcat
   245                                           (cdr expr))))
   183                                           (lambda (prop)
   246                      `((tag ,(append tag-data (list classes))) . ,input))
   184                                             (cdadr prop))
   247                    `((tag ,(append tag-data '(nil))) . ,input))))
   185                                           (cdr expr)
       
   186                                           " "))))
       
   187                    `((tag ,tagname ,(append props (list classes))) . ,input))
       
   188                  `(,tag . ,input)))
       
   189 
   248 
   190 (defun zencoding-tagname (input)
   249 (defun zencoding-tagname (input)
   191   "Parse a tagname a-zA-Z0-9 tagname (e.g. html/head/xsl:if/br)."
   250   "Parse a tagname a-zA-Z0-9 tagname (e.g. html/head/xsl:if/br)."
   192   (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9:-]*\\)" 2 "tagname, a-zA-Z0-9"
   251   (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9:-]*\/?\\)" 2 "tagname, a-zA-Z0-9"
   193                    `((tagname . ,(elt it 1)) . ,input)))
   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))))
   194 
   258 
   195 (defun zencoding-pexpr (input)
   259 (defun zencoding-pexpr (input)
   196   "A zen coding expression with parentheses around it."
   260   "A zen coding expression with parentheses around it."
   197   (zencoding-parse "(" 1 "("
   261   (zencoding-parse "(" 1 "("
   198                    (zencoding-run zencoding-expr
   262                    (zencoding-run zencoding-subexpr
   199                                   (zencoding-aif (zencoding-regex ")" input '(0 1))
   263                                   (zencoding-aif (zencoding-regex ")" input '(0 1))
   200                                                  `(,expr . ,(elt it 1))
   264                                                  `(,expr . ,(elt it 1))
   201                                                  '(error "expecting `)'")))))
   265                                                  '(error "expecting `)'")))))
   202 
   266 
   203 (defun zencoding-parent-child (input)
   267 (defun zencoding-parent-child (input)
   220                                 (zencoding-child expr input)
   284                                 (zencoding-child expr input)
   221                                 '(error "expected parent"))))
   285                                 '(error "expected parent"))))
   222 
   286 
   223 (defun zencoding-child-sans (parent input)
   287 (defun zencoding-child-sans (parent input)
   224   (zencoding-parse ">" 1 ">"
   288   (zencoding-parse ">" 1 ">"
   225                    (zencoding-run zencoding-expr
   289                    (zencoding-run zencoding-subexpr
   226                                   it
   290                                   it
   227                                   '(error "expected child"))))
   291                                   '(error "expected child"))))
   228 
   292 
   229 (defun zencoding-child (parent input)
   293 (defun zencoding-child (parent input)
   230   (zencoding-parse ">" 1 ">"
   294   (zencoding-parse ">" 1 ">"
   231                    (zencoding-run zencoding-expr
   295                    (zencoding-run zencoding-subexpr
   232                                   (let ((child expr))
   296                                   (let ((child expr))
   233                                     `((parent-child ,parent ,child) . ,input))
   297                                     `((parent-child ,parent ,child) . ,input))
   234                                   '(error "expected child"))))
   298                                   '(error "expected child"))))
   235 
   299 
   236 (defun zencoding-sibling (input)
   300 (defun zencoding-sibling (input)
   243 (defun zencoding-siblings (input)
   307 (defun zencoding-siblings (input)
   244   "Parse an e+e expression, where e is an tag or a pexpr."
   308   "Parse an e+e expression, where e is an tag or a pexpr."
   245   (zencoding-run zencoding-sibling
   309   (zencoding-run zencoding-sibling
   246                  (let ((parent expr))
   310                  (let ((parent expr))
   247                    (zencoding-parse "\\+" 1 "+"
   311                    (zencoding-parse "\\+" 1 "+"
   248                                     (zencoding-run zencoding-expr
   312                                     (zencoding-run zencoding-subexpr
   249                                                    (let ((child expr))
   313                                                    (let ((child expr))
   250                                                      `((zencoding-siblings ,parent ,child) . ,input))
   314                                                      `((sibling ,parent ,child) . ,input))
   251                                                    '(error "expected second sibling"))))
   315                                                    (zencoding-expand parent input))))
   252                  '(error "expected first sibling")))
   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"))))
   253 
   335 
   254 (defun zencoding-name (input)
   336 (defun zencoding-name (input)
   255   "Parse a class or identifier name, e.g. news, footer, mainimage"
   337   "Parse a class or identifier name, e.g. news, footer, mainimage"
   256   (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9-_]*\\)" 2 "class or identifer name"
   338   (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9-_:]*\\)" 2 "class or identifer name"
   257                    `((name . ,(elt it 1)) . ,input)))
   339                    `((name . ,(elt it 1)) . ,input)))
   258 
   340 
   259 (defun zencoding-class (input)
   341 (defun zencoding-class (input)
   260   "Parse a classname expression, e.g. .foo"
   342   "Parse a classname expression, e.g. .foo"
   261   (zencoding-parse "\\." 1 "."
   343   (zencoding-parse "\\." 1 "."
   262                    (zencoding-run zencoding-name
   344                    (zencoding-run zencoding-name
   263                                   `((class ,expr) . ,input)
   345                                   `((class ,expr) . ,input)
   264                                   '(error "expected class name"))))
   346                                   '(error "expected class name"))))
   265 
       
   266 (defun zencoding-identifier (input)
   347 (defun zencoding-identifier (input)
   267   "Parse an identifier expression, e.g. #foo"
   348   "Parse an identifier expression, e.g. #foo"
   268   (zencoding-parse "#" 1 "#"
   349   (zencoding-parse "#" 1 "#"
   269                    (zencoding-run zencoding-name
   350                    (zencoding-run zencoding-name
   270                                   `((identifier . ,expr) . ,input))))
   351                                   `((identifier . ,expr) . ,input))))
   276                                 `((classes . ,(cons expr (cdar it))) . ,(cdr it))
   357                                 `((classes . ,(cons expr (cdar it))) . ,(cdr it))
   277                                 `((classes . ,(list expr)) . ,input))
   358                                 `((classes . ,(list expr)) . ,input))
   278                  '(error "expected class")))
   359                  '(error "expected class")))
   279 
   360 
   280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   361 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   281 ;; Zen coding transformer from AST to HTML
   362 ;; Zen coding transformer from AST to string
   282 
       
   283 ;; Fix-me: make mode specific
       
   284 (defvar zencoding-single-tags
       
   285   '("br"
       
   286     "img"))
       
   287 
   363 
   288 (defvar zencoding-inline-tags
   364 (defvar zencoding-inline-tags
   289   '("a"
   365   '("a"
   290     "abbr"
   366     "abbr"
   291     "acronym"
   367     "acronym"
   292     "cite"
   368     "cite"
   293     "code"
   369     "code"
       
   370     "dd"
   294     "dfn"
   371     "dfn"
       
   372     "dt"
   295     "em"
   373     "em"
   296     "h1" "h2" "h3" "h4" "h5" "h6"
   374     "h1" "h2" "h3" "h4" "h5" "h6"
   297     "kbd"
   375     "kbd"
       
   376     "li"
   298     "q"
   377     "q"
   299     "span"
   378     "span"
   300     "strong"
   379     "strong"
   301     "var"))
   380     "var"))
   302 
   381 
   303 (defvar zencoding-block-tags
   382 (defvar zencoding-block-tags
   304   '("p"))
   383   '("p"))
   305 
   384 
   306 ;; li
   385 (defvar zencoding-self-closing-tags
   307 ;; a
   386   '("br"
   308 ;; em
   387     "img"
   309 ;; p
   388     "input"))
   310 
   389 
   311 (defvar zencoding-leaf-function nil
   390 (defvar zencoding-leaf-function nil
   312   "Function to execute when expanding a leaf node in the
   391   "Function to execute when expanding a leaf node in the
   313   Zencoding AST.")
   392   Zencoding AST.")
   314 
   393 
   315 (defun zencoding-make-tag (tag &optional content)
   394 (defvar zencoding-filters
   316   (let* ((name (car tag))
   395   '("html" (zencoding-primary-filter zencoding-make-html-tag)
   317          (lf (if
   396     "c"    (zencoding-primary-filter zencoding-make-commented-html-tag)
   318                  (or
   397     "haml" (zencoding-primary-filter zencoding-make-haml-tag)
   319                   (member name zencoding-block-tags)
   398     "hic"  (zencoding-primary-filter zencoding-make-hiccup-tag)
   320                   (and
   399     "e"    (zencoding-escape-xml)))
   321                    (> (length name) 1)
   400 
   322                    (not (member name zencoding-inline-tags))
   401 (defun zencoding-primary-filter (input proc)
   323                    ))
   402   "Process filter that needs to be executed first, ie. not given output from other filter."
   324                  "\n" ""))
   403   (if (listp input)
   325          (single (member name zencoding-single-tags))
   404       (let ((tag-maker (cadr proc)))
   326         (props (apply 'concat (mapcar
   405         (zencoding-transform-ast input tag-maker))
   327                                (lambda (prop)
   406     nil))
   328                                  (concat " " (symbol-name (car prop))
   407 
   329                                          "=\"" (cadr prop) "\""))
   408 (defun zencoding-process-filter (filters input)
   330                                (cadr tag)))))
   409   "Process filters, chain one filter output as the input of the next filter."
   331     (concat lf "<" name props ">" lf
   410   (let ((filter-data (member (car filters) zencoding-filters))
   332             (if single
   411         (more-filters (cdr filters)))
   333                 ""
   412     (if filter-data
   334               (concat
   413         (let* ((proc   (cadr filter-data))
   335                (if content content
   414                (fun    (car proc))
   336                  (if zencoding-leaf-function
   415                (filter-output (funcall fun input proc)))
   337                      (funcall zencoding-leaf-function)
   416           (if more-filters
   338                    ""))
   417               (zencoding-process-filter more-filters filter-output)
   339                lf "</" name ">")))))
   418             filter-output))
   340 
   419       nil)))
   341 (defun zencoding-transform (ast)
   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."
   342   (let ((type (car ast)))
   534   (let ((type (car ast)))
   343     (cond
   535     (cond
   344      ((eq type 'list)
   536      ((eq type 'list)
   345       (mapconcat 'zencoding-transform (cadr ast) ""))
   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"))
   346      ((eq type 'tag)
   542      ((eq type 'tag)
   347       (zencoding-make-tag (cdr ast)))
   543       (zencoding-make-tag tag-maker (cadr ast)))
   348      ((eq type 'parent-child)
   544      ((eq type 'parent-child)
   349       (let ((parent (cdadr ast))
   545       (let ((parent (cadadr ast))
   350             (children (zencoding-transform (caddr ast))))
   546             (children (zencoding-transform-ast (caddr ast) tag-maker)))
   351         (zencoding-make-tag parent children)))
   547         (zencoding-make-tag tag-maker parent children)))
   352      ((eq type 'zencoding-siblings)
   548      ((eq type 'sibling)
   353       (let ((sib1 (zencoding-transform (cadr ast)))
   549       (let ((sib1 (zencoding-transform-ast (cadr ast) tag-maker))
   354             (sib2 (zencoding-transform (caddr ast))))
   550             (sib2 (zencoding-transform-ast (caddr ast) tag-maker)))
   355         (concat sib1 sib2))))))
   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))
   356 
   558 
   357 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   559 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   358 ;; Test-cases
   560 ;; Test-cases
   359 
   561 
   360 (defun zencoding-test-cases ()
   562 (defun zencoding-test-cases ()
   361   (let ((tests '(;; Tags
   563   (let ((tests '(;; Tags
   362                  ("a"                      "<a></a>")
   564                  ("a"                      "<a></a>")
   363                  ("a.x"                    "<a class=\"x\"></a>")
   565                  ("a.x"                    "<a class=\"x\"></a>")
   364                  ("a#q.x"                  "<a id=\"q\" class=\"x\"></a>")
   566                  ("a#q.x"                  "<a id=\"q\" class=\"x\"></a>")
   365                  ("a#q.x.y.z"              "<a id=\"q\" class=\"x y z\"></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>")
   366                  ;; Siblings
   588                  ;; Siblings
   367                  ("a+b"                    "<a></a><b></b>")
   589                  ("a+b"                    "<a></a>"
   368                  ("a+b+c"                  "<a></a><b></b><c></c>")
   590                                            "<b></b>")
   369                  ("a.x+b"                  "<a class=\"x\"></a><b></b>")
   591                  ("a+b+c"                  "<a></a>"
   370                  ("a#q.x+b"                "<a id=\"q\" class=\"x\"></a><b></b>")
   592                                            "<b></b>"
   371                  ("a#q.x.y.z+b"            "<a id=\"q\" class=\"x y z\"></a><b></b>")
   593                                            "<c></c>")
   372                  ("a#q.x.y.z+b#p.l.m.n"    "<a id=\"q\" class=\"x y z\"></a><b id=\"p\" class=\"l m n\"></b>")
   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>")
   373                  ;; Parent > child
   625                  ;; Parent > child
   374                  ("a>b"                    "<a><b></b></a>")
   626                  ("a>b"                    "<a><b></b></a>")
   375                  ("a>b>c"                  "<a><b><c></c></b></a>")
   627                  ("a>b>c"                  "<a><b><c></c></b></a>")
   376                  ("a.x>b"                  "<a class=\"x\"><b></b></a>")
   628                  ("a.x>b"                  "<a class=\"x\"><b></b></a>")
   377                  ("a#q.x>b"                "<a id=\"q\" class=\"x\"><b></b></a>")
   629                  ("a#q.x>b"                "<a id=\"q\" class=\"x\"><b></b></a>")
   378                  ("a#q.x.y.z>b"            "<a id=\"q\" class=\"x y z\"><b></b></a>")
   630                  ("a#q.x.y.z>b"            "<a id=\"q\" class=\"x y z\"><b></b></a>")
   379                  ("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>")
   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>")
   380                  ("a>b+c"                  "<a><b></b><c></c></a>")
   632                  ("#q>.x"                  "<div id=\"q\">"
   381                  ("a>b+c>d"                "<a><b></b><c><d></d></c></a>")
   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>")
   382                  ;; Multiplication
   644                  ;; Multiplication
   383                  ("a*1"                    "<a></a>")
   645                  ("a*1"                    "<a></a>")
   384                  ("a*2"                    "<a></a><a></a>")
   646                  ("a*2"                    "<a></a>"
   385                  ("a*2+b*2"                "<a></a><a></a><b></b><b></b>")
   647                                            "<a></a>")
   386                  ("a*2>b*2"                "<a><b></b><b></b></a><a><b></b><b></b></a>")
   648                  ("a/*2"                   "<a/>"
   387                  ("a>b*2"                  "<a><b></b><b></b></a>")
   649                                            "<a/>")
   388                  ("a#q.x>b#q.x*2"          "<a id=\"q\" class=\"x\"><b id=\"q\" class=\"x\"></b><b id=\"q\" class=\"x\"></b></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>")
   389                  ;; Properties
   674                  ;; Properties
       
   675                  ("a x"                    "<a x=\"\"></a>")
       
   676                  ("a x="                   "<a x=\"\"></a>")
       
   677                  ("a x=\"\""               "<a x=\"\"></a>")
   390                  ("a x=y"                  "<a x=\"y\"></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>")
   391                  ("a x=y m=l"              "<a x=\"y\" m=\"l\"></a>")
   683                  ("a x=y m=l"              "<a x=\"y\" m=\"l\"></a>")
       
   684                  ("a/ x=y m=l"             "<a x=\"y\" m=\"l\"/>")
   392                  ("a#foo x=y m=l"          "<a id=\"foo\" x=\"y\" m=\"l\"></a>")
   685                  ("a#foo x=y m=l"          "<a id=\"foo\" x=\"y\" m=\"l\"></a>")
   393                  ("a.foo x=y m=l"          "<a class=\"foo\" x=\"y\" m=\"l\"></a>")
   686                  ("a.foo x=y m=l"          "<a class=\"foo\" x=\"y\" m=\"l\"></a>")
   394                  ("a#foo.bar.mu x=y m=l"   "<a id=\"foo\" class=\"bar mu\" 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>")
   395                  ("a x=y+b"                "<a x=\"y\"></a><b></b>")
   688                  ("a/#foo.bar.mu x=y m=l"  "<a id=\"foo\" class=\"bar mu\" x=\"y\" m=\"l\"/>")
   396                  ("a x=y+b x=y"            "<a x=\"y\"></a><b x=\"y\"></b>")
   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>")
   397                  ("a x=y>b"                "<a x=\"y\"><b></b></a>")
   693                  ("a x=y>b"                "<a x=\"y\"><b></b></a>")
   398                  ("a x=y>b x=y"            "<a x=\"y\"><b x=\"y\"></b></a>")
   694                  ("a x=y>b x=y"            "<a x=\"y\"><b x=\"y\"></b></a>")
   399                  ("a x=y>b x=y+c x=y"      "<a x=\"y\"><b x=\"y\"></b><c x=\"y\"></c></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>")
   400                  ;; Parentheses
   699                  ;; Parentheses
   401                  ("(a)"                    "<a></a>")
   700                  ("(a)"                    "<a></a>")
   402                  ("(a)+(b)"                "<a></a><b></b>")
   701                  ("(a)+(b)"                "<a></a>"
       
   702                                            "<b></b>")
   403                  ("a>(b)"                  "<a><b></b></a>")
   703                  ("a>(b)"                  "<a><b></b></a>")
   404                  ("(a>b)>c"                "<a><b></b></a>")
   704                  ("(a>b)>c"                "<a><b></b></a>")
   405                  ("(a>b)+c"                "<a><b></b></a><c></c>")
   705                  ("(a>b)+c"                "<a><b></b></a>"
   406                  ("z+(a>b)+c+k"            "<z></z><a><b></b></a><c></c><k></k>")
   706                                            "<c></c>")
   407                  ("(a)*2"                  "<a></a><a></a>")
   707                  ("z+(a>b)+c+k"            "<z></z>"
   408                  ("((a)*2)"                "<a></a><a></a>")
   708                                            "<a><b></b></a>"
   409                  ("((a)*2)"                "<a></a><a></a>")
   709                                            "<c></c>"
   410                  ("(a>b)*2"                "<a><b></b></a><a><b></b></a>")
   710                                            "<k></k>")
   411                  ("(a+b)*2"                "<a></a><b></b><a></a><b></b>")
   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;")
   412                  )))
   761                  )))
   413     (mapc (lambda (input)
   762     (mapc (lambda (input)
   414             (let ((expected (cadr input))
   763             (let ((expected (mapconcat 'identity (cdr input) "\n"))
   415                   (actual (zencoding-transform (car (zencoding-expr (car input))))))
   764                   (actual (zencoding-transform (car (zencoding-expr (car input))))))
   416               (if (not (equal expected actual))
   765               (if (not (equal expected actual))
   417                   (error (concat "Assertion " (car input) " failed:"
   766                   (error (concat "Assertion " (car input) " failed:"
   418                                  expected
   767                                  expected
   419                                  " == "
   768                                  " == "
   420                                  actual)))))
   769                                  actual)))))
   421             tests)
   770             tests)
   422     (concat (number-to-string (length tests)) " tests performed. All OK.")))
   771     (concat (number-to-string (length tests)) " tests performed. All OK.")))
   423 
       
   424 
   772 
   425 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   773 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   426 ;; Zencoding minor mode
   774 ;; Zencoding minor mode
   427 
   775 
   428 (defgroup zencoding nil
   776 (defgroup zencoding nil
   437          (line (buffer-substring-no-properties start end))
   785          (line (buffer-substring-no-properties start end))
   438          (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2)))
   786          (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2)))
   439     (if (first expr)
   787     (if (first expr)
   440         (list (first expr) start end))))
   788         (list (first expr) start end))))
   441 
   789 
       
   790 (defcustom zencoding-indentation 4
       
   791   "Number of spaces used for indentation."
       
   792   :type '(number :tag "Spaces")
       
   793   :group 'zencoding)
       
   794 
   442 (defun zencoding-prettify (markup indent)
   795 (defun zencoding-prettify (markup indent)
   443   (save-match-data
   796   (let ((first-col (format (format "%%%ds" indent) ""))
   444     ;;(setq markup (replace-regexp-in-string "><" ">\n<" markup))
   797         (tab       (format (format "%%%ds" zencoding-indentation) "")))
   445     (setq markup (replace-regexp-in-string "\n\n" "\n" markup))
   798     (concat first-col
   446     (setq markup (replace-regexp-in-string "^\n" "" markup)))
   799             (replace-regexp-in-string "\n" (concat "\n" first-col)
   447   (with-temp-buffer
   800                                       (replace-regexp-in-string "    " tab markup)))))
   448     (indent-to indent)
       
   449     (insert "<i></i>")
       
   450     (insert "\n")
       
   451     (let ((here (point)))
       
   452       (insert markup)
       
   453       (sgml-mode)
       
   454       (indent-region here (point-max))
       
   455       (buffer-substring-no-properties here (point-max)))))
       
   456 
   801 
   457 ;;;###autoload
   802 ;;;###autoload
   458 (defun zencoding-expand-line (arg)
   803 (defun zencoding-expand-line (arg)
   459   "Replace the current line's zencode expression with the corresponding expansion.
   804   "Replace the current line's zencode expression with the corresponding expansion.
   460 If prefix ARG is given or region is visible call `zencoding-preview' to start an
   805 If prefix ARG is given or region is visible call `zencoding-preview' to start an
   495 
   840 
   496 (if zencoding-mode-keymap
   841 (if zencoding-mode-keymap
   497     nil
   842     nil
   498   (progn
   843   (progn
   499     (setq zencoding-mode-keymap (make-sparse-keymap))
   844     (setq zencoding-mode-keymap (make-sparse-keymap))
       
   845     (define-key zencoding-mode-keymap (kbd "C-j") 'zencoding-expand-line)
   500     (define-key zencoding-mode-keymap (kbd "<C-return>") 'zencoding-expand-line)))
   846     (define-key zencoding-mode-keymap (kbd "<C-return>") 'zencoding-expand-line)))
   501 
   847 
   502 ;;;###autoload
   848 ;;;###autoload
   503 (define-minor-mode zencoding-mode
   849 (define-minor-mode zencoding-mode
   504   "Minor mode for writing HTML and CSS markup.
   850   "Minor mode for writing HTML and CSS markup.
   520 Home page URL `http://www.emacswiki.org/emacs/ZenCoding'.
   866 Home page URL `http://www.emacswiki.org/emacs/ZenCoding'.
   521 
   867 
   522 See also `zencoding-expand-line'."
   868 See also `zencoding-expand-line'."
   523   :lighter " Zen"
   869   :lighter " Zen"
   524   :keymap zencoding-mode-keymap)
   870   :keymap zencoding-mode-keymap)
   525 
       
   526 
   871 
   527 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   872 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   528 ;; Zencoding yasnippet integration
   873 ;; Zencoding yasnippet integration
   529 
   874 
   530 (defun zencoding-transform-yas (ast)
   875 (defun zencoding-transform-yas (ast)
   574   "Face for preview output field."
   919   "Face for preview output field."
   575   :group 'zencoding)
   920   :group 'zencoding)
   576 
   921 
   577 (defvar zencoding-preview-keymap
   922 (defvar zencoding-preview-keymap
   578   (let ((map (make-sparse-keymap)))
   923   (let ((map (make-sparse-keymap)))
       
   924     (define-key map (kbd "RET") 'zencoding-preview-accept)
   579     (define-key map (kbd "<return>") 'zencoding-preview-accept)
   925     (define-key map (kbd "<return>") 'zencoding-preview-accept)
   580     (define-key map [(control ?g)] 'zencoding-preview-abort)
   926     (define-key map [(control ?g)] 'zencoding-preview-abort)
   581     map))
   927     map))
   582 
   928 
   583 (defun zencoding-preview-accept ()
   929 (defun zencoding-preview-accept ()
   699   (let* ((string (buffer-substring-no-properties
  1045   (let* ((string (buffer-substring-no-properties
   700 		  (overlay-start zencoding-preview-input)
  1046 		  (overlay-start zencoding-preview-input)
   701 		  (overlay-end zencoding-preview-input)))
  1047 		  (overlay-end zencoding-preview-input)))
   702 	 (ast    (car (zencoding-expr string))))
  1048 	 (ast    (car (zencoding-expr string))))
   703     (when (not (eq ast 'error))
  1049     (when (not (eq ast 'error))
   704       (zencoding-prettify (zencoding-transform ast)
  1050       (let ((output (zencoding-transform ast)))
   705                           indent))))
  1051         (when output
       
  1052           (zencoding-prettify output indent))))))
   706 
  1053 
   707 (defun zencoding-update-preview (indent)
  1054 (defun zencoding-update-preview (indent)
   708   (let* ((pretty (zencoding-preview-transformed indent))
  1055   (let* ((pretty (zencoding-preview-transformed indent))
   709          (show (when pretty
  1056          (show (when pretty
   710                  (propertize pretty 'face 'highlight))))
  1057                  (propertize pretty 'face 'highlight))))
   711     (when show
  1058     (when show
   712       (overlay-put zencoding-preview-output 'after-string
  1059       (overlay-put zencoding-preview-output 'after-string
   713                    (concat show "\n")))))
  1060                    (concat show "\n")))))
   714 ;; a+bc
       
   715 
       
   716 ;;;;;;;;;;
       
   717 ;; Chris's version
       
   718 
       
   719 ;; (defvar zencoding-realtime-preview-keymap
       
   720 ;;   (let ((map (make-sparse-keymap)))
       
   721 ;;     (define-key map "\C-c\C-c" 'zencoding-delete-overlay-pair)
       
   722 
       
   723 ;;     map)
       
   724 ;;   "Keymap used in zencoding realtime preview overlays.")
       
   725 
       
   726 ;; ;;;###autoload
       
   727 ;; (defun zencoding-realtime-preview-of-region (beg end)
       
   728 ;;   "Construct a real-time preview for the region BEG to END."
       
   729 ;;   (interactive "r")
       
   730 ;;   (let ((beg2)
       
   731 ;; 	(end2))
       
   732 ;;     (save-excursion
       
   733 ;;       (goto-char beg)
       
   734 ;;       (forward-line)
       
   735 ;;       (setq beg2 (point)
       
   736 ;; 	    end2 (point))
       
   737 ;;       (insert "\n"))
       
   738 ;;     (let ((input-and-output (zencoding-make-overlay-pair beg end beg2 end2)))
       
   739 ;;       (zencoding-handle-overlay-change (car input-and-output) nil nil nil)))
       
   740 ;;   )
       
   741 
       
   742 ;; (defun zencoding-make-overlay-pair (beg1 end1 beg2 end2)
       
   743 ;;   "Construct an input and an output overlay for BEG1 END1 and BEG2 END2"
       
   744 ;;   (let ((input  (make-overlay beg1 end1 nil t t))
       
   745 ;; 	(output (make-overlay beg2 end2)))
       
   746 ;;     ;; Setup input overlay
       
   747 ;;     (overlay-put input  'face '(:underline t))
       
   748 ;;     (overlay-put input  'modification-hooks
       
   749 ;; 		        (list #'zencoding-handle-overlay-change))
       
   750 ;;     (overlay-put input  'output output)
       
   751 ;;     (overlay-put input  'keymap zencoding-realtime-preview-keymap)
       
   752 ;;     ;; Setup output overlay
       
   753 ;;     (overlay-put output 'face '(:overline t))
       
   754 ;;     (overlay-put output 'intangible t)
       
   755 ;;     (overlay-put output 'input input)
       
   756 ;;     ;; Return the overlays.
       
   757 ;;     (list input output))
       
   758 ;;   )
       
   759 
       
   760 ;; (defun zencoding-delete-overlay-pair (&optional one)
       
   761 ;;   "Delete a pair of input and output overlays based on ONE."
       
   762 ;;   (interactive) ;; Since called from keymap
       
   763 ;;   (unless one
       
   764 ;;     (let ((overlays (overlays-at (point))))
       
   765 ;;       (while (and overlays
       
   766 ;; 		  (not (or (overlay-get (car overlays) 'input)
       
   767 ;; 			   (overlay-get (car overlays) 'output))))
       
   768 ;; 	(setq overlays (cdr overlays)))
       
   769 ;;       (setq one (car overlays))))
       
   770 ;;   (when one
       
   771 ;;     (let ((other (or (overlay-get one 'input)
       
   772 ;; 		     (overlay-get one 'output))))
       
   773 ;;       (delete-overlay one)
       
   774 ;;       (delete-overlay other)))
       
   775 ;;   )
       
   776 
       
   777 ;; (defun zencoding-handle-overlay-change (input del beg end &optional old)
       
   778 ;;   "Update preview after overlay change."
       
   779 ;;   (let* ((output (overlay-get input 'output))
       
   780 ;; 	 (start  (overlay-start output))
       
   781 ;; 	 (string (buffer-substring-no-properties
       
   782 ;; 		  (overlay-start input)
       
   783 ;; 		  (overlay-end input)))
       
   784 ;; 	 (ast    (car (zencoding-expr string)))
       
   785 ;; 	 (markup (when (not (eq ast 'error))
       
   786 ;; 		   (zencoding-transform ast))))
       
   787 ;;     (save-excursion
       
   788 ;;       (delete-region start (overlay-end output))
       
   789 ;;       (goto-char start)
       
   790 ;;       (if markup
       
   791 ;; 	  (insert markup)
       
   792 ;; 	(insert (propertize "error" 'face 'font-lock-error-face)))
       
   793 ;;       (move-overlay output start (point))))
       
   794 ;;   )
       
   795 
  1061 
   796 (provide 'zencoding-mode)
  1062 (provide 'zencoding-mode)
   797 
  1063 
   798 ;;; zencoding-mode.el ends here
  1064 ;;; zencoding-mode.el ends here