dot-emacs/packages/ts-mode.el

467 lines
15 KiB
EmacsLisp
Raw Normal View History

;;; ts-mode.el --- An Emacs major mode for editing TypoScript files
;; Copyright (C) 2009 Joachim Mathes
;;
;; Author: Joachim Mathes <joachim <underscore> mathes <at> web <dot> de>
;; Created: July 2009
;; Version: 0.1
;; Last-Updated: Thu Aug 13 00:18:18 CEST 2009
;; By: Joachim Mathes
;; Update #: 4
;; Keywords: files
;; URL: http://www.emacswiki.org/emacs/ts-mode.el
;; EmacsWiki: TypoScriptMode
;; 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:
;; Installation:
;; To install just drop this file into a directory on your load-path and
;; byte-compile it. To set up Emacs to automatically edit files ending in ".ts"
;; using ts-mode add the following to your ~/.emacs file (GNU Emacs) or
;; ~/.xemacs/init.el file (XEmacs):
;; (setq auto-mode-alist (cons '("\\.ts$" . ts-mode) auto-mode-alist))
;; (autoload 'ts-mode "ts-mode" "TypoScript file editing mode." t)
;; Description:
;; This is a major mode for editing TypoScript input files. It is developed to
;; support syntax highlighting, indentation and folding of blocks.
;; This file is *NOT* part of GNU Emacs.
;;; History:
;;
;;; Code:
(defconst ts-version "0.1"
"`ts-mode' version number.")
;; User definable variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
(defgroup typoscript nil
"Major mode for editing TypoScript files."
:prefix "ts-"
:group 'languages)
(defcustom ts-newline-function 'newline-and-indent
"Function to be called upon pressing `RET'."
:type '(choice (const newline)
(const newline-and-indent)
(const reindent-then-newline-and-indent))
:group 'typoscript)
(defcustom ts-block-indentation 2
"The indentation relative to a predecessing line which begins a new block.
In TypoScript blocks start with the left parenthesis `(' or the left brace
`{'."
:type 'integer
:group 'typoscript)
(defcustom ts-fold-foreground-color "white"
"The foreground color used to highlight the folded block.
The default value is `white'. For a list of all available colors use `M-x
list-colors-display'"
:type 'color
:group 'typoscript)
(defcustom ts-fold-background-color "DodgerBlue1"
"The background color used to highlight the folded block.
The default value is `DodgerBlue1'. For a list of all available colors use
`M-x list-colors-display'"
:type 'color
:group 'typoscript)
;; Internal variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
(defvar ts-mode-hook nil
"Hook called by `ts-mode'.")
(defvar ts-classes-face 'ts-classes-face
"Face for TypoScript classes.")
(make-face 'ts-classes-face)
(defvar ts-path-face 'ts-path-face
"Face for TypoScript paths.")
(make-face 'ts-path-face)
(defvar ts-block-face 'ts-block-face
"Face for TypoScript blocks.")
(make-face 'ts-block-face)
(defvar ts-conditional-face 'ts-conditional-face
"Face for TypoScript conditionals.")
(make-face 'ts-conditional-face)
(defvar ts-html-face 'ts-html-face
"Face for TypoScript HTML tags.")
(make-face 'ts-html-face)
(defun ts-font-lock-mode-hook ()
"Defines a TypoScript font lock mode hook."
(or (face-differs-from-default-p 'ts-classes-face)
(copy-face 'font-lock-keyword-face 'ts-classes-face))
(copy-face 'font-lock-builtin-face 'ts-path-face)
(set-face-foreground 'ts-path-face
"DarkTurquoise" nil)
(copy-face 'font-lock-builtin-face 'ts-block-face)
(set-face-foreground 'ts-block-face
"DodgerBlue1" nil)
(copy-face 'font-lock-builtin-face 'ts-conditional-face)
(set-face-foreground 'ts-conditional-face
"maroon" nil)
(copy-face 'font-lock-builtin-face 'ts-html-face)
(set-face-foreground 'ts-html-face
"ForestGreen" nil))
(defvar ts-font-lock-keywords
(let ((kw1 (mapconcat 'identity
;; Basic TypoScript classes
'("CONFIG" "PAGE" "TEXT" "COA" "COA_INT"
"FILE" "IMAGE" "GIFBUILDER" "CASE" "TEMPLATE"
"HMENU" "GMENU" "CONTENT")
"\\|")))
(list
;; Paths
'("^[ \t]*\\([[:alnum:]-_\\.]+\\)[ \t]*[=<>]" 1 'ts-path-face)
;; Blocks
'("^[ \t]*\\([[:alnum:]-_\\.]+\\)[ \t]*[{(]" 1 'ts-block-face)
;; Periods
;;'("^[ \t]*" "\\(\\.\\)" nil nil (1 'default t))
;; Classes (keywords)
(list (concat "\\<\\(" kw1 "\\)\\>") 1 'ts-classes-face t)
;; Conditional expressions `[...]'
'("^[ \t]*\\(\\[.+?\\]\\)[ \t]*$" 1 'ts-conditional-face)
;; Comment lines beginning with hash symbol `#'
'("^[ \t]*\\(#.*\\)$" 1 'font-lock-comment-face)
;; HTML special character encodings on the right side of the operator
'("\\(=\\|=<\\|>\\|:=\\)" "\\(&[#[:alnum:]]+;\\)" nil nil (0 'ts-html-face))
;; HTML tags
'("=<?\\|>\\|:=\\|[ \t]*" "\\(<[^<]+?>\\)" nil nil (0 'ts-html-face))
;; HTML color definitions
'("#[[:xdigit:]]\\{6\\}[ \t\n]+" 0 'ts-html-face t)))
"Expressions to highlight in TypoScript mode.")
(defvar ts-mode-syntax-table nil
"Syntax table used in TypoScript Mode buffers.")
(defvar ts-mode-map ()
"Key map used in TypoScript Mode buffers.")
(defvar ts-highlight-overlays [nil nil]
"A vector of different overlay to do highlighting.
This vector concerns only highlighting of horizontal lines.")
;; Functions
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;;;###autoload
(defun ts-mode ()
"Major mode for editing TypoScript files.
Bug reports, suggestions for new features and critics should go to
`joachim_mathes@web.de'.
This mode knows about syntax highlighting, indentation and folding of
blocks.
COMMANDS
\\{ts-mode-map}
VARIABLES
ts-newline-function\t\tbehaviour after pressing `RET'
ts-block-indentation\t\tindentation value
ts-fold-foreground-color\t\tforeground color of folded measurement block
ts-fold-background-color\t\tbackground color of folded measurement block"
(interactive)
;; Set up local variables
(kill-all-local-variables)
(make-local-variable 'font-lock-defaults)
(make-local-variable 'comment-start)
(make-local-variable 'comment-end)
(make-local-variable 'comment-start-skip)
(make-local-variable 'indent-line-function)
(make-local-variable 'defun-prompt-regexp)
(when (not ts-mode-syntax-table)
(setq ts-mode-syntax-table (make-syntax-table))
;; Parenthesis, brackets and braces
(modify-syntax-entry ?\( "()" ts-mode-syntax-table)
(modify-syntax-entry ?\) ")(" ts-mode-syntax-table)
(modify-syntax-entry ?\[ "(]" ts-mode-syntax-table)
(modify-syntax-entry ?\] ")[" ts-mode-syntax-table)
(modify-syntax-entry ?\{ "(}" ts-mode-syntax-table)
(modify-syntax-entry ?\} "){" ts-mode-syntax-table)
;; Comment delimiters
(modify-syntax-entry ?/ ". 124b" ts-mode-syntax-table)
(modify-syntax-entry ?* ". 23" ts-mode-syntax-table)
(modify-syntax-entry ?\n "> b" ts-mode-syntax-table)
(modify-syntax-entry ?\" "." ts-mode-syntax-table)
(modify-syntax-entry ?. "." ts-mode-syntax-table))
(set-syntax-table ts-mode-syntax-table)
(add-hook 'font-lock-mode-hook 'ts-font-lock-mode-hook)
(setq defun-prompt-regexp "^[ \t]*\\([[:alnum:]-_\\.]+\\)[ \t]*")
(if ts-mode-map
nil
(setq ts-mode-map (make-sparse-keymap))
(define-key ts-mode-map "\r" 'ts-newline)
(define-key ts-mode-map "\C-c\C-e" 'ts-fold-block)
(define-key ts-mode-map "\C-c\C-a" 'ts-unfold-block)
(define-key ts-mode-map "\C-c\C-u\C-r" 'ts-unfold-region)
(define-key ts-mode-map "\C-c\C-u\C-b" 'ts-unfold-buffer)
(define-key ts-mode-map "}" 'ts-electric-brace)
(define-key ts-mode-map ")" 'ts-electric-brace))
(use-local-map ts-mode-map)
(setq major-mode 'ts-mode
mode-name "TypoScript"
font-lock-defaults '(ts-font-lock-keywords)
comment-start "# "
comment-end ""
comment-start-skip "# "
indent-line-function 'ts-indent-line)
;; Run the mode hook.
(if ts-mode-hook
(run-hooks 'ts-mode-hook)))
(defun ts-newline ()
"Call the dedicated newline function.
The variable `ts-newline-function' decides which newline function to
use."
(interactive)
(funcall ts-newline-function))
(defun ts-indent-line ()
"Indent current line for TypoScript mode."
(let ((cp (point)) ; current point
(cc (current-column)) ; current column
(ci (current-indentation)) ; current indentation
(cl (line-number-at-pos)) ; current line
(counter 0)
ps ; parser state
psp ; parser state position
save-indent-column)
;; Evaluate parser state
(save-excursion
(beginning-of-line)
(setq ps (ts-parser-state))
(cond
;; Check if parser state position is:
;; -> Inside a comment
((nth 8 ps)
(setq psp (nth 8 ps))
(goto-char psp)
(setq save-indent-column (+ (current-column)
1)))
;; Check if parser state position is:
;; -> Inside a parenthetical grouping
((nth 1 ps)
(setq psp (nth 1 ps))
(cond
;; Check if point is looking at a string and a closing curly brace
((looking-at "[ \t[:alnum:]]*[)}]")
(goto-char psp)
(back-to-indentation)
(setq save-indent-column (current-column)))
(t
(goto-char psp)
(back-to-indentation)
(setq save-indent-column (+ (current-column)
ts-block-indentation)))))
;; Check if parser state position is:
;; -> nil
(t
;; Skip empty lines
(forward-line -1)
(while (and (looking-at "^[ \t]*\n")
(not (bobp)))
(forward-line -1))
(back-to-indentation)
(setq save-indent-column (current-column)))))
;; Set indentation value on current line
(back-to-indentation)
(backward-delete-char-untabify (current-column))
(indent-to save-indent-column)
(if (> cc ci)
(forward-char (- cc ci)))))
(defun ts-parser-state ()
"Return the parser state at point."
(save-excursion
(let ((here (point))
sps)
;; For correct indentation the character position of the start of the
;; innermost parenthetical grouping has to be found.
(goto-char (point-min))
;; Now get the parser state, i.e. the depth in parentheses.
(save-excursion
(setq sps (parse-partial-sexp (point) here)))
sps)))
(defun ts-block-start ()
"Return buffer position of the last unclosed enclosing block.
If nesting level is zero, return nil."
(let ((status (ts-parser-state)))
(if (<= (car status) 0)
nil
(car (cdr status)))))
;; Electric characters
(defun ts-electric-brace (arg)
"Insert closing brace.
Argument ARG prefix."
(interactive "*P")
;; Insert closing brace.
(self-insert-command (prefix-numeric-value arg))
(when (and (looking-at "[ \t]*$")
(looking-back "^[ \t]*[})]"))
(ts-indent-line)))
;; Folding
(defun ts-fold-block ()
"Hide the block on which point currently is located."
(interactive)
(let ((current-point (point))
(block-start (ts-block-start)))
(if (not block-start)
(message "Point is not within a block.")
;; Look for block start
(save-excursion
(goto-char (ts-block-start))
(beginning-of-line)
(setq block-start (point)))
(when block-start
(let ((block-name
;; Save block name
(save-excursion
(goto-char block-start)
(beginning-of-line)
(looking-at
"^[ \t]*\\(.*?\\)[ \t]*{")
(match-string 1)))
(block-end
;; Look for block end
(save-excursion
(goto-char block-start)
(forward-list)
(point)))
;; Variable for overlay
skampi-overlay)
;; ------------------------------------------------------------------
;; The following local variables are defined up to here:
;; [1] block-start: point of block start, at the beginning
;; of the line; nil otherwise
;; [2] block-name : name of block, i.e. the object path
;; [3] block-end : point of block end, at the end of the
;; line which contains the closing curly brace `}
;; ------------------------------------------------------------------
;; Check if end of measurement block is beyond point;
;; call fold function otherwise
(if (>= block-end current-point)
(ts-fold block-start block-end block-name)
(message "Error: No valid block found."))
;; Indent overlay
(goto-char block-start)
(beginning-of-line)
(ts-indent-line))))))
(defun ts-fold (block-start block-end block-name)
"Fold block.
The block starts at BLOCK-START and ends at BLOCK-END. Its
BLOCK-NAME is the TypoScript object path."
(let (ts-overlay)
;; Check if block-start and block-end are valid values, i.e. not nil
(if (or (eq block-start nil)
(eq block-end nil))
(message "Error: No valid block found.")
;; Make an overlay and hide block
(setq ts-overlay (make-overlay block-start block-end
(current-buffer) t nil))
(overlay-put ts-overlay 'category 'ts-fold)
(overlay-put ts-overlay 'evaporate t)
(overlay-put ts-overlay 'mouse-face 'highlight)
(overlay-put ts-overlay 'display (concat "["
(propertize block-name
'face
nil)
"]"))
(overlay-put ts-overlay 'font-lock-face `(:foreground ,ts-fold-foreground-color
:background ,ts-fold-background-color))
(overlay-put ts-overlay 'help-echo (concat
"Folded block: "
block-name)))))
(defun ts-unfold-buffer ()
"Unfold all blocks in the buffer."
(interactive)
(ts-unfold-region (point-min) (point-max)))
(defun ts-unfold-region (start end)
"Unfold all blocks in the region.
The region delimiters are START and END."
(interactive "r")
(let ((ts-overlays (overlays-in start end)))
(ts-unfold-overlays ts-overlays)))
(defun ts-unfold-block ()
"Unfold block at point."
(interactive)
(let ((ts-overlays (overlays-at (point))))
(ts-unfold-overlays ts-overlays)))
(defun ts-unfold-overlays (ts-overlays)
"Unfold all overlays set by ts-fold in TS-OVERLAYS.
Return non-nil if an unfold happened, nil otherwise."
(let (found)
(dolist (overlay ts-overlays)
(when (eq (overlay-get overlay 'category) 'ts-fold)
(delete-overlay overlay)
(setq found t)))
found))
(provide 'ts-mode)
;;; ts-mode.el ends here