zencoding-mode.el
changeset 35 4a9c440b6764
parent 34 8e91ec6fd0a2
child 36 d915699fbc26
equal deleted inserted replaced
34:8e91ec6fd0a2 35:4a9c440b6764
     1 ;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup
       
     2 ;;
       
     3 ;; Copyright (C) 2009, Chris Done
       
     4 ;;
       
     5 ;; Author: Chris Done <[email protected]>
       
     6 (defconst zencoding-mode:version "0.5")
       
     7 ;; Last-Updated: 2009-11-20 Fri
       
     8 ;; Keywords: convenience
       
     9 ;;
       
    10 ;; 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 ;; the Free Software Foundation; either version 3, or (at your option)
       
    13 ;; any later version.
       
    14 ;;
       
    15 ;; This file is distributed in the hope that it will be useful,
       
    16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
       
    18 ;; GNU General Public License for more details.
       
    19 ;;
       
    20 ;; 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 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
       
    23 ;; Boston, MA 02110-1301, USA.
       
    24 ;;
       
    25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
    26 ;;
       
    27 ;;; Commentary:
       
    28 ;;
       
    29 ;; Unfold CSS-selector-like expressions to markup. Intended to be used
       
    30 ;; with sgml-like languages; xml, html, xhtml, xsl, etc.
       
    31 ;;
       
    32 ;; See `zencoding-mode' for more information.
       
    33 ;;
       
    34 ;; Copy zencoding-mode.el to your load-path and add to your .emacs:
       
    35 ;;
       
    36 ;;    (require 'zencoding-mode)
       
    37 ;;
       
    38 ;; Example setup:
       
    39 ;;
       
    40 ;;    (add-to-list 'load-path "~/Emacs/zencoding/")
       
    41 ;;    (require 'zencoding-mode)
       
    42 ;;    (add-hook 'sgml-mode-hook 'zencoding-mode) ;; Auto-start on any markup modes
       
    43 ;;
       
    44 ;; Enable the minor mode with M-x zencoding-mode.
       
    45 ;;
       
    46 ;; See ``Test cases'' section for a complete set of expression types.
       
    47 ;;
       
    48 ;; If you are hacking on this project, eval (zencoding-test-cases) to
       
    49 ;; ensure that your changes have not broken anything. Feel free to add
       
    50 ;; new test cases if you add new features.
       
    51 ;;
       
    52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
    53 ;;
       
    54 ;;; History:
       
    55 ;;
       
    56 ;; Modified by Lennart Borgman.
       
    57 ;;
       
    58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
    59 ;;
       
    60 ;;; Code:
       
    61 
       
    62 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
    63 ;; Generic parsing macros and utilities
       
    64 
       
    65 (defmacro zencoding-aif (test-form then-form &rest else-forms)
       
    66   "Anaphoric if. Temporary variable `it' is the result of test-form."
       
    67   `(let ((it ,test-form))
       
    68      (if it ,then-form ,@(or else-forms '(it)))))
       
    69 
       
    70 (defmacro zencoding-pif (test-form then-form &rest else-forms)
       
    71   "Parser anaphoric if. Temporary variable `it' is the result of test-form."
       
    72   `(let ((it ,test-form))
       
    73      (if (not (eq 'error (car it))) ,then-form ,@(or else-forms '(it)))))
       
    74 
       
    75 (defmacro zencoding-parse (regex nums label &rest body)
       
    76   "Parse according to a regex and update the `input' variable."
       
    77   `(zencoding-aif (zencoding-regex ,regex input ',(number-sequence 0 nums))
       
    78                   (let ((input (elt it ,nums)))
       
    79                     ,@body)
       
    80                   `,`(error ,(concat "expected " ,label))))
       
    81 
       
    82 (defmacro zencoding-run (parser then-form &rest else-forms)
       
    83   "Run a parser and update the input properly, extract the parsed
       
    84    expression."
       
    85   `(zencoding-pif (,parser input)
       
    86                   (let ((input (cdr it))
       
    87                         (expr (car it)))
       
    88                     ,then-form)
       
    89                   ,@(or else-forms '(it))))
       
    90 
       
    91 (defmacro zencoding-por (parser1 parser2 then-form &rest else-forms)
       
    92   "OR two parsers. Try one parser, if it fails try the next."
       
    93   `(zencoding-pif (,parser1 input)
       
    94                   (let ((input (cdr it))
       
    95                         (expr (car it)))
       
    96                     ,then-form)
       
    97                   (zencoding-pif (,parser2 input)
       
    98                                  (let ((input (cdr it))
       
    99                                        (expr (car it)))
       
   100                                    ,then-form)
       
   101                                  ,@else-forms)))
       
   102 
       
   103 (defun zencoding-regex (regexp string refs)
       
   104   "Return a list of (`ref') matches for a `regex' on a `string' or nil."
       
   105   (if (string-match (concat "^" regexp "\\([^\n]*\\)$") string)
       
   106       (mapcar (lambda (ref) (match-string ref string))
       
   107               (if (sequencep refs) refs (list refs)))
       
   108     nil))
       
   109 
       
   110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   111 ;; Zen coding parsers
       
   112 
       
   113 (defun zencoding-expr (input)
       
   114   "Parse a zen coding expression. This pretty much defines precedence."
       
   115   (zencoding-run zencoding-siblings
       
   116                  it
       
   117                  (zencoding-run zencoding-parent-child
       
   118                                 it
       
   119                                 (zencoding-run zencoding-multiplier
       
   120                                                it
       
   121                                                (zencoding-run zencoding-pexpr
       
   122                                                               it
       
   123                                                               (zencoding-run zencoding-tag
       
   124                                                                              it
       
   125                                                                              '(error "no match, expecting ( or a-zA-Z0-9")))))))
       
   126 
       
   127 (defun zencoding-multiplier (input)
       
   128   (zencoding-por zencoding-pexpr zencoding-tag
       
   129                  (let ((multiplier expr))
       
   130                    (zencoding-parse "\\*\\([0-9]+\\)" 2 "*n where n is a number"
       
   131                                     (let ((multiplicand (read (elt it 1))))
       
   132                                       `((list ,(make-list multiplicand multiplier)) . ,input))))
       
   133                  '(error "expected *n multiplier")))
       
   134 
       
   135 (defun zencoding-tag (input)
       
   136   "Parse a tag."
       
   137   (zencoding-run zencoding-tagname
       
   138                  (let ((result it)
       
   139                        (tagname (cdr expr)))
       
   140                    (zencoding-pif (zencoding-run zencoding-identifier
       
   141                                                  (zencoding-tag-classes
       
   142                                                   `(tag ,tagname ((id ,(cddr expr)))) input)
       
   143                                                  (zencoding-tag-classes `(tag ,tagname ()) input))
       
   144                                   (let ((expr-and-input it) (expr (car it)) (input (cdr it)))
       
   145                                     (zencoding-pif (zencoding-tag-props expr input)
       
   146                                                    it
       
   147                                                    expr-and-input))))
       
   148                  '(error "expected tagname")))
       
   149 
       
   150 (defun zencoding-tag-props (tag input)
       
   151   (zencoding-run zencoding-props
       
   152                  (let ((tagname (cadr tag))
       
   153                        (existing-props (caddr tag))
       
   154                        (props (cdr expr)))
       
   155                    `((tag ,tagname
       
   156                           ,(append existing-props props))
       
   157                      . ,input))))
       
   158 
       
   159 (defun zencoding-props (input)
       
   160   "Parse many props."
       
   161     (zencoding-run zencoding-prop
       
   162                    (zencoding-pif (zencoding-props input)
       
   163                                   `((props . ,(cons expr (cdar it))) . ,(cdr it))
       
   164                                   `((props . ,(list expr)) . ,input))))
       
   165 
       
   166 (defun zencoding-prop (input)
       
   167   (zencoding-parse
       
   168    " " 1 "space"
       
   169    (zencoding-run
       
   170     zencoding-name
       
   171     (let ((name (cdr expr)))
       
   172       (zencoding-parse "=\\([^\\,\\+\\>\\ )]*\\)" 2
       
   173                        "=property value"
       
   174                        (let ((value (elt it 1))
       
   175                              (input (elt it 2)))
       
   176                          `((,(read name) ,value) . ,input)))))))
       
   177 
       
   178 (defun zencoding-tag-classes (tag input)
       
   179   (zencoding-run zencoding-classes
       
   180                  (let ((tagname (cadr tag))
       
   181                        (props (caddr tag))
       
   182                        (classes `(class ,(mapconcat
       
   183                                           (lambda (prop)
       
   184                                             (cdadr prop))
       
   185                                           (cdr expr)
       
   186                                           " "))))
       
   187                    `((tag ,tagname ,(append props (list classes))) . ,input))
       
   188                  `(,tag . ,input)))
       
   189 
       
   190 (defun zencoding-tagname (input)
       
   191   "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"
       
   193                    `((tagname . ,(elt it 1)) . ,input)))
       
   194 
       
   195 (defun zencoding-pexpr (input)
       
   196   "A zen coding expression with parentheses around it."
       
   197   (zencoding-parse "(" 1 "("
       
   198                    (zencoding-run zencoding-expr
       
   199                                   (zencoding-aif (zencoding-regex ")" input '(0 1))
       
   200                                                  `(,expr . ,(elt it 1))
       
   201                                                  '(error "expecting `)'")))))
       
   202 
       
   203 (defun zencoding-parent-child (input)
       
   204   "Parse an tag>e expression, where `n' is an tag and `e' is any
       
   205    expression."
       
   206   (zencoding-run zencoding-multiplier
       
   207                  (let* ((items (cadr expr))
       
   208                         (rest (zencoding-child-sans expr input)))
       
   209                    (if (not (eq (car rest) 'error))
       
   210                        (let ((child (car rest))
       
   211                              (input (cdr rest)))
       
   212                          (cons (cons 'list
       
   213                                      (cons (mapcar (lambda (parent)
       
   214                                                      `(parent-child ,parent ,child))
       
   215                                                    items)
       
   216                                            nil))
       
   217                                input))
       
   218                      '(error "expected child")))
       
   219                  (zencoding-run zencoding-tag
       
   220                                 (zencoding-child expr input)
       
   221                                 '(error "expected parent"))))
       
   222 
       
   223 (defun zencoding-child-sans (parent input)
       
   224   (zencoding-parse ">" 1 ">"
       
   225                    (zencoding-run zencoding-expr
       
   226                                   it
       
   227                                   '(error "expected child"))))
       
   228 
       
   229 (defun zencoding-child (parent input)
       
   230   (zencoding-parse ">" 1 ">"
       
   231                    (zencoding-run zencoding-expr
       
   232                                   (let ((child expr))
       
   233                                     `((parent-child ,parent ,child) . ,input))
       
   234                                   '(error "expected child"))))
       
   235 
       
   236 (defun zencoding-sibling (input)
       
   237   (zencoding-por zencoding-pexpr zencoding-multiplier
       
   238                  it
       
   239                  (zencoding-run zencoding-tag
       
   240                                 it
       
   241                                 '(error "expected sibling"))))
       
   242 
       
   243 (defun zencoding-siblings (input)
       
   244   "Parse an e+e expression, where e is an tag or a pexpr."
       
   245   (zencoding-run zencoding-sibling
       
   246                  (let ((parent expr))
       
   247                    (zencoding-parse "\\+" 1 "+"
       
   248                                     (zencoding-run zencoding-expr
       
   249                                                    (let ((child expr))
       
   250                                                      `((zencoding-siblings ,parent ,child) . ,input))
       
   251                                                    '(error "expected second sibling"))))
       
   252                  '(error "expected first sibling")))
       
   253 
       
   254 (defun zencoding-name (input)
       
   255   "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"
       
   257                    `((name . ,(elt it 1)) . ,input)))
       
   258 
       
   259 (defun zencoding-class (input)
       
   260   "Parse a classname expression, e.g. .foo"
       
   261   (zencoding-parse "\\." 1 "."
       
   262                    (zencoding-run zencoding-name
       
   263                                   `((class ,expr) . ,input)
       
   264                                   '(error "expected class name"))))
       
   265 
       
   266 (defun zencoding-identifier (input)
       
   267   "Parse an identifier expression, e.g. #foo"
       
   268   (zencoding-parse "#" 1 "#"
       
   269                    (zencoding-run zencoding-name
       
   270                                   `((identifier . ,expr) . ,input))))
       
   271 
       
   272 (defun zencoding-classes (input)
       
   273   "Parse many classes."
       
   274   (zencoding-run zencoding-class
       
   275                  (zencoding-pif (zencoding-classes input)
       
   276                                 `((classes . ,(cons expr (cdar it))) . ,(cdr it))
       
   277                                 `((classes . ,(list expr)) . ,input))
       
   278                  '(error "expected class")))
       
   279 
       
   280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   281 ;; Zen coding transformer from AST to HTML
       
   282 
       
   283 ;; Fix-me: make mode specific
       
   284 (defvar zencoding-single-tags
       
   285   '("br"
       
   286     "img"))
       
   287 
       
   288 (defvar zencoding-inline-tags
       
   289   '("a"
       
   290     "abbr"
       
   291     "acronym"
       
   292     "cite"
       
   293     "code"
       
   294     "dfn"
       
   295     "em"
       
   296     "h1" "h2" "h3" "h4" "h5" "h6"
       
   297     "kbd"
       
   298     "q"
       
   299     "span"
       
   300     "strong"
       
   301     "var"))
       
   302 
       
   303 (defvar zencoding-block-tags
       
   304   '("p"))
       
   305 
       
   306 ;; li
       
   307 ;; a
       
   308 ;; em
       
   309 ;; p
       
   310 
       
   311 (defvar zencoding-leaf-function nil
       
   312   "Function to execute when expanding a leaf node in the
       
   313   Zencoding AST.")
       
   314 
       
   315 (defun zencoding-make-tag (tag &optional content)
       
   316   (let* ((name (car tag))
       
   317          (lf (if
       
   318                  (or
       
   319                   (member name zencoding-block-tags)
       
   320                   (and
       
   321                    (> (length name) 1)
       
   322                    (not (member name zencoding-inline-tags))
       
   323                    ))
       
   324                  "\n" ""))
       
   325          (single (member name zencoding-single-tags))
       
   326         (props (apply 'concat (mapcar
       
   327                                (lambda (prop)
       
   328                                  (concat " " (symbol-name (car prop))
       
   329                                          "=\"" (cadr prop) "\""))
       
   330                                (cadr tag)))))
       
   331     (concat lf "<" name props ">" lf
       
   332             (if single
       
   333                 ""
       
   334               (concat
       
   335                (if content content
       
   336                  (if zencoding-leaf-function
       
   337                      (funcall zencoding-leaf-function)
       
   338                    ""))
       
   339                lf "</" name ">")))))
       
   340 
       
   341 (defun zencoding-transform (ast)
       
   342   (let ((type (car ast)))
       
   343     (cond
       
   344      ((eq type 'list)
       
   345       (mapconcat 'zencoding-transform (cadr ast) ""))
       
   346      ((eq type 'tag)
       
   347       (zencoding-make-tag (cdr ast)))
       
   348      ((eq type 'parent-child)
       
   349       (let ((parent (cdadr ast))
       
   350             (children (zencoding-transform (caddr ast))))
       
   351         (zencoding-make-tag parent children)))
       
   352      ((eq type 'zencoding-siblings)
       
   353       (let ((sib1 (zencoding-transform (cadr ast)))
       
   354             (sib2 (zencoding-transform (caddr ast))))
       
   355         (concat sib1 sib2))))))
       
   356 
       
   357 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   358 ;; Test-cases
       
   359 
       
   360 (defun zencoding-test-cases ()
       
   361   (let ((tests '(;; Tags
       
   362                  ("a"                      "<a></a>")
       
   363                  ("a.x"                    "<a class=\"x\"></a>")
       
   364                  ("a#q.x"                  "<a id=\"q\" class=\"x\"></a>")
       
   365                  ("a#q.x.y.z"              "<a id=\"q\" class=\"x y z\"></a>")
       
   366                  ;; Siblings
       
   367                  ("a+b"                    "<a></a><b></b>")
       
   368                  ("a+b+c"                  "<a></a><b></b><c></c>")
       
   369                  ("a.x+b"                  "<a class=\"x\"></a><b></b>")
       
   370                  ("a#q.x+b"                "<a id=\"q\" class=\"x\"></a><b></b>")
       
   371                  ("a#q.x.y.z+b"            "<a id=\"q\" class=\"x y z\"></a><b></b>")
       
   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>")
       
   373                  ;; Parent > child
       
   374                  ("a>b"                    "<a><b></b></a>")
       
   375                  ("a>b>c"                  "<a><b><c></c></b></a>")
       
   376                  ("a.x>b"                  "<a class=\"x\"><b></b></a>")
       
   377                  ("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>")
       
   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>")
       
   380                  ("a>b+c"                  "<a><b></b><c></c></a>")
       
   381                  ("a>b+c>d"                "<a><b></b><c><d></d></c></a>")
       
   382                  ;; Multiplication
       
   383                  ("a*1"                    "<a></a>")
       
   384                  ("a*2"                    "<a></a><a></a>")
       
   385                  ("a*2+b*2"                "<a></a><a></a><b></b><b></b>")
       
   386                  ("a*2>b*2"                "<a><b></b><b></b></a><a><b></b><b></b></a>")
       
   387                  ("a>b*2"                  "<a><b></b><b></b></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>")
       
   389                  ;; Properties
       
   390                  ("a x=y"                  "<a x=\"y\"></a>")
       
   391                  ("a x=y m=l"              "<a x=\"y\" m=\"l\"></a>")
       
   392                  ("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>")
       
   394                  ("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>")
       
   396                  ("a x=y+b x=y"            "<a x=\"y\"></a><b x=\"y\"></b>")
       
   397                  ("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>")
       
   399                  ("a x=y>b x=y+c x=y"      "<a x=\"y\"><b x=\"y\"></b><c x=\"y\"></c></a>")
       
   400                  ;; Parentheses
       
   401                  ("(a)"                    "<a></a>")
       
   402                  ("(a)+(b)"                "<a></a><b></b>")
       
   403                  ("a>(b)"                  "<a><b></b></a>")
       
   404                  ("(a>b)>c"                "<a><b></b></a>")
       
   405                  ("(a>b)+c"                "<a><b></b></a><c></c>")
       
   406                  ("z+(a>b)+c+k"            "<z></z><a><b></b></a><c></c><k></k>")
       
   407                  ("(a)*2"                  "<a></a><a></a>")
       
   408                  ("((a)*2)"                "<a></a><a></a>")
       
   409                  ("((a)*2)"                "<a></a><a></a>")
       
   410                  ("(a>b)*2"                "<a><b></b></a><a><b></b></a>")
       
   411                  ("(a+b)*2"                "<a></a><b></b><a></a><b></b>")
       
   412                  )))
       
   413     (mapc (lambda (input)
       
   414             (let ((expected (cadr input))
       
   415                   (actual (zencoding-transform (car (zencoding-expr (car input))))))
       
   416               (if (not (equal expected actual))
       
   417                   (error (concat "Assertion " (car input) " failed:"
       
   418                                  expected
       
   419                                  " == "
       
   420                                  actual)))))
       
   421             tests)
       
   422     (concat (number-to-string (length tests)) " tests performed. All OK.")))
       
   423 
       
   424 
       
   425 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   426 ;; Zencoding minor mode
       
   427 
       
   428 (defgroup zencoding nil
       
   429   "Customization group for zencoding-mode."
       
   430   :group 'convenience)
       
   431 
       
   432 (defun zencoding-expr-on-line ()
       
   433   "Extract a zencoding expression and the corresponding bounds
       
   434    for the current line."
       
   435   (let* ((start (line-beginning-position))
       
   436          (end (line-end-position))
       
   437          (line (buffer-substring-no-properties start end))
       
   438          (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2)))
       
   439     (if (first expr)
       
   440         (list (first expr) start end))))
       
   441 
       
   442 (defun zencoding-prettify (markup indent)
       
   443   (save-match-data
       
   444     ;;(setq markup (replace-regexp-in-string "><" ">\n<" markup))
       
   445     (setq markup (replace-regexp-in-string "\n\n" "\n" markup))
       
   446     (setq markup (replace-regexp-in-string "^\n" "" markup)))
       
   447   (with-temp-buffer
       
   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 
       
   457 ;;;###autoload
       
   458 (defun zencoding-expand-line (arg)
       
   459   "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
       
   461 interactive preview.
       
   462 
       
   463 Otherwise expand line directly.
       
   464 
       
   465 For more information see `zencoding-mode'."
       
   466   (interactive "P")
       
   467   (let* ((here (point))
       
   468          (preview (if zencoding-preview-default (not arg) arg))
       
   469          (beg (if preview
       
   470                   (progn
       
   471                     (beginning-of-line)
       
   472                     (skip-chars-forward " \t")
       
   473                     (point))
       
   474                 (when mark-active (region-beginning))))
       
   475          (end (if preview
       
   476                   (progn
       
   477                     (end-of-line)
       
   478                     (skip-chars-backward " \t")
       
   479                     (point))
       
   480                 (when mark-active (region-end)))))
       
   481     (if beg
       
   482         (progn
       
   483           (goto-char here)
       
   484           (zencoding-preview beg end))
       
   485       (let ((expr (zencoding-expr-on-line)))
       
   486         (if expr
       
   487             (let* ((markup (zencoding-transform (car (zencoding-expr (first expr)))))
       
   488                    (pretty (zencoding-prettify markup (current-indentation))))
       
   489               (save-excursion
       
   490                 (delete-region (second expr) (third expr))
       
   491                 (zencoding-insert-and-flash pretty))))))))
       
   492 
       
   493 (defvar zencoding-mode-keymap nil
       
   494   "Keymap for zencode minor mode.")
       
   495 
       
   496 (if zencoding-mode-keymap
       
   497     nil
       
   498   (progn
       
   499     (setq zencoding-mode-keymap (make-sparse-keymap))
       
   500     (define-key zencoding-mode-keymap (kbd "<C-return>") 'zencoding-expand-line)))
       
   501 
       
   502 ;;;###autoload
       
   503 (define-minor-mode zencoding-mode
       
   504   "Minor mode for writing HTML and CSS markup.
       
   505 With zen coding for HTML and CSS you can write a line like
       
   506 
       
   507   ul#name>li.item*2
       
   508 
       
   509 and have it expanded to
       
   510 
       
   511   <ul id=\"name\">
       
   512     <li class=\"item\"></li>
       
   513     <li class=\"item\"></li>
       
   514   </ul>
       
   515 
       
   516 This minor mode defines keys for quick access:
       
   517 
       
   518 \\{zencoding-mode-keymap}
       
   519 
       
   520 Home page URL `http://www.emacswiki.org/emacs/ZenCoding'.
       
   521 
       
   522 See also `zencoding-expand-line'."
       
   523   :lighter " Zen"
       
   524   :keymap zencoding-mode-keymap)
       
   525 
       
   526 
       
   527 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   528 ;; Zencoding yasnippet integration
       
   529 
       
   530 (defun zencoding-transform-yas (ast)
       
   531   (let* ((leaf-count 0)
       
   532          (zencoding-leaf-function
       
   533           (lambda ()
       
   534             (format "$%d" (incf leaf-count)))))
       
   535     (zencoding-transform ast)))
       
   536 
       
   537 ;;;###autoload
       
   538 (defun zencoding-expand-yas ()
       
   539   (interactive)
       
   540   (let ((expr (zencoding-expr-on-line)))
       
   541     (if expr
       
   542         (let* ((markup (zencoding-transform-yas (car (zencoding-expr (first expr)))))
       
   543                (filled (replace-regexp-in-string "><" ">\n<" markup)))
       
   544           (delete-region (second expr) (third expr))
       
   545           (insert filled)
       
   546           (indent-region (second expr) (point))
       
   547           (yas/expand-snippet
       
   548            (buffer-substring (second expr) (point))
       
   549            (second expr) (point))))))
       
   550 
       
   551 
       
   552 
       
   553 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
   554 ;;; Real-time preview
       
   555 ;;
       
   556 
       
   557 ;;;;;;;;;;
       
   558 ;; Lennart's version
       
   559 
       
   560 (defvar zencoding-preview-input nil)
       
   561 (make-local-variable 'zencoding-preview-input)
       
   562 (defvar zencoding-preview-output nil)
       
   563 (make-local-variable 'zencoding-preview-output)
       
   564 (defvar zencoding-old-show-paren nil)
       
   565 (make-local-variable 'zencoding-old-show-paren)
       
   566 
       
   567 (defface zencoding-preview-input
       
   568   '((default :box t :inherit secondary-selection))
       
   569   "Face for preview input field."
       
   570   :group 'zencoding)
       
   571 
       
   572 (defface zencoding-preview-output
       
   573   '((default :inherit highlight))
       
   574   "Face for preview output field."
       
   575   :group 'zencoding)
       
   576 
       
   577 (defvar zencoding-preview-keymap
       
   578   (let ((map (make-sparse-keymap)))
       
   579     (define-key map (kbd "<return>") 'zencoding-preview-accept)
       
   580     (define-key map [(control ?g)] 'zencoding-preview-abort)
       
   581     map))
       
   582 
       
   583 (defun zencoding-preview-accept ()
       
   584   (interactive)
       
   585   (let ((ovli zencoding-preview-input))
       
   586     (if (not (and (overlayp ovli)
       
   587                   (bufferp (overlay-buffer ovli))))
       
   588         (message "Preview is not active")
       
   589       (let* ((indent (current-indentation))
       
   590              (markup (zencoding-preview-transformed indent)))
       
   591         (when markup
       
   592           (delete-region (line-beginning-position) (overlay-end ovli))
       
   593           (zencoding-insert-and-flash markup)))))
       
   594   (zencoding-preview-abort))
       
   595 
       
   596 (defvar zencoding-flash-ovl nil)
       
   597 (make-variable-buffer-local 'zencoding-flash-ovl)
       
   598 
       
   599 (defun zencoding-remove-flash-ovl (buf)
       
   600   (with-current-buffer buf
       
   601     (when (overlayp zencoding-flash-ovl)
       
   602       (delete-overlay zencoding-flash-ovl))
       
   603     (setq zencoding-flash-ovl nil)))
       
   604 
       
   605 (defcustom zencoding-preview-default t
       
   606   "If non-nil then preview is the default action.
       
   607 This determines how `zencoding-expand-line' works by default."
       
   608   :type 'boolean
       
   609   :group 'zencoding)
       
   610 
       
   611 (defcustom zencoding-insert-flash-time 0.5
       
   612   "Time to flash insertion.
       
   613 Set this to a negative number if you do not want flashing the
       
   614 expansion after insertion."
       
   615   :type '(number :tag "Seconds")
       
   616   :group 'zencoding)
       
   617 
       
   618 (defun zencoding-insert-and-flash (markup)
       
   619   (zencoding-remove-flash-ovl (current-buffer))
       
   620   (let ((here (point)))
       
   621     (insert markup)
       
   622     (setq zencoding-flash-ovl (make-overlay here (point)))
       
   623     (overlay-put zencoding-flash-ovl 'face 'zencoding-preview-output)
       
   624     (when (< 0 zencoding-insert-flash-time)
       
   625       (run-with-idle-timer zencoding-insert-flash-time
       
   626                            nil 'zencoding-remove-flash-ovl (current-buffer)))))
       
   627 
       
   628 ;;;###autoload
       
   629 (defun zencoding-preview (beg end)
       
   630   "Expand zencode between BEG and END interactively.
       
   631 This will show a preview of the expanded zen code and you can
       
   632 accept it or skip it."
       
   633   (interactive (if mark-active
       
   634                    (list (region-beginning) (region-end))
       
   635                  (list nil nil)))
       
   636   (zencoding-preview-abort)
       
   637   (if (not beg)
       
   638       (message "Region not active")
       
   639     (setq zencoding-old-show-paren show-paren-mode)
       
   640     (show-paren-mode -1)
       
   641     (let ((here (point)))
       
   642       (goto-char beg)
       
   643       (forward-line 1)
       
   644       (unless (= 0 (current-column))
       
   645         (insert "\n"))
       
   646       (let* ((opos (point))
       
   647              (ovli (make-overlay beg end nil nil t))
       
   648              (ovlo (make-overlay opos opos))
       
   649              (info (propertize " Zen preview. Choose with RET. Cancel by stepping out. \n"
       
   650                                'face 'tooltip)))
       
   651         (overlay-put ovli 'face 'zencoding-preview-input)
       
   652         (overlay-put ovli 'keymap zencoding-preview-keymap)
       
   653         (overlay-put ovlo 'face 'zencoding-preview-output)
       
   654         (overlay-put ovlo 'before-string info)
       
   655         (setq zencoding-preview-input  ovli)
       
   656         (setq zencoding-preview-output ovlo)
       
   657         (add-hook 'before-change-functions 'zencoding-preview-before-change t t)
       
   658         (goto-char here)
       
   659         (add-hook 'post-command-hook 'zencoding-preview-post-command t t)))))
       
   660 
       
   661 (defvar zencoding-preview-pending-abort nil)
       
   662 (make-variable-buffer-local 'zencoding-preview-pending-abort)
       
   663 
       
   664 (defun zencoding-preview-before-change (beg end)
       
   665   (when
       
   666       (or (> beg (overlay-end zencoding-preview-input))
       
   667           (< beg (overlay-start zencoding-preview-input))
       
   668           (> end (overlay-end zencoding-preview-input))
       
   669           (< end (overlay-start zencoding-preview-input)))
       
   670     (setq zencoding-preview-pending-abort t)))
       
   671 
       
   672 (defun zencoding-preview-abort ()
       
   673   "Abort zen code preview."
       
   674   (interactive)
       
   675   (setq zencoding-preview-pending-abort nil)
       
   676   (remove-hook 'before-change-functions 'zencoding-preview-before-change t)
       
   677   (when (overlayp zencoding-preview-input)
       
   678     (delete-overlay zencoding-preview-input))
       
   679   (setq zencoding-preview-input nil)
       
   680   (when (overlayp zencoding-preview-output)
       
   681     (delete-overlay zencoding-preview-output))
       
   682   (setq zencoding-preview-output nil)
       
   683   (remove-hook 'post-command-hook 'zencoding-preview-post-command t)
       
   684   (when zencoding-old-show-paren (show-paren-mode 1)))
       
   685 
       
   686 (defun zencoding-preview-post-command ()
       
   687   (condition-case err
       
   688       (zencoding-preview-post-command-1)
       
   689     (error (message "zencoding-preview-post: %s" err))))
       
   690 
       
   691 (defun zencoding-preview-post-command-1 ()
       
   692   (if (and (not zencoding-preview-pending-abort)
       
   693            (<= (point) (overlay-end zencoding-preview-input))
       
   694            (>= (point) (overlay-start zencoding-preview-input)))
       
   695       (zencoding-update-preview (current-indentation))
       
   696     (zencoding-preview-abort)))
       
   697 
       
   698 (defun zencoding-preview-transformed (indent)
       
   699   (let* ((string (buffer-substring-no-properties
       
   700 		  (overlay-start zencoding-preview-input)
       
   701 		  (overlay-end zencoding-preview-input)))
       
   702 	 (ast    (car (zencoding-expr string))))
       
   703     (when (not (eq ast 'error))
       
   704       (zencoding-prettify (zencoding-transform ast)
       
   705                           indent))))
       
   706 
       
   707 (defun zencoding-update-preview (indent)
       
   708   (let* ((pretty (zencoding-preview-transformed indent))
       
   709          (show (when pretty
       
   710                  (propertize pretty 'face 'highlight))))
       
   711     (when show
       
   712       (overlay-put zencoding-preview-output 'after-string
       
   713                    (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 
       
   796 (provide 'zencoding-mode)
       
   797 
       
   798 ;;; zencoding-mode.el ends here