diff options
Diffstat (limited to 'zencoding-mode.el')
| -rw-r--r-- | zencoding-mode.el | 502 |
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 |