467 lines
15 KiB
EmacsLisp
467 lines
15 KiB
EmacsLisp
|
;;; 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
|