nxhtml/util/zencoding-mode.el

   1 ;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup
   2 ;;
   3 ;; Copyright (C) 2009, Chris Done
   4 ;;
   5 ;; Author: Chris Done <chrisdone@gmail.com>
   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 (eval-when-compile (require 'cl))
  66
  67 (defcustom zencoding-preview-default t
  68   "If non-nil then preview is the default action.
  69 This determines how `zencoding-expand-line' works by default."
  70   :type 'boolean
  71   :group 'zencoding)
  72
  73 (defcustom zencoding-insert-flash-time 0.5
  74   "Time to flash insertion.
  75 Set this to a negative number if you do not want flashing the
  76 expansion after insertion."
  77   :type '(number :tag "Seconds")
  78   :group 'zencoding)
  79
  80 (defmacro zencoding-aif (test-form then-form &rest else-forms)
  81   "Anaphoric if. Temporary variable `it' is the result of test-form."
  82   `(let ((it ,test-form))
  83      (if it ,then-form ,@(or else-forms '(it)))))
  84
  85 (defmacro zencoding-pif (test-form then-form &rest else-forms)
  86   "Parser anaphoric if. Temporary variable `it' is the result of test-form."
  87   `(let ((it ,test-form))
  88      (if (not (eq 'error (car it))) ,then-form ,@(or else-forms '(it)))))
  89
  90 (defmacro zencoding-parse (regex nums label &rest body)
  91   "Parse according to a regex and update the `input' variable."
  92   `(zencoding-aif (zencoding-regex ,regex input ',(number-sequence 0 nums))
  93                   (let ((input (elt it ,nums)))
  94                     ,@body)
  95                   `,`(error ,(concat "expected " ,label))))
  96
  97 (defmacro zencoding-run (parser then-form &rest else-forms)
  98   "Run a parser and update the input properly, extract the parsed
  99    expression."
 100   `(zencoding-pif (,parser input)
 101                   (let ((input (cdr it))
 102                         (expr (car it)))
 103                     ,then-form)
 104                   ,@(or else-forms '(it))))
 105
 106 (defmacro zencoding-por (parser1 parser2 then-form &rest else-forms)
 107   "OR two parsers. Try one parser, if it fails try the next."
 108   `(zencoding-pif (,parser1 input)
 109                   (let ((input (cdr it))
 110                         (expr (car it)))
 111                     ,then-form)
 112                   (zencoding-pif (,parser2 input)
 113                                  (let ((input (cdr it))
 114                                        (expr (car it)))
 115                                    ,then-form)
 116                                  ,@else-forms)))
 117
 118 (defun zencoding-regex (regexp string refs)
 119   "Return a list of (`ref') matches for a `regex' on a `string' or nil."
 120   (if (string-match (concat "^" regexp "\\([^\n]*\\)$") string)
 121       (mapcar (lambda (ref) (match-string ref string))
 122               (if (sequencep refs) refs (list refs)))
 123     nil))
 124
 125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 126 ;; Zen coding parsers
 127
 128 (defun zencoding-expr (input)
 129   "Parse a zen coding expression. This pretty much defines precedence."
 130   (zencoding-run zencoding-siblings
 131                  it
 132                  (zencoding-run zencoding-parent-child
 133                                 it
 134                                 (zencoding-run zencoding-multiplier
 135                                                it
 136                                                (zencoding-run zencoding-pexpr
 137                                                               it
 138                                                               (zencoding-run zencoding-tag
 139                                                                              it
 140                                                                              '(error "no match, expecting ( or a-zA-Z0-9")))))))
 141
 142 (defun zencoding-multiplier (input)
 143   (zencoding-por zencoding-pexpr zencoding-tag
 144                  (let ((multiplier expr))
 145                    (zencoding-parse "\\*\\([0-9]+\\)" 2 "*n where n is a number"
 146                                     (let ((multiplicand (read (elt it 1))))
 147                                       `((list ,(make-list multiplicand multiplier)) . ,input))))
 148                  '(error "expected *n multiplier")))
 149
 150 (defun zencoding-tag (input)
 151   "Parse a tag."
 152   (zencoding-run zencoding-tagname
 153                  (let ((result it)
 154                        (tagname (cdr expr)))
 155                    (zencoding-pif (zencoding-run zencoding-identifier
 156                                                  (zencoding-tag-classes
 157                                                   `(tag ,tagname ((id ,(cddr expr)))) input)
 158                                                  (zencoding-tag-classes `(tag ,tagname ()) input))
 159                                   (let ((expr-and-input it) (expr (car it)) (input (cdr it)))
 160                                     (zencoding-pif (zencoding-tag-props expr input)
 161                                                    it
 162                                                    expr-and-input))))
 163                  '(error "expected tagname")))
 164
 165 (defun zencoding-tag-props (tag input)
 166   (zencoding-run zencoding-props
 167                  (let ((tagname (cadr tag))
 168                        (existing-props (caddr tag))
 169                        (props (cdr expr)))
 170                    `((tag ,tagname
 171                           ,(append existing-props props))
 172                      . ,input))))
 173
 174 (defun zencoding-props (input)
 175   "Parse many props."
 176     (zencoding-run zencoding-prop
 177                    (zencoding-pif (zencoding-props input)
 178                                   `((props . ,(cons expr (cdar it))) . ,(cdr it))
 179                                   `((props . ,(list expr)) . ,input))))
 180
 181 (defun zencoding-prop (input)
 182   (zencoding-parse
 183    " " 1 "space"
 184    (zencoding-run
 185     zencoding-name
 186     (let ((name (cdr expr)))
 187       (zencoding-parse "=\\([^\\,\\+\\>\\ )]*\\)" 2
 188                        "=property value"
 189                        (let ((value (elt it 1))
 190                              (input (elt it 2)))
 191                          `((,(read name) ,value) . ,input)))))))
 192
 193 (defun zencoding-tag-classes (tag input)
 194   (zencoding-run zencoding-classes
 195                  (let ((tagname (cadr tag))
 196                        (props (caddr tag))
 197                        (classes `(class ,(mapconcat
 198                                           (lambda (prop)
 199                                             (cdadr prop))
 200                                           (cdr expr)
 201                                           " "))))
 202                    `((tag ,tagname ,(append props (list classes))) . ,input))
 203                  `(,tag . ,input)))
 204
 205 (defun zencoding-tagname (input)
 206   "Parse a tagname a-zA-Z0-9 tagname (e.g. html/head/xsl:if/br)."
 207   (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9:-]*\\)" 2 "tagname, a-zA-Z0-9"
 208                    `((tagname . ,(elt it 1)) . ,input)))
 209
 210 (defun zencoding-pexpr (input)
 211   "A zen coding expression with parentheses around it."
 212   (zencoding-parse "(" 1 "("
 213                    (zencoding-run zencoding-expr
 214                                   (zencoding-aif (zencoding-regex ")" input '(0 1))
 215                                                  `(,expr . ,(elt it 1))
 216                                                  '(error "expecting `)'")))))
 217
 218 (defun zencoding-parent-child (input)
 219   "Parse an tag>e expression, where `n' is an tag and `e' is any
 220    expression."
 221   (zencoding-run zencoding-multiplier
 222                  (let* ((items (cadr expr))
 223                         (rest (zencoding-child-sans expr input)))
 224                    (if (not (eq (car rest) 'error))
 225                        (let ((child (car rest))
 226                              (input (cdr rest)))
 227                          (cons (cons 'list
 228                                      (cons (mapcar (lambda (parent)
 229                                                      `(parent-child ,parent ,child))
 230                                                    items)
 231                                            nil))
 232                                input))
 233                      '(error "expected child")))
 234                  (zencoding-run zencoding-tag
 235                                 (zencoding-child expr input)
 236                                 '(error "expected parent"))))
 237
 238 (defun zencoding-child-sans (parent input)
 239   (zencoding-parse ">" 1 ">"
 240                    (zencoding-run zencoding-expr
 241                                   it
 242                                   '(error "expected child"))))
 243
 244 (defun zencoding-child (parent input)
 245   (zencoding-parse ">" 1 ">"
 246                    (zencoding-run zencoding-expr
 247                                   (let ((child expr))
 248                                     `((parent-child ,parent ,child) . ,input))
 249                                   '(error "expected child"))))
 250
 251 (defun zencoding-sibling (input)
 252   (zencoding-por zencoding-pexpr zencoding-multiplier
 253                  it
 254                  (zencoding-run zencoding-tag
 255                                 it
 256                                 '(error "expected sibling"))))
 257
 258 (defun zencoding-siblings (input)
 259   "Parse an e+e expression, where e is an tag or a pexpr."
 260   (zencoding-run zencoding-sibling
 261                  (let ((parent expr))
 262                    (zencoding-parse "\\+" 1 "+"
 263                                     (zencoding-run zencoding-expr
 264                                                    (let ((child expr))
 265                                                      `((zencoding-siblings ,parent ,child) . ,input))
 266                                                    '(error "expected second sibling"))))
 267                  '(error "expected first sibling")))
 268
 269 (defun zencoding-name (input)
 270   "Parse a class or identifier name, e.g. news, footer, mainimage"
 271   (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9-_]*\\)" 2 "class or identifer name"
 272                    `((name . ,(elt it 1)) . ,input)))
 273
 274 (defun zencoding-class (input)
 275   "Parse a classname expression, e.g. .foo"
 276   (zencoding-parse "\\." 1 "."
 277                    (zencoding-run zencoding-name
 278                                   `((class ,expr) . ,input)
 279                                   '(error "expected class name"))))
 280
 281 (defun zencoding-identifier (input)
 282   "Parse an identifier expression, e.g. #foo"
 283   (zencoding-parse "#" 1 "#"
 284                    (zencoding-run zencoding-name
 285                                   `((identifier . ,expr) . ,input))))
 286
 287 (defun zencoding-classes (input)
 288   "Parse many classes."
 289   (zencoding-run zencoding-class
 290                  (zencoding-pif (zencoding-classes input)
 291                                 `((classes . ,(cons expr (cdar it))) . ,(cdr it))
 292                                 `((classes . ,(list expr)) . ,input))
 293                  '(error "expected class")))
 294
 295 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 296 ;; Zen coding transformer from AST to HTML
 297
 298 ;; Fix-me: make mode specific
 299 (defvar zencoding-single-tags
 300   '("br"
 301     "img"))
 302
 303 (defvar zencoding-inline-tags
 304   '("a"
 305     "abbr"
 306     "acronym"
 307     "cite"
 308     "code"
 309     "dfn"
 310     "em"
 311     "h1" "h2" "h3" "h4" "h5" "h6"
 312     "kbd"
 313     "q"
 314     "span"
 315     "strong"
 316     "var"))
 317
 318 (defvar zencoding-block-tags
 319   '("p"))
 320
 321 ;; li
 322 ;; a
 323 ;; em
 324 ;; p
 325
 326 (defvar zencoding-leaf-function nil
 327   "Function to execute when expanding a leaf node in the
 328   Zencoding AST.")
 329
 330 (defun zencoding-make-tag (tag &optional content)
 331   (let* ((name (car tag))
 332          (lf (if
 333                  (or
 334                   (member name zencoding-block-tags)
 335                   (and
 336                    (> (length name) 1)
 337                    (not (member name zencoding-inline-tags))
 338                    ))
 339                  "\n" ""))
 340          (single (member name zencoding-single-tags))
 341         (props (apply 'concat (mapcar
 342                                (lambda (prop)
 343                                  (concat " " (symbol-name (car prop))
 344                                          "=\"" (cadr prop) "\""))
 345                                (cadr tag)))))
 346     (concat lf "<" name props ">" lf
 347             (if single
 348                 ""
 349               (concat
 350                (if content content
 351                  (if zencoding-leaf-function
 352                      (funcall zencoding-leaf-function)
 353                    ""))
 354                lf "</" name ">")))))
 355
 356 (defun zencoding-transform (ast)
 357   (let ((type (car ast)))
 358     (cond
 359      ((eq type 'list)
 360       (mapconcat 'zencoding-transform (cadr ast) ""))
 361      ((eq type 'tag)
 362       (zencoding-make-tag (cdr ast)))
 363      ((eq type 'parent-child)
 364       (let ((parent (cdadr ast))
 365             (children (zencoding-transform (caddr ast))))
 366         (zencoding-make-tag parent children)))
 367      ((eq type 'zencoding-siblings)
 368       (let ((sib1 (zencoding-transform (cadr ast)))
 369             (sib2 (zencoding-transform (caddr ast))))
 370         (concat sib1 sib2))))))
 371
 372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 373 ;; Test-cases
 374
 375 (defun zencoding-test-cases ()
 376   (let ((tests '(;; Tags
 377                  ("a"                      "<a></a>")
 378                  ("a.x"                    "<a class=\"x\"></a>")
 379                  ("a#q.x"                  "<a id=\"q\" class=\"x\"></a>")
 380                  ("a#q.x.y.z"              "<a id=\"q\" class=\"x y z\"></a>")
 381                  ;; Siblings
 382                  ("a+b"                    "<a></a><b></b>")
 383                  ("a+b+c"                  "<a></a><b></b><c></c>")
 384                  ("a.x+b"                  "<a class=\"x\"></a><b></b>")
 385                  ("a#q.x+b"                "<a id=\"q\" class=\"x\"></a><b></b>")
 386                  ("a#q.x.y.z+b"            "<a id=\"q\" class=\"x y z\"></a><b></b>")
 387                  ("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>")
 388                  ;; Parent > child
 389                  ("a>b"                    "<a><b></b></a>")
 390                  ("a>b>c"                  "<a><b><c></c></b></a>")
 391                  ("a.x>b"                  "<a class=\"x\"><b></b></a>")
 392                  ("a#q.x>b"                "<a id=\"q\" class=\"x\"><b></b></a>")
 393                  ("a#q.x.y.z>b"            "<a id=\"q\" class=\"x y z\"><b></b></a>")
 394                  ("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>")
 395                  ("a>b+c"                  "<a><b></b><c></c></a>")
 396                  ("a>b+c>d"                "<a><b></b><c><d></d></c></a>")
 397                  ;; Multiplication
 398                  ("a*1"                    "<a></a>")
 399                  ("a*2"                    "<a></a><a></a>")
 400                  ("a*2+b*2"                "<a></a><a></a><b></b><b></b>")
 401                  ("a*2>b*2"                "<a><b></b><b></b></a><a><b></b><b></b></a>")
 402                  ("a>b*2"                  "<a><b></b><b></b></a>")
 403                  ("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>")
 404                  ;; Properties
 405                  ("a x=y"                  "<a x=\"y\"></a>")
 406                  ("a x=y m=l"              "<a x=\"y\" m=\"l\"></a>")
 407                  ("a#foo x=y m=l"          "<a id=\"foo\" x=\"y\" m=\"l\"></a>")
 408                  ("a.foo x=y m=l"          "<a class=\"foo\" x=\"y\" m=\"l\"></a>")
 409                  ("a#foo.bar.mu x=y m=l"   "<a id=\"foo\" class=\"bar mu\" x=\"y\" m=\"l\"></a>")
 410                  ("a x=y+b"                "<a x=\"y\"></a><b></b>")
 411                  ("a x=y+b x=y"            "<a x=\"y\"></a><b x=\"y\"></b>")
 412                  ("a x=y>b"                "<a x=\"y\"><b></b></a>")
 413                  ("a x=y>b x=y"            "<a x=\"y\"><b x=\"y\"></b></a>")
 414                  ("a x=y>b x=y+c x=y"      "<a x=\"y\"><b x=\"y\"></b><c x=\"y\"></c></a>")
 415                  ;; Parentheses
 416                  ("(a)"                    "<a></a>")
 417                  ("(a)+(b)"                "<a></a><b></b>")
 418                  ("a>(b)"                  "<a><b></b></a>")
 419                  ("(a>b)>c"                "<a><b></b></a>")
 420                  ("(a>b)+c"                "<a><b></b></a><c></c>")
 421                  ("z+(a>b)+c+k"            "<z></z><a><b></b></a><c></c><k></k>")
 422                  ("(a)*2"                  "<a></a><a></a>")
 423                  ("((a)*2)"                "<a></a><a></a>")
 424                  ("((a)*2)"                "<a></a><a></a>")
 425                  ("(a>b)*2"                "<a><b></b></a><a><b></b></a>")
 426                  ("(a+b)*2"                "<a></a><b></b><a></a><b></b>")
 427                  )))
 428     (mapc (lambda (input)
 429             (let ((expected (cadr input))
 430                   (actual (zencoding-transform (car (zencoding-expr (car input))))))
 431               (if (not (equal expected actual))
 432                   (error (concat "Assertion " (car input) " failed:"
 433                                  expected
 434                                  " == "
 435                                  actual)))))
 436             tests)
 437     (concat (number-to-string (length tests)) " tests performed. All OK.")))
 438
 439
 440 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 441 ;; Zencoding minor mode
 442
 443 ;;;###autoload
 444 (defgroup zencoding nil
 445   "Customization group for zencoding-mode."
 446   :group 'convenience)
 447
 448 (defun zencoding-expr-on-line ()
 449   "Extract a zencoding expression and the corresponding bounds
 450    for the current line."
 451   (let* ((start (line-beginning-position))
 452          (end (line-end-position))
 453          (line (buffer-substring-no-properties start end))
 454          (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2)))
 455     (if (first expr)
 456         (list (first expr) start end))))
 457
 458 (defun zencoding-prettify (markup indent)
 459   (save-match-data
 460     ;;(setq markup (replace-regexp-in-string "><" ">\n<" markup))
 461     (setq markup (replace-regexp-in-string "\n\n" "\n" markup))
 462     (setq markup (replace-regexp-in-string "^\n" "" markup)))
 463   (with-temp-buffer
 464     (indent-to indent)
 465     (insert "<i></i>")
 466     (insert "\n")
 467     (let ((here (point)))
 468       (insert markup)
 469       (sgml-mode)
 470       (indent-region here (point-max))
 471       (buffer-substring-no-properties here (point-max)))))
 472
 473 ;;;###autoload
 474 (defun zencoding-expand-line (arg)
 475   "Replace the current line's zencode expression with the corresponding expansion.
 476 If prefix ARG is given or region is visible call `zencoding-preview' to start an
 477 interactive preview.
 478
 479 Otherwise expand line directly.
 480
 481 For more information see `zencoding-mode'."
 482   (interactive "P")
 483   (let* ((here (point))
 484          (preview (if zencoding-preview-default (not arg) arg))
 485          (beg (if preview
 486                   (progn
 487                     (beginning-of-line)
 488                     (skip-chars-forward " \t")
 489                     (point))
 490                 (when mark-active (region-beginning))))
 491          (end (if preview
 492                   (progn
 493                     (end-of-line)
 494                     (skip-chars-backward " \t")
 495                     (point))
 496                 (when mark-active (region-end)))))
 497     (if beg
 498         (progn
 499           (goto-char here)
 500           (zencoding-preview beg end))
 501       (let ((expr (zencoding-expr-on-line)))
 502         (if expr
 503             (let* ((markup (zencoding-transform (car (zencoding-expr (first expr)))))
 504                    (pretty (zencoding-prettify markup (current-indentation))))
 505               (save-excursion
 506                 (delete-region (second expr) (third expr))
 507                 (zencoding-insert-and-flash pretty))))))))
 508
 509 (defvar zencoding-mode-keymap nil
 510   "Keymap for zencode minor mode.")
 511
 512 (if zencoding-mode-keymap
 513     nil
 514   (progn
 515     (setq zencoding-mode-keymap (make-sparse-keymap))
 516     (define-key zencoding-mode-keymap (kbd "<C-return>") 'zencoding-expand-line)))
 517
 518 ;;;###autoload
 519 (define-minor-mode zencoding-mode
 520   "Minor mode for writing HTML and CSS markup.
 521 With zen coding for HTML and CSS you can write a line like
 522
 523   ul#name>li.item*2
 524
 525 and have it expanded to
 526
 527   <ul id=\"name\">
 528     <li class=\"item\"></li>
 529     <li class=\"item\"></li>
 530   </ul>
 531
 532 This minor mode defines keys for quick access:
 533
 534 \\{zencoding-mode-keymap}
 535
 536 Home page URL `http://www.emacswiki.org/emacs/ZenCoding'.
 537
 538 See also `zencoding-expand-line'."
 539   :lighter " Zen"
 540   :keymap zencoding-mode-keymap)
 541
 542
 543 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 544 ;; Zencoding yasnippet integration
 545
 546 (defun zencoding-transform-yas (ast)
 547   (let* ((leaf-count 0)
 548          (zencoding-leaf-function
 549           (lambda ()
 550             (format "$%d" (incf leaf-count)))))
 551     (zencoding-transform ast)))
 552
 553 ;;;###autoload
 554 (defun zencoding-expand-yas ()
 555   (interactive)
 556   (let ((expr (zencoding-expr-on-line)))
 557     (if expr
 558         (let* ((markup (zencoding-transform-yas (car (zencoding-expr (first expr)))))
 559                (filled (replace-regexp-in-string "><" ">\n<" markup)))
 560           (delete-region (second expr) (third expr))
 561           (insert filled)
 562           (indent-region (second expr) (point))
 563           (yas/expand-snippet
 564            (buffer-substring (second expr) (point))
 565            (second expr) (point))))))
 566
 567
 568 \f
 569 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 570 ;;; Real-time preview
 571 ;;
 572
 573 ;;;;;;;;;;
 574 ;; Lennart's version
 575
 576 (defvar zencoding-preview-input nil)
 577 (make-local-variable 'zencoding-preview-input)
 578 (defvar zencoding-preview-output nil)
 579 (make-local-variable 'zencoding-preview-output)
 580 (defvar zencoding-old-show-paren nil)
 581 (make-local-variable 'zencoding-old-show-paren)
 582
 583 (defface zencoding-preview-input
 584   '((default :box t :inherit secondary-selection))
 585   "Face for preview input field."
 586   :group 'zencoding)
 587
 588 (defface zencoding-preview-output
 589   '((default :inherit highlight))
 590   "Face for preview output field."
 591   :group 'zencoding)
 592
 593 (defvar zencoding-preview-keymap
 594   (let ((map (make-sparse-keymap)))
 595     (define-key map (kbd "<return>") 'zencoding-preview-accept)
 596     (define-key map [(control ?g)] 'zencoding-preview-abort)
 597     map))
 598
 599 (defun zencoding-preview-accept ()
 600   (interactive)
 601   (let ((ovli zencoding-preview-input))
 602     (if (not (and (overlayp ovli)
 603                   (bufferp (overlay-buffer ovli))))
 604         (message "Preview is not active")
 605       (let* ((indent (current-indentation))
 606              (markup (zencoding-preview-transformed indent)))
 607         (when markup
 608           (delete-region (line-beginning-position) (overlay-end ovli))
 609           (zencoding-insert-and-flash markup)))))
 610   (zencoding-preview-abort))
 611
 612 (defvar zencoding-flash-ovl nil)
 613 (make-variable-buffer-local 'zencoding-flash-ovl)
 614
 615 (defun zencoding-remove-flash-ovl (buf)
 616   (with-current-buffer buf
 617     (when (overlayp zencoding-flash-ovl)
 618       (delete-overlay zencoding-flash-ovl))
 619     (setq zencoding-flash-ovl nil)))
 620
 621 (defun zencoding-insert-and-flash (markup)
 622   (zencoding-remove-flash-ovl (current-buffer))
 623   (let ((here (point)))
 624     (insert markup)
 625     (setq zencoding-flash-ovl (make-overlay here (point)))
 626     (overlay-put zencoding-flash-ovl 'face 'zencoding-preview-output)
 627     (when (< 0 zencoding-insert-flash-time)
 628       (run-with-idle-timer zencoding-insert-flash-time
 629                            nil 'zencoding-remove-flash-ovl (current-buffer)))))
 630
 631 ;;;###autoload
 632 (defun zencoding-preview (beg end)
 633   "Expand zencode between BEG and END interactively.
 634 This will show a preview of the expanded zen code and you can
 635 accept it or skip it."
 636   (interactive (if mark-active
 637                    (list (region-beginning) (region-end))
 638                  (list nil nil)))
 639   (zencoding-preview-abort)
 640   (if (not beg)
 641       (message "Region not active")
 642     (setq zencoding-old-show-paren show-paren-mode)
 643     (show-paren-mode -1)
 644     (let ((here (point)))
 645       (goto-char beg)
 646       (forward-line 1)
 647       (unless (= 0 (current-column))
 648         (insert "\n"))
 649       (let* ((opos (point))
 650              (ovli (make-overlay beg end nil nil t))
 651              (ovlo (make-overlay opos opos))
 652              (info (propertize " Zen preview. Choose with RET. Cancel by stepping out. \n"
 653                                'face 'tooltip)))
 654         (overlay-put ovli 'face 'zencoding-preview-input)
 655         (overlay-put ovli 'keymap zencoding-preview-keymap)
 656         (overlay-put ovlo 'face 'zencoding-preview-output)
 657         (overlay-put ovlo 'before-string info)
 658         (setq zencoding-preview-input  ovli)
 659         (setq zencoding-preview-output ovlo)
 660         (add-hook 'before-change-functions 'zencoding-preview-before-change t t)
 661         (goto-char here)
 662         (add-hook 'post-command-hook 'zencoding-preview-post-command t t)))))
 663
 664 (defvar zencoding-preview-pending-abort nil)
 665 (make-variable-buffer-local 'zencoding-preview-pending-abort)
 666
 667 (defun zencoding-preview-before-change (beg end)
 668   (when
 669       (or (> beg (overlay-end zencoding-preview-input))
 670           (< beg (overlay-start zencoding-preview-input))
 671           (> end (overlay-end zencoding-preview-input))
 672           (< end (overlay-start zencoding-preview-input)))
 673     (setq zencoding-preview-pending-abort t)))
 674
 675 (defun zencoding-preview-abort ()
 676   "Abort zen code preview."
 677   (interactive)
 678   (setq zencoding-preview-pending-abort nil)
 679   (remove-hook 'before-change-functions 'zencoding-preview-before-change t)
 680   (when (overlayp zencoding-preview-input)
 681     (delete-overlay zencoding-preview-input))
 682   (setq zencoding-preview-input nil)
 683   (when (overlayp zencoding-preview-output)
 684     (delete-overlay zencoding-preview-output))
 685   (setq zencoding-preview-output nil)
 686   (remove-hook 'post-command-hook 'zencoding-preview-post-command t)
 687   (when zencoding-old-show-paren (show-paren-mode 1)))
 688
 689 (defun zencoding-preview-post-command ()
 690   (condition-case err
 691       (zencoding-preview-post-command-1)
 692     (error (message "zencoding-preview-post: %s" err))))
 693
 694 (defun zencoding-preview-post-command-1 ()
 695   (if (and (not zencoding-preview-pending-abort)
 696            (<= (point) (overlay-end zencoding-preview-input))
 697            (>= (point) (overlay-start zencoding-preview-input)))
 698       (zencoding-update-preview (current-indentation))
 699     (zencoding-preview-abort)))
 700
 701 (defun zencoding-preview-transformed (indent)
 702   (let* ((string (buffer-substring-no-properties
 703                   (overlay-start zencoding-preview-input)
 704                   (overlay-end zencoding-preview-input)))
 705          (ast    (car (zencoding-expr string))))
 706     (when (not (eq ast 'error))
 707       (zencoding-prettify (zencoding-transform ast)
 708                           indent))))
 709
 710 (defun zencoding-update-preview (indent)
 711   (let* ((pretty (zencoding-preview-transformed indent))
 712          (show (when pretty
 713                  (propertize pretty 'face 'highlight))))
 714     (when show
 715       (overlay-put zencoding-preview-output 'after-string
 716                    (concat show "\n")))))
 717 ;; a+bc
 718
 719 ;;;;;;;;;;
 720 ;; Chris's version
 721
 722 ;; (defvar zencoding-realtime-preview-keymap
 723 ;;   (let ((map (make-sparse-keymap)))
 724 ;;     (define-key map "\C-c\C-c" 'zencoding-delete-overlay-pair)
 725
 726 ;;     map)
 727 ;;   "Keymap used in zencoding realtime preview overlays.")
 728
 729 ;; ;;;###autoload
 730 ;; (defun zencoding-realtime-preview-of-region (beg end)
 731 ;;   "Construct a real-time preview for the region BEG to END."
 732 ;;   (interactive "r")
 733 ;;   (let ((beg2)
 734 ;;      (end2))
 735 ;;     (save-excursion
 736 ;;       (goto-char beg)
 737 ;;       (forward-line)
 738 ;;       (setq beg2 (point)
 739 ;;          end2 (point))
 740 ;;       (insert "\n"))
 741 ;;     (let ((input-and-output (zencoding-make-overlay-pair beg end beg2 end2)))
 742 ;;       (zencoding-handle-overlay-change (car input-and-output) nil nil nil)))
 743 ;;   )
 744
 745 ;; (defun zencoding-make-overlay-pair (beg1 end1 beg2 end2)
 746 ;;   "Construct an input and an output overlay for BEG1 END1 and BEG2 END2"
 747 ;;   (let ((input  (make-overlay beg1 end1 nil t t))
 748 ;;      (output (make-overlay beg2 end2)))
 749 ;;     ;; Setup input overlay
 750 ;;     (overlay-put input  'face '(:underline t))
 751 ;;     (overlay-put input  'modification-hooks
 752 ;;                      (list #'zencoding-handle-overlay-change))
 753 ;;     (overlay-put input  'output output)
 754 ;;     (overlay-put input  'keymap zencoding-realtime-preview-keymap)
 755 ;;     ;; Setup output overlay
 756 ;;     (overlay-put output 'face '(:overline t))
 757 ;;     (overlay-put output 'intangible t)
 758 ;;     (overlay-put output 'input input)
 759 ;;     ;; Return the overlays.
 760 ;;     (list input output))
 761 ;;   )
 762
 763 ;; (defun zencoding-delete-overlay-pair (&optional one)
 764 ;;   "Delete a pair of input and output overlays based on ONE."
 765 ;;   (interactive) ;; Since called from keymap
 766 ;;   (unless one
 767 ;;     (let ((overlays (overlays-at (point))))
 768 ;;       (while (and overlays
 769 ;;                (not (or (overlay-get (car overlays) 'input)
 770 ;;                         (overlay-get (car overlays) 'output))))
 771 ;;      (setq overlays (cdr overlays)))
 772 ;;       (setq one (car overlays))))
 773 ;;   (when one
 774 ;;     (let ((other (or (overlay-get one 'input)
 775 ;;                   (overlay-get one 'output))))
 776 ;;       (delete-overlay one)
 777 ;;       (delete-overlay other)))
 778 ;;   )
 779
 780 ;; (defun zencoding-handle-overlay-change (input del beg end &optional old)
 781 ;;   "Update preview after overlay change."
 782 ;;   (let* ((output (overlay-get input 'output))
 783 ;;       (start  (overlay-start output))
 784 ;;       (string (buffer-substring-no-properties
 785 ;;                (overlay-start input)
 786 ;;                (overlay-end input)))
 787 ;;       (ast    (car (zencoding-expr string)))
 788 ;;       (markup (when (not (eq ast 'error))
 789 ;;                 (zencoding-transform ast))))
 790 ;;     (save-excursion
 791 ;;       (delete-region start (overlay-end output))
 792 ;;       (goto-char start)
 793 ;;       (if markup
 794 ;;        (insert markup)
 795 ;;      (insert (propertize "error" 'face 'font-lock-error-face)))
 796 ;;       (move-overlay output start (point))))
 797 ;;   )
 798
 799 (provide 'zencoding-mode)
 800
 801 ;;; zencoding-mode.el ends here