author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Tue, 25 May 2010 08:09:57 +1200 | |
changeset 285 | 034958cf32d9 |
parent 234 | 10e62e160cb0 |
permissions | -rw-r--r-- |
150 | 1 |
;;; etng-r1.el --- eager-ThiNG r1 code editing commands for Emacs |
2 |
||
3 |
;; Add code like the following to your .emacs to install: |
|
4 |
;; (autoload 'etng-r1-mode "...path.to.wherever.you.put.this.file.../etng-r1.el" nil t) |
|
5 |
;; (setq auto-mode-alist (cons '("\\.tng\\'" . etng-r1-mode) |
|
6 |
;; auto-mode-alist)) |
|
7 |
||
8 |
;; Copyright (C) 1988,94,96,2000 Free Software Foundation, Inc. |
|
9 |
;; Copyright (C) 2003, 2005 Tony Garnock-Jones <tonyg@lshift.net> |
|
10 |
||
11 |
;; This file is based on GNU Emacs' AWK mode (awk-mode.el). |
|
12 |
||
13 |
;; This is free software; you can redistribute it and/or modify |
|
14 |
;; it under the terms of the GNU General Public License as published by |
|
15 |
;; the Free Software Foundation; either version 2, or (at your option) |
|
16 |
;; any later version. |
|
17 |
||
18 |
;; This is distributed in the hope that it will be useful, |
|
19 |
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
20 |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
21 |
;; GNU General Public License for more details. |
|
22 |
||
23 |
;; You should have received a copy of the GNU General Public License |
|
24 |
;; along with this software; see the file COPYING. If not, write to the |
|
25 |
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
|
26 |
;; Boston, MA 02111-1307, USA. |
|
27 |
||
28 |
(require 'cmuscheme) |
|
29 |
(require 'comint) |
|
30 |
(require 'cc-mode) |
|
31 |
||
32 |
(defvar etng-r1-mode-syntax-table nil |
|
33 |
"Syntax table in use in etng-r1-mode buffers.") |
|
34 |
||
35 |
(if etng-r1-mode-syntax-table |
|
36 |
() |
|
37 |
(setq etng-r1-mode-syntax-table (make-syntax-table)) |
|
38 |
(modify-syntax-entry ?_ "_" etng-r1-mode-syntax-table) |
|
39 |
(modify-syntax-entry ?- ". 12b" etng-r1-mode-syntax-table) |
|
40 |
(mapcar #'(lambda (x) (modify-syntax-entry x "." etng-r1-mode-syntax-table)) |
|
41 |
'(?, ?\; ?+ ?= ?| ?/ ?? ?. ?< ?> ?* ?& ?^ ?% ?$ ?# ?@ ?! ?` ?~)) |
|
42 |
(modify-syntax-entry ?\' "\"" etng-r1-mode-syntax-table)) |
|
43 |
||
44 |
(defconst etng-r1-font-lock-keywords |
|
45 |
(eval-when-compile |
|
46 |
(list |
|
47 |
'(";;" . font-lock-warning-face) |
|
48 |
||
179
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
49 |
;; Method definitions. |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
50 |
'("\\(\\.[a-zA-Z:]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~:]\\)*\\>\\).*->" |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
51 |
(1 font-lock-function-name-face)) |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
52 |
'("define\\s +\\([^: ]*:\\)?\\(\\<[A-Z]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>\\)" |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
53 |
(2 font-lock-type-face)) |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
54 |
;;'("define\\s +\\([a-zA-Z:]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~:]\\)*\\>\\)\\s +=" |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
55 |
;; (1 font-lock-variable-name-face)) |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
56 |
'("define\\s +\\([a-zA-Z:]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~:]\\)*\\>\\)" |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
57 |
(1 font-lock-function-name-face)) |
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
58 |
|
150 | 59 |
;; Atoms. |
179
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
60 |
;;'("\\.[a-zA-Z:]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~:]\\)*\\>" . font-lock-constant-face) |
150 | 61 |
;;'("\\.\\<\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>" . font-lock-constant-face) |
62 |
||
63 |
;; Keywords. |
|
180
699bd98ab59e
Permit let-* to be highlighted, just like define-*
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
179
diff
changeset
|
64 |
'("\\<\\(define\\|let\\)\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>" . font-lock-keyword-face) |
150 | 65 |
;; '("\\<\\(new\\)\\s \\([a-zA-Z]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\|::\\)*\\)\\>" |
66 |
;; (1 font-lock-keyword-face) (2 font-lock-type-face)) |
|
67 |
(regexp-opt |
|
68 |
'( |
|
69 |
"do" |
|
70 |
"in" |
|
71 |
"self" |
|
160 | 72 |
"super" |
150 | 73 |
"nextMethod" |
74 |
;;"letrec" |
|
234
10e62e160cb0
Switch from "[]" to "rec {}", and add "rec selfid {}" form
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
180
diff
changeset
|
75 |
"rec" |
150 | 76 |
"namespace" |
77 |
;;"new" |
|
78 |
"return" |
|
79 |
"exit" |
|
80 |
"catch" |
|
81 |
"handle" |
|
82 |
"case" |
|
83 |
"of" |
|
84 |
"if" |
|
85 |
"else" |
|
86 |
) |
|
87 |
'words) |
|
88 |
||
89 |
;; Namespaces. |
|
90 |
'("\\<[A-Z]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>::" . font-lock-type-face) |
|
91 |
||
92 |
;; Selectors. |
|
93 |
;;'("\\<[A-Z]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>:" . font-lock-function-name-face) |
|
94 |
||
95 |
;; Symbols (by convention). |
|
96 |
'("\\<[A-Z]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>" . font-lock-type-face) |
|
97 |
;;'("\\<[A-Z]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>" . font-lock-constant-face) |
|
98 |
||
99 |
;; Functions. |
|
100 |
;;'("(\\(\\<[a-zA-Z]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>\\)\\($\\|\\s [^-+=_|/?<>*&^%$@!`~#]\\)" |
|
101 |
;;(1 font-lock-function-name-face)) |
|
102 |
||
103 |
;; Variables. |
|
179
0ea141eacbea
Tweak syntax-highlighting
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
160
diff
changeset
|
104 |
;;'("[a-zA-Z:]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~:]\\)*\\>" . font-lock-variable-name-face) |
150 | 105 |
|
106 |
;; Infixops. |
|
107 |
'("\\<[-+=_|/?<>*&^%$@!`~]\\([-a-zA-Z0-9+=_|/?<>*&^%$@!`~]\\)*\\>" |
|
108 |
. font-lock-function-name-face) |
|
109 |
)) |
|
110 |
"Default expressions to highlight in ETNG-R1 mode.") |
|
111 |
||
112 |
(defun tng-mode-variables () |
|
113 |
(make-local-variable 'comment-start) |
|
114 |
(make-local-variable 'comment-end) |
|
115 |
(make-local-variable 'comment-start-skip) |
|
116 |
(setq comment-start "--") |
|
117 |
(setq comment-end "") |
|
118 |
(setq comment-start-skip "-- *") |
|
119 |
(make-local-variable 'c-syntactic-indentation) |
|
120 |
(setq c-syntactic-indentation nil) |
|
121 |
(make-local-variable 'font-lock-defaults) |
|
122 |
(setq font-lock-defaults '(etng-r1-font-lock-keywords nil nil ((?_ . "w"))))) |
|
123 |
||
124 |
;;;###autoload |
|
125 |
(define-derived-mode etng-r1-mode c-mode "ETNG-R1" |
|
126 |
"Major mode for editing ETNG-R1 code. |
|
127 |
This is much like C mode except for the syntax of comments. Its keymap |
|
128 |
inherits from C mode's and it has the same variables for customizing |
|
129 |
indentation. It has its own abbrev table and its own syntax table. |
|
130 |
||
131 |
Turning on ETNG-R1 mode runs `etng-r1-mode-hook'." ;; actually a lie |
|
132 |
(tng-mode-variables)) |
|
133 |
||
134 |
;--------------------------------------------------------------------------- |
|
135 |
||
136 |
(defcustom tng-program-name "./main.scm" |
|
137 |
"*Program invoked by the `run-tng' command." |
|
138 |
:type 'string |
|
139 |
:group 'tng) |
|
140 |
||
141 |
(defcustom inferior-tng-mode-hook nil |
|
142 |
"*Hook for customising inferior-tng mode." |
|
143 |
:type 'hook |
|
144 |
:group 'tng) |
|
145 |
||
146 |
(defvar tng-buffer) |
|
147 |
||
148 |
(define-derived-mode inferior-tng-mode comint-mode "Inferior ThiNG" |
|
149 |
"Major mode for interacting with an inferior ThiNG process." |
|
150 |
;; Customise in inferior-tng-mode-hook |
|
151 |
(setq comint-prompt-regexp "^\"[^\"\n]*\" *") |
|
152 |
(tng-mode-variables) |
|
153 |
(setq mode-line-process '(":%s"))) |
|
154 |
||
155 |
;;;###autoload |
|
156 |
(defun run-tng (cmd) |
|
157 |
"Run an inferior ThiNG process, input and output via buffer *tng*. |
|
158 |
If there is a process already running in `*tng*', switch to that buffer. |
|
159 |
With argument, allows you to edit the command line (default is value |
|
160 |
of `tng-program-name'). Runs the hooks `inferior-tng-mode-hook' |
|
161 |
\(after the `comint-mode-hook' is run). |
|
162 |
\(Type \\[describe-mode] in the process buffer for a list of commands.)" |
|
163 |
(interactive (list (if current-prefix-arg |
|
164 |
(read-string "Run ThiNG: " tng-program-name) |
|
165 |
tng-program-name))) |
|
166 |
(if (not (comint-check-proc "*tng*")) |
|
167 |
(let ((cmdlist (scheme-args-to-list cmd))) |
|
168 |
(set-buffer (apply 'make-comint "tng" (car cmdlist) |
|
169 |
nil (cdr cmdlist))) |
|
170 |
(inferior-tng-mode))) |
|
171 |
(setq tng-program-name cmd) |
|
172 |
(setq tng-buffer "*tng*") |
|
173 |
(pop-to-buffer "*tng*")) |
|
174 |
||
175 |
(provide 'etng-r1-mode) |
|
176 |
||
177 |
;;; etng-r1.el ends here |