final tt updates
[emacs-init.git] / 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