diff -r e1b82f67f96e -r d4adcd3d5ef9 thirdparty/zencoding-mode.el --- a/thirdparty/zencoding-mode.el Sat Jun 22 22:54:53 2013 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1064 +0,0 @@ -;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup - -;; Copyright (C) 2009, Chris Done - -;; Version: 0.5.1 -;; Author: Chris Done -;; URL: https://github.com/rooney/zencoding -;; Last-Updated: 2011-12-31 Sat -;; Keywords: convenience - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Unfold CSS-selector-like expressions to markup. Intended to be used -;; with sgml-like languages; xml, html, xhtml, xsl, etc. -;; -;; See `zencoding-mode' for more information. -;; -;; Copy zencoding-mode.el to your load-path and add to your .emacs: -;; -;; (require 'zencoding-mode) -;; -;; Example setup: -;; -;; (add-to-list 'load-path "~/Emacs/zencoding/") -;; (require 'zencoding-mode) -;; (add-hook 'sgml-mode-hook 'zencoding-mode) ;; Auto-start on any markup modes -;; -;; Enable the minor mode with M-x zencoding-mode. -;; -;; See ``Test cases'' section for a complete set of expression types. -;; -;; If you are hacking on this project, eval (zencoding-test-cases) to -;; ensure that your changes have not broken anything. Feel free to add -;; new test cases if you add new features. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; History: -;; -;; Modified by Lennart Borgman. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(defconst zencoding-mode:version "0.5.1") - -;; Include the trie data structure for caching -;(require 'zencoding-trie) - -(require 'cl) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Generic parsing macros and utilities - -(defmacro zencoding-aif (test-form then-form &rest else-forms) - "Anaphoric if. Temporary variable `it' is the result of test-form." - `(let ((it ,test-form)) - (if it ,then-form ,@(or else-forms '(it))))) - -(defmacro zencoding-pif (test-form then-form &rest else-forms) - "Parser anaphoric if. Temporary variable `it' is the result of test-form." - `(let ((it ,test-form)) - (if (not (eq 'error (car it))) ,then-form ,@(or else-forms '(it))))) - -(defmacro zencoding-parse (regex nums label &rest body) - "Parse according to a regex and update the `input' variable." - `(zencoding-aif (zencoding-regex ,regex input ',(number-sequence 0 nums)) - (let ((input (elt it ,nums))) - ,@body) - `,`(error ,(concat "expected " ,label)))) - -(defmacro zencoding-run (parser then-form &rest else-forms) - "Run a parser and update the input properly, extract the parsed - expression." - `(zencoding-pif (,parser input) - (let ((input (cdr it)) - (expr (car it))) - ,then-form) - ,@(or else-forms '(it)))) - -(defmacro zencoding-por (parser1 parser2 then-form &rest else-forms) - "OR two parsers. Try one parser, if it fails try the next." - `(zencoding-pif (,parser1 input) - (let ((input (cdr it)) - (expr (car it))) - ,then-form) - (zencoding-pif (,parser2 input) - (let ((input (cdr it)) - (expr (car it))) - ,then-form) - ,@else-forms))) - -(defun zencoding-regex (regexp string refs) - "Return a list of (`ref') matches for a `regex' on a `string' or nil." - (if (string-match (concat "^" regexp "\\([^\n]*\\)$") string) - (mapcar (lambda (ref) (match-string ref string)) - (if (sequencep refs) refs (list refs))) - nil)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Zen coding parsers - -(defun zencoding-expr (input) - "Parse a zen coding expression with optional filters." - (zencoding-pif (zencoding-parse "\\(.*?\\)|" 2 "expr|filter" it) - (let ((input (elt it 1)) - (filters (elt it 2))) - (zencoding-pif (zencoding-extract-filters filters) - (zencoding-filter input it) - it)) - (zencoding-filter input (zencoding-default-filter)))) - -(defun zencoding-subexpr (input) - "Parse a zen coding expression with no filter. This pretty much defines precedence." - (zencoding-run zencoding-siblings - it - (zencoding-run zencoding-parent-child - it - (zencoding-run zencoding-multiplier - it - (zencoding-run zencoding-pexpr - it - (zencoding-run zencoding-tag - it - '(error "no match, expecting ( or a-zA-Z0-9"))))))) - -(defun zencoding-extract-filters (input) - "Extract filters from expression." - (zencoding-pif (zencoding-parse "\\([^\\|]+?\\)|" 2 "" it) - (let ((filter-name (elt it 1)) - (more-filters (elt it 2))) - (zencoding-pif (zencoding-extract-filters more-filters) - (cons filter-name it) - it)) - (zencoding-parse "\\([^\\|]+\\)" 1 "filter name" `(,(elt it 1))))) - -(defun zencoding-filter (input filters) - "Construct AST with specified filters." - (zencoding-pif (zencoding-subexpr input) - (let ((result (car it)) - (rest (cdr it))) - `((filter ,filters ,result) . ,rest)) - it)) - -(defun zencoding-default-filter () - "Default filter(s) to be used if none is specified." - (let* ((file-ext (car (zencoding-regex ".*\\(\\..*\\)" (or (buffer-file-name) "") 1))) - (defaults '(".html" ("html") - ".htm" ("html") - ".haml" ("haml") - ".clj" ("hic"))) - (default-else '("html")) - (selected-default (member file-ext defaults))) - (if selected-default - (cadr selected-default) - default-else))) - -(defun zencoding-multiplier (input) - (zencoding-por zencoding-pexpr zencoding-tag - (let ((multiplier expr)) - (zencoding-parse "\\*\\([0-9]+\\)" 2 "*n where n is a number" - (let ((multiplicand (read (elt it 1)))) - `((list ,(make-list multiplicand multiplier)) . ,input)))) - '(error "expected *n multiplier"))) - -(defun zencoding-tag (input) - "Parse a tag." - (zencoding-run zencoding-tagname - (let ((tagname (cadr expr)) - (has-body? (cddr expr))) - (zencoding-pif (zencoding-run zencoding-identifier - (zencoding-tag-classes - `(tag (,tagname ,has-body? ,(cddr expr))) input) - (zencoding-tag-classes - `(tag (,tagname ,has-body? nil)) input)) - (let ((expr (car it)) - (input (cdr it))) - (zencoding-tag-props expr input)))) - (zencoding-default-tag input))) - -(defun zencoding-default-tag (input) - "Parse a #id or .class" - (zencoding-parse "\\([#|\\.]\\)" 1 "tagname" - (zencoding-tag (concat "div" (elt it 0))))) - -(defun zencoding-tag-props (tag input) - (let ((tag-data (cadr tag))) - (zencoding-run zencoding-props - (let ((props (cdr expr))) - `((tag ,(append tag-data (list props))) . ,input)) - `((tag ,(append tag-data '(nil))) . ,input)))) - -(defun zencoding-props (input) - "Parse many props." - (zencoding-run zencoding-prop - (zencoding-pif (zencoding-props input) - `((props . ,(cons expr (cdar it))) . ,(cdr it)) - `((props . ,(list expr)) . ,input)))) - -(defun zencoding-prop (input) - (zencoding-parse - " " 1 "space" - (zencoding-run - zencoding-name - (let ((name (cdr expr))) - (zencoding-pif (zencoding-prop-value name input) - it - `((,(read name) "") . ,input)))))) - -(defun zencoding-prop-value (name input) - (zencoding-pif (zencoding-parse "=\"\\(.*?\\)\"" 2 - "=\"property value\"" - (let ((value (elt it 1)) - (input (elt it 2))) - `((,(read name) ,value) . ,input))) - it - (zencoding-parse "=\\([^\\,\\+\\>\\ )]*\\)" 2 - "=property value" - (let ((value (elt it 1)) - (input (elt it 2))) - `((,(read name) ,value) . ,input))))) - -(defun zencoding-tag-classes (tag input) - (let ((tag-data (cadr tag))) - (zencoding-run zencoding-classes - (let ((classes (mapcar (lambda (cls) (cdadr cls)) - (cdr expr)))) - `((tag ,(append tag-data (list classes))) . ,input)) - `((tag ,(append tag-data '(nil))) . ,input)))) - -(defun zencoding-tagname (input) - "Parse a tagname a-zA-Z0-9 tagname (e.g. html/head/xsl:if/br)." - (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9:-]*\/?\\)" 2 "tagname, a-zA-Z0-9" - (let* ((tag-spec (elt it 1)) - (empty-tag (zencoding-regex "\\([^\/]*\\)\/" tag-spec 1)) - (tag (if empty-tag - (car empty-tag) - tag-spec))) - `((tagname . (,tag . ,(not empty-tag))) . ,input)))) - -(defun zencoding-pexpr (input) - "A zen coding expression with parentheses around it." - (zencoding-parse "(" 1 "(" - (zencoding-run zencoding-subexpr - (zencoding-aif (zencoding-regex ")" input '(0 1)) - `(,expr . ,(elt it 1)) - '(error "expecting `)'"))))) - -(defun zencoding-parent-child (input) - "Parse an tag>e expression, where `n' is an tag and `e' is any - expression." - (zencoding-run zencoding-multiplier - (let* ((items (cadr expr)) - (rest (zencoding-child-sans expr input))) - (if (not (eq (car rest) 'error)) - (let ((child (car rest)) - (input (cdr rest))) - (cons (cons 'list - (cons (mapcar (lambda (parent) - `(parent-child ,parent ,child)) - items) - nil)) - input)) - '(error "expected child"))) - (zencoding-run zencoding-tag - (zencoding-child expr input) - '(error "expected parent")))) - -(defun zencoding-child-sans (parent input) - (zencoding-parse ">" 1 ">" - (zencoding-run zencoding-subexpr - it - '(error "expected child")))) - -(defun zencoding-child (parent input) - (zencoding-parse ">" 1 ">" - (zencoding-run zencoding-subexpr - (let ((child expr)) - `((parent-child ,parent ,child) . ,input)) - '(error "expected child")))) - -(defun zencoding-sibling (input) - (zencoding-por zencoding-pexpr zencoding-multiplier - it - (zencoding-run zencoding-tag - it - '(error "expected sibling")))) - -(defun zencoding-siblings (input) - "Parse an e+e expression, where e is an tag or a pexpr." - (zencoding-run zencoding-sibling - (let ((parent expr)) - (zencoding-parse "\\+" 1 "+" - (zencoding-run zencoding-subexpr - (let ((child expr)) - `((sibling ,parent ,child) . ,input)) - (zencoding-expand parent input)))) - '(error "expected first sibling"))) - -(defvar zencoding-expandable-tags - '("dl" ">(dt+dd)" - "ol" ">li" - "ul" ">li" - "table" ">tr>td")) - -(defun zencoding-expand (parent input) - "Parse an e+ expression, where e is an expandable tag" - (let* ((parent-tag (car (elt parent 1))) - (expandable (member parent-tag zencoding-expandable-tags))) - (if expandable - (let ((expansion (zencoding-child parent (concat (cadr expandable))))) - (zencoding-pif (zencoding-parse "+\\(.*\\)" 1 "+expr" - (zencoding-subexpr (elt it 1))) - `((sibling ,(car expansion) ,(car it))) - expansion)) - '(error "expected second sibling")))) - -(defun zencoding-name (input) - "Parse a class or identifier name, e.g. news, footer, mainimage" - (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9-_:]*\\)" 2 "class or identifer name" - `((name . ,(elt it 1)) . ,input))) - -(defun zencoding-class (input) - "Parse a classname expression, e.g. .foo" - (zencoding-parse "\\." 1 "." - (zencoding-run zencoding-name - `((class ,expr) . ,input) - '(error "expected class name")))) -(defun zencoding-identifier (input) - "Parse an identifier expression, e.g. #foo" - (zencoding-parse "#" 1 "#" - (zencoding-run zencoding-name - `((identifier . ,expr) . ,input)))) - -(defun zencoding-classes (input) - "Parse many classes." - (zencoding-run zencoding-class - (zencoding-pif (zencoding-classes input) - `((classes . ,(cons expr (cdar it))) . ,(cdr it)) - `((classes . ,(list expr)) . ,input)) - '(error "expected class"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Zen coding transformer from AST to string - -(defvar zencoding-inline-tags - '("a" - "abbr" - "acronym" - "cite" - "code" - "dd" - "dfn" - "dt" - "em" - "h1" "h2" "h3" "h4" "h5" "h6" - "kbd" - "li" - "q" - "span" - "strong" - "var")) - -(defvar zencoding-block-tags - '("p")) - -(defvar zencoding-self-closing-tags - '("br" - "img" - "input")) - -(defvar zencoding-leaf-function nil - "Function to execute when expanding a leaf node in the - Zencoding AST.") - -(defvar zencoding-filters - '("html" (zencoding-primary-filter zencoding-make-html-tag) - "c" (zencoding-primary-filter zencoding-make-commented-html-tag) - "haml" (zencoding-primary-filter zencoding-make-haml-tag) - "hic" (zencoding-primary-filter zencoding-make-hiccup-tag) - "e" (zencoding-escape-xml))) - -(defun zencoding-primary-filter (input proc) - "Process filter that needs to be executed first, ie. not given output from other filter." - (if (listp input) - (let ((tag-maker (cadr proc))) - (zencoding-transform-ast input tag-maker)) - nil)) - -(defun zencoding-process-filter (filters input) - "Process filters, chain one filter output as the input of the next filter." - (let ((filter-data (member (car filters) zencoding-filters)) - (more-filters (cdr filters))) - (if filter-data - (let* ((proc (cadr filter-data)) - (fun (car proc)) - (filter-output (funcall fun input proc))) - (if more-filters - (zencoding-process-filter more-filters filter-output) - filter-output)) - nil))) - -(defun zencoding-make-tag (tag-maker tag-info &optional content) - "Extract tag info and pass them to tag-maker." - (let* ((name (pop tag-info)) - (has-body? (pop tag-info)) - (id (pop tag-info)) - (classes (pop tag-info)) - (props (pop tag-info)) - (self-closing? (not (or content - (and has-body? - (not (member name zencoding-self-closing-tags))))))) - (funcall tag-maker name id classes props self-closing? - (if content content - (if zencoding-leaf-function (funcall zencoding-leaf-function)))))) - -(defun zencoding-make-html-tag (tag-name tag-id tag-classes tag-props self-closing? content) - "Create HTML markup string" - (let* ((id (zencoding-concat-or-empty " id=\"" tag-id "\"")) - (classes (zencoding-mapconcat-or-empty " class=\"" tag-classes " " "\"")) - (props (zencoding-mapconcat-or-empty " " tag-props " " nil - (lambda (prop) - (concat (symbol-name (car prop)) "=\"" (cadr prop) "\"")))) - (content-multiline? (and content (string-match "\n" content))) - (block-tag? (or (member tag-name zencoding-block-tags) - (and (> (length tag-name) 1) - (not (member tag-name zencoding-inline-tags))))) - (lf (if (or content-multiline? block-tag?) - "\n"))) - (concat "<" tag-name id classes props (if self-closing? - "/>" - (concat ">" (if content - (if (or content-multiline? block-tag?) - (zencoding-indent content) - content)) - lf - ""))))) - -(defun zencoding-make-commented-html-tag (tag-name tag-id tag-classes tag-props self-closing? content) - "Create HTML markup string with extra comments for elements with #id or .classes" - (let ((body (zencoding-make-html-tag tag-name tag-id tag-classes tag-props self-closing? content))) - (if (or tag-id tag-classes) - (let ((id (zencoding-concat-or-empty "#" tag-id)) - (classes (zencoding-mapconcat-or-empty "." tag-classes "."))) - (concat "\n" - body - "\n")) - body))) - -(defun zencoding-make-haml-tag (tag-name tag-id tag-classes tag-props self-closing? content) - "Create HAML string" - (let ((name (if (and (equal tag-name "div") - (or tag-id tag-classes)) - "" - (concat "%" tag-name))) - (id (zencoding-concat-or-empty "#" tag-id)) - (classes (zencoding-mapconcat-or-empty "." tag-classes ".")) - (props (zencoding-mapconcat-or-empty "{" tag-props ", " "}" - (lambda (prop) - (concat ":" (symbol-name (car prop)) " => \"" (cadr prop) "\""))))) - (concat name id classes props (if content - (zencoding-indent content))))) - -(defun zencoding-make-hiccup-tag (tag-name tag-id tag-classes tag-props self-closing? content) - "Create Hiccup string" - (let* ((id (zencoding-concat-or-empty "#" tag-id)) - (classes (zencoding-mapconcat-or-empty "." tag-classes ".")) - (props (zencoding-mapconcat-or-empty " {" tag-props ", " "}" - (lambda (prop) - (concat ":" (symbol-name (car prop)) " \"" (cadr prop) "\"")))) - (content-multiline? (and content (string-match "\n" content))) - (block-tag? (or (member tag-name zencoding-block-tags) - (and (> (length tag-name) 1) - (not (member tag-name zencoding-inline-tags)))))) - (concat "[:" tag-name id classes props - (if content - (if (or content-multiline? block-tag?) - (zencoding-indent content) - (concat " " content))) - "]"))) - -(defun zencoding-concat-or-empty (prefix body &optional suffix) - "Return prefixed suffixed text or empty string." - (if body - (concat prefix body suffix) - "")) - -(defun zencoding-mapconcat-or-empty (prefix list-body delimiter &optional suffix map-fun) - "Return prefixed suffixed mapconcated text or empty string." - (if list-body - (let* ((mapper (if map-fun map-fun 'identity)) - (body (mapconcat mapper list-body delimiter))) - (concat prefix body suffix)) - "")) - -(defun zencoding-escape-xml (input proc) - "Escapes XML-unsafe characters: <, > and &." - (replace-regexp-in-string - "<" "<" - (replace-regexp-in-string - ">" ">" - (replace-regexp-in-string - "&" "&" - (if (stringp input) - input - (zencoding-process-filter (zencoding-default-filter) input)))))) - -(defun zencoding-transform (ast-with-filters) - "Transform AST (containing filter data) into string." - (let ((filters (cadr ast-with-filters)) - (ast (caddr ast-with-filters))) - (zencoding-process-filter filters ast))) - -(defun zencoding-transform-ast (ast tag-maker) - "Transform AST (without filter data) into string." - (let ((type (car ast))) - (cond - ((eq type 'list) - (mapconcat (lexical-let ((make-tag-fun tag-maker)) - #'(lambda (sub-ast) - (zencoding-transform-ast sub-ast make-tag-fun))) - (cadr ast) - "\n")) - ((eq type 'tag) - (zencoding-make-tag tag-maker (cadr ast))) - ((eq type 'parent-child) - (let ((parent (cadadr ast)) - (children (zencoding-transform-ast (caddr ast) tag-maker))) - (zencoding-make-tag tag-maker parent children))) - ((eq type 'sibling) - (let ((sib1 (zencoding-transform-ast (cadr ast) tag-maker)) - (sib2 (zencoding-transform-ast (caddr ast) tag-maker))) - (concat sib1 "\n" sib2)))))) - -(defun zencoding-indent (text) - "Indent the text" - (if text - (replace-regexp-in-string "\n" "\n " (concat "\n" text)) - nil)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Test-cases - -(defun zencoding-test-cases () - (let ((tests '(;; Tags - ("a" "") - ("a.x" "") - ("a#q.x" "") - ("a#q.x.y.z" "") - ("#q" "
" - "
") - (".x" "
" - "
") - ("#q.x" "
" - "
") - ("#q.x.y.z" "
" - "
") - ;; Empty tags - ("a/" "") - ("a/.x" "") - ("a/#q.x" "") - ("a/#q.x.y.z" "") - ;; Self-closing tags - ("input type=text" "") - ("img" "") - ("img>metadata/*2" "" - " " - " " - "") - ;; Siblings - ("a+b" "" - "") - ("a+b+c" "" - "" - "") - ("a.x+b" "" - "") - ("a#q.x+b" "" - "") - ("a#q.x.y.z+b" "" - "") - ("a#q.x.y.z+b#p.l.m.n" "" - "") - ;; Tag expansion - ("table+" "" - " " - " " - " " - "
" - "
") - ("dl+" "
" - "
" - "
" - "
") - ("ul+" "") - ("ul++ol+" "" - "
    " - "
  1. " - "
