-
Notifications
You must be signed in to change notification settings - Fork 0
/
txl-mode.el
356 lines (321 loc) · 14.1 KB
/
txl-mode.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
;;; txl-mode.el -- major mode for editing TXL programs and grammars.
;; Markus Stoy ([email protected]), Rostock (Germany), November/December 2003.
;; Installation (only tested under XEmacs-21.4 for Linux and WindowsXP):
; - put this file into directory where Emacs can find it (within load-path)
; - add following lines to Emacs init file (.emacs or init.el or maybe something else)
; (require 'txl-mode)
; (add-to-list 'auto-mode-alist '("\\.\\([tT]xl\\|[gG]rm\\|[gG]rammar\\|[rR]ul\\(es\\)?\\|[mM]od\\(ule\\)?\\)$" . txl-mode))
;; Features:
; - syntax highlighting (with font-lock-mode)
; - automatic indentation according to TXL style guide (perhaps stil buggy...)
; - compile/debug/run TXL program from within Emacs
; - comment/uncomment regions
; - insert skeletion rules/functions/defines, find and insert matching end's
; - abbreviations for keywords (with abbrev-mode; scroll down to see a list)
; - TXL submenu which contains all new functions and their keyboard shortcuts
;; Wish list:
; - navigation (jump to nonterminal/function/rule under cursor, next/previous nonterminal/function/rule, ...)
; - use comint for run/debug/compile instead of simple shell-command? (which looks ugly under Windows)
;; Known bugs:
; - 'x% is highlighted as comment
; - compile and debug don't work under Windows
;; Oct 16 2008, Ivan N. Veselov <[email protected]>
;; - added compatibility with Emacs (fixed GNU Emacs/XEmacs compatibility issues
;; with font-lock-defaults and set-keymap-name).
;; Tested with GNU Emacs 22.3.1.
;;; Code: ----------------------------------------------------------------------
(defvar txl-mode-hook nil "Normal hook run when entering TXL mode.")
; syntax table -----------------------------------------------------------------
(defvar txl-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?' "'" table) ; apostrophe quotes
;; % participates in all 3 comment styles %...\n %(...)% %{...}%
(modify-syntax-entry ?% "< 14" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?\( "()2b" table)
(modify-syntax-entry ?\) ")(3b" table)
(modify-syntax-entry ?\{ "(}2c" table)
(modify-syntax-entry ?\} "){3c" table)
table)
"Syntax table used while in TXL mode.")
(defvar txl-mode-font-lock-syntax-alist
'((?' . "/") ; ' escapes keywords and comments
(?_ . "w")) ; don't highlight keyword_foo
"Syntax used for highlighting TXL")
(defvar txl-mode-font-lock-syntactic-keywords
'(("\"[^\"]*\\('\\)\"" 1 "."))) ; ' doesn't escape inside strings
; syntax highlighting ----------------------------------------------------------
(defvar txl-mode-keywords
`(
;; preprocessor directives
("^[[:space:]]*#[a-z]+" 0 font-lock-preprocessor-face)
;; quoted literal symbol
("'[^]\t\n ]+" 0 font-lock-constant-face)
;; builtin rules (with parameters)
(,(concat "\\[\\(\\(?:[\\+-\\*/:#_\\.^,=><\\$]\\|"
(regexp-opt
'("div" "rem" "index" "length" "select" "head" "tail" "~=" ">="
"<=" "grep" "quote" "unquote" "parse" "unparse" "reparse"
"read" "write" "fget" "getp" "fput" "putp" "fputp" "fclose"
"message" "pragma" "quit" "system" "pipe"))
"\\)\\)[[:space:]]+")
1 font-lock-builtin-face)
;; builtin rules (without parameters) and predefined nonterminal types
(,(concat "\\["
(regexp-opt
'("!" "get" "put" "print" "printattr" "debug" "breakpoint" "id"
"number" "stringlit" "charlit" "comment" "space" "newline"
"upperlowerid" "upperid" "lowerupperid" "lowerid"
"floatnumber" "decimalnumber" "integernumber"
"empty" "key" "token" "any") t))
1 font-lock-builtin-face)
;; formatting tokens (without number)
(,(concat "\\[\\(?:"
(regexp-opt '("NL" "IN" "EX" "TAB" "SP" "SPOFF" "SPON" "KEEP"))
"\\)\\]")
0 font-lock-comment-face)
;; formatting tokens (with number)
("\\[\\(IN\\|EX\\|TAB\\|SP\\)_[1-9][0-9]*\\]" 0 font-lock-comment-face)
;; type keywords
(,(regexp-opt '("attr" "list" "opt" "repeat" "see") 'words)
1 font-lock-type-face)
;; other keywords
(,(regexp-opt '("all" "assert" "by" "comments" "compounds" "construct"
"deconstruct" "define" "each" "end" "export" "external"
"function" "import" "include" "keys" "match" "not"
"redefine" "replace" "rule" "skipping" "tokens" "where")
'words)
1 font-lock-keyword-face)
;; number
("\\<[0-9]+\\([.][0-9]+\\)?\\([eE][-+]?[0-9]+\\)?\\>" 0 font-lock-constant-face))
"Keywords for font-lock-mode used while in TXL mode.")
; abbreviations ----------------------------------------------------------------
(defvar txl-mode-abbrev-table
(let ((table (make-abbrev-table)))
(define-abbrev table "ass" "assert" nil)
(define-abbrev table "com" "comments" nil)
(define-abbrev table "cmp" "compounds" nil)
(define-abbrev table "con" "construct" nil)
(define-abbrev table "dec" "deconstruct" nil)
(define-abbrev table "def" "define" nil)
(define-abbrev table "exp" "export" nil)
(define-abbrev table "ext" "external" nil)
(define-abbrev table "fun" "function" nil)
(define-abbrev table "imp" "import" nil)
(define-abbrev table "inc" "include" nil)
(define-abbrev table "red" "redefine" nil)
(define-abbrev table "rpt" "repeat" nil)
(define-abbrev table "rep" "replace" nil)
(define-abbrev table "ski" "skipping" nil)
(define-abbrev table "tok" "tokens" nil)
table)
"Abbrev table used while in TXL mode.")
; keyboard shortcuts -----------------------------------------------------------
(defvar txl-mode-map
(let ((map (make-sparse-keymap)))
(if (functionp 'set-keymap-name)
(set-keymap-name map 'txl-mode-map))
(define-key map "\C-cc" 'comment-region)
(define-key map "\C-cu" 'txl-mode-uncomment-region)
(define-key map "\C-cd" 'txl-mode-insert-define)
(define-key map "\C-cf" 'txl-mode-insert-function)
(define-key map "\C-cr" 'txl-mode-insert-rule)
(define-key map "\C-c\C-e" 'txl-mode-insert-end)
(define-key map "\C-c\C-c" 'txl-mode-compile)
(define-key map "\C-c\C-d" 'txl-mode-debug)
(define-key map "\C-c\C-r" 'txl-mode-run)
(define-key map "\C-i" 'txl-mode-indent-line)
(define-key map "\C-C\C-i" 'indent-region)
map)
"Keymap for TXL mode.")
; menubar ----------------------------------------------------------------------
(defvar txl-mode-menubar-menu
'("T%_XL"
["Ru%_n " txl-mode-run :suffix (concat (txl-mode-get-name nil) "...")]
["De%_bug " txl-mode-debug :suffix (concat (txl-mode-get-name nil) "...")]
["Com%_pile " txl-mode-compile :suffix (txl-mode-get-name nil)]
"--"
["%_Indent Region" indent-region :active (region-exists-p)]
["%_Comment Region" comment-region :active (region-exists-p)]
["%_Uncomment Region" txl-mode-uncomment-region (region-exists-p)]
"--"
["Insert %_Define" txl-mode-insert-define]
["Insert %_Function" txl-mode-insert-function]
["Insert %_Rule" txl-mode-insert-rule]
["%_End Block" txl-mode-insert-end :active (txl-mode-block)]
"--"
["Use %_Abbreviations" (setq abbrev-mode (not abbrev-mode))
:style toggle :selected abbrev-mode])
"TXL menu.")
(defvar txl-mode-input-file '()
"The last input file used for `txl-mode-run' and `txl-mode-debug'")
(defvar txl-mode-options nil "The last options used for `txl-mode-run'")
(defun txl-mode () ; -----------------------------------------------------------
"Major mode for editing TXL programs and grammars.
\\{txl-mode-map}
Turning on TXL mode runs the normal hook `txl-mode-hook'."
(interactive)
(kill-all-local-variables)
(make-local-variable 'txl-mode-input-file)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'txl-mode-indent-line)
(make-local-variable 'comment-start)
(setq comment-start "%")
(make-local-variable 'comment-end)
(setq comment-end "")
(set-syntax-table txl-mode-syntax-table)
(if (featurep 'xemacs)
(setq font-lock-keywords txl-mode-keywords) ;; XEmacs
(setq font-lock-defaults ;; Emacs
`(txl-mode-keywords
nil nil
,txl-mode-font-lock-syntax-alist
nil
(font-lock-syntactic-keywords
. ,txl-mode-font-lock-syntactic-keywords))))
(setq local-abbrev-table txl-mode-abbrev-table)
(setq abbrev-mode t)
(use-local-map txl-mode-map)
(setq major-mode 'txl-mode
mode-name "TXL")
(if (and (featurep 'menubar)
current-menubar)
(progn
(set-buffer-menubar current-menubar)
(add-submenu nil txl-mode-menubar-menu)))
(run-hooks 'txl-mode-hook))
; code templates ---------------------------------------------------------------
(defun txl-mode-insert-define ()
"Insert an empty nonterminal definition."
(interactive)
(insert "\ndefine \nend define")
(end-of-line 0))
(defun txl-mode-insert-function ()
"Insert an empty function."
(interactive)
(insert "\nfunction \n replace\n by\nend function")
(end-of-line -2))
(defun txl-mode-insert-rule ()
"Insert an empty rule."
(interactive)
(insert "\nrule \n replace\n by\nend rule")
(end-of-line -2))
(defun txl-mode-insert-end ()
"Insert matching end for define, rule, function etc."
(interactive)
(let ((current-block (txl-mode-block)))
(if current-block
(insert (concat "end " current-block "\n\n"))
(message "Not inside TXL block."))))
(defun txl-mode-uncomment-region ()
"Uncomment region."
(interactive)
(comment-region (region-beginning) (region-end) -1))
; compile, debug and run TXL programs ------------------------------------------
(defun txl-mode-compile ()
"Compile TXL program."
(interactive)
(shell-command (concat "txlc " (txl-mode-get-name t)) "*TXL Compilation*"))
(defun txl-mode-debug (input-file)
"Ask input file from user and debug TXL program."
(interactive (list (read-file-name "Input file: " nil txl-mode-input-file t)))
(setq txl-mode-input-file input-file)
(shell-command (concat "txldb " input-file " " (txl-mode-get-name t) " &") "*TXL Debug*")
(other-window 1)
(end-of-buffer))
(defun txl-mode-run (input-file &optional options)
"Ask input file from user and run TXL program. With prefix arg
ask for extra options as well."
(interactive (list (read-file-name "Input file: " nil txl-mode-input-file t)
(when current-prefix-arg
(read-string (format "txl options (%s): " txl-mode-options)
nil nil txl-mode-options))))
(setq txl-mode-input-file input-file)
(if options (setq txl-mode-options options)
(setq options ""))
(shell-command (concat "txl " options " " input-file " " (txl-mode-get-name t)) "*TXL Output*"))
(defvar txl-mode-extension-regexp
"[tT]xl\\|[gG]rm\\|[gG]rammar\\|[rR]ul\\(es\\)?\\|[mM]od\\(ule\\)?"
"A regexp that matches filename extensions used by TXL")
(defun txl-mode-get-name (full)
"If buffer file name has ending used by TXL, return base name
and ending `.Txl', otherwise return unchanged. The argument controls whether full path
is included or not."
(let ((ext (file-name-extension buffer-file-name))
(base (file-name-sans-extension (file-name-nondirectory buffer-file-name))))
(concat (if full
(file-name-directory buffer-file-name) "")
base
(if (string-match txl-mode-extension-regexp ext)
".Txl" ext))))
; automatic indentation --------------------------------------------------------
(defun txl-mode-indent-line (&optional whole-exp)
"Indent current line as TXL code.
With argument, indent any additional lines of the same clause
rigidly along with this one (not yet)."
(interactive "p")
(let ((indent (txl-mode-indent-level))
(pos (point-marker))
(beg (line-beginning-position)))
(back-to-indentation)
(unless (zerop (- indent (current-column)))
(delete-region beg (point))
(indent-to indent))
;; special case for grammar alternative indentation
(when (looking-at "|")
(forward-char)
(just-one-space 3))
(when (> (marker-position pos) (point))
(goto-char pos))
(set-marker pos nil)))
(defun txl-mode-indent-level ()
"Compute TXL indentation level."
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(cond
;; beginning of buffer: do not indent
((bobp) 0)
;; block start/end delimiters: do not indent
((looking-at "\\(define\\|redefine\\|keys\\|compounds\\|comments\\|tokens\\|function\\|rule\\|end\\)\\>") 0)
;; block-keywords: indent 4
((looking-at "\\(import\\|export\\|replace\\|by\\|match\\|deconstruct\\|construct\\|where\\|assert\\|skipping\\)\\>") 4)
;; alternative-sperator: indent 4
((looking-at "|") 4)
;; comments: within blocks indent 4, outside do not indent
((looking-at "%") (if (txl-mode-block) 4 0))
;; function calls: line up with previous
((looking-at "\\[") (txl-mode-indent-fun-level))
;; all other stuff: within blocks indent 8, outside do not indent
(t (if (txl-mode-block) 8 0)))))
(defun txl-mode-block ()
"If point is currently inside TXL block, return its name (define, rule, function, etc),
otherwise return nil."
(interactive)
(save-excursion
(let ((searching t) (within-block nil))
(while searching
(beginning-of-line 0)
(if (bobp)
(setq searching nil))
(skip-chars-forward " \t")
(if (looking-at "\\(define\\|redefine\\|keys\\|compounds\\|comments\\|tokens\\|function\\|rule\\)\\>")
(setq searching nil within-block (match-string 1)))
(if (looking-at "end\\>")
(setq searching nil within-block nil)))
within-block)))
(defun txl-mode-indent-fun-level ()
"Compute indentation level of first function call on previous line.
If there is none, return 8 or 0, depending whether currently inside block."
(save-excursion
(end-of-line 0)
(let ((eol (point)))
(beginning-of-line)
(skip-chars-forward "^\[" eol)
(if (eolp)
(progn
(end-of-line 2)
(if (txl-mode-block) 8 0))
(current-column)))))
(provide 'txl-mode)
;;; txl-mode.el ends here