live expansion and more tidying

1 files changed, 383 insertions, 119 deletions

diff --git a/zencoding-mode.el b/zencoding-mode.el
index 25987a2..f61e9b8 100644
--- a/zencoding-mode.el
+++ b/zencoding-mode.el
@@ -1,48 +1,62 @@
 ;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup
-
+;;
 ;; Copyright (C) 2009, Chris Done
-
+;;
 ;; Author: Chris Done <chrisdone@gmail.com>
+(defconst zencoding-mode:version "0.5")
+;; Last-Updated: 2009-11-20 Fri
 ;; 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:
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -88,7 +102,7 @@
 
 (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 "\\(.*\\)$") string)
+  (if (string-match (concat "^" regexp "\\([^\n]*\\)$") string)
       (mapcar (lambda (ref) (match-string ref string))
               (if (sequencep refs) refs (list refs)))
     nil))
@@ -266,21 +280,63 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Zen coding transformer from AST to HTML
 
+;; Fix-me: make mode specific
+(defvar zencoding-single-tags
+  '("br"
+    "img"))
+
+(defvar zencoding-inline-tags
+  '("a"
+    "abbr"
+    "acronym"
+    "cite"
+    "code"
+    "dfn"
+    "em"
+    "h1" "h2" "h3" "h4" "h5" "h6"
+    "kbd"
+    "q"
+    "span"
+    "strong"
+    "var"))
+
+(defvar zencoding-block-tags
+  '("p"))
+
+;; li
+;; a
+;; em
+;; p
+
 (defvar zencoding-leaf-function nil
   "Function to execute when expanding a leaf node in the
   Zencoding AST.")
 
 (defun zencoding-make-tag (tag &optional content)
-  (let ((name (car tag))
+  (let* ((name (car tag))
+         (lf (if
+                 (or
+                  (member name zencoding-block-tags)
+                  (and
+                   (> (length name) 1)
+                   (not (member name zencoding-inline-tags))
+                   ))
+                 "\n" ""))
+         (single (member name zencoding-single-tags))
         (props (apply 'concat (mapcar
                                (lambda (prop)
                                  (concat " " (symbol-name (car prop))
                                          "=\"" (cadr prop) "\""))
                                (cadr tag)))))
-    (concat "<" name props ">"
-            (if content content
-              (if zencoding-leaf-function (funcall zencoding-leaf-function)))
-            "</" name ">")))
+    (concat lf "<" name props ">" lf
+            (if single
+                ""
+              (concat
+               (if content content
+                 (if zencoding-leaf-function
+                     (funcall zencoding-leaf-function)
+                   ""))
+               lf "</" name ">")))))
 
 (defun zencoding-transform (ast)
   (let ((type (car ast)))
@@ -354,14 +410,14 @@
                  ("(a>b)*2"                "<a><b></b></a><a><b></b></a>")
                  ("(a+b)*2"                "<a></a><b></b><a></a><b></b>")
                  )))
-    (mapcar (lambda (input)
-              (let ((expected (cadr input))
-                    (actual (zencoding-transform (car (zencoding-expr (car input))))))
-                (if (not (equal expected actual))
-                    (error (concat "Assertion " (car input) " failed:"
-                                   expected
-                                   " == "
-                                   actual)))))
+    (mapc (lambda (input)
+            (let ((expected (cadr input))
+                  (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.")))
 
@@ -369,27 +425,67 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Zencoding minor mode
 
-(defun zencoding-expr-at-point ()
+(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]*\\)\\(.+\\)" line 2)))
+         (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2)))
     (if (first expr)
         (list (first expr) start end))))
 
-(defun zencoding-expand-line ()
-  "Replace the current line's zencode expression with the corresponding expansion."
-  (interactive)
-  (let ((expr (zencoding-expr-at-point)))
-    (if expr
-          (let* ((markup (zencoding-transform (car (zencoding-expr (first expr)))))
-                 (filled (replace-regexp-in-string "><" ">\n<" markup)))
-            (save-excursion
-              (delete-region (second expr) (third expr))
-              (insert filled)
-              (indent-region (second expr) (point)))))))
+(defun zencoding-prettify (markup indent)
+  (save-match-data
+    ;;(setq markup (replace-regexp-in-string "><" ">\n<" markup))
+    (setq markup (replace-regexp-in-string "\n\n" "\n" markup))
+    (setq markup (replace-regexp-in-string "^\n" "" markup)))
+  (with-temp-buffer
+    (indent-to indent)
+    (insert "<i></i>")
+    (insert "\n")
+    (let ((here (point)))
+      (insert markup)
+      (sgml-mode)
+      (indent-region here (point-max))
+      (buffer-substring-no-properties here (point-max)))))
+
+;;;###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* ((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
+        (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.")
@@ -400,7 +496,27 @@
     (setq zencoding-mode-keymap (make-sparse-keymap))
     (define-key zencoding-mode-keymap (kbd "<C-return>") 'zencoding-expand-line)))
 
-(define-minor-mode zencoding-mode "Minor mode to assist writing markup."
+;;;###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
+
+  <ul id=\"name\">
+    <li class=\"item\"></li>
+    <li class=\"item\"></li>
+  </ul>
+
+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)
 
@@ -415,98 +531,246 @@
             (format "$%d" (incf leaf-count)))))
     (zencoding-transform ast)))
 