") - ("ul#q.x.y m=l+" "") - ;; Parent > child - ("a>b" "") - ("a>b>c" "") - ("a.x>b" "") - ("a#q.x>b" "") - ("a#q.x.y.z>b" "") - ("a#q.x.y.z>b#p.l.m.n" "") - ("#q>.x" "
" - "
" - "
" - "
") - ("a>b+c" "" - " " - " " - "") - ("a>b+c>d" "" - " " - " " - "") - ;; Multiplication - ("a*1" "") - ("a*2" "" - "") - ("a/*2" "" - "") - ("a*2+b*2" "" - "" - "" - "") - ("a*2>b*2" "" - " " - " " - "" - "" - " " - " " - "") - ("a>b*2" "" - " " - " " - "") - ("a#q.x>b#q.x*2" "" - " " - " " - "") - ("a#q.x>b/#q.x*2" "" - " " - " " - "") - ;; Properties - ("a x" "") - ("a x=" "") - ("a x=\"\"" "") - ("a x=y" "") - ("a x=\"y\"" "") - ("a x=\"()\"" "") - ("a x m" "") - ("a x= m=\"\"" "") - ("a x=y m=l" "") - ("a/ x=y m=l" "") - ("a#foo x=y m=l" "") - ("a.foo x=y m=l" "") - ("a#foo.bar.mu x=y m=l" "") - ("a/#foo.bar.mu x=y m=l" "") - ("a x=y+b" "" - "") - ("a x=y+b x=y" "" - "") - ("a x=y>b" "") - ("a x=y>b x=y" "") - ("a x=y>b x=y+c x=y" "" - " " - " " - "") - ;; Parentheses - ("(a)" "") - ("(a)+(b)" "" - "") - ("a>(b)" "") - ("(a>b)>c" "") - ("(a>b)+c" "" - "") - ("z+(a>b)+c+k" "" - "" - "" - "") - ("(a)*2" "" - "") - ("((a)*2)" "" - "") - ("((a))*2" "" - "") - ("(a>b)*2" "" - "") - ("(a+b)*2" "" - "" - "" - "") - ;; Filter: comment - ("a.b|c" "" - "" - "") - ("#a>.b|c" "" - "
" - " " - "
" - "
" - " " - "
" - "") - ;; Filter: HAML - ("a|haml" "%a") - ("a#q.x.y.z|haml" "%a#q.x.y.z") - ("a#q.x x=y m=l|haml" "%a#q.x{:x => \"y\", :m => \"l\"}") - ("div|haml" "%div") - ("div.footer|haml" ".footer") - (".footer|haml" ".footer") - ("p>a href=#+br|haml" "%p" - " %a{:href => \"#\"}" - " %br") - ;; Filter: Hiccup - ("a|hic" "[:a]") - ("a#q.x.y.z|hic" "[:a#q.x.y.z]") - ("a#q.x x=y m=l|hic" "[:a#q.x {:x \"y\", :m \"l\"}]") - (".footer|hic" "[:div.footer]") - ("p>a href=#+br|hic" "[:p" - " [:a {:href \"#\"}]" - " [:br]]") - ("#q>(a*2>b)+p>b|hic" "[:div#q" - " [:a [:b]]" - " [:a [:b]]" - " [:p" - " [:b]]]") - ;; Filter: escape - ("script src="|e" "<script src=\"&quot;\">" - "</script>") - ))) - (mapc (lambda (input) - (let ((expected (mapconcat 'identity (cdr input) "\n")) - (actual (zencoding-transform (car (zencoding-expr (car input)))))) - (if (not (equal expected actual)) - (error (concat "Assertion " (car input) " failed:" - expected - " == " - actual))))) - tests) - (concat (number-to-string (length tests)) " tests performed. All OK."))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Zencoding minor mode - -(defgroup zencoding nil - "Customization group for zencoding-mode." - :group 'convenience) - -(defun zencoding-expr-on-line () - "Extract a zencoding expression and the corresponding bounds - for the current line." - (let* ((start (line-beginning-position)) - (end (line-end-position)) - (line (buffer-substring-no-properties start end)) - (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2))) - (if (first expr) - (list (first expr) start end)))) - -(defcustom zencoding-indentation 4 - "Number of spaces used for indentation." - :type '(number :tag "Spaces") - :group 'zencoding) - -(defun zencoding-prettify (markup indent) - (let ((first-col (format (format "%%%ds" indent) "")) - (tab (format (format "%%%ds" zencoding-indentation) ""))) - (concat first-col - (replace-regexp-in-string "\n" (concat "\n" first-col) - (replace-regexp-in-string " " tab markup))))) - -;;;###autoload -(defun zencoding-expand-line (arg) - "Replace the current line's zencode expression with the corresponding expansion. -If prefix ARG is given or region is visible call `zencoding-preview' to start an -interactive preview. - -Otherwise expand line directly. - -For more information see `zencoding-mode'." - (interactive "P") - (let* ((here (point)) - (preview (if zencoding-preview-default (not arg) arg)) - (beg (if preview - (progn - (beginning-of-line) - (skip-chars-forward " \t") - (point)) - (when mark-active (region-beginning)))) - (end (if preview - (progn - (end-of-line) - (skip-chars-backward " \t") - (point)) - (when mark-active (region-end))))) - (if beg - (progn - (goto-char here) - (zencoding-preview beg end)) - (let ((expr (zencoding-expr-on-line))) - (if expr - (let* ((markup (zencoding-transform (car (zencoding-expr (first expr))))) - (pretty (zencoding-prettify markup (current-indentation)))) - (save-excursion - (delete-region (second expr) (third expr)) - (zencoding-insert-and-flash pretty)))))))) - -(defvar zencoding-mode-keymap nil - "Keymap for zencode minor mode.") - -(if zencoding-mode-keymap - nil - (progn - (setq zencoding-mode-keymap (make-sparse-keymap)) - (define-key zencoding-mode-keymap (kbd "C-j") 'zencoding-expand-line) - (define-key zencoding-mode-keymap (kbd "") 'zencoding-expand-line))) - -;;;###autoload -(define-minor-mode zencoding-mode - "Minor mode for writing HTML and CSS markup. -With zen coding for HTML and CSS you can write a line like - - ul#name>li.item*2 - -and have it expanded to - -
    -
  • -
  • -
- -This minor mode defines keys for quick access: - -\\{zencoding-mode-keymap} - -Home page URL `http://www.emacswiki.org/emacs/ZenCoding'. - -See also `zencoding-expand-line'." - :lighter " Zen" - :keymap zencoding-mode-keymap) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Zencoding yasnippet integration - -(defun zencoding-transform-yas (ast) - (let* ((leaf-count 0) - (zencoding-leaf-function - (lambda () - (format "$%d" (incf leaf-count))))) - (zencoding-transform ast))) - -;;;###autoload -(defun zencoding-expand-yas () - (interactive) - (let ((expr (zencoding-expr-on-line))) - (if expr - (let* ((markup (zencoding-transform-yas (car (zencoding-expr (first expr))))) - (filled (replace-regexp-in-string "><" ">\n<" markup))) - (delete-region (second expr) (third expr)) - (insert filled) - (indent-region (second expr) (point)) - (yas/expand-snippet - (buffer-substring (second expr) (point)) - (second expr) (point)))))) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Real-time preview -;; - -;;;;;;;;;; -;; Lennart's version - -(defvar zencoding-preview-input nil) -(make-local-variable 'zencoding-preview-input) -(defvar zencoding-preview-output nil) -(make-local-variable 'zencoding-preview-output) -(defvar zencoding-old-show-paren nil) -(make-local-variable 'zencoding-old-show-paren) - -(defface zencoding-preview-input - '((default :box t :inherit secondary-selection)) - "Face for preview input field." - :group 'zencoding) - -(defface zencoding-preview-output - '((default :inherit highlight)) - "Face for preview output field." - :group 'zencoding) - -(defvar zencoding-preview-keymap - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'zencoding-preview-accept) - (define-key map (kbd "") 'zencoding-preview-accept) - (define-key map [(control ?g)] 'zencoding-preview-abort) - map)) - -(defun zencoding-preview-accept () - (interactive) - (let ((ovli zencoding-preview-input)) - (if (not (and (overlayp ovli) - (bufferp (overlay-buffer ovli)))) - (message "Preview is not active") - (let* ((indent (current-indentation)) - (markup (zencoding-preview-transformed indent))) - (when markup - (delete-region (line-beginning-position) (overlay-end ovli)) - (zencoding-insert-and-flash markup))))) - (zencoding-preview-abort)) - -(defvar zencoding-flash-ovl nil) -(make-variable-buffer-local 'zencoding-flash-ovl) - -(defun zencoding-remove-flash-ovl (buf) - (with-current-buffer buf - (when (overlayp zencoding-flash-ovl) - (delete-overlay zencoding-flash-ovl)) - (setq zencoding-flash-ovl nil))) - -(defcustom zencoding-preview-default t - "If non-nil then preview is the default action. -This determines how `zencoding-expand-line' works by default." - :type 'boolean - :group 'zencoding) - -(defcustom zencoding-insert-flash-time 0.5 - "Time to flash insertion. -Set this to a negative number if you do not want flashing the -expansion after insertion." - :type '(number :tag "Seconds") - :group 'zencoding) - -(defun zencoding-insert-and-flash (markup) - (zencoding-remove-flash-ovl (current-buffer)) - (let ((here (point))) - (insert markup) - (setq zencoding-flash-ovl (make-overlay here (point))) - (overlay-put zencoding-flash-ovl 'face 'zencoding-preview-output) - (when (< 0 zencoding-insert-flash-time) - (run-with-idle-timer zencoding-insert-flash-time - nil 'zencoding-remove-flash-ovl (current-buffer))))) - -;;;###autoload -(defun zencoding-preview (beg end) - "Expand zencode between BEG and END interactively. -This will show a preview of the expanded zen code and you can -accept it or skip it." - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list nil nil))) - (zencoding-preview-abort) - (if (not beg) - (message "Region not active") - (setq zencoding-old-show-paren show-paren-mode) - (show-paren-mode -1) - (let ((here (point))) - (goto-char beg) - (forward-line 1) - (unless (= 0 (current-column)) - (insert "\n")) - (let* ((opos (point)) - (ovli (make-overlay beg end nil nil t)) - (ovlo (make-overlay opos opos)) - (info (propertize " Zen preview. Choose with RET. Cancel by stepping out. \n" - 'face 'tooltip))) - (overlay-put ovli 'face 'zencoding-preview-input) - (overlay-put ovli 'keymap zencoding-preview-keymap) - (overlay-put ovlo 'face 'zencoding-preview-output) - (overlay-put ovlo 'before-string info) - (setq zencoding-preview-input ovli) - (setq zencoding-preview-output ovlo) - (add-hook 'before-change-functions 'zencoding-preview-before-change t t) - (goto-char here) - (add-hook 'post-command-hook 'zencoding-preview-post-command t t))))) - -(defvar zencoding-preview-pending-abort nil) -(make-variable-buffer-local 'zencoding-preview-pending-abort) - -(defun zencoding-preview-before-change (beg end) - (when - (or (> beg (overlay-end zencoding-preview-input)) - (< beg (overlay-start zencoding-preview-input)) - (> end (overlay-end zencoding-preview-input)) - (< end (overlay-start zencoding-preview-input))) - (setq zencoding-preview-pending-abort t))) - -(defun zencoding-preview-abort () - "Abort zen code preview." - (interactive) - (setq zencoding-preview-pending-abort nil) - (remove-hook 'before-change-functions 'zencoding-preview-before-change t) - (when (overlayp zencoding-preview-input) - (delete-overlay zencoding-preview-input)) - (setq zencoding-preview-input nil) - (when (overlayp zencoding-preview-output) - (delete-overlay zencoding-preview-output)) - (setq zencoding-preview-output nil) - (remove-hook 'post-command-hook 'zencoding-preview-post-command t) - (when zencoding-old-show-paren (show-paren-mode 1))) - -(defun zencoding-preview-post-command () - (condition-case err - (zencoding-preview-post-command-1) - (error (message "zencoding-preview-post: %s" err)))) - -(defun zencoding-preview-post-command-1 () - (if (and (not zencoding-preview-pending-abort) - (<= (point) (overlay-end zencoding-preview-input)) - (>= (point) (overlay-start zencoding-preview-input))) - (zencoding-update-preview (current-indentation)) - (zencoding-preview-abort))) - -(defun zencoding-preview-transformed (indent) - (let* ((string (buffer-substring-no-properties - (overlay-start zencoding-preview-input) - (overlay-end zencoding-preview-input))) - (ast (car (zencoding-expr string)))) - (when (not (eq ast 'error)) - (let ((output (zencoding-transform ast))) - (when output - (zencoding-prettify output indent)))))) - -(defun zencoding-update-preview (indent) - (let* ((pretty (zencoding-preview-transformed indent)) - (show (when pretty - (propertize pretty 'face 'highlight)))) - (when show - (overlay-put zencoding-preview-output 'after-string - (concat show "\n"))))) - -(provide 'zencoding-mode) - -;;; zencoding-mode.el ends here