Support comment-region and friends
[hcoop/domtool2.git] / elisp / domtool-mode.el
CommitLineData
4542571e
AC
1; Created by Brian Templeton (bpt@hcoop.net)
2; Extended by Adam Chlipala (adamc@hcoop.net)
3
4(eval-when-compile (require 'cl))
5
6(defvar domtool-indent 2)
7
8(defvar domtool-mode-syntax-table
9 (let ((table (make-syntax-table)))
10 (loop for i from ?a to ?z
11 do (modify-syntax-entry i "w" table))
12 (loop for i from ?A to ?Z
13 do (modify-syntax-entry i "w" table))
14 (loop for i from ?0 to ?9
15 do (modify-syntax-entry i "w" table))
16 (mapc
17 (lambda (pair)
18 (loop for ch across (if (stringp (car pair))
19 (car pair)
20 (string (car pair)))
21 do (modify-syntax-entry ch (cadr pair) table)))
22 '((" \t\n\14" " ") ; \14 is ^L
23 (?_ "_")
24 (?* ". 23n")
25 (?\( "()1")
26 (?\) ")(4")
27 (?\" "\"")
28 (?\\ "\\")
29 (?\[ "(]")
30 (?\] ")[")
31 ;; We identify single-line comments using
32 ;; font-lock-syntactic-keywords, because it's easier to
33 ;; recognize documentation comments using the syntax table.
34 (?\{ "(}12b")
35 (?\} "){34b")
36 ("->=<,:;^!&" ".") ; -> => <- = , : ; ^ ! &
37 ))
38 table))
39
ef18a741
AC
40(defun domtool-syms-re (&rest syms)
41 (concat "\\<" (regexp-opt syms t) "\\>"))
ef18a741
AC
42(defconst domtool-types-regexp
43 (domtool-syms-re "proxy_target" "proxy_port" "mod_rewrite_cond_flag" "mod_rewrite_flag" "rewrite_arg" "redirect_code" "autoindex_option" "autoindex_width" "homedir_path" "dnsRecord" "apache_option" "authType" "location" "ssl" "ssl_cert_path" "suexec_flag" "web_node" "aliasTarget" "aliasSource" "email" "emailUser" "mail_node" "dnsKind" "master" "dns_node" "soa" "serial" "your_path" "your_group" "your_user" "group" "user" "node" "your_domain_host" "your_domain" "domain" "host" "ip" "no_newlines" "no_spaces" "bool" "string" "int")
44 "A regexp that matches Domtool types from the standard library.")
45
46(defconst domtool-contexts-regexp
47 (domtool-syms-re "Location" "Vhost" "Domain")
48 "A regexp that matches Domtool contexts from the standard library.")
49
50(defconst domtool-actions-regexp
51 (domtool-syms-re "errorDocument" "scriptAlias" "alias" "proxyPassReverse" "proxyPass" "rewriteLogLevel" "localProxyRewrite" "rewriteBase" "rewriteCond" "rewriteRule" "setEnv" "davFilesystem" "readmeName" "headerName" "unset_indexOptions" "set_indexOptions" "indexOptions" "addDescription" "mailmanWebHost" "dnsDefault" "dnsAlias" "dnsMail" "dnsIP" "nameserver" "dom" "web" "webAt" "relayMail" "handleMail" "dns" "addDefaultCharset" "action" "forceTypeOff" "forceType" "directoryIndex" "unset_options" "set_options" "options" "satisfyAny" "satisfyAll" "denyFrom" "denyFromAll" "allowFrom" "allowFromAll" "orderDenyAllow" "orderAllowDeny" "requireGroup" "requireUser" "requireValidUser" "authUserFile" "authName" "authType" "serverAliasDefault" "serverAlias" "serverAliasHost" "directory" "location" "vhost" "defaultAlias" "aliasDrop" "aliasMulti" "emailAlias" "aliasPrim" "domain")
52 "A regexp that matches Domtool actions from the standard library.")
53
54(defconst domtool-vals-regexp
55 (domtool-syms-re "ornext" "cond_nocase" "env" "skip" "redirectWith" "mimeType" "passthrough" "noescape" "qsappend" "nocase" "nosubreq" "chain" "last" "gone" "forbidden" "redirect" "redir307" "redir305" "redir304" "redir303" "redir302" "redir301" "redir300" "seeother" "permanent" "temp" "xhtml" "versionSort" "trackModified" "suppressSize" "suppressRules" "suppressLastModified" "suppressIcon" "suppressHtmlPreamble" "suppressDescription" "suppressColumnSorting" "scanHtmlTitles" "nameWidth" "ignoreClient" "ignoreCase" "iconWidth" "iconHeight" "iconsAreLinks" "htmlTable" "foldersFirst" "fancyIndexing" "descriptionWidth" "characters" "autofit" "home" "web_node" "default_node" "dnsDefaultA" "dnsNS" "dnsMX" "dnsCNAME" "dnsA" "indexes" "includesNOEXEC" "execCGI" "kerberos" "digest" "basic" "use_cert" "no_ssl" "web_node_to_node" "dropTarget" "addressesTarget" "addressTarget" "catchAllSource" "defaultSource" "userSource" "mail_node_to_node" "noDns" "useDns" "internalMaster" "externalMaster" "dns_node_to_node" "defaultSoa" "soa" "serialConst" "serialAuto" "ip_of_node" "true" "false")
56 "A regexp that matches Domtool vals from the standard library.")
57
58(defconst domtool-env-vars-regexp
3b37f60f 59 (domtool-syms-re "Aliases" "DNS" "DocumentRoot" "Group" "MailNodes" "Mailbox" "SSL" "ServerAdmin" "SuExec" "TTL" "User" "WWW" "WebNodes")
ef18a741
AC
60 "A regexp that matches Domtool env-vars from the standard library.")
61
4542571e
AC
62(defvar domtool-font-lock-keywords
63 `(,(concat
64 "\\_<"
65 (regexp-opt '("let" "in" "begin" "end" "with" "where" "extern" "type"
ef18a741 66 "val" "context" "Root")
4542571e
AC
67 t)
68 "\\_>")
ef18a741
AC
69
70 (,domtool-actions-regexp . font-lock-builtin-face)
71 (,domtool-vals-regexp . font-lock-variable-name-face)
72 (,domtool-contexts-regexp . font-lock-constant-face)
73 (,domtool-env-vars-regexp . font-lock-constant-face)
74 (,domtool-types-regexp . font-lock-type-face)
75
4542571e
AC
76 ("type[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-type-face)
77 ("val[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-variable-name-face)))
78
79(defvar domtool-font-lock-syntactic-keywords
80 '(("\\(#\\).*\\(\n\\|\\'\\)"
81 (1 "!")
82 (2 "!"))))
83
84(defun domtool-font-lock-syntactic-face-function (state)
85 "Major mode for editing Domtool files."
86 (cond ((nth 3 state) font-lock-string-face)
87 ((eq (nth 7 state) t) font-lock-doc-face)
88 (t font-lock-comment-face)))
89
90(define-derived-mode domtool-mode fundamental-mode "Domtool"
91 ;; For some reason, whatever twiddling `define-derived-mode' does
92 ;; with the syntax table breaks recognition of (*...*) comments. So
93 ;; we need to tell d-d-m to leave our syntax table alone.
94 :syntax-table domtool-mode-syntax-table
95 (set (make-local-variable 'indent-line-function) 'domtool-indent-line)
96 (set (make-local-variable 'font-lock-defaults)
97 '(domtool-font-lock-keywords
98 nil nil nil nil
99 (font-lock-syntactic-keywords
100 . domtool-font-lock-syntactic-keywords)
101 (font-lock-syntactic-face-function
e3989a67
AC
102 . domtool-font-lock-syntactic-face-function)))
103 (set (make-local-variable 'indent-line-function) 'sml-indent-line)
104 (set (make-local-variable 'comment-start) "(* ")
105 (set (make-local-variable 'comment-end) " *)")
106 (set (make-local-variable 'comment-nested) t))
4542571e
AC
107
108(defun domtool-indent-line ()
109 (let ((savep (> (current-column) (current-indentation)))
110 (indent (domtool-calculate-indent)))
111 (cond
112 ((eq indent 'noindent) indent)
113 (savep (save-excursion (indent-line-to indent)))
114 (t (indent-line-to indent)))))
115
3b37f60f 116(defun until-closed-helper (level)
1cbe9174
AC
117 (if
118 (re-search-backward "\\_<\\(with\\|where\\|begin\\|end\\)\\_>"
119 nil t)
120 (cond
121 ((string= (match-string 0) "end")
3b37f60f 122 (until-closed-helper (+ level 1)))
1cbe9174
AC
123 ((= level 0)
124 (current-indentation))
125 (t
3b37f60f
AC
126 (until-closed-helper (- level 1))))
127
128 0))
1cbe9174 129
3b37f60f
AC
130(defun until-closed (is-with)
131 (save-excursion
132 (if is-with
133 (until-closed-helper 1)
134 (until-closed-helper 0))))
1cbe9174 135
4542571e
AC
136(defun domtool-calculate-indent ()
137 (save-excursion
138 (back-to-indentation)
139 (multiple-value-bind (previous-keyword base-indent)
140 (save-excursion
1cbe9174 141 (if (re-search-backward "\\_<\\(with\\|where\\|begin\\|end\\)\\_>"
4542571e
AC
142 nil t)
143 (values (match-string 0) (current-indentation))
144 (values nil 0)))
145 (let ((state (syntax-ppss)))
146 (cond
147 ((nth 3 state)
148 'noindent)
149 ((nth 4 state)
150 (domtool-calculate-comment-indent state))
3b37f60f
AC
151 ((looking-at "\\_<\\(with\\)\\_>")
152 (until-closed t))
153 ((looking-at "\\_<\\(end\\)\\_>")
154 (until-closed nil))
4542571e
AC
155 ((not previous-keyword)
156 base-indent)
157 ((string= previous-keyword "end")
158 base-indent)
159 (t
160 (+ base-indent domtool-indent)))))))
161
162(defun domtool-calculate-comment-indent (state)
163 (ecase (nth 7 state)
164 ((t) 'noindent)
165 ((syntax-table) 'noindent) ; can't happen
166 ((nil) (let ((start (nth 8 state))
167 (depth 0))
168 (while (> (point) start)
169 (re-search-backward "(\\*\\|\\*)" start t)
170 (if (looking-at "(\\*")
171 (incf depth)
172 (decf depth)))
173 (+ (current-indentation) depth)))))