+;;;###autoload
 (defun zencoding-expand-yas ()
   (interactive)
-  (let ((expr (zencoding-expr-at-point)))
+  (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 
+          (yas/expand-snippet
            (buffer-substring (second expr) (point))
            (second expr) (point))))))
 
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Real-time preview
 ;;
 
-(defvar zencoding-realtime-preview-keymap
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-c\C-c" 'zencoding-delete-overlay-pair)
+;;;;;;;;;;
+;; Lennart's version
 
-    map)
-  "Keymap used in zencoding realtime preview overlays.")
+(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)
 
-(defun zencoding-realtime-preview-of-region (beg end)
-  "Construct a real-time preview for the region BEG to END."
-  (interactive "r")
-  (let ((beg2)
-	(end2))
-    (save-excursion
-      (goto-char beg)
-      (forward-line)
-      (setq beg2 (point)
-	    end2 (point))
+(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 "<return>") 'zencoding-preview-accept)
+    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)))
+  (if (not beg)
+      (message "Region not active")
+    (setq zencoding-old-show-paren show-paren-mode)
+    (show-paren-mode -1)
+    (goto-char beg)
+    (forward-line 1)
+    (unless (= 0 (current-column))
       (insert "\n"))
-    (let ((input-and-output (zencoding-make-overlay-pair beg end beg2 end2)))
-      (zencoding-handle-overlay-change (car input-and-output) nil nil nil)))
-  )
-
-(defun zencoding-make-overlay-pair (beg1 end1 beg2 end2)
-  "Construct an input and an output overlay for BEG1 END1 and BEG2 END2"
-  (let ((input  (make-overlay beg1 end1 nil t t))
-	(output (make-overlay beg2 end2)))
-    ;; Setup input overlay
-    (overlay-put input  'face '(:underline t))
-    (overlay-put input  'modification-hooks
-		        (list #'zencoding-handle-overlay-change))
-    (overlay-put input  'output output)
-    (overlay-put input  'keymap zencoding-realtime-preview-keymap)
-    ;; Setup output overlay
-    (overlay-put output 'face '(:overline t))
-    (overlay-put output 'intangible t)
-    (overlay-put output 'input input)
-    ;; Return the overlays.
-    (list input output))
-  )
-
-(defun zencoding-delete-overlay-pair (&optional one)
-  "Delete a pair of input and output overlays based on ONE."
-  (interactive) ;; Since called from keymap
-  (unless one
-    (let ((overlays (overlays-at (point))))
-      (while (and overlays
-		  (not (or (overlay-get (car overlays) 'input)
-			   (overlay-get (car overlays) 'output))))
-	(setq overlays (cdr overlays)))
-      (setq one (car overlays))))
-  (when one
-    (let ((other (or (overlay-get one 'input)
-		     (overlay-get one 'output))))
-      (delete-overlay one)
-      (delete-overlay other)))
-  )
-
-(defun zencoding-handle-overlay-change (input del beg end &optional old)
-  "Update preview after overlay change."
-  (let* ((output (overlay-get input 'output))
-	 (start  (overlay-start output))
-	 (string (buffer-substring-no-properties
-		  (overlay-start input)
-		  (overlay-end input)))
-	 (ast    (car (zencoding-expr string)))
-	 (markup (when (not (eq ast 'error))
-		   (zencoding-transform ast))))
-    (save-excursion
-      (delete-region start (overlay-end output))
-      (goto-char start)
-      (if markup
-	  (insert markup)
-	(insert (propertize "error" 'face 'font-lock-error-face)))
-      (move-overlay output start (point))))
-  )
-
-(provide 'zencoding-mode)
\ No newline at end of file
+    (let* ((opos (point))
+           (ovli (make-overlay beg end))
+           (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)
+      (goto-char beg)
+      (add-hook 'post-command-hook 'zencoding-preview-post-command t t))))
+
+(defun zencoding-preview-post-command ()
+  (condition-case err
+      (zencoding-preview-post-command-1)
+    (error (message "zencoding-preview-post: %s" err))))
+
+(defun zencoding-preview-abort ()
+  (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-1 ()
+  (if (and (<= (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))
+      (zencoding-prettify (zencoding-transform ast)
+                          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"))
+      )))
+;; a+bc
+
+;;;;;;;;;;
+;; Chris's version
+
+;; (defvar zencoding-realtime-preview-keymap
+;;   (let ((map (make-sparse-keymap)))
+;;     (define-key map "\C-c\C-c" 'zencoding-delete-overlay-pair)
+
+;;     map)
+;;   "Keymap used in zencoding realtime preview overlays.")
+
+;; ;;;###autoload
+;; (defun zencoding-realtime-preview-of-region (beg end)
+;;   "Construct a real-time preview for the region BEG to END."
+;;   (interactive "r")
+;;   (let ((beg2)
+;; 	(end2))
+;;     (save-excursion
+;;       (goto-char beg)
+;;       (forward-line)
+;;       (setq beg2 (point)
+;; 	    end2 (point))
+;;       (insert "\n"))
+;;     (let ((input-and-output (zencoding-make-overlay-pair beg end beg2 end2)))
+;;       (zencoding-handle-overlay-change (car input-and-output) nil nil nil)))
+;;   )
+
+;; (defun zencoding-make-overlay-pair (beg1 end1 beg2 end2)
+;;   "Construct an input and an output overlay for BEG1 END1 and BEG2 END2"
+;;   (let ((input  (make-overlay beg1 end1 nil t t))
+;; 	(output (make-overlay beg2 end2)))
+;;     ;; Setup input overlay
+;;     (overlay-put input  'face '(:underline t))
+;;     (overlay-put input  'modification-hooks
+;; 		        (list #'zencoding-handle-overlay-change))
+;;     (overlay-put input  'output output)
+;;     (overlay-put input  'keymap zencoding-realtime-preview-keymap)
+;;     ;; Setup output overlay
+;;     (overlay-put output 'face '(:overline t))
+;;     (overlay-put output 'intangible t)
+;;     (overlay-put output 'input input)
+;;     ;; Return the overlays.
+;;     (list input output))
+;;   )
+
+;; (defun zencoding-delete-overlay-pair (&optional one)
+;;   "Delete a pair of input and output overlays based on ONE."
+;;   (interactive) ;; Since called from keymap
+;;   (unless one
+;;     (let ((overlays (overlays-at (point))))
+;;       (while (and overlays
+;; 		  (not (or (overlay-get (car overlays) 'input)
+;; 			   (overlay-get (car overlays) 'output))))
+;; 	(setq overlays (cdr overlays)))
+;;       (setq one (car overlays))))
+;;   (when one
+;;     (let ((other (or (overlay-get one 'input)
+;; 		     (overlay-get one 'output))))
+;;       (delete-overlay one)
+;;       (delete-overlay other)))
+;;   )
+
+;; (defun zencoding-handle-overlay-change (input del beg end &optional old)
+;;   "Update preview after overlay change."
+;;   (let* ((output (overlay-get input 'output))
+;; 	 (start  (overlay-start output))
+;; 	 (string (buffer-substring-no-properties
+;; 		  (overlay-start input)
+;; 		  (overlay-end input)))
+;; 	 (ast    (car (zencoding-expr string)))
+;; 	 (markup (when (not (eq ast 'error))
+;; 		   (zencoding-transform ast))))
+;;     (save-excursion
+;;       (delete-region start (overlay-end output))
+;;       (goto-char start)
+;;       (if markup
+;; 	  (insert markup)
+;; 	(insert (propertize "error" 'face 'font-lock-error-face)))
+;;       (move-overlay output start (point))))
+;;   )
+
+(provide 'zencoding-mode)
+
+;;; zencoding-mode.el ends